1 | package MusicBrainz; |
---|
2 | |
---|
3 | use strict; |
---|
4 | use warnings; |
---|
5 | |
---|
6 | our @ISA = qw{Exporter}; |
---|
7 | our @EXPORT = qw{get_musicbrainz_info}; |
---|
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 | $info{MBZ_DISCID} = $discid; |
---|
39 | |
---|
40 | my $xpath = XML::XPath->new(); |
---|
41 | my $xml = lookup_release($discid) || return; |
---|
42 | |
---|
43 | $xpath->set_xml($xml); |
---|
44 | |
---|
45 | # get the release; if there is more than one, take the first one |
---|
46 | # TODO: configurable release selection criteria |
---|
47 | my $release_count = $xpath->findvalue('count(//release)'); |
---|
48 | my ($release) = $xpath->findnodes('//release[1]'); |
---|
49 | $info{RELEASE_MBID} = $xpath->findvalue('@id', $release)->value; |
---|
50 | $info{ALBUM} = $xpath->findvalue('title', $release)->value; |
---|
51 | $info{ARTIST} = $xpath->findvalue('artist-credit/name-credit/artist/name', $release)->value; |
---|
52 | |
---|
53 | # TODO: get release date |
---|
54 | |
---|
55 | # select the proper medium (important for multidisc releases) |
---|
56 | my ($medium) = $xpath->findnodes("medium-list/medium[disc-list/disc/\@id='$discid']", $release); |
---|
57 | |
---|
58 | my $ua = LWP::UserAgent->new; |
---|
59 | my $tracknum = 1; |
---|
60 | for my $track_node ($xpath->findnodes('track-list/track', $medium)) { |
---|
61 | my $prefix = sprintf('TRACK%02d', $tracknum); |
---|
62 | #$info{"$prefix.MB_TRACKID"} = $xpath->findvalue('@id', $track_node); |
---|
63 | my $recording_mbid = $info{"$prefix.RECORDING_MBID"} = $xpath->findvalue('recording/@id', $track_node)->value; |
---|
64 | $info{"$prefix.TITLE"} = $xpath->findvalue('recording/title', $track_node)->value; |
---|
65 | $info{"$prefix.ARTIST"} = $xpath->findvalue('recording/artist-credit/name-credit/artist/name', $track_node)->value || $info{ARTIST}; |
---|
66 | $info{TRACKS}[$tracknum]{TITLE} = $info{"$prefix.TITLE"}; |
---|
67 | $info{TRACKS}[$tracknum]{ARTIST} = $info{"$prefix.ARTIST"}; |
---|
68 | #my $uri = URI->new("http://musicbrainz.org/ws/2/recording/$recording_mbid"); |
---|
69 | #$uri->query_form(inc => 'artists'); |
---|
70 | #my $res = $ua->get($uri); |
---|
71 | #die $res->decoded_content; |
---|
72 | |
---|
73 | #TODO: get track relations (Covers, etc.) |
---|
74 | |
---|
75 | $tracknum++; |
---|
76 | } |
---|
77 | |
---|
78 | return \%info; |
---|
79 | } |
---|
80 | |
---|
81 | # module return |
---|
82 | 1; |
---|
83 | |
---|
84 | =begin MBZ API version 1 |
---|
85 | |
---|
86 | sub lookup_release { |
---|
87 | my ($discid) = @_; |
---|
88 | my $ua = LWP::UserAgent->new; |
---|
89 | |
---|
90 | my $uri = URI->new('http://musicbrainz.org/ws/1/release/'); |
---|
91 | $uri->query_form(type => 'xml', discid => $discid); |
---|
92 | |
---|
93 | my $res = $ua->get($uri); |
---|
94 | return $res->decoded_content; |
---|
95 | } |
---|
96 | |
---|
97 | sub get_musicbrainz_info { |
---|
98 | my ($discid) = @_; |
---|
99 | my %info; |
---|
100 | |
---|
101 | $info{MBZ_DISCID} = $discid; |
---|
102 | |
---|
103 | my $xpath = XML::XPath->new(); |
---|
104 | |
---|
105 | $xpath->set_xml(lookup_release($discid)); |
---|
106 | |
---|
107 | # TODO: check for more than 1 release? |
---|
108 | |
---|
109 | $info{MB_RELEASE_ID} = $xpath->findvalue('//release/@id'); |
---|
110 | $info{ALBUM} = $xpath->findvalue('//release/title'); |
---|
111 | $info{ARTIST} = $xpath->findvalue('//release/artist/name'); |
---|
112 | $info{TRACKS} = []; |
---|
113 | |
---|
114 | # TODO: get release date |
---|
115 | |
---|
116 | my $tracknum = 1; |
---|
117 | for my $track_node ($xpath->findnodes('//track-list/track')) { |
---|
118 | $info{TRACKS}[$tracknum]{MB_TRACKID} = $xpath->findvalue('@id', $track_node); |
---|
119 | $info{TRACKS}[$tracknum]{TITLE} = $xpath->findvalue('title', $track_node); |
---|
120 | $info{TRACKS}[$tracknum]{ARTIST} = $xpath->findvalue('artist/name', $track_node) || $info{ARTIST}; |
---|
121 | $tracknum++; |
---|
122 | } |
---|
123 | |
---|
124 | return %info; |
---|
125 | } |
---|
126 | |
---|
127 | =cut |
---|
128 | |
---|
129 | =begin WebService::MusicBrainz code |
---|
130 | |
---|
131 | my $ws_artists = WebService::MusicBrainz->new_artist; |
---|
132 | my $ws_releases = WebService::MusicBrainz->new_release; |
---|
133 | my $ws_tracks = WebService::MusicBrainz->new_track; |
---|
134 | |
---|
135 | # search on the discid |
---|
136 | my $response = $ws_releases->search({ DISCID => $discid }); |
---|
137 | |
---|
138 | # save this object, since WS::MBZ deletes it when you fetch it |
---|
139 | # TODO: bug report to WS::MBZ? |
---|
140 | my $release = $response->release; |
---|
141 | |
---|
142 | # return undef if there is no matching release for this DiscID |
---|
143 | return unless defined $release; |
---|
144 | |
---|
145 | # search again, using the MBID of the first release found |
---|
146 | # TODO: deal with multiple releases found? |
---|
147 | # include tracks and artist info |
---|
148 | $response = $ws_releases->search({ |
---|
149 | MBID => $release->id, |
---|
150 | INC => 'discs tracks artist release-events counts', |
---|
151 | }); |
---|
152 | |
---|
153 | # get the fully filled out Release object (that represents the disc) |
---|
154 | $release = $response->release; |
---|
155 | |
---|
156 | if (defined $release->artist) { |
---|
157 | $info{ARTIST} = $release->artist->name; |
---|
158 | } |
---|
159 | if (defined $release->title) { |
---|
160 | $info{ALBUM} = $release->title; |
---|
161 | } |
---|
162 | |
---|
163 | # this is ID3v2:TDRL = Release Date |
---|
164 | # (for now we just take the first date) |
---|
165 | my $release_date = eval { @{ $release->release_event_list->events }[0]->date }; |
---|
166 | $release_date = '' if $@; |
---|
167 | |
---|
168 | $info{DATE} = $release_date; |
---|
169 | |
---|
170 | # get full info on each of the tracks |
---|
171 | my @tracks; |
---|
172 | my $track_num = 1; |
---|
173 | for my $track_id (map { $_->id } @{ $release->track_list->tracks }) { |
---|
174 | my $response = $ws_tracks->search({ |
---|
175 | MBID => $track_id, |
---|
176 | INC => 'artist track-rels', |
---|
177 | }); |
---|
178 | my $track = $response->track; |
---|
179 | my $prefix = sprintf('TRACK%02d', $track_num); |
---|
180 | $info{"$prefix.TITLE"} = $track->title; |
---|
181 | #if (defined $track->artist && $track->artist->name ne $release->artist->name) { |
---|
182 | $info{"$prefix.ARTIST"} = $track->artist->name; |
---|
183 | $info{"$prefix.DATE"} = $release_date; |
---|
184 | #} |
---|
185 | push @tracks, $track; |
---|
186 | |
---|
187 | |
---|
188 | if (defined $track->relation_list) { |
---|
189 | for my $relation (@{ $track->relation_list->relations }) { |
---|
190 | #warn $relation->type, $relation->target; |
---|
191 | my $response = $ws_tracks->search({ |
---|
192 | MBID => $relation->target, |
---|
193 | INC => 'artist releases', |
---|
194 | }); |
---|
195 | my $track = $response->track; |
---|
196 | $info{"$prefix.ORIGINAL_ARTIST"} = $track->artist->name; |
---|
197 | $info{"$prefix.ORIGINAL_ALBUM"} = |
---|
198 | ( (@{ $track->release_list->releases })[0]->title ); |
---|
199 | } |
---|
200 | } |
---|
201 | |
---|
202 | $track_num++; |
---|
203 | } |
---|
204 | |
---|
205 | =cut |
---|