MusicBrainz
Instruction how to get information from MusicBrainz database.
Script above shows how to get basic information about entered artist. Script returns list of albums with release date, title, and url to front and back cover (if exits)
Tutorial for MusicBrain is here
First of all we need to check artist id
http://www.musicbrainz.org/ws/2/artist/?query=<artist>
Next we can get xml contains release-list using following link:
http://www.musicbrainz.org/ws/2/release?artist=<artistID>
According to the wiki.musicbrainz.org : cover arts are available via coverartarchive.org
http://coverartarchive.org
bll 2018-11-8: To get information on a known recording, I am using:
http://musicbrainz.org/ws/2/recording/2409871f-6cde-42a1-a017-722b86f87e68?inc=artists%20releases%20media%20artist-credits
Let's try to get some basic info:
package require http
package require tdom
proc ___returnArtistID {artist} {
set r [::http::geturl http://www.musicbrainz.org/ws/2/artist/?query=$artist]
set data [::http::data $r]
::http::cleanup $r
set doc [dom parse $data]
set root [$doc documentElement]
set ns {xmlns http://musicbrainz.org/ns/mmd-2.0#}
set nodesList [$root selectNodes -namespaces $ns //xmlns:artist-list//xmlns:artist]
return [[lindex $nodesList 0] getAttribute id]
}
proc ___coverURL {type id} {
return "http://coverartarchive.org/release/$id/$type"
}
proc ___returnReleases {artistID} {
set r [::http::geturl http://www.musicbrainz.org/ws/2/release?artist=$artistID]
set data [::http::data $r]
::http::cleanup $r
set doc [dom parse $data]
set root [$doc documentElement]
set ns {xmlns http://musicbrainz.org/ns/mmd-2.0#}
set nodesList [$root selectNodes -namespaces $ns //xmlns:release-list//xmlns:release]
#id used in the second query
foreach node $nodesList {
set date ""
set id [$node getAttribute id]
lappend ids $id
set titleNode [$node selectNodes -namespaces $ns //xmlns:release-list//xmlns:release\[@id='$id'\]//xmlns:title]
set dateNodes [$node selectNodes -namespaces $ns //xmlns:release-list//xmlns:release\[@id='$id'\]//xmlns:date]
set coverFrontNode [$node selectNodes -namespaces $ns //xmlns:release-list//xmlns:release\[@id='$id'\]//xmlns:cover-art-archive//xmlns:front]
set coverBackNode [$node selectNodes -namespaces $ns //xmlns:release-list//xmlns:release\[@id='$id'\]//xmlns:cover-art-archive//xmlns:back]
set frontC [expr {[$coverFrontNode text] eq "true" ? [___coverURL "front" $id] : "false" }]
set backC [expr {[$coverFrontNode text] eq "true" ? [___coverURL "back" $id] : "false" }]
puts "##### Title: [$titleNode text] #####"
puts "date: [[lindex $dateNodes 0] text]"
puts "cover front: $frontC"
puts "cover back: $backC"
puts "##### #####"
}
return $ids
}
set artistID [___returnArtistID "portishead"]
set releaseIDs [___returnReleases $artistID]
puts [___returnArtistID "portishead"]DG: I'm trying the JSON interface and prefer it so far. The code is much easier to get inside the data, IMO. JSON Web Service
package require Tcl 8.6 ;# for try and expand {*}
package require tls ;# for https protocol
package require http ;# in tcllib
package require uri ;# in tcllib
# consider, also https://github.com/RubyLane/rl_json
package require json ;# in tcllib
http::register https 443 tls:socket
http::config -useragent {tclBrainz 0.1 alpha test}
proc fetchJSON {uri {recurse_limit 4}} {
http::config -accept "application/json"
set token [http::geturl $uri]
upvar #0 $token state
if {[http::status $token] ne "ok" || [http::ncode $token] != 200} {
# was the error a redirect? If so, do it..
if {[http::ncode $token] == 302 && [incr recurse_limit -1] > 0} {
array set meta $state(meta)
set result [fetchJSON $meta(Location) $recurse_limit]
http::cleanup $token
return $result
}
set err [http::code $token]
http::cleanup $token
return -code error $err
}
set json [http::data $token]
array set meta $state(meta)
http::cleanup $token
# Do we need to do encoding conversions or was it already done
# in transit?
if {[info exist meta(Content-Type)] && \
[regexp -nocase {charset\s*=\s*(\S+)} $meta(Content-Type)]} {
# Socket channel encodings already performed! No Work to do
# here. See section 5.2.2 of the html spec. Server set
# encodings win.
} else {
# When the server doesn't declare an encoding, should we guess?
# BUG: Sloppy server. Send them a bug report.
#set json [encoding convertfrom utf-8 $json]
}
return [json::json2dict $json]
}
proc mblookup {entity mbid {inc {}}} {
array set uri [list scheme http host musicbrainz.org path ws/2]
#set uri(user) XYZPDQ
#set uri(pwd) qweasdzxcrtyfghvbn ;# md5crypt
set uri(path) [file join $uri(path) $entity]
set uri(path) [file join $uri(path) $mbid]
if {$inc ne ""} {
set uri(query) "inc=$inc"
}
return [fetchJSON [uri::join {*}[array get uri]]]
}
# returns a complete and formatted area
proc unwindArea {mbid} {
set result [list]
# town, county, state (subdivision), country
set query [mblookup area $mbid {area-rels}]
if {[llength [dict get $query relations]] != 0} {
foreach relation [dict get $query relations] {
switch -- [dict get $relation type-id] {
"de7cc874-8b1b-3a05-8272-f3834c968fb7" {
# part-of
if {[lsearch [dict keys $relation] "direction"] != -1 &&
[dict get $relation direction] eq "backward"} {
# we are searching backwards and there is only one to find
# skip County
if {[dict get $query type] eq "County"} {
return [list {*}[unwindArea [dict get $relation area id]]]
} else {
return [list [dict get $query name] {*}[unwindArea [dict get $relation area id]]]
}
}
}
default {
continue ;# not usable
}
}
}
}
# when no backward relation exists, we are done and at the top
return [list [lindex [dict get $query iso-3166-1-codes] 0]]
}
# Make filenames safe for all operating systems
# https://stackoverflow.com/questions/1976007/what-characters-are-forbidden-in-windows-and-linux-directory-names
#
proc fnSafe {fname} {
return [string map [list \
: \u2236 \
/ \u29f8 \
* \u204e \
? \uff1f \
\x22 \u2033 \
\x5c \u29f5 \
. \u2024 \
| \u01c0 \
< \u25c2 \
> \u25b8 \
\x00 \u2400 \
\x01 \u2401 \
\x02 \u2402 \
\x03 \u2403 \
\x04 \u2404 \
\x05 \u2405 \
\x06 \u2406 \
\x07 \u2407 \
\x08 \u2408 \
\x09 \u2409 \
\x0a \u240a \
\x0b \u240b \
\x0c \u240c \
\x0d \u240d \
\x0e \u240e \
\x0f \u240f \
\x10 \u2410 \
\x11 \u2411 \
\x12 \u2412 \
\x13 \u2413 \
\x14 \u2414 \
\x15 \u2415 \
\x16 \u2416 \
\x17 \u2417 \
\x18 \u2418 \
\x19 \u2419 \
\x1a \u241a \
\x1b \u241b \
\x1c \u241c \
\x1d \u241d \
\x1e \u241e \
\x1f \u241f \
] $fname]
}
# Remove the useless search assistance info that clouds the purpose
# of disambiguation (aka %_releasecomment% in Picard) on a
# release title.
#
proc processDisambig {disambig} {
set d ""
if {$disambig eq ""} return ""
regexp {^(?:\d{4}-\d{2}-\d{2}.*; ){0,1}(.*)$} $disambig dummy d
return $d
}
# Generate the live bootleg directory name from the
# (new WS/2) advanced relationship information
#
proc genBootlegDirName {mbid} {
array set ri [list]
set query [mblookup release $mbid \
{place-rels+area-rels+release-groups}]
# first check that this is a live, bootleg, single show recording
if {[dict get $query status] ne "Bootleg"} {
return -code error "not a bootleg"
}
set secondaries [dict get $query release-group secondary-types]
if {[lsearch $secondaries "Compilation"] != -1} {
return -code error "compilations are not a single show"
}
if {[lsearch $secondaries "Live"] == -1} {
return -code error "not a live show"
}
foreach relation [dict get $query relations] {
switch -- [dict get $relation type-id] {
"4dda6e40-14af-46bb-bb78-ea22f4a99dfa" {
# event
unset relation
continue ;# not usable. 'held at' is not shared (at this time)
}
"354043e1-bdc2-4c7f-b338-2bf9c1d56e88" {
# area
if {[dict get $relation type] ne "recorded in"} {
unset relation
continue ;# not usable.
}
# use target-credit instead of name, if set
set ri(place) [expr {
[dict get $relation target-credit] ne "" ?
[dict get $relation target-credit] :
[dict get $relation place name]}]
set ri(area) [join [unwindArea \
[dict get $relation place area id]] ", "]
break ;# done
}
"3b1fae9f-5b22-42c5-a40c-d1e5c9b90251" {
# place
if {[dict get $relation type] ne "recorded at"} {
unset relation
continue ;# not usable.
}
# use target-credit instead of name, if set
set ri(place) [expr {
[dict get $relation target-credit] ne "" ?
[dict get $relation target-credit] :
[dict get $relation place name]}]
set ri(area) [join [unwindArea \
[dict get $relation place area id]] ", "]
break ;# done
}
default {
unset relation
continue ;# not usable.
}
}
}
if {![info exist relation]} {
return -code error "recording location not specified"
}
set d [processDisambig [dict get $query disambiguation]]
# replace dash with endash
set ri(date) [string map [list - \u2013] [dict get $relation begin]]
set ri(title) [dict get $query title]
return [fnSafe "$ri(date): $ri(title)[expr {$d ne ""?" ($d)":""}]:\
[expr {$ri(place) ne ""?"$ri(place), ":""}]$ri(area)"]
}
% genBootlegDirName 277decca-ce36-48dd-9115-0d69a14cd955
1971–09–23∶ Ladies and Gentlemen… This Is Led Zeppelin∶ Nippon Budokan, Kitanomaru Kōen, Chiyoda, Tokyo, JP
% genBootlegDirName 0b80625d-87dd-4aa3-a270-3398545efe53
1973–05–26∶ A Memento of Salt Lake City (sb+audc mix)∶ Salt Palace, Salt Lake City, Utah, US
% genBootlegDirName 4dc3c0af-4c56-4900-ba34-65d081ce274d
1973–01–22∶ Any Port in a Storm∶ University of Southampton Students’ Union, Southampton, England, GBIt seems to look good
