| 1 | package MusicBrainz; |
|---|
| 2 | |
|---|
| 3 | use strict; |
|---|
| 4 | use warnings; |
|---|
| 5 | |
|---|
| 6 | our @ISA = qw{Exporter}; |
|---|
| 7 | our @EXPORT = qw{get_musicbrainz_info lookup_release}; |
|---|
| 8 | |
|---|
| 9 | #use WebService::MusicBrainz; |
|---|
| 10 | use LWP; |
|---|
| 11 | use XML::XPath; |
|---|
| 12 | use XML::XPath::XMLParser; |
|---|
| 13 | |
|---|
| 14 | sub lookup_release { |
|---|
| 15 | my ($discid) = @_; |
|---|
| 16 | my $ua = LWP::UserAgent->new; |
|---|
| 17 | |
|---|
| 18 | #my $uri = URI->new('http://musicbrainz.org/ws/1/release/'); |
|---|
| 19 | #$uri->query_form(type => 'xml', discid => $discid); |
|---|
| 20 | my $uri = URI->new("http://musicbrainz.org/ws/2/discid/$discid"); |
|---|
| 21 | $uri->query_form(inc => 'artists+labels+recordings+release-groups+artist-credits'); |
|---|
| 22 | |
|---|
| 23 | my $res = $ua->get($uri); |
|---|
| 24 | # pause for a second, so we don't run afoul of the MusicBrainz API TOS |
|---|
| 25 | sleep 1; |
|---|
| 26 | |
|---|
| 27 | warn $res->status_line, "\n" if $res->code != 200; |
|---|
| 28 | return if $res->code >= 400; |
|---|
| 29 | #TODO: if we get a 5xx error, retry? |
|---|
| 30 | |
|---|
| 31 | return $res->decoded_content; |
|---|
| 32 | } |
|---|
| 33 | |
|---|
| 34 | sub get_musicbrainz_info { |
|---|
| 35 | my ($discid) = @_; |
|---|
| 36 | my %info; |
|---|
| 37 | |
|---|
| 38 | #TODO: deprecate the old MBZ tag name |
|---|
| 39 | $info{MBZ_DISCID} = $discid; |
|---|
| 40 | $info{MUSICBRAINZ_DISCID} = $discid; |
|---|
| 41 | |
|---|
| 42 | my $xpath = XML::XPath->new(); |
|---|
| 43 | my $xml = lookup_release($discid) || return; |
|---|
| 44 | |
|---|
| 45 | $xpath->set_xml($xml); |
|---|
| 46 | |
|---|
| 47 | # get the release; if there is more than one, take the first one |
|---|
| 48 | my $release_count = $xpath->findvalue('count(//release)'); |
|---|
| 49 | my @releases = $xpath->findnodes('//release'); |
|---|
| 50 | my $base = 'http://musicbrainz.org/release/'; |
|---|
| 51 | |
|---|
| 52 | my $i = 1; |
|---|
| 53 | #TODO: use this as the basis for an interactive menu to pick the correct release ID |
|---|
| 54 | warn "$release_count release(s) found matching $discid\n"; |
|---|
| 55 | for my $release (@releases) { |
|---|
| 56 | warn sprintf "%2d) $base%s %s %s (%s)\n", |
|---|
| 57 | $i++, |
|---|
| 58 | $xpath->findvalue('@id', $release)->value, |
|---|
| 59 | $xpath->findvalue('.//label-info/label/name', $release)->value, |
|---|
| 60 | $xpath->findvalue('.//label-info/catalog-number', $release)->value, |
|---|
| 61 | $xpath->findvalue('barcode', $release)->value; |
|---|
| 62 | } |
|---|
| 63 | |
|---|
| 64 | # use the VorbisComment names from here http://musicbrainz.org/doc/MusicBrainz_Picard/Tags/Mapping |
|---|
| 65 | |
|---|
| 66 | # use the first release by default |
|---|
| 67 | # TODO: configurable release selection criteria |
|---|
| 68 | my $release = $releases[0]; |
|---|
| 69 | |
|---|
| 70 | $info{MUSICBRAINZ_ALBUMID} = $xpath->findvalue('@id', $release)->value; |
|---|
| 71 | $info{ALBUM} = $xpath->findvalue('title', $release)->value; |
|---|
| 72 | @info{qw{ALBUMARTIST ALBUMARTISTSORT}} = get_artist_credits($xpath, $release); |
|---|
| 73 | $info{DATE} = $xpath->findvalue('date', $release)->value; |
|---|
| 74 | $info{ORIGINALDATE} = $xpath->findvalue('release-group/first-release-date', $release)->value; |
|---|
| 75 | |
|---|
| 76 | # select the proper medium (important for multidisc releases) |
|---|
| 77 | my ($medium) = $xpath->findnodes("medium-list/medium[disc-list/disc/\@id='$discid']", $release); |
|---|
| 78 | |
|---|
| 79 | # disc position info |
|---|
| 80 | $info{DISCNUMBER} = $xpath->findvalue('position', $medium)->value; |
|---|
| 81 | $info{DISCTOTAL} = $xpath->findvalue('../@count', $medium)->value; |
|---|
| 82 | |
|---|
| 83 | #my $ua = LWP::UserAgent->new; |
|---|
| 84 | my $tracknum = 1; |
|---|
| 85 | for my $track_node ($xpath->findnodes('track-list/track', $medium)) { |
|---|
| 86 | my $prefix = sprintf('TRACK%02d', $tracknum); |
|---|
| 87 | |
|---|
| 88 | $info{"$prefix.MUSICBRAINZ_TRACKID"} = $xpath->findvalue('@id', $track_node)->value; |
|---|
| 89 | |
|---|
| 90 | my ($recording) = $xpath->findnodes('recording', $track_node); |
|---|
| 91 | $info{"$prefix.MUSICBRAINZ_RECORDINGID"} = $xpath->findvalue('@id', $recording)->value; |
|---|
| 92 | $info{"$prefix.TITLE"} = $xpath->findvalue('title', $recording)->value; |
|---|
| 93 | @info{"$prefix.ARTIST", "$prefix.ARTISTSORT"} = get_artist_credits($xpath, $recording); |
|---|
| 94 | |
|---|
| 95 | $info{TRACKS}[$tracknum]{TITLE} = $info{"$prefix.TITLE"}; |
|---|
| 96 | $info{TRACKS}[$tracknum]{ARTIST} = $info{"$prefix.ARTIST"}; |
|---|
| 97 | $info{TRACKS}[$tracknum]{ARTISTSORT} = $info{"$prefix.ARTISTSORT"}; |
|---|
| 98 | |
|---|
| 99 | #my $uri = URI->new("http://musicbrainz.org/ws/2/recording/$recording_mbid"); |
|---|
| 100 | #$uri->query_form(inc => 'artists'); |
|---|
| 101 | #my $res = $ua->get($uri); |
|---|
| 102 | #die $res->decoded_content; |
|---|
| 103 | |
|---|
| 104 | #TODO: get track relations (Covers, etc.) |
|---|
| 105 | |
|---|
| 106 | $tracknum++; |
|---|
| 107 | } |
|---|
| 108 | |
|---|
| 109 | return \%info; |
|---|
| 110 | } |
|---|
| 111 | |
|---|
| 112 | sub get_artist_credits { |
|---|
| 113 | my ($xpath, $context_node) = @_; |
|---|
| 114 | |
|---|
| 115 | # use the MusicBrainz join phrase to build up the multiple artist credits |
|---|
| 116 | my ($credit, $sort_credit) = ('', ''); |
|---|
| 117 | for my $credit_node ($xpath->findnodes('artist-credit/name-credit', $context_node)) { |
|---|
| 118 | $credit .= $xpath->findvalue('concat(artist/name, @joinphrase)', $credit_node)->value; |
|---|
| 119 | $sort_credit .= $xpath->findvalue('concat(artist/sort-name, @joinphrase)', $credit_node)->value; |
|---|
| 120 | } |
|---|
| 121 | |
|---|
| 122 | return ($credit, $sort_credit); |
|---|
| 123 | } |
|---|
| 124 | |
|---|
| 125 | # module return |
|---|
| 126 | 1; |
|---|
| 127 | |
|---|
| 128 | =begin MBZ API version 1 |
|---|
| 129 | |
|---|
| 130 | sub lookup_release { |
|---|
| 131 | my ($discid) = @_; |
|---|
| 132 | my $ua = LWP::UserAgent->new; |
|---|
| 133 | |
|---|
| 134 | my $uri = URI->new('http://musicbrainz.org/ws/1/release/'); |
|---|
| 135 | $uri->query_form(type => 'xml', discid => $discid); |
|---|
| 136 | |
|---|
| 137 | my $res = $ua->get($uri); |
|---|
| 138 | return $res->decoded_content; |
|---|
| 139 | } |
|---|
| 140 | |
|---|
| 141 | sub get_musicbrainz_info { |
|---|
| 142 | my ($discid) = @_; |
|---|
| 143 | my %info; |
|---|
| 144 | |
|---|
| 145 | $info{MBZ_DISCID} = $discid; |
|---|
| 146 | |
|---|
| 147 | my $xpath = XML::XPath->new(); |
|---|
| 148 | |
|---|
| 149 | $xpath->set_xml(lookup_release($discid)); |
|---|
| 150 | |
|---|
| 151 | # TODO: check for more than 1 release? |
|---|
| 152 | |
|---|
| 153 | $info{MB_RELEASE_ID} = $xpath->findvalue('//release/@id'); |
|---|
| 154 | $info{ALBUM} = $xpath->findvalue('//release/title'); |
|---|
| 155 | $info{ARTIST} = $xpath->findvalue('//release/artist/name'); |
|---|
| 156 | $info{TRACKS} = []; |
|---|
| 157 | |
|---|
| 158 | # TODO: get release date |
|---|
| 159 | |
|---|
| 160 | my $tracknum = 1; |
|---|
| 161 | for my $track_node ($xpath->findnodes('//track-list/track')) { |
|---|
| 162 | $info{TRACKS}[$tracknum]{MB_TRACKID} = $xpath->findvalue('@id', $track_node); |
|---|
| 163 | $info{TRACKS}[$tracknum]{TITLE} = $xpath->findvalue('title', $track_node); |
|---|
| 164 | $info{TRACKS}[$tracknum]{ARTIST} = $xpath->findvalue('artist/name', $track_node) || $info{ARTIST}; |
|---|
| 165 | $tracknum++; |
|---|
| 166 | } |
|---|
| 167 | |
|---|
| 168 | return %info; |
|---|
| 169 | } |
|---|
| 170 | |
|---|
| 171 | =cut |
|---|
| 172 | |
|---|
| 173 | =begin WebService::MusicBrainz code |
|---|
| 174 | |
|---|
| 175 | my $ws_artists = WebService::MusicBrainz->new_artist; |
|---|
| 176 | my $ws_releases = WebService::MusicBrainz->new_release; |
|---|
| 177 | my $ws_tracks = WebService::MusicBrainz->new_track; |
|---|
| 178 | |
|---|
| 179 | # search on the discid |
|---|
| 180 | my $response = $ws_releases->search({ DISCID => $discid }); |
|---|
| 181 | |
|---|
| 182 | # save this object, since WS::MBZ deletes it when you fetch it |
|---|
| 183 | # TODO: bug report to WS::MBZ? |
|---|
| 184 | my $release = $response->release; |
|---|
| 185 | |
|---|
| 186 | # return undef if there is no matching release for this DiscID |
|---|
| 187 | return unless defined $release; |
|---|
| 188 | |
|---|
| 189 | # search again, using the MBID of the first release found |
|---|
| 190 | # TODO: deal with multiple releases found? |
|---|
| 191 | # include tracks and artist info |
|---|
| 192 | $response = $ws_releases->search({ |
|---|
| 193 | MBID => $release->id, |
|---|
| 194 | INC => 'discs tracks artist release-events counts', |
|---|
| 195 | }); |
|---|
| 196 | |
|---|
| 197 | # get the fully filled out Release object (that represents the disc) |
|---|
| 198 | $release = $response->release; |
|---|
| 199 | |
|---|
| 200 | if (defined $release->artist) { |
|---|
| 201 | $info{ARTIST} = $release->artist->name; |
|---|
| 202 | } |
|---|
| 203 | if (defined $release->title) { |
|---|
| 204 | $info{ALBUM} = $release->title; |
|---|
| 205 | } |
|---|
| 206 | |
|---|
| 207 | # this is ID3v2:TDRL = Release Date |
|---|
| 208 | # (for now we just take the first date) |
|---|
| 209 | my $release_date = eval { @{ $release->release_event_list->events }[0]->date }; |
|---|
| 210 | $release_date = '' if $@; |
|---|
| 211 | |
|---|
| 212 | $info{DATE} = $release_date; |
|---|
| 213 | |
|---|
| 214 | # get full info on each of the tracks |
|---|
| 215 | my @tracks; |
|---|
| 216 | my $track_num = 1; |
|---|
| 217 | for my $track_id (map { $_->id } @{ $release->track_list->tracks }) { |
|---|
| 218 | my $response = $ws_tracks->search({ |
|---|
| 219 | MBID => $track_id, |
|---|
| 220 | INC => 'artist track-rels', |
|---|
| 221 | }); |
|---|
| 222 | my $track = $response->track; |
|---|
| 223 | my $prefix = sprintf('TRACK%02d', $track_num); |
|---|
| 224 | $info{"$prefix.TITLE"} = $track->title; |
|---|
| 225 | #if (defined $track->artist && $track->artist->name ne $release->artist->name) { |
|---|
| 226 | $info{"$prefix.ARTIST"} = $track->artist->name; |
|---|
| 227 | $info{"$prefix.DATE"} = $release_date; |
|---|
| 228 | #} |
|---|
| 229 | push @tracks, $track; |
|---|
| 230 | |
|---|
| 231 | |
|---|
| 232 | if (defined $track->relation_list) { |
|---|
| 233 | for my $relation (@{ $track->relation_list->relations }) { |
|---|
| 234 | #warn $relation->type, $relation->target; |
|---|
| 235 | my $response = $ws_tracks->search({ |
|---|
| 236 | MBID => $relation->target, |
|---|
| 237 | INC => 'artist releases', |
|---|
| 238 | }); |
|---|
| 239 | my $track = $response->track; |
|---|
| 240 | $info{"$prefix.ORIGINAL_ARTIST"} = $track->artist->name; |
|---|
| 241 | $info{"$prefix.ORIGINAL_ALBUM"} = |
|---|
| 242 | ( (@{ $track->release_list->releases })[0]->title ); |
|---|
| 243 | } |
|---|
| 244 | } |
|---|
| 245 | |
|---|
| 246 | $track_num++; |
|---|
| 247 | } |
|---|
| 248 | |
|---|
| 249 | =cut |
|---|