| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Audio::Ofa::Util; | 
| 2 | 2 |  |  | 2 |  | 46001 | use strict; | 
|  | 2 |  |  |  |  | 5 |  | 
|  | 2 |  |  |  |  | 82 |  | 
| 3 | 2 |  |  | 2 |  | 11 | use warnings; | 
|  | 2 |  |  |  |  | 3 |  | 
|  | 2 |  |  |  |  | 63 |  | 
| 4 | 2 |  |  | 2 |  | 2055 | use Audio::Ofa qw(OFA_LITTLE_ENDIAN ofa_create_print); | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | use Audio::Extract::PCM; | 
| 6 |  |  |  |  |  |  | use Carp; | 
| 7 |  |  |  |  |  |  | use LWP::UserAgent; | 
| 8 |  |  |  |  |  |  | use XML::Simple; | 
| 9 |  |  |  |  |  |  | use Time::HiRes; | 
| 10 |  |  |  |  |  |  | use base qw(Class::Accessor::Fast); | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | our $VERSION = '0.04'; | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | =head1 NAME | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | Audio::Ofa::Util - Retrieve audio fingerprints and metadata for unknown audio files | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | This module tries to make retrieving audio fingerprints and metadata for | 
| 22 |  |  |  |  |  |  | unknown audio files as easy as possible.  It interfaces with the modules | 
| 23 |  |  |  |  |  |  | L and L, provides a simple L based | 
| 24 |  |  |  |  |  |  | interface to the MusicDNS library, and can make use of L to | 
| 25 |  |  |  |  |  |  | read some popular music formats. | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | The most comprehensive way to use this is to start with a (possibly untagged) | 
| 28 |  |  |  |  |  |  | file name and get full metadata: | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | my $util = Audio::Ofa::Util->new(filename => 'song.ogg'); | 
| 31 |  |  |  |  |  |  | my @tracks = $util->musicbrainz_lookup or die $util->error; | 
| 32 |  |  |  |  |  |  | for (@tracks) { | 
| 33 |  |  |  |  |  |  | print 'Artist: ', $_->artist, "\n"; | 
| 34 |  |  |  |  |  |  | print 'Title:  ', $_->title, "\n"; | 
| 35 |  |  |  |  |  |  | print 'Track:  ', $_->track, "\n"; | 
| 36 |  |  |  |  |  |  | print 'Album:  ', $_->album, "\n\n"; | 
| 37 |  |  |  |  |  |  | } | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | To create an audio fingerprint: | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | my $util = Audio::Ofa::Util->new(filename => 'song.ogg'); | 
| 42 |  |  |  |  |  |  | $util->analyze_file or die $util->error; | 
| 43 |  |  |  |  |  |  | print $util->fingerprint, "\n"; | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | To create a fingerprint B look it up at MusicDNS: | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  | my $util = Audio::Ofa::Util->new(filename => 'song.ogg'); | 
| 48 |  |  |  |  |  |  | $util->musicdns_lookup or die $util->error; # calls analyze_file implicitly | 
| 49 |  |  |  |  |  |  | print $util->artist, ' - ', $util->title, "\n"; | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | To look up a known fingerprint at MusicDNS (you need the length of the song, too): | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | my $util = Audio::Ofa::Util->new(fingerprint => $fp, duration => $millisecs); | 
| 54 |  |  |  |  |  |  |  | 
| 55 |  |  |  |  |  |  | The overall process goes like this: | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | =over 8 | 
| 58 |  |  |  |  |  |  |  | 
| 59 |  |  |  |  |  |  | =item * | 
| 60 |  |  |  |  |  |  |  | 
| 61 |  |  |  |  |  |  | We create an audio fingerprint, which stores some characteristics of a | 
| 62 |  |  |  |  |  |  | recording in a rather small amount of data.  This is what libofa (and the Perl | 
| 63 |  |  |  |  |  |  | binding in L) does.  This module (L) faciliates | 
| 64 |  |  |  |  |  |  | this with L by allowing to fingerprint some widely used music | 
| 65 |  |  |  |  |  |  | formats and storing the results so they can be used for the next steps: | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | =item * | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | The audio fingerprint is submitted to the MusicDNS web service.  Using a | 
| 70 |  |  |  |  |  |  | proprietary fuzzy algorithm and their database, they determine which song we | 
| 71 |  |  |  |  |  |  | have at hand.  MusicDNS returns B metadeta: The artist, the song title, | 
| 72 |  |  |  |  |  |  | and a PUID.  This "portable unique identifier" is an arbitrary index into their | 
| 73 |  |  |  |  |  |  | database and is unique for every recording of a given song. | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | Note that while libofa's audio fingerprints may change after transformations of | 
| 76 |  |  |  |  |  |  | a recording (such as lossy audio compression or radio transmission), the fuzzy | 
| 77 |  |  |  |  |  |  | algorithm will (ideally) still find the same PUID. | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | =item * | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  | Because we usually want to know more than the artist and title, we look up the | 
| 82 |  |  |  |  |  |  | PUID in a second Web Database called MusicBrainz.  It provides us with all | 
| 83 |  |  |  |  |  |  | desired metadata such as all the albums the song has appeared on in this | 
| 84 |  |  |  |  |  |  | particular version, and the respective track numbers. | 
| 85 |  |  |  |  |  |  |  | 
| 86 |  |  |  |  |  |  | This module provides a basic MusicBrainz PUID lookup through | 
| 87 |  |  |  |  |  |  | L.  If you want to know even more (such as members of the | 
| 88 |  |  |  |  |  |  | band and the previous bands of those members), you can use | 
| 89 |  |  |  |  |  |  | L, to which this module provides an easy frontend. | 
| 90 |  |  |  |  |  |  |  | 
| 91 |  |  |  |  |  |  | =back | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | =cut | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  |  | 
| 96 |  |  |  |  |  |  | my %musicdns_parameters = ( | 
| 97 |  |  |  |  |  |  | client_id      => ['cid', 'c44f70e49000dd7c0d1388bff2bf4152'], | 
| 98 |  |  |  |  |  |  | client_version => ['cvr', __PACKAGE__ . '-' . __PACKAGE__->VERSION], | 
| 99 |  |  |  |  |  |  | fingerprint    => ['fpt', undef], | 
| 100 |  |  |  |  |  |  | metadata       => ['rmd', 1], | 
| 101 |  |  |  |  |  |  | bitrate        => ['brt', 0], | 
| 102 |  |  |  |  |  |  | extension      => ['fmt', 'unknown'], | 
| 103 |  |  |  |  |  |  | duration       => ['dur', undef], | 
| 104 |  |  |  |  |  |  | artist         => ['art', 'unknown'], | 
| 105 |  |  |  |  |  |  | title          => ['ttl', 'unknown'], | 
| 106 |  |  |  |  |  |  | album          => ['alb', 'unknown'], | 
| 107 |  |  |  |  |  |  | track          => ['tnm', 0], | 
| 108 |  |  |  |  |  |  | genre          => ['gnr', 'unknown'], | 
| 109 |  |  |  |  |  |  | year           => ['yrr', 0], | 
| 110 |  |  |  |  |  |  | #encoding       => ["enc=%s", undef],       // Encoding. e = true: ISO-8859-15; e = false: UTF-8 (default). Optional. | 
| 111 |  |  |  |  |  |  | ); | 
| 112 |  |  |  |  |  |  |  | 
| 113 |  |  |  |  |  |  |  | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | my %fields; | 
| 116 |  |  |  |  |  |  | @fields{'filename', 'puids', 'error', keys %musicdns_parameters} = (); | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | __PACKAGE__->mk_accessors(keys %fields); | 
| 119 |  |  |  |  |  |  |  | 
| 120 |  |  |  |  |  |  |  | 
| 121 |  |  |  |  |  |  | =head1 ACCESSORS | 
| 122 |  |  |  |  |  |  |  | 
| 123 |  |  |  |  |  |  | =head2 filename | 
| 124 |  |  |  |  |  |  |  | 
| 125 |  |  |  |  |  |  | See L. | 
| 126 |  |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | =head2 fingerprint, duration | 
| 128 |  |  |  |  |  |  |  | 
| 129 |  |  |  |  |  |  | See L and L. | 
| 130 |  |  |  |  |  |  |  | 
| 131 |  |  |  |  |  |  | =head2 client_id, client_version, metadata, bitrate, extension, artist, title, | 
| 132 |  |  |  |  |  |  | album, track, genre, year, puids | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | See L. | 
| 135 |  |  |  |  |  |  |  | 
| 136 |  |  |  |  |  |  | Note that puids accesses an array reference.  If it is not defined or not set, | 
| 137 |  |  |  |  |  |  | it means that no PUID has been looked up yet.  If it is an empty array, it | 
| 138 |  |  |  |  |  |  | means that no PUIDs were found. | 
| 139 |  |  |  |  |  |  |  | 
| 140 |  |  |  |  |  |  | =head2 error | 
| 141 |  |  |  |  |  |  |  | 
| 142 |  |  |  |  |  |  | Description of the last error that happened. | 
| 143 |  |  |  |  |  |  |  | 
| 144 |  |  |  |  |  |  |  | 
| 145 |  |  |  |  |  |  | =head1 METHODS | 
| 146 |  |  |  |  |  |  |  | 
| 147 |  |  |  |  |  |  | =head2 new | 
| 148 |  |  |  |  |  |  |  | 
| 149 |  |  |  |  |  |  | Constructor.  Accepts key-value pairs as initializers for all of the fields, | 
| 150 |  |  |  |  |  |  | c.f. L, but currently only the following calls make sense: | 
| 151 |  |  |  |  |  |  |  | 
| 152 |  |  |  |  |  |  | Audio::Ofa::Util->new(filename => $filename); | 
| 153 |  |  |  |  |  |  | Audio::Ofa::Util->new(fingerprint => $fp, duration => $dur); | 
| 154 |  |  |  |  |  |  | Audio::Ofa::Util->new(puid => $puid); | 
| 155 |  |  |  |  |  |  |  | 
| 156 |  |  |  |  |  |  | =cut | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  | sub new { | 
| 159 |  |  |  |  |  |  | my $class = shift; | 
| 160 |  |  |  |  |  |  |  | 
| 161 |  |  |  |  |  |  | my (%args) = @_; | 
| 162 |  |  |  |  |  |  | for my $key (keys %args) { | 
| 163 |  |  |  |  |  |  | croak "Bad key $key" unless exists $fields{$key}; | 
| 164 |  |  |  |  |  |  | if ('puids' eq $key && 'ARRAY' ne ref $args{$key}) { | 
| 165 |  |  |  |  |  |  | croak 'puids: Array expected'; | 
| 166 |  |  |  |  |  |  | } | 
| 167 |  |  |  |  |  |  | } | 
| 168 |  |  |  |  |  |  |  | 
| 169 |  |  |  |  |  |  | return bless \%args, $class; | 
| 170 |  |  |  |  |  |  | } | 
| 171 |  |  |  |  |  |  |  | 
| 172 |  |  |  |  |  |  |  | 
| 173 |  |  |  |  |  |  | use constant FREQ => 44100; | 
| 174 |  |  |  |  |  |  |  | 
| 175 |  |  |  |  |  |  |  | 
| 176 |  |  |  |  |  |  | =head2 analyze_file | 
| 177 |  |  |  |  |  |  |  | 
| 178 |  |  |  |  |  |  | This creates an Audio Fingerprint of a sound file.  The audio file is read | 
| 179 |  |  |  |  |  |  | using L, which currently uses the extarnal "sox" program | 
| 180 |  |  |  |  |  |  | and supports encodings such as MP3, Ogg/Vorbis and many others. | 
| 181 |  |  |  |  |  |  |  | 
| 182 |  |  |  |  |  |  | You must set C before calling this method. | 
| 183 |  |  |  |  |  |  |  | 
| 184 |  |  |  |  |  |  | The fingerprint is calculated by L, and the | 
| 185 |  |  |  |  |  |  | C field of the object will be set. | 
| 186 |  |  |  |  |  |  | Additionally, the C (in milliseconds) and the C will be | 
| 187 |  |  |  |  |  |  | set to the values provided by the file name. | 
| 188 |  |  |  |  |  |  |  | 
| 189 |  |  |  |  |  |  | In case of an error, an empty list is returned and the error message can be | 
| 190 |  |  |  |  |  |  | retrieved via L.  Otherwise, a true value will be returned. | 
| 191 |  |  |  |  |  |  |  | 
| 192 |  |  |  |  |  |  | =cut | 
| 193 |  |  |  |  |  |  |  | 
| 194 |  |  |  |  |  |  |  | 
| 195 |  |  |  |  |  |  | sub analyze_file { | 
| 196 |  |  |  |  |  |  | my $this = shift; | 
| 197 |  |  |  |  |  |  |  | 
| 198 |  |  |  |  |  |  | my $fn = $this->filename; | 
| 199 |  |  |  |  |  |  | croak 'No filename given' unless defined $fn; | 
| 200 |  |  |  |  |  |  |  | 
| 201 |  |  |  |  |  |  | use bytes; | 
| 202 |  |  |  |  |  |  |  | 
| 203 |  |  |  |  |  |  | my $extractor = Audio::Extract::PCM->new($fn); | 
| 204 |  |  |  |  |  |  | my $pcm = $extractor->pcm(FREQ, 2, 2); | 
| 205 |  |  |  |  |  |  |  | 
| 206 |  |  |  |  |  |  | unless (defined $pcm) { | 
| 207 |  |  |  |  |  |  | $this->error('Could not extract audio data: ' . $extractor->error); | 
| 208 |  |  |  |  |  |  | return (); | 
| 209 |  |  |  |  |  |  | } | 
| 210 |  |  |  |  |  |  |  | 
| 211 |  |  |  |  |  |  | my $duration = int (1000 * length($$pcm) / (2*2) / FREQ); # 2 channels, 2 bytes per sample | 
| 212 |  |  |  |  |  |  |  | 
| 213 |  |  |  |  |  |  | # Fingerprinting only uses the first 135 seconds; we throw away the rest. | 
| 214 |  |  |  |  |  |  | # Certainly it would be more efficient to instruct sox not to generate more | 
| 215 |  |  |  |  |  |  | # than 135 seconds; however we need the rest to calculate the duration. | 
| 216 |  |  |  |  |  |  | # Unless I find a possibility to find out the duration from as many file | 
| 217 |  |  |  |  |  |  | # formats as sox supports, I will probably use this unefficient solution. | 
| 218 |  |  |  |  |  |  | # It's just a matter of Pink Floyd vs. Ramones. | 
| 219 |  |  |  |  |  |  | my $s135 = (2*2)*FREQ*135; | 
| 220 |  |  |  |  |  |  | substr($$pcm, $s135, length($$pcm)-$s135, '') if $s135 < length($$pcm); | 
| 221 |  |  |  |  |  |  |  | 
| 222 |  |  |  |  |  |  | # This is usually the same, but "use bytes" has no effect here. | 
| 223 |  |  |  |  |  |  | # substr($pcm, $s135) = '' if length($pcm) > $s135; | 
| 224 |  |  |  |  |  |  |  | 
| 225 |  |  |  |  |  |  | my $fp = ofa_create_print($$pcm, OFA_LITTLE_ENDIAN, length($$pcm)/2, FREQ, 1); | 
| 226 |  |  |  |  |  |  | undef $$pcm; | 
| 227 |  |  |  |  |  |  | unless ($fp) { | 
| 228 |  |  |  |  |  |  | $this->error("Fingerprint could not be calculated"); | 
| 229 |  |  |  |  |  |  | return (); | 
| 230 |  |  |  |  |  |  | } | 
| 231 |  |  |  |  |  |  |  | 
| 232 |  |  |  |  |  |  | my ($extension) = $fn =~ /^\.([a-z0-9])\z/i; | 
| 233 |  |  |  |  |  |  |  | 
| 234 |  |  |  |  |  |  | $this->fingerprint($fp); | 
| 235 |  |  |  |  |  |  | $this->duration($duration); | 
| 236 |  |  |  |  |  |  | $this->extension($extension); | 
| 237 |  |  |  |  |  |  |  | 
| 238 |  |  |  |  |  |  | return 1; | 
| 239 |  |  |  |  |  |  | } | 
| 240 |  |  |  |  |  |  |  | 
| 241 |  |  |  |  |  |  |  | 
| 242 |  |  |  |  |  |  | =head2 musicdns_lookup | 
| 243 |  |  |  |  |  |  |  | 
| 244 |  |  |  |  |  |  | This looks up a track at the MusicDNS web service. | 
| 245 |  |  |  |  |  |  |  | 
| 246 |  |  |  |  |  |  | To do a fingerprint lookup, the keys C and C must be | 
| 247 |  |  |  |  |  |  | present, where duration is the length of the song in milli seconds. | 
| 248 |  |  |  |  |  |  | Additionally, the following fields (defaults in parentheses) will be sent to | 
| 249 |  |  |  |  |  |  | the MusicDNS service: | 
| 250 |  |  |  |  |  |  |  | 
| 251 |  |  |  |  |  |  | client_id (hardcoded client id), client_version (module name and version), | 
| 252 |  |  |  |  |  |  | fingerprint, metadata (1), bitrate (0), extension ("unknown"), duration, artist | 
| 253 |  |  |  |  |  |  | ("unknown"), title ("unknown"), album ("unknown"), track (0), genre | 
| 254 |  |  |  |  |  |  | ("unknown"), year (0). | 
| 255 |  |  |  |  |  |  |  | 
| 256 |  |  |  |  |  |  | To do a fingerprint lookup, C and C must have been set | 
| 257 |  |  |  |  |  |  | (can be given to L), where C is the song length in milli | 
| 258 |  |  |  |  |  |  | seconds. | 
| 259 |  |  |  |  |  |  |  | 
| 260 |  |  |  |  |  |  | If C hasn't been set, L is called implicitly. | 
| 261 |  |  |  |  |  |  |  | 
| 262 |  |  |  |  |  |  | client_id defaults to a hard-coded Client ID.  You can get your own from | 
| 263 |  |  |  |  |  |  | http://www.musicip.com. | 
| 264 |  |  |  |  |  |  |  | 
| 265 |  |  |  |  |  |  | You should set as much of the above-mentioned metadata (like artist, etc.) as | 
| 266 |  |  |  |  |  |  | you have available, because the MusicDNS terms of service require this in order | 
| 267 |  |  |  |  |  |  | to help clean errors in their database. | 
| 268 |  |  |  |  |  |  |  | 
| 269 |  |  |  |  |  |  | In the case of an error, C returns an empty list and the error | 
| 270 |  |  |  |  |  |  | message can be retrieved with the L method. | 
| 271 |  |  |  |  |  |  |  | 
| 272 |  |  |  |  |  |  | In the case of success, C sets the fields C to the | 
| 273 |  |  |  |  |  |  | found PUIDs, and sets the fields C and C to the first of the | 
| 274 |  |  |  |  |  |  | found values, and returns a true value.  In list context, it returns a list of | 
| 275 |  |  |  |  |  |  | objects which have C, C and C methods. | 
| 276 |  |  |  |  |  |  |  | 
| 277 |  |  |  |  |  |  | =cut | 
| 278 |  |  |  |  |  |  |  | 
| 279 |  |  |  |  |  |  |  | 
| 280 |  |  |  |  |  |  | sub musicdns_lookup { | 
| 281 |  |  |  |  |  |  | my $this = shift; | 
| 282 |  |  |  |  |  |  |  | 
| 283 |  |  |  |  |  |  | if (defined $this->fingerprint) { | 
| 284 |  |  |  |  |  |  | unless (defined $this->duration) { | 
| 285 |  |  |  |  |  |  | croak 'Fingerprint was given but duration wasn\'t'; | 
| 286 |  |  |  |  |  |  | } | 
| 287 |  |  |  |  |  |  | } else { | 
| 288 |  |  |  |  |  |  | $this->analyze_file or return (); | 
| 289 |  |  |  |  |  |  | } | 
| 290 |  |  |  |  |  |  |  | 
| 291 |  |  |  |  |  |  | my %req_params; | 
| 292 |  |  |  |  |  |  |  | 
| 293 |  |  |  |  |  |  | while (my ($key, $val) = each %musicdns_parameters) { | 
| 294 |  |  |  |  |  |  | my ($param, $default) = @$val; | 
| 295 |  |  |  |  |  |  |  | 
| 296 |  |  |  |  |  |  | if (defined $this->$key()) { | 
| 297 |  |  |  |  |  |  | $req_params{$param} = $this->$key(); | 
| 298 |  |  |  |  |  |  |  | 
| 299 |  |  |  |  |  |  | } elsif (defined $default) { | 
| 300 |  |  |  |  |  |  | $req_params{$param} = $default; | 
| 301 |  |  |  |  |  |  | } | 
| 302 |  |  |  |  |  |  | } | 
| 303 |  |  |  |  |  |  | utf8::encode($_) for values %req_params; | 
| 304 |  |  |  |  |  |  |  | 
| 305 |  |  |  |  |  |  | my $url = 'http://ofa.musicdns.org/ofa/1/track'; | 
| 306 |  |  |  |  |  |  | my $ua = LWP::UserAgent->new; | 
| 307 |  |  |  |  |  |  | $ua->env_proxy; | 
| 308 |  |  |  |  |  |  |  | 
| 309 |  |  |  |  |  |  | #use Data::Dumper; | 
| 310 |  |  |  |  |  |  | #warn Dumper \%req_params; | 
| 311 |  |  |  |  |  |  |  | 
| 312 |  |  |  |  |  |  | my $response = $ua->post($url, \%req_params); | 
| 313 |  |  |  |  |  |  |  | 
| 314 |  |  |  |  |  |  | unless ($response->is_success) { | 
| 315 |  |  |  |  |  |  | $this->error('Server says ' . $response->status_line); | 
| 316 |  |  |  |  |  |  | return (); | 
| 317 |  |  |  |  |  |  | } | 
| 318 |  |  |  |  |  |  |  | 
| 319 |  |  |  |  |  |  | unless ('text/xml' eq $response->header('Content-Type')) { | 
| 320 |  |  |  |  |  |  | $this->error('Unexpected content type: ' . $response->header('Content-Type')); | 
| 321 |  |  |  |  |  |  | return (); | 
| 322 |  |  |  |  |  |  | } | 
| 323 |  |  |  |  |  |  |  | 
| 324 |  |  |  |  |  |  | unless (defined $response->content) { | 
| 325 |  |  |  |  |  |  | $this->error('No content'); | 
| 326 |  |  |  |  |  |  | return (); | 
| 327 |  |  |  |  |  |  | } | 
| 328 |  |  |  |  |  |  |  | 
| 329 |  |  |  |  |  |  | my $xml = XMLin($response->content, ForceArray => ['track', 'puid']); | 
| 330 |  |  |  |  |  |  |  | 
| 331 |  |  |  |  |  |  | # warn Dumper $xml; | 
| 332 |  |  |  |  |  |  |  | 
| 333 |  |  |  |  |  |  | my @return = map { | 
| 334 |  |  |  |  |  |  | +{ | 
| 335 |  |  |  |  |  |  | title => $_->{title}, | 
| 336 |  |  |  |  |  |  | artist => $_->{artist}{name}, | 
| 337 |  |  |  |  |  |  | puids => [keys %{$_->{'puid-list'}{puid}}], | 
| 338 |  |  |  |  |  |  | }; | 
| 339 |  |  |  |  |  |  | } @{$xml->{track}}; | 
| 340 |  |  |  |  |  |  |  | 
| 341 |  |  |  |  |  |  | $this->error('No tracks returned') unless @return; | 
| 342 |  |  |  |  |  |  |  | 
| 343 |  |  |  |  |  |  | $this->puids([map @{$_->{puids}}, @return]); | 
| 344 |  |  |  |  |  |  | $this->title($return[0]{title}); | 
| 345 |  |  |  |  |  |  | $this->artist($return[0]{artist}); | 
| 346 |  |  |  |  |  |  |  | 
| 347 |  |  |  |  |  |  | if (wantarray) { | 
| 348 |  |  |  |  |  |  | return map Audio::Ofa::Util::Metadata->new( | 
| 349 |  |  |  |  |  |  | $_->{artist}, $_->{title}, $_->{puids}[0] | 
| 350 |  |  |  |  |  |  | ), @return; | 
| 351 |  |  |  |  |  |  | } else { | 
| 352 |  |  |  |  |  |  | return 1; | 
| 353 |  |  |  |  |  |  | } | 
| 354 |  |  |  |  |  |  | } | 
| 355 |  |  |  |  |  |  |  | 
| 356 |  |  |  |  |  |  |  | 
| 357 |  |  |  |  |  |  | =head2 musicbrainz_lookup | 
| 358 |  |  |  |  |  |  |  | 
| 359 |  |  |  |  |  |  | This looks up a PUID at MusicBrainz.  The PUID can come from a call to | 
| 360 |  |  |  |  |  |  | L.  In fact this is implicitly done if there is no PUID | 
| 361 |  |  |  |  |  |  | stored in the object (cf. L). | 
| 362 |  |  |  |  |  |  |  | 
| 363 |  |  |  |  |  |  | This returns a list of L objects on | 
| 364 |  |  |  |  |  |  | success, or the first of them in scalar context. | 
| 365 |  |  |  |  |  |  | Otherwise it returns an empty list and the error message can be retrieved via | 
| 366 |  |  |  |  |  |  | the L method. | 
| 367 |  |  |  |  |  |  |  | 
| 368 |  |  |  |  |  |  | This method returns a list of tracks or the first track in scalar context.  The | 
| 369 |  |  |  |  |  |  | tracks are represented as objects that are guaranteed to have the methods | 
| 370 |  |  |  |  |  |  | C, C, C, C | 
| 371 |  |  |  |  |  |  | L object, and the four former return | 
| 372 |  |  |  |  |  |  | values that have been retrieved from that object for your convenience. | 
| 373 |  |  |  |  |  |  |  | 
| 374 |  |  |  |  |  |  | In the case of an error, an empty list is returned and the error can be | 
| 375 |  |  |  |  |  |  | returned via the L method. | 
| 376 |  |  |  |  |  |  |  | 
| 377 |  |  |  |  |  |  | =cut | 
| 378 |  |  |  |  |  |  |  | 
| 379 |  |  |  |  |  |  |  | 
| 380 |  |  |  |  |  |  | # MusicBrainz demands that we not look up more often than once a second. | 
| 381 |  |  |  |  |  |  | my $last_mb_lookup = 0; | 
| 382 |  |  |  |  |  |  |  | 
| 383 |  |  |  |  |  |  |  | 
| 384 |  |  |  |  |  |  | sub musicbrainz_lookup { | 
| 385 |  |  |  |  |  |  | my $this = shift; | 
| 386 |  |  |  |  |  |  | my (%args) = @_; | 
| 387 |  |  |  |  |  |  |  | 
| 388 |  |  |  |  |  |  | require WebService::MusicBrainz::Track; | 
| 389 |  |  |  |  |  |  |  | 
| 390 |  |  |  |  |  |  | unless ($this->puids) { | 
| 391 |  |  |  |  |  |  | $this->musicdns_lookup or return (); | 
| 392 |  |  |  |  |  |  | } | 
| 393 |  |  |  |  |  |  | my @puids = @{ $this->puids }; | 
| 394 |  |  |  |  |  |  |  | 
| 395 |  |  |  |  |  |  | my @tracks; | 
| 396 |  |  |  |  |  |  | my $searcherror; | 
| 397 |  |  |  |  |  |  |  | 
| 398 |  |  |  |  |  |  | for my $puid (@puids) { | 
| 399 |  |  |  |  |  |  |  | 
| 400 |  |  |  |  |  |  | my $next_lookup_in = $last_mb_lookup + 1 - Time::HiRes::time(); | 
| 401 |  |  |  |  |  |  | if ($next_lookup_in > 0 && $next_lookup_in < 1) { | 
| 402 |  |  |  |  |  |  | Time::HiRes::sleep($next_lookup_in); | 
| 403 |  |  |  |  |  |  | } | 
| 404 |  |  |  |  |  |  | $last_mb_lookup = Time::HiRes::time(); | 
| 405 |  |  |  |  |  |  |  | 
| 406 |  |  |  |  |  |  | my $ws = WebService::MusicBrainz::Track->new(); | 
| 407 |  |  |  |  |  |  |  | 
| 408 |  |  |  |  |  |  | local $@; | 
| 409 |  |  |  |  |  |  | local $SIG{__DIE__}; | 
| 410 |  |  |  |  |  |  |  | 
| 411 |  |  |  |  |  |  | my $resp = eval { $ws->search({ PUID => $puid }) }; | 
| 412 |  |  |  |  |  |  |  | 
| 413 |  |  |  |  |  |  | unless ($resp && $resp->track_list) { | 
| 414 |  |  |  |  |  |  | if ($@) { | 
| 415 |  |  |  |  |  |  | # search throws exception e.g. for "503 Service Temporarily | 
| 416 |  |  |  |  |  |  | # Unavailable" errors | 
| 417 |  |  |  |  |  |  | $this->error("$@"); | 
| 418 |  |  |  |  |  |  | return (); | 
| 419 |  |  |  |  |  |  | } | 
| 420 |  |  |  |  |  |  |  | 
| 421 |  |  |  |  |  |  | $searcherror = 'search failed'; | 
| 422 |  |  |  |  |  |  | next; | 
| 423 |  |  |  |  |  |  | } | 
| 424 |  |  |  |  |  |  |  | 
| 425 |  |  |  |  |  |  | push @tracks, $resp->track_list; | 
| 426 |  |  |  |  |  |  | } | 
| 427 |  |  |  |  |  |  |  | 
| 428 |  |  |  |  |  |  | unless (@tracks) { | 
| 429 |  |  |  |  |  |  | $this->error($searcherror || 'no tracks were returned'); | 
| 430 |  |  |  |  |  |  | } | 
| 431 |  |  |  |  |  |  |  | 
| 432 |  |  |  |  |  |  | $_ = Audio::Ofa::Util::Metadata->new($_) for @tracks; | 
| 433 |  |  |  |  |  |  |  | 
| 434 |  |  |  |  |  |  | return wantarray ? @tracks : $tracks[0]; | 
| 435 |  |  |  |  |  |  | } | 
| 436 |  |  |  |  |  |  |  | 
| 437 |  |  |  |  |  |  |  | 
| 438 |  |  |  |  |  |  | package # hide from PAUSE | 
| 439 |  |  |  |  |  |  | Audio::Ofa::Util::Metadata; | 
| 440 |  |  |  |  |  |  | use strict; | 
| 441 |  |  |  |  |  |  | use warnings; | 
| 442 |  |  |  |  |  |  | use base qw(Class::Accessor::Fast); | 
| 443 |  |  |  |  |  |  | __PACKAGE__->mk_accessors(qw(title artist album track wsres puid)); | 
| 444 |  |  |  |  |  |  |  | 
| 445 |  |  |  |  |  |  | sub new { | 
| 446 |  |  |  |  |  |  | my $class = shift; | 
| 447 |  |  |  |  |  |  | my $this = bless {}, $class; | 
| 448 |  |  |  |  |  |  |  | 
| 449 |  |  |  |  |  |  | if (@_ == 1) { | 
| 450 |  |  |  |  |  |  | my ($ws_track) = @_; # should be a WebService::MusicBrainz::Response::Track object | 
| 451 |  |  |  |  |  |  |  | 
| 452 |  |  |  |  |  |  | $this->artist($ws_track->artist->name); | 
| 453 |  |  |  |  |  |  | $this->title($ws_track->title); | 
| 454 |  |  |  |  |  |  | $this->track(($ws_track->release_list->releases->[0]->track_list->offset || 0) + 1); | 
| 455 |  |  |  |  |  |  | $this->album($ws_track->release_list->releases->[0]->title); | 
| 456 |  |  |  |  |  |  | $this->wsres($ws_track); | 
| 457 |  |  |  |  |  |  | } else { | 
| 458 |  |  |  |  |  |  | my ($artist, $title, $puid) = @_; | 
| 459 |  |  |  |  |  |  |  | 
| 460 |  |  |  |  |  |  | $this->artist($artist); | 
| 461 |  |  |  |  |  |  | $this->title($title); | 
| 462 |  |  |  |  |  |  | $this->puid($puid); | 
| 463 |  |  |  |  |  |  | } | 
| 464 |  |  |  |  |  |  |  | 
| 465 |  |  |  |  |  |  | return $this; | 
| 466 |  |  |  |  |  |  | } | 
| 467 |  |  |  |  |  |  |  | 
| 468 |  |  |  |  |  |  |  | 
| 469 |  |  |  |  |  |  | 1; | 
| 470 |  |  |  |  |  |  |  | 
| 471 |  |  |  |  |  |  | __END__ |