File Coverage

blib/lib/MP3/Info.pm
Criterion Covered Total %
statement 431 897 48.0
branch 191 524 36.4
condition 77 254 30.3
subroutine 29 43 67.4
pod 7 8 87.5
total 735 1726 42.5


line stmt bran cond sub pod time code
1             package MP3::Info;
2              
3             # JRF: Added support for ID3v2.4 spec-valid frame size processing (falling back to old
4             # non-spec valid frame size processing)
5             # Added support for ID3v2.4 footers.
6             # Updated text frames to correct mis-terminated frame content.
7             # Added ignoring of encrypted frames.
8             # TODO: sort out flags for compression / DLI
9              
10             require 5.006;
11              
12 4     4   109268 use strict;
  4         8  
  4         145  
13 4     4   8385 use overload;
  4         5028  
  4         31  
14 4     4   172 use Carp;
  4         17  
  4         516  
15 4     4   21 use Fcntl qw(:seek);
  4         6  
  4         621  
16              
17 4         3409 use vars qw(
18             @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $REVISION
19             @mp3_genres %mp3_genres @winamp_genres %winamp_genres $try_harder
20             @t_bitrate @t_sampling_freq @frequency_tbl %v1_tag_fields
21             @v1_tag_names %v2_tag_names %v2_to_v1_names $AUTOLOAD
22             @mp3_info_fields %rva2_channel_types
23             $debug_24 $debug_Tencoding
24 4     4   25 );
  4         14  
25              
26             @ISA = 'Exporter';
27             @EXPORT = qw(
28             set_mp3tag get_mp3tag get_mp3info remove_mp3tag
29             use_winamp_genres
30             );
31             @EXPORT_OK = qw(@mp3_genres %mp3_genres use_mp3_utf8);
32             %EXPORT_TAGS = (
33             genres => [qw(@mp3_genres %mp3_genres)],
34             utf8 => [qw(use_mp3_utf8)],
35             all => [@EXPORT, @EXPORT_OK]
36             );
37              
38             # $Id: Info.pm 28 2008-11-09 01:08:44Z dsully $
39             ($REVISION) = ' $Revision$ ' =~ /\$Revision:\s+([^\s]+)/;
40             $VERSION = '1.24';
41              
42             # JRF: Whether we're debugging the ID3v2.4 support
43             $debug_24 = 0;
44             $debug_Tencoding = 0;
45              
46             =pod
47              
48             =head1 NAME
49              
50             MP3::Info - Manipulate / fetch info from MP3 audio files
51              
52             =head1 SYNOPSIS
53              
54             #!perl -w
55             use MP3::Info;
56             my $file = 'Pearls_Before_Swine.mp3';
57             set_mp3tag($file, 'Pearls Before Swine', q"77's",
58             'Sticks and Stones', '1990',
59             q"(c) 1990 77's LTD.", 'rock & roll');
60              
61             my $tag = get_mp3tag($file) or die "No TAG info";
62             $tag->{GENRE} = 'rock';
63             set_mp3tag($file, $tag);
64              
65             my $info = get_mp3info($file);
66             printf "$file length is %d:%d\n", $info->{MM}, $info->{SS};
67              
68             =cut
69              
70             {
71             my $c = -1;
72             # set all lower-case and regular-cased versions of genres as keys
73             # with index as value of each key
74             %mp3_genres = map {($_, ++$c, lc, $c)} @mp3_genres;
75              
76             # do it again for winamp genres
77             $c = -1;
78             %winamp_genres = map {($_, ++$c, lc, $c)} @winamp_genres;
79             }
80              
81             =pod
82              
83             my $mp3 = new MP3::Info $file;
84             $mp3->title('Perls Before Swine');
85             printf "$file length is %s, title is %s\n",
86             $mp3->time, $mp3->title;
87              
88              
89             =head1 DESCRIPTION
90              
91             =over 4
92              
93             =item $mp3 = MP3::Info-Enew(FILE)
94              
95             OOP interface to the rest of the module. The same keys
96             available via get_mp3info and get_mp3tag are available
97             via the returned object (using upper case or lower case;
98             but note that all-caps "VERSION" will return the module
99             version, not the MP3 version).
100              
101             Passing a value to one of the methods will set the value
102             for that tag in the MP3 file, if applicable.
103              
104             =cut
105              
106             sub new {
107 0     0 1 0 my($pack, $file) = @_;
108              
109 0 0       0 my $info = get_mp3info($file) or return undef;
110 0   0     0 my $tags = get_mp3tag($file) || { map { ($_ => undef) } @v1_tag_names };
111 0         0 my %self = (
112             FILE => $file,
113             TRY_HARDER => 0
114             );
115              
116 0         0 @self{@mp3_info_fields, @v1_tag_names, 'file'} = (
117 0         0 @{$info}{@mp3_info_fields},
118 0         0 @{$tags}{@v1_tag_names},
119             $file
120             );
121              
122 0         0 return bless \%self, $pack;
123             }
124              
125             sub can {
126 0     0 0 0 my $self = shift;
127 0 0       0 return $self->SUPER::can(@_) unless ref $self;
128 0         0 my $name = uc shift;
129 0 0   0   0 return sub { $self->$name(@_) } if exists $self->{$name};
  0         0  
130 0         0 return undef;
131             }
132              
133             sub AUTOLOAD {
134 0     0   0 my($self) = @_;
135 0         0 (my $name = uc $AUTOLOAD) =~ s/^.*://;
136              
137 0 0       0 if (exists $self->{$name}) {
138             my $sub = exists $v1_tag_fields{$name}
139             ? sub {
140 0 0   0   0 if (defined $_[1]) {
141 0         0 $_[0]->{$name} = $_[1];
142 0         0 set_mp3tag($_[0]->{FILE}, $_[0]);
143             }
144 0         0 return $_[0]->{$name};
145             }
146             : sub {
147 0     0   0 return $_[0]->{$name}
148 0 0       0 };
149              
150 4     4   24 no strict 'refs';
  4         4  
  4         13288  
151 0         0 *{$AUTOLOAD} = $sub;
  0         0  
152 0         0 goto &$AUTOLOAD;
153              
154             } else {
155 0         0 carp(sprintf "No method '$name' available in package %s.",
156             __PACKAGE__);
157             }
158             }
159              
160 0     0   0 sub DESTROY {
161              
162             }
163              
164              
165             =item use_mp3_utf8([STATUS])
166              
167             Tells MP3::Info to (or not) return TAG info in UTF-8.
168             TRUE is 1, FALSE is 0. Default is TRUE, if available.
169              
170             Will only be able to turn it on if Encode is available. ID3v2
171             tags will be converted to UTF-8 according to the encoding specified
172             in each tag; ID3v1 tags will be assumed Latin-1 and converted
173             to UTF-8.
174              
175             Function returns status (TRUE/FALSE). If no argument is supplied,
176             or an unaccepted argument is supplied, function merely returns status.
177              
178             This function is not exported by default, but may be exported
179             with the C<:utf8> or C<:all> export tag.
180              
181             =cut
182              
183             my $unicode_base_module = eval { require Encode; require Encode::Guess };
184              
185             my $UNICODE = use_mp3_utf8($unicode_base_module ? 1 : 0);
186              
187             eval { require Encode::Detect::Detector };
188              
189             my $unicode_detect_module = $@ ? 0 : 1;
190              
191             sub use_mp3_utf8 {
192 4     4 1 13 my $val = shift;
193              
194 4         319 $UNICODE = 0;
195              
196 4 50       25 if ($val == 1) {
197              
198 4 50       28 if ($unicode_base_module) {
199              
200 4         8 $Encode::Guess::NoUTFAutoGuess = 1;
201 4         6 $UNICODE = 1;
202             }
203             }
204              
205 4         13 return $UNICODE;
206             }
207              
208             =pod
209              
210             =item use_winamp_genres()
211              
212             Puts WinAmp genres into C<@mp3_genres> and C<%mp3_genres>
213             (adds 68 additional genres to the default list of 80).
214             This is a separate function because these are non-standard
215             genres, but they are included because they are widely used.
216              
217             You can import the data structures with one of:
218              
219             use MP3::Info qw(:genres);
220             use MP3::Info qw(:DEFAULT :genres);
221             use MP3::Info qw(:all);
222              
223             =cut
224              
225             sub use_winamp_genres {
226 1     1 1 222 %mp3_genres = %winamp_genres;
227 1         38 @mp3_genres = @winamp_genres;
228 1         3 return 1;
229             }
230              
231             =pod
232              
233             =item remove_mp3tag (FILE [, VERSION, BUFFER])
234              
235             Can remove ID3v1 or ID3v2 tags. VERSION should be C<1> for ID3v1
236             (the default), C<2> for ID3v2, and C for both.
237              
238             For ID3v1, removes last 128 bytes from file if those last 128 bytes begin
239             with the text 'TAG'. File will be 128 bytes shorter.
240              
241             For ID3v2, removes ID3v2 tag. Because an ID3v2 tag is at the
242             beginning of the file, we rewrite the file after removing the tag data.
243             The buffer for rewriting the file is 4MB. BUFFER (in bytes) ca
244             change the buffer size.
245              
246             Returns the number of bytes removed, or -1 if no tag removed,
247             or undef if there is an error.
248              
249             =cut
250              
251             sub remove_mp3tag {
252 16     16 1 9863 my($file, $version, $buf) = @_;
253 16         22 my($fh, $return);
254              
255 16   50     78 $buf ||= 4096*1024; # the bigger the faster
256 16   50     33 $version ||= 1;
257              
258 16 50 33     77 if (not (defined $file && $file ne '')) {
259 0         0 $@ = "No file specified";
260 0         0 return undef;
261             }
262              
263 16 50       276 if (not -s $file) {
264 0         0 $@ = "File is empty";
265 0         0 return undef;
266             }
267              
268 16 50       37 if (ref $file) { # filehandle passed
269 0         0 $fh = $file;
270             } else {
271 16 50       587 if (not open $fh, '+<', $file) {
272 0         0 $@ = "Can't open $file: $!";
273 0         0 return undef;
274             }
275             }
276              
277 16         33 binmode $fh;
278              
279 16 50 33     83 if ($version eq 1 || $version eq 'ALL') {
280 16         82 seek $fh, -128, SEEK_END;
281 16         28 my $tell = tell $fh;
282 16 100       362 if (<$fh> =~ /^TAG/) {
283 5 50       219 truncate $fh, $tell or carp "Can't truncate '$file': $!";
284 5         13 $return += 128;
285             }
286             }
287              
288 16 50 33     76 if ($version eq 2 || $version eq 'ALL') {
289 16         42 my $v2h = _get_v2head($fh);
290 16 100       39 if ($v2h) {
291 6         15 local $\;
292 6         54 seek $fh, 0, SEEK_END;
293 6         10 my $eof = tell $fh;
294 6         10 my $off = $v2h->{tag_size};
295              
296 6         16 while ($off < $eof) {
297 6         29 seek $fh, $off, SEEK_SET;
298 6         191 read $fh, my($bytes), $buf;
299 6         34 seek $fh, $off - $v2h->{tag_size}, SEEK_SET;
300 6         165 print $fh $bytes;
301 6         18 $off += $buf;
302             }
303              
304 6 50       233 truncate $fh, $eof - $v2h->{tag_size}
305             or carp "Can't truncate '$file': $!";
306 6         34 $return += $v2h->{tag_size};
307             }
308              
309             # JRF: I've not written the code to strip ID3v2.4 footers.
310             # Sorry, I'm lazy.
311             }
312              
313 16         41 _close($file, $fh);
314              
315 16   100     98 return $return || -1;
316             }
317              
318              
319             =pod
320              
321             =item set_mp3tag (FILE, TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE [, TRACKNUM])
322              
323             =item set_mp3tag (FILE, $HASHREF)
324              
325             Adds/changes tag information in an MP3 audio file. Will clobber
326             any existing information in file.
327              
328             Fields are TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE. All fields have
329             a 30-byte limit, except for YEAR, which has a four-byte limit, and GENRE,
330             which is one byte in the file. The GENRE passed in the function is a
331             case-insensitive text string representing a genre found in C<@mp3_genres>.
332              
333             Will accept either a list of values, or a hashref of the type
334             returned by C.
335              
336             If TRACKNUM is present (for ID3v1.1), then the COMMENT field can only be
337             28 bytes.
338              
339             ID3v2 support may come eventually. Note that if you set a tag on a file
340             with ID3v2, the set tag will be for ID3v1[.1] only, and if you call
341             C on the file, it will show you the (unchanged) ID3v2 tags,
342             unless you specify ID3v1.
343              
344             =cut
345              
346             sub set_mp3tag {
347 5     5 1 11026 my($file, $title, $artist, $album, $year, $comment, $genre, $tracknum) = @_;
348 5         9 my(%info, $oldfh, $ref, $fh);
349 5         30 local %v1_tag_fields = %v1_tag_fields;
350              
351             # set each to '' if undef
352 5 100       27 for ($title, $artist, $album, $year, $comment, $tracknum, $genre,
  70         117  
353             (@info{@v1_tag_names}))
354             {$_ = defined() ? $_ : ''}
355              
356 5 50       36 ($ref) = (overload::StrVal($title) =~ /^(?:.*\=)?([^=]*)\((?:[^\(]*)\)$/)
357             if ref $title;
358             # populate data to hashref if hashref is not passed
359 5 50       63 if (!$ref) {
    50          
360 0         0 (@info{@v1_tag_names}) =
361             ($title, $artist, $album, $year, $comment, $tracknum, $genre);
362              
363             # put data from hashref into hashref if hashref is passed
364             } elsif ($ref eq 'HASH') {
365 5         41 %info = %$title;
366              
367             # return otherwise
368             } else {
369 0         0 carp(<<'EOT');
370             Usage: set_mp3tag (FILE, TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE [, TRACKNUM])
371             set_mp3tag (FILE, $HASHREF)
372             EOT
373 0         0 return undef;
374             }
375              
376 5 50 33     54 if (not (defined $file && $file ne '')) {
377 0         0 $@ = "No file specified";
378 0         0 return undef;
379             }
380              
381 5 50       107 if (not -s $file) {
382 0         0 $@ = "File is empty";
383 0         0 return undef;
384             }
385              
386             # comment field length 28 if ID3v1.1
387 5 50       20 $v1_tag_fields{COMMENT} = 28 if $info{TRACKNUM};
388              
389              
390             # only if -w is on
391 5 50       18 if ($^W) {
392             # warn if fields too long
393 5         17 foreach my $field (keys %v1_tag_fields) {
394 25 50       82 $info{$field} = '' unless defined $info{$field};
395 25 50       75 if (length($info{$field}) > $v1_tag_fields{$field}) {
396 0         0 carp "Data too long for field $field: truncated to " .
397             "$v1_tag_fields{$field}";
398             }
399             }
400              
401 5 50       18 if ($info{GENRE}) {
402 5 50       21 carp "Genre `$info{GENRE}' does not exist\n"
403             unless exists $mp3_genres{$info{GENRE}};
404             }
405             }
406              
407 5 50       15 if ($info{TRACKNUM}) {
408 5         10 $info{TRACKNUM} =~ s/^(\d+)\/(\d+)$/$1/;
409 5 50 33     82 unless ($info{TRACKNUM} =~ /^\d+$/ &&
      33        
410             $info{TRACKNUM} > 0 && $info{TRACKNUM} < 256) {
411 0 0       0 carp "Tracknum `$info{TRACKNUM}' must be an integer " .
412             "from 1 and 255\n" if $^W;
413 0         0 $info{TRACKNUM} = '';
414             }
415             }
416              
417 5 50       13 if (ref $file) { # filehandle passed
418 0         0 $fh = $file;
419             } else {
420 5 50       199 if (not open $fh, '+<', $file) {
421 0         0 $@ = "Can't open $file: $!";
422 0         0 return undef;
423             }
424             }
425              
426 5         11 binmode $fh;
427 5         18 $oldfh = select $fh;
428 5         31 seek $fh, -128, SEEK_END;
429             # go to end of file if no ID3v1 tag, beginning of existing tag if tag present
430 5 100       133 seek $fh, (<$fh> =~ /^TAG/ ? -128 : 0), SEEK_END;
431              
432             # get genre value
433 5 50 33     40 $info{GENRE} = $info{GENRE} && exists $mp3_genres{$info{GENRE}} ?
434             $mp3_genres{$info{GENRE}} : 255; # some default genre
435              
436 5         14 local $\;
437             # print TAG to file
438 5 50       21 if ($info{TRACKNUM}) {
439 5         46 print pack 'a3a30a30a30a4a28xCC', 'TAG', @info{@v1_tag_names};
440             } else {
441 0         0 print pack 'a3a30a30a30a4a30C', 'TAG', @info{@v1_tag_names[0..4, 6]};
442             }
443              
444 5         14 select $oldfh;
445              
446 5         13 _close($file, $fh);
447              
448 5         53 return 1;
449             }
450              
451             =pod
452              
453             =item get_mp3tag (FILE [, VERSION, RAW_V2, APE2])
454              
455             Returns hash reference containing tag information in MP3 file. The keys
456             returned are the same as those supplied for C, except in the
457             case of RAW_V2 being set.
458              
459             If VERSION is C<1>, the information is taken from the ID3v1 tag (if present).
460             If VERSION is C<2>, the information is taken from the ID3v2 tag (if present).
461             If VERSION is not supplied, or is false, the ID3v1 tag is read if present, and
462             then, if present, the ID3v2 tag information will override any existing ID3v1
463             tag info.
464              
465             If RAW_V2 is C<1>, the raw ID3v2 tag data is returned, without any manipulation
466             of text encoding. The key name is the same as the frame ID (ID to name mappings
467             are in the global %v2_tag_names).
468              
469             If RAW_V2 is C<2>, the ID3v2 tag data is returned, manipulating for Unicode if
470             necessary, etc. It also takes multiple values for a given key (such as comments)
471             and puts them in an arrayref.
472              
473             If APE is C<1>, an APE tag will be located before all other tags.
474              
475             If the ID3v2 version is older than ID3v2.2.0 or newer than ID3v2.4.0, it will
476             not be read.
477              
478             Strings returned will be in Latin-1, unless UTF-8 is specified (L),
479             (unless RAW_V2 is C<1>).
480              
481             Also returns a TAGVERSION key, containing the ID3 version used for the returned
482             data (if TAGVERSION argument is C<0>, may contain two versions).
483              
484             =cut
485              
486             sub get_mp3tag {
487 14     14 1 24736 my $file = shift;
488 14   50     77 my $ver = shift || 0;
489 14   50     57 my $raw = shift || 0;
490 14   50     56 my $find_ape = shift || 0;
491 14         15 my $fh;
492              
493 14         28 my $has_v1 = 0;
494 14         19 my $has_v2 = 0;
495 14         15 my $has_ape = 0;
496 14         33 my %info = ();
497              
498             # See if a version number was passed. Make sure it's a 1 or a 2
499 14 0 0     29 $ver = !$ver ? 0 : ($ver == 2 || $ver == 1) ? $ver : 0;
    50          
500              
501 14 50 33     68 if (!(defined $file && $file ne '')) {
502 0         0 $@ = "No file specified";
503 0         0 return undef;
504             }
505              
506 14         213 my $filesize = -s $file;
507              
508 14 50       37 if (!$filesize) {
509 0         0 $@ = "File is empty";
510 0         0 return undef;
511             }
512              
513             # filehandle passed
514 14 50       30 if (ref $file) {
515              
516 0         0 $fh = $file;
517              
518             } else {
519              
520 14 50       480 open($fh, $file) || do {
521 0         0 $@ = "Can't open $file: $!";
522 0         0 return undef;
523             };
524             }
525              
526 14         37 binmode $fh;
527              
528             # Try and find an APE Tag - this is where FooBar2k & others
529             # store ReplayGain information
530 14 50       35 if ($find_ape) {
531              
532 0         0 $has_ape = _parse_ape_tag($fh, $filesize, \%info);
533             }
534              
535 14 50       32 if ($ver < 2) {
536              
537 14         37 $has_v1 = _get_v1tag($fh, \%info);
538              
539 14 50 33     56 if ($ver == 1 && !$has_v1) {
540 0         0 _close($file, $fh);
541 0         0 $@ = "No ID3v1 tag found";
542 0         0 return undef;
543             }
544             }
545              
546 14 50 33     69 if ($ver == 2 || $ver == 0) {
547 14         42 $has_v2 = _get_v2tag($fh, $ver, $raw, \%info);
548             }
549              
550 14 0 66     48 if (!$has_v1 && !$has_v2 && !$has_ape) {
      33        
551 0         0 _close($file, $fh);
552 0         0 $@ = "No ID3 or APE tag found";
553 0         0 return undef;
554             }
555              
556 14 50 33     48 unless ($raw && $ver == 2) {
557              
558             # Strip out NULLs unless we want the raw data.
559 14         35 foreach my $key (keys %info) {
560              
561 105 50       193 if (defined $info{$key}) {
562 105         147 $info{$key} =~ s/\000+.*//g;
563 105         266 $info{$key} =~ s/\s+$//;
564             }
565             }
566              
567 14         37 for (@v1_tag_names) {
568 98 100       225 $info{$_} = '' unless defined $info{$_};
569             }
570             }
571              
572 14 50 33     81 if (keys %info && !defined $info{'GENRE'}) {
573 0         0 $info{'GENRE'} = '';
574             }
575              
576 14         39 _close($file, $fh);
577              
578 14 50       126 return keys %info ? \%info : undef;
579             }
580              
581             sub _get_v1tag {
582 14     14   20 my ($fh, $info) = @_;
583              
584 14         72 seek $fh, -128, SEEK_END;
585 14         303 read($fh, my $tag, 128);
586              
587 14 100 33     102 if (!defined($tag) || $tag !~ /^TAG/) {
588              
589 6         13 return 0;
590             }
591              
592 8 100       36 if (substr($tag, -3, 2) =~ /\000[^\000]/) {
593              
594 7         57 (undef, @{$info}{@v1_tag_names}) =
  7         48  
595             (unpack('a3a30a30a30a4a28', $tag),
596             ord(substr($tag, -2, 1)),
597             $mp3_genres[ord(substr $tag, -1)]);
598              
599 7         30 $info->{'TAGVERSION'} = 'ID3v1.1';
600              
601             } else {
602              
603 1         10 (undef, @{$info}{@v1_tag_names[0..4, 6]}) =
  1         11  
604             (unpack('a3a30a30a30a4a30', $tag),
605             $mp3_genres[ord(substr $tag, -1)]);
606              
607 1         5 $info->{'TAGVERSION'} = 'ID3v1';
608             }
609              
610 8 50       22 if (!$UNICODE) {
611 0         0 return 1;
612             }
613              
614             # Save off the old suspects list, since we add
615             # iso-8859-1 below, but don't want that there
616             # for possible ID3 v2.x parsing below.
617 8         40 my $oldSuspects = $Encode::Encoding{'Guess'}->{'Suspects'};
618              
619 8         13 for my $key (keys %{$info}) {
  8         32  
620              
621 63 50       141 next unless $info->{$key};
622              
623             # Try and guess the encoding.
624 63 50       120 if ($unicode_detect_module) {
625              
626 0   0     0 my $charset = Encode::Detect::Detector::detect($info->{$key}) || 'iso-8859-1';
627 0         0 my $enc = Encode::find_encoding($charset);
628              
629 0 0       0 if ($enc) {
630              
631 0         0 $info->{$key} = $enc->decode($info->{$key}, 0);
632              
633 0         0 next;
634             }
635             }
636              
637 63         97 my $value = $info->{$key};
638 63         217 my $icode = Encode::Guess->guess($value);
639              
640 63 50       3089 if (!ref($icode)) {
641              
642             # Often Latin1 bytes are
643             # stuffed into a 1.1 tag.
644 0         0 Encode::Guess->add_suspects('iso-8859-1');
645              
646 0         0 while (length($value)) {
647              
648 0         0 $icode = Encode::Guess->guess($value);
649              
650 0 0       0 last if ref($icode);
651              
652             # Remove garbage and retry
653             # (string is truncated in the
654             # middle of a multibyte char?)
655 0         0 $value =~ s/(.)$//;
656             }
657             }
658              
659 63 50       307 $info->{$key} = Encode::decode(ref($icode) ? $icode->name : 'iso-8859-1', $info->{$key});
660            
661             # Trim any trailing nuls
662 63         1316 $info->{$key} =~ s/\x00+$//g;
663             }
664              
665 8         19 Encode::Guess->set_suspects(keys %{$oldSuspects});
  8         37  
666              
667 8         475 return 1;
668             }
669              
670             sub _parse_v2tag {
671 6     6   11 my ($ver, $raw_v2, $v2, $info) = @_;
672              
673             # Make sure any existing TXXX flags are an array.
674             # As we might need to append comments to it below.
675 6 50 33     29 if ($v2->{'TXXX'} && ref($v2->{'TXXX'}) ne 'ARRAY') {
676              
677 0         0 $v2->{'TXXX'} = [ $v2->{'TXXX'} ];
678             }
679              
680             # J.River Media Center sticks RG tags in comments.
681             # Ugh. Make them look like TXXX tags, which is really what they are.
682 6 50 33     27 if (ref($v2->{'COMM'}) eq 'ARRAY' && grep { /Media Jukebox/ } @{$v2->{'COMM'}}) {
  0         0  
  0         0  
683              
684 0         0 for my $comment (@{$v2->{'COMM'}}) {
  0         0  
685              
686 0 0       0 if ($comment =~ /Media Jukebox/) {
687              
688             # we only want one null to lead.
689 0         0 $comment =~ s/^\000+//g;
690              
691 0         0 push @{$v2->{'TXXX'}}, "\000$comment";
  0         0  
692             }
693             }
694             }
695              
696 6 50       20 my $hash = $raw_v2 == 2 ? { map { ($_, $_) } keys %v2_tag_names } : \%v2_to_v1_names;
  0         0  
697              
698 6         6 for my $id (keys %{$hash}) {
  6         31  
699              
700 96 100       188 next if !exists $v2->{$id};
701              
702 36 50       123 if ($id =~ /^UFID?$/) {
    50          
    50          
703              
704 0         0 my @ufid_list = split(/\0/, $v2->{$id});
705              
706 0 0       0 $info->{$hash->{$id}} = $ufid_list[1] if ($#ufid_list > 0);
707              
708             } elsif ($id =~ /^RVA[D2]?$/) {
709              
710             # Expand these binary fields. See the ID3 spec for Relative Volume Adjustment.
711 0 0 0     0 if ($id eq 'RVA2') {
    0          
712              
713             # ID is a text string
714 0         0 ($info->{$hash->{$id}}->{'ID'}, my $rvad) = split /\0/, $v2->{$id};
715              
716 0         0 my $channel = $rva2_channel_types{ ord(substr($rvad, 0, 1, '')) };
717              
718 0         0 $info->{$hash->{$id}}->{$channel}->{'REPLAYGAIN_TRACK_GAIN'} =
719             sprintf('%f', _grab_int_16(\$rvad) / 512);
720              
721 0         0 my $peakBytes = ord(substr($rvad, 0, 1, ''));
722              
723 0 0       0 if (int($peakBytes / 8)) {
724              
725 0         0 $info->{$hash->{$id}}->{$channel}->{'REPLAYGAIN_TRACK_PEAK'} =
726             sprintf('%f', _grab_int_16(\$rvad) / 512);
727             }
728              
729             } elsif ($id eq 'RVAD' || $id eq 'RVA') {
730              
731 0         0 my $rvad = $v2->{$id};
732 0         0 my $flags = ord(substr($rvad, 0, 1, ''));
733 0         0 my $desc = ord(substr($rvad, 0, 1, ''));
734              
735             # iTunes appears to be the only program that actually writes
736             # out a RVA/RVAD tag. Everyone else punts.
737 0         0 for my $type (qw(REPLAYGAIN_TRACK_GAIN REPLAYGAIN_TRACK_PEAK)) {
738              
739 0         0 for my $channel (qw(RIGHT LEFT)) {
740              
741 0         0 my $val = _grab_uint_16(\$rvad) / 256;
742              
743             # iTunes uses a range of -255 to 255
744             # to be -100% (silent) to 100% (+6dB)
745 0 0       0 if ($val == -255) {
746 0         0 $val = -96.0;
747             } else {
748 0         0 $val = 20.0 * log(($val+255)/255)/log(10);
749             }
750              
751 0 0       0 $info->{$hash->{$id}}->{$channel}->{$type} = $flags & 0x01 ? $val : -$val;
752             }
753             }
754             }
755              
756             } elsif ($id =~ /^A?PIC$/) {
757              
758 0         0 my $pic = $v2->{$id};
759              
760             # if there is more than one picture, just grab the first one.
761             # JRF: Should consider looking for either the thumbnail or the front cover,
762             # rather than just returning the first one.
763             # Possibly also checking that the format is actually understood,
764             # but that's really down to the caller - we can't say whether the
765             # format is understood here.
766 0 0       0 if (ref($pic) eq 'ARRAY') {
767 0         0 $pic = (@$pic)[0];
768             }
769              
770 4     4   4881 use bytes;
  4         49  
  4         21  
771              
772 0         0 my $valid_pic = 0;
773 0         0 my $pic_len = 0;
774 0         0 my $pic_format = '';
775              
776             # look for ID3 v2.2 picture
777 0 0 0     0 if ($pic && $id eq 'PIC') {
    0 0        
778              
779             # look for ID3 v2.2 picture
780 0         0 my ($encoding, $format, $picture_type, $description) = unpack 'Ca3CZ*', $pic;
781 0         0 $pic_len = length($description) + 1 + 5;
782              
783             # skip extra terminating null if unicode
784 0 0       0 if ($encoding) { $pic_len++; }
  0         0  
785              
786 0 0       0 if ($pic_len < length($pic)) {
787 0         0 $valid_pic = 1;
788 0         0 $pic_format = $format;
789             }
790              
791             } elsif ($pic && $id eq 'APIC') {
792              
793             # look for ID3 v2.3/2.4 picture
794 0         0 my ($encoding, $format) = unpack 'C Z*', $pic;
795              
796 0         0 $pic_len = length($format) + 2;
797              
798 0 0       0 if ($pic_len < length($pic)) {
799              
800 0         0 my ($picture_type, $description) = unpack "x$pic_len C Z*", $pic;
801              
802 0         0 $pic_len += 1 + length($description) + 1;
803              
804             # skip extra terminating null if UTF-16 (encoding 1 or 2)
805 0 0 0     0 if ( $encoding == 1 || $encoding == 2 ) { $pic_len++; }
  0         0  
806              
807 0         0 $valid_pic = 1;
808 0         0 $pic_format = $format;
809             }
810             }
811              
812             # Proceed if we have a valid picture.
813 0 0 0     0 if ($valid_pic && $pic_format) {
814              
815 0         0 my ($data) = unpack("x$pic_len A*", $pic);
816              
817 0 0 0     0 if (length($data) && $pic_format) {
818              
819 0         0 $info->{$hash->{$id}} = {
820             'DATA' => $data,
821             'FORMAT' => $pic_format,
822             }
823             }
824             }
825              
826             } else {
827 36         50 my $data1 = $v2->{$id};
828              
829 36 50       94 $data1 = [ $data1 ] if ref($data1) ne 'ARRAY';
830              
831 36         53 for my $data (@$data1) {
832             # TODO : this should only be done for certain frames;
833             # using RAW still gives you access, but we should be smarter
834             # about how individual frame types are handled. it's not
835             # like the list is infinitely long.
836 36         96 $data =~ s/^(.)//; # strip first char (text encoding)
837 36         62 my $encoding = $1;
838 36         34 my $desc;
839              
840             # Comments & Unsyncronized Lyrics have the same format.
841 36 100       110 if ($id =~ /^(COM[M ]?|US?LT)$/) { # space for iTunes brokenness
842              
843 6         19 $data =~ s/^(?:...)//; # strip language
844             }
845              
846             # JRF: I believe this should probably only be applied to the text frames
847             # and not every single frame.
848 36 50       93 if ($UNICODE) {
849              
850 36 50 33     197 if ($encoding eq "\001" || $encoding eq "\002") { # UTF-16, UTF-16BE
    50          
    50          
851             # text fields can be null-separated lists;
852             # UTF-16 therefore needs special care
853             #
854             # foobar2000 encodes tags in UTF-16LE
855             # (which is apparently illegal)
856             # Encode dies on a bad BOM, so it is
857             # probably wise to wrap it in an eval
858             # anyway
859 0   0     0 $data = eval { Encode::decode('utf16', $data) } || Encode::decode('utf16le', $data);
860              
861             } elsif ($encoding eq "\003") { # UTF-8
862              
863             # make sure string is UTF8, and set flag appropriately
864 0         0 $data = Encode::decode('utf8', $data);
865              
866             } elsif ($encoding eq "\000") {
867              
868             # Only guess if it's not ascii.
869 36 50 33     207 if ($data && $data !~ /^[\x00-\x7F]+$/) {
870              
871 0 0       0 if ($unicode_detect_module) {
872              
873 0   0     0 my $charset = Encode::Detect::Detector::detect($data) || 'iso-8859-1';
874 0         0 my $enc = Encode::find_encoding($charset);
875              
876 0 0       0 if ($enc) {
877 0         0 $data = $enc->decode($data, 0);
878             }
879              
880             } else {
881              
882             # Try and guess the encoding, otherwise just use latin1
883 0         0 my $dec = Encode::Guess->guess($data);
884              
885 0 0       0 if (ref $dec) {
886 0         0 $data = $dec->decode($data);
887             } else {
888             # Best try
889 0         0 $data = Encode::decode('iso-8859-1', $data);
890             }
891             }
892             }
893             }
894              
895             } else {
896              
897             # If the string starts with an
898             # UTF-16 little endian BOM, use a hack to
899             # convert to ASCII per best-effort
900 0         0 my $pat;
901 0 0       0 if ($data =~ s/^\xFF\xFE//) {
    0          
902             # strip additional BOMs as seen in COM(M?) and TXX(X?)
903 0 0 0     0 $data = join ("",map { ( /^(..)$/ && ! /(\xFF\xFE)/ )? $_: "" } (split /(..)/, $data));
  0         0  
904 0         0 $pat = 'v';
905             } elsif ($data =~ s/^\xFE\xFF//) {
906             # strip additional BOMs as seen in COM(M?) and TXX(X?)
907 0 0 0     0 $data = join ("",map { ( /^(..)$/ && ! /(\xFF\xFE)/ )? $_: "" } (split /(..)/, $data));
  0         0  
908 0         0 $pat = 'n';
909             }
910              
911 0 0       0 if ($pat) {
912             # strip additional 0s
913 0 0 0     0 $data = join ("",map { ( /^(..)$/ && ! /(\x00\x00)/ )? $_: "" } (split /(..)/, $data));
  0         0  
914 0 0 0     0 $data = pack 'C*', map {
915 0         0 (chr =~ /[[:ascii:]]/ && chr =~ /[[:print:]]/)
916             ? $_
917             : ord('?')
918             } unpack "$pat*", $data;
919             }
920             }
921              
922             # We do this after decoding so we could be certain we're dealing
923             # with 8-bit text.
924 36 100 33     226 if ($id =~ /^(COM[M ]?|US?LT)$/) { # space for iTunes brokenness
    100          
    50          
925              
926 6         24 $data =~ s/^(.*?)\000//; # strip up to first NULL(s),
927             # for sub-comments (TODO:
928             # handle all comment data)
929 6         13 $desc = $1;
930              
931 6 50 33     37 if ($encoding eq "\001" || $encoding eq "\002") {
932              
933 0         0 $data =~ s/^\x{feff}//;
934             }
935              
936             } elsif ($id =~ /^TCON?$/) {
937              
938 6         9 my ($index, $name);
939              
940             # Turn multiple nulls into a single.
941 6         19 $data =~ s/\000+/\000/g;
942              
943             # Handle the ID3v2.x spec -
944             #
945             # just an index number, possibly
946             # paren enclosed - referer to the v1 genres.
947 6 50       25 if ($data =~ /^ \(? (\d+) \)?\000?$/sx) {
    0          
    0          
    0          
948              
949 6         11 $index = $1;
950              
951             # Paren enclosed index with refinement.
952             # (4)Eurodisco
953             } elsif ($data =~ /^ \( (\d+) \)\000? ([^\(].+)$/x) {
954              
955 0         0 ($index, $name) = ($1, $2);
956              
957             # List of indexes: (37)(38)
958             } elsif ($data =~ /^ \( (\d+) \)\000?/x) {
959              
960 0         0 my @genres = ();
961              
962 0         0 while ($data =~ s/^ \( (\d+) \)//x) {
963              
964             # The indexes might have a refinement
965             # not sure why one wouldn't just use
966             # the proper genre in the first place..
967 0 0       0 if ($data =~ s/^ ( [^\(]\D+ ) ( \000 | \( | \Z)/$2/x) {
968              
969 0         0 push @genres, $1;
970              
971             } else {
972              
973 0         0 push @genres, $mp3_genres[$1];
974             }
975             }
976              
977 0         0 $data = \@genres;
978              
979             } elsif ($data =~ /^[^\000]+\000/) {
980              
981             # name genres separated by nulls.
982 0         0 $data = [ split /\000/, $data ];
983             }
984              
985             # Text based genres will fall through.
986 6 50 33     35 if ($name && $name ne "\000") {
    50          
987 0         0 $data = $name;
988             } elsif (defined $index) {
989 6         14 $data = $mp3_genres[$index];
990             }
991              
992             # Collapse single genres down, as we may have another tag.
993 6 50 33     32 if ($data && ref($data) eq 'ARRAY' && scalar @$data == 1) {
      33        
994              
995 0         0 $data = $data->[0];
996             }
997              
998             } elsif ($id =~ /^T...?$/ && $id ne 'TXXX') {
999            
1000             # In ID3v2.4 there's a slight content change for text fields.
1001             # They can contain multiple values which are nul terminated
1002             # within the frame. We ONLY want to split these into multiple
1003             # array values if they didn't request raw values (1).
1004             # raw_v2 = 0 => parse simply
1005             # raw_v2 = 1 => don't parse
1006             # raw_v2 = 2 => do split into arrayrefs
1007            
1008             # Strip off any trailing NULs, which would indicate an empty
1009             # field and cause an array with no elements to be created.
1010 24         67 $data =~ s/\x00+$//;
1011              
1012            
1013 24 0 0     73 if ($data =~ /\x00/ && ($raw_v2 == 2 || $raw_v2 == 0))
      33        
1014             {
1015             # There are embedded nuls in the string, which means an ID3v2.4
1016             # multi-value frame. And they wanted arrays rather than simple
1017             # values.
1018             # Strings are already UTF-8, so any double nuls from 16 bit
1019             # characters will have already been reduced to single nuls.
1020 0         0 $data = [ split /\000/, $data ];
1021             }
1022             }
1023              
1024 36 50       68 if ($desc)
1025             {
1026             # It's a frame with a description, so we may need to construct a hash
1027             # for the data, rather than an array.
1028 0 0       0 if ($raw_v2 == 2) {
    0          
1029              
1030 0         0 $data = { $desc => $data };
1031              
1032             } elsif ($desc =~ /^iTun/) {
1033              
1034             # leave iTunes tags alone.
1035 0         0 $data = join(' ', $desc, $data);
1036             }
1037             }
1038              
1039 36 50 33     81 if ($raw_v2 == 2 && exists $info->{$hash->{$id}}) {
1040              
1041 0 0       0 if (ref $info->{$hash->{$id}} eq 'ARRAY') {
1042 0         0 push @{$info->{$hash->{$id}}}, $data;
  0         0  
1043             } else {
1044 0         0 $info->{$hash->{$id}} = [ $info->{$hash->{$id}}, $data ];
1045             }
1046              
1047             } else {
1048              
1049             # User defined frame
1050 36 50       80 if ($id eq 'TXXX') {
    50          
1051              
1052 0         0 my ($key, $val) = split(/\0/, $data);
1053              
1054             # Some programs - such as FB2K leave a UTF-16 BOM on the value
1055 0 0 0     0 if ($encoding eq "\001" || $encoding eq "\002") {
1056              
1057 0         0 $val =~ s/^\x{feff}//;
1058             }
1059              
1060 0         0 $info->{uc($key)} = $val;
1061              
1062             } elsif ($id eq 'PRIV') {
1063              
1064 0         0 my ($key, $val) = split(/\0/, $data);
1065 0         0 $info->{uc($key)} = unpack('v', $val);
1066              
1067             } else {
1068              
1069 36         51 my $key = $hash->{$id};
1070              
1071             # If we have multiple values
1072             # for the same key - turn them
1073             # into an array ref.
1074 36 50 33     137 if ($ver == 2 && $info->{$key} && !ref($info->{$key})) {
    50 33        
      33        
1075              
1076 0 0       0 if (ref($data) eq "ARRAY") {
1077            
1078 0         0 $info->{$key} = [ $info->{$key}, @$data ];
1079             } else {
1080            
1081 0         0 my $old = delete $info->{$key};
1082            
1083 0         0 @{$info->{$key}} = ($old, $data);
  0         0  
1084             }
1085              
1086             } elsif ($ver == 2 && ref($info->{$key}) eq 'ARRAY') {
1087            
1088 0 0       0 if (ref($data) eq "ARRAY") {
1089              
1090 0         0 push @{$info->{$key}}, @$data;
  0         0  
1091              
1092             } else {
1093              
1094 0         0 push @{$info->{$key}}, $data;
  0         0  
1095             }
1096              
1097             } else {
1098              
1099 36         165 $info->{$key} = $data;
1100             }
1101             }
1102             }
1103             }
1104             }
1105             }
1106             }
1107              
1108             sub _get_v2tag {
1109 14     14   28 my ($fh, $ver, $raw, $info, $start) = @_;
1110 14         16 my $eof;
1111 14         19 my $gotanyv2 = 0;
1112              
1113             # First we need to check the end of the file for any footer
1114              
1115 14         76 seek $fh, -128, SEEK_END;
1116 14         28 $eof = (tell $fh) + 128;
1117              
1118             # go to end of file if no ID3v1 tag, beginning of existing tag if tag present
1119 14 100       183 if (<$fh> =~ /^TAG/) {
1120 8         12 $eof -= 128;
1121             }
1122              
1123 14         98 seek $fh, $eof, SEEK_SET;
1124             # print STDERR "Checking for footer at $eof\n";
1125              
1126 14 50       38 if (my $v2f = _get_v2foot($fh)) {
1127 0         0 $eof -= $v2f->{tag_size};
1128             # We have a ID3v2.4 footer. Must read it.
1129 0 0       0 $gotanyv2 |= (_get_v2tagdata($fh, $ver, $raw, $info, $eof) ? 2 : 0);
1130             }
1131              
1132             # Now read any ID3v2 header
1133 14 100       43 $gotanyv2 |= (_get_v2tagdata($fh, $ver, $raw, $info, $start) ? 1 : 0);
1134              
1135             # Because we've merged the entries it makes sense to trim any duplicated
1136             # values - for example if there's a footer and a header that contain the same
1137             # data then this results in every entry being an array containing two
1138             # identical values.
1139 14         21 for my $name (keys %{$info})
  14         51  
1140             {
1141             # Note: We must not sort these elements to do the comparison because that
1142             # changes the order in which they are claimed to appear. Whilst this
1143             # probably isn't important, it may matter for default display - for
1144             # example a lyric should be shown by default with the first entry
1145             # in the tag in the case where the user has not specified a language
1146             # preference. If we sorted the array it would destroy that order.
1147             # This is a longwinded way of checking for duplicates and only writing the
1148             # first element - we check the array for duplicates and clear all subsequent
1149             # entries which are duplicates of earlier ones.
1150 105 50       218 if (ref $info->{$name} eq 'ARRAY')
1151             {
1152 0         0 my @array = ();
1153 0         0 my ($i, $o);
1154 0         0 my @chk = @{$info->{$name}};
  0         0  
1155 0         0 for $i ( 0..$#chk )
1156             {
1157 0         0 my $ielement = $chk[$i];
1158 0 0       0 if (defined $ielement)
1159             {
1160 0         0 for $o ( ($i+1)..$#chk )
1161             {
1162 0 0 0     0 $chk[$o] = undef if (defined $o && defined $chk[$o] && ($ielement eq $chk[$o]));
      0        
1163             }
1164 0         0 push @array, $ielement;
1165             }
1166             }
1167             # We may have reduced the array to a single element. If so, just assign
1168             # a regular scalar instead of the array.
1169 0 0       0 if ($#array == 0)
1170             {
1171 0         0 $info->{$name} = $array[0];
1172             }
1173             else
1174             {
1175 0         0 $info->{$name} = \@array;
1176             }
1177             }
1178             }
1179              
1180 14         42 return $gotanyv2;
1181             }
1182              
1183             # $has_v2 = &_get_v2tagdata($filehandle, $ver, $raw, $info, $startinfile);
1184             # $info is a hash reference which will be updated with the new ID3v2 details
1185             # if the updated bit is set, and set to the new details if the updated bit
1186             # is clear.
1187             # If undefined, $startinfile will be treated as 0 (see _get_v2head).
1188             # $v2h is a reference to a hash of the frames present within the tag.
1189             # Any frames which are repeated within the tag (eg USLT with different
1190             # languages) will be supplied as an array rather than a scalar. All client
1191             # code needs to be aware that any frame may be duplicated.
1192             sub _get_v2tagdata {
1193 14     14   22 my($fh, $ver, $raw, $info, $start) = @_;
1194 14         20 my($off, $end, $myseek, $v2, $v2h, $hlen, $num, $wholetag);
1195              
1196 14         19 $v2 = {};
1197 14 100       42 $v2h = _get_v2head($fh, $start) or return 0;
1198              
1199 6 50       30 if ($v2h->{major_version} < 2) {
1200 0 0       0 carp "This is $v2h->{version}; " .
1201             "ID3v2 versions older than ID3v2.2.0 not supported\n"
1202             if $^W;
1203 0         0 return 0;
1204             }
1205              
1206             # use syncsafe bytes if using version 2.4
1207 6         11 my $id3v2_4_frame_size_broken = 0;
1208 6 100       15 my $bytesize = ($v2h->{major_version} > 3) ? 128 : 256;
1209              
1210             # alas, that's what the spec says, but iTunes and others don't syncsafe
1211             # the length, which breaks MP3 files with v2.4 tags longer than 128 bytes,
1212             # like every image file.
1213             # Because we should not break the spec conformant files due to
1214             # spec-inconformant programs, we first try the correct form and if the
1215             # data looks wrong we revert to broken behaviour.
1216              
1217 6 100       55 if ($v2h->{major_version} == 2) {
1218 2         4 $hlen = 6;
1219 2         4 $num = 3;
1220             } else {
1221 4         6 $hlen = 10;
1222 4         8 $num = 4;
1223             }
1224              
1225 6         11 $off = $v2h->{ext_header_size} + 10;
1226 6         8 $end = $v2h->{tag_size} + 10; # should we read in the footer too?
1227              
1228             # JRF: If the format was ID3v2.2 and the compression bit was set, then we can't
1229             # actually read the content because there are no defined compression schemes
1230             # for ID3v2.2. Perform no more processing, and return failure because we
1231             # cannot read anything.
1232 6 50 66     74 return 0 if ($v2h->{major_version} == 2 && $v2h->{compression});
1233              
1234             # JRF: If the update flag is set then the input data is the same as that which was
1235             # passed in. ID3v2.4 section 3.2.
1236 6 50       15 if ($v2h->{update}) {
1237 0         0 $v2 = $info;
1238             }
1239              
1240             # Bug 8939, Trying to read past the end of the file may crash on win32
1241 6         54 my $size = -s $fh;
1242 6 50       18 if ( $v2h->{offset} + $end > $size ) {
1243 0         0 $end -= $v2h->{offset} + $end - $size;
1244             }
1245              
1246 6         50 seek $fh, $v2h->{offset}, SEEK_SET;
1247 6         84 read $fh, $wholetag, $end;
1248              
1249             # JRF: The discrepency between ID3v2.3 and ID3v2.4 is that :
1250             # 2.3: unsync flag indicates that unsync is used on the entire tag
1251             # 2.4: unsync flag indicates that all frames have the unsync bit set
1252             # In 2.4 this means that the size of the frames which have the unsync bit
1253             # set will be the unsync'd size (section 4. in the ID3v2.4.0 structure
1254             # specification).
1255             # This means that when processing 2.4 files we should perform all the
1256             # unsynchronisation processing at the frame level, not the tag level.
1257             # The tag unsync bit is redundant (IMO).
1258 6 100       19 if ($v2h->{major_version} == 4) {
1259 2         5 $v2h->{unsync} = 0
1260             }
1261              
1262 6 50       25 $wholetag =~ s/\xFF\x00/\xFF/gs if $v2h->{unsync};
1263              
1264             # JRF: If we /knew/ there would be something special in the tag which meant
1265             # that the ID3v2.4 frame size was broken we could check it here. If,
1266             # for example, the iTunes files had the word 'iTunes' somewhere in the
1267             # tag and we knew that it was broken for versions below 3.145 (which is
1268             # a number I just picked out of the air), then we could do something like this :
1269             # if ($v2h->{major_version} == 4) &&
1270             # $wholetag =~ /iTunes ([0-9]+\.[0-9]+)/ &&
1271             # $1 < 3.145)
1272             # {
1273             # $id3v2_4_frame_size_broken = 1;
1274             # }
1275             # However I have not included this because I don't have examples of broken
1276             # files - and in any case couldn't guarentee I'd get it right.
1277              
1278             $myseek = sub {
1279 42 50   42   68 return unless $wholetag;
1280            
1281 42         74 my $bytes = substr($wholetag, $off, $hlen);
1282              
1283             # iTunes is stupid and sticks ID3v2.2 3 byte frames in a
1284             # ID3v2.3 or 2.4 header. Ignore tags with a space in them.
1285 42 100       320 if ($bytes !~ /^([A-Z0-9\? ]{$num})/) {
1286 6         21 return;
1287             }
1288              
1289 36         75 my ($id, $size) = ($1, $hlen);
1290 36         108 my @bytes = reverse unpack "C$num", substr($bytes, $num, $num);
1291              
1292 36         68 for my $i (0 .. ($num - 1)) {
1293 132         203 $size += $bytes[$i] * $bytesize ** $i;
1294             }
1295              
1296             # JRF: Now provide the fall back for the broken ID3v2.4 frame size
1297             # (which will persist for subsequent frames if detected).
1298              
1299             # Part 1: If the frame size cannot be valid according to the
1300             # specification (or if it would be larger than the tag
1301             # size allows).
1302 36 50 66     212 if ($v2h->{major_version}==4 &&
      33        
      66        
1303             $id3v2_4_frame_size_broken == 0 && # we haven't detected brokenness yet
1304             ((($bytes[0] | $bytes[1] | $bytes[2] | $bytes[3]) & 0x80) != 0 || # 0-bits set in size
1305             $off + $size > $end) # frame size would excede the tag end
1306             )
1307             {
1308             # The frame is definately not correct for the specification, so drop to
1309             # broken frame size system instead.
1310 0         0 $bytesize = 128;
1311 0         0 $size -= $hlen; # hlen has alread been added, so take that off again
1312 0         0 $size = (($size & 0x0000007f)) |
1313             (($size & 0x00003f80)<<1) |
1314             (($size & 0x001fc000)<<2) |
1315             (($size & 0x0fe00000)<<3); # convert spec to non-spec sizes
1316              
1317 0         0 $size += $hlen; # and re-add header len so that the entire frame's size is known
1318              
1319 0         0 $id3v2_4_frame_size_broken = 1;
1320              
1321 0 0       0 print "Frame size cannot be valid ID3v2.4 (part 1); reverting to broken behaviour\n" if ($debug_24);
1322              
1323             }
1324              
1325             # Part 2: If the frame size would result in the following frame being
1326             # invalid.
1327 36 50 66     140 if ($v2h->{major_version}==4 &&
      66        
      33        
1328             $id3v2_4_frame_size_broken == 0 && # we haven't detected brokenness yet
1329             $size > 0x80+$hlen && # ignore frames that are too short to ever be wrong
1330             $off + $size < $end)
1331             {
1332              
1333 0 0       0 print "Frame size might not be valid ID3v2.4 (part 2); checking for following frame validity\n" if ($debug_24);
1334              
1335 0         0 my $morebytes = substr($wholetag, $off+$size, 4);
1336              
1337 0 0 0     0 if (! ($morebytes =~ /^([A-Z0-9]{4})/ || $morebytes =~ /^\x00{4}/) ) {
1338              
1339             # The next tag cannot be valid because its name is wrong, which means that
1340             # either the size must be invalid or the next frame truely is broken.
1341             # Either way, we can try to reduce the size to see.
1342 0         0 my $retrysize;
1343              
1344 0 0       0 print " following frame isn't valid using spec\n" if ($debug_24);
1345              
1346 0         0 $retrysize = $size - $hlen; # remove already added header length
1347 0         0 $retrysize = (($retrysize & 0x0000007f)) |
1348             (($retrysize & 0x00003f80)<<1) |
1349             (($retrysize & 0x001fc000)<<2) |
1350             (($retrysize & 0x0fe00000)<<3); # convert spec to non-spec sizes
1351              
1352 0         0 $retrysize += $hlen; # and re-add header len so that the entire frame's size is known
1353              
1354 0 0       0 if (length($wholetag) >= ($off+$retrysize+4)) {
1355              
1356 0         0 $morebytes = substr($wholetag, $off+$retrysize, 4);
1357              
1358             } else {
1359              
1360 0         0 $morebytes = '';
1361             }
1362              
1363 0 0 0     0 if (! ($morebytes =~ /^([A-Z0-9]{4})/ ||
      0        
1364             $morebytes =~ /^\x00{4}/ ||
1365             $off + $retrysize > $end) )
1366             {
1367             # With the retry at the smaller size, the following frame still isn't valid
1368             # so the only thing we can assume is that this frame is just broken beyond
1369             # repair. Give up right now - there's no way we can recover.
1370 0 0       0 print " and isn't valid using broken-spec support; giving up\n" if ($debug_24);
1371 0         0 return;
1372             }
1373            
1374 0 0       0 print " but is fine with broken-spec support; reverting to broken behaviour\n" if ($debug_24);
1375            
1376             # We're happy that the non-spec size looks valid to lead us to the next frame.
1377             # We might be wrong, generating false-positives, but that's really what you
1378             # get for trying to handle applications that don't handle the spec properly -
1379             # use something that isn't broken.
1380             # (this is a copy of the recovery code in part 1)
1381 0         0 $size = $retrysize;
1382 0         0 $bytesize = 128;
1383 0         0 $id3v2_4_frame_size_broken = 1;
1384              
1385             } else {
1386              
1387 0 0       0 print " looks like valid following frame; keeping spec behaviour\n" if ($debug_24);
1388              
1389             }
1390             }
1391              
1392 36         52 my $flags = {};
1393              
1394             # JRF: was > 3, but that's not true; future versions may be incompatible
1395 36 100       91 if ($v2h->{major_version} == 4) {
    100          
1396 12         74 my @bits = split //, unpack 'B16', substr($bytes, 8, 2);
1397 12         32 $flags->{frame_zlib} = $bits[12]; # JRF: need to know about compressed
1398 12         18 $flags->{frame_encrypt} = $bits[13]; # JRF: ... and encrypt
1399 12         14 $flags->{frame_unsync} = $bits[14];
1400 12         33 $flags->{data_len_indicator} = $bits[15];
1401             }
1402              
1403             # JRF: version 3 was in a different order
1404             elsif ($v2h->{major_version} == 3) {
1405 12         73 my @bits = split //, unpack 'B16', substr($bytes, 8, 2);
1406 12         33 $flags->{frame_zlib} = $bits[8]; # JRF: need to know about compressed
1407 12         18 $flags->{data_len_indicator} = $bits[8]; # JRF: and compression implies the DLI is present
1408 12         42 $flags->{frame_encrypt} = $bits[9]; # JRF: ... and encrypt
1409             }
1410              
1411 36         138 return ($id, $size, $flags);
1412 6         51 };
1413              
1414 6         14 while ($off < $end) {
1415 42 100       69 my ($id, $size, $flags) = &$myseek or last;
1416 36         49 my ($hlenextra) = 0;
1417              
1418             # NOTE: Wrong; the encrypt comes after the DLI. maybe.
1419             # JRF: Encrypted frames need to be decrypted first
1420 36 50       77 if ($flags->{frame_encrypt}) {
1421              
1422 0         0 my ($encypt_method) = substr($wholetag, $off+$hlen+$hlenextra, 1);
1423              
1424 0         0 $hlenextra++;
1425              
1426             # We don't actually know how to decrypt anything, so we'll just skip the entire frame.
1427 0         0 $off += $size;
1428              
1429 0         0 next;
1430             }
1431              
1432 36         79 my $bytes = substr($wholetag, $off+$hlen+$hlenextra, $size-$hlen-$hlenextra);
1433              
1434 36         31 my $data_len;
1435 36 50       69 if ($flags->{data_len_indicator}) {
1436 0         0 $data_len = 0;
1437              
1438 0         0 my @data_len_bytes = reverse unpack 'C4', substr($bytes, 0, 4);
1439              
1440 0         0 $bytes = substr($bytes, 4);
1441              
1442 0         0 for my $i (0..3) {
1443 0         0 $data_len += $data_len_bytes[$i] * 128 ** $i;
1444             }
1445             }
1446              
1447 36 50       56 print "got $id, length " . length($bytes) . " frameunsync: ".$flags->{frame_unsync}." tag unsync: ".$v2h->{unsync} ."\n" if ($debug_24);
1448              
1449             # perform frame-level unsync if needed (skip if already done for whole tag)
1450 36 50 33     84 $bytes =~ s/\xFF\x00/\xFF/gs if $flags->{frame_unsync} && !$v2h->{unsync};
1451              
1452             # JRF: Decompress now if compressed.
1453             # (FIXME: Not implemented yet)
1454              
1455             # if we know the data length, sanity check it now.
1456 36 50 33     73 if ($flags->{data_len_indicator} && defined $data_len) {
1457 0 0       0 carp("Size mismatch on $id\n") unless $data_len == length($bytes);
1458             }
1459              
1460             # JRF: Apply small sanity check on text elements - they must end with :
1461             # a 0 if they are ISO8859-1
1462             # 0,0 if they are unicode
1463             # (This is handy because it can be caught by the 'duplicate elements'
1464             # in array checks)
1465             # There is a question in my mind whether I should be doing this here - it
1466             # is introducing knowledge of frame content format into the raw reader
1467             # which is not a good idea. But if the frames are broken we at least
1468             # recover.
1469 36 100 100     225 if (($v2h->{major_version} == 3 || $v2h->{major_version} == 4) && $id =~ /^T/) {
      100        
1470              
1471 20         29 my $encoding = substr($bytes, 0, 1);
1472            
1473             # Both these cases are candidates for providing some warning, I feel.
1474             # ISO-8859-1 or UTF-8 $bytes
1475 20 50 33     202 if (($encoding eq "\x00" || $encoding eq "\x03") && $bytes !~ /\x00$/) {
    50 33        
      33        
      33        
1476              
1477 0         0 $bytes .= "\x00";
1478 0 0       0 print "Text frame $id has malformed ISO-8859-1/UTF-8 content\n" if ($debug_Tencoding);
1479              
1480             # # UTF-16, UTF-16BE
1481             } elsif ( ($encoding eq "\x01" || $encoding eq "\x02") && $bytes !~ /\x00\x00$/) {
1482              
1483 0         0 $bytes .= "\x00\x00";
1484 0 0       0 print "Text frame $id has malformed UTF-16/UTF-16BE content\n" if ($debug_Tencoding);
1485              
1486             } else {
1487              
1488             # Other encodings cannot be fixed up (we don't know how 'cos they're not defined).
1489             }
1490             }
1491              
1492 36 50       61 if (exists $v2->{$id}) {
1493              
1494 0 0       0 if (ref $v2->{$id} eq 'ARRAY') {
1495 0         0 push @{$v2->{$id}}, $bytes;
  0         0  
1496             } else {
1497 0         0 $v2->{$id} = [$v2->{$id}, $bytes];
1498             }
1499              
1500             } else {
1501              
1502 36         103 $v2->{$id} = $bytes;
1503             }
1504              
1505 36         101 $off += $size;
1506             }
1507              
1508 6 50 33     51 if (($ver == 0 || $ver == 2) && $v2) {
      33        
1509              
1510 6 50 33     30 if ($raw == 1 && $ver == 2) {
1511              
1512 0         0 %$info = %$v2;
1513              
1514 0         0 $info->{'TAGVERSION'} = $v2h->{'version'};
1515              
1516             } else {
1517              
1518 6         18 _parse_v2tag($ver, $raw, $v2, $info);
1519              
1520 6 50 33     35 if ($ver == 0 && $info->{'TAGVERSION'}) {
1521 0         0 $info->{'TAGVERSION'} .= ' / ' . $v2h->{'version'};
1522             } else {
1523 6         14 $info->{'TAGVERSION'} = $v2h->{'version'};
1524             }
1525             }
1526             }
1527              
1528 6         151 return 1;
1529             }
1530              
1531             =pod
1532              
1533             =item get_mp3info (FILE)
1534              
1535             Returns hash reference containing file information for MP3 file.
1536             This data cannot be changed. Returned data:
1537              
1538             VERSION MPEG audio version (1, 2, 2.5)
1539             LAYER MPEG layer description (1, 2, 3)
1540             STEREO boolean for audio is in stereo
1541              
1542             VBR boolean for variable bitrate
1543             BITRATE bitrate in kbps (average for VBR files)
1544             FREQUENCY frequency in kHz
1545             SIZE bytes in audio stream
1546             OFFSET bytes offset that stream begins
1547              
1548             SECS total seconds
1549             MM minutes
1550             SS leftover seconds
1551             MS leftover milliseconds
1552             TIME time in MM:SS
1553              
1554             COPYRIGHT boolean for audio is copyrighted
1555             PADDING boolean for MP3 frames are padded
1556             MODE channel mode (0 = stereo, 1 = joint stereo,
1557             2 = dual channel, 3 = single channel)
1558             FRAMES approximate number of frames
1559             FRAME_LENGTH approximate length of a frame
1560             VBR_SCALE VBR scale from VBR header
1561              
1562             On error, returns nothing and sets C<$@>.
1563              
1564             =cut
1565              
1566             sub get_mp3info {
1567 6     6 1 11 my($file) = @_;
1568 6         8 my($off, $byte, $eof, $h, $tot, $fh);
1569              
1570 6 50 33     31 if (not (defined $file && $file ne '')) {
1571 0         0 $@ = "No file specified";
1572 0         0 return undef;
1573             }
1574            
1575 6         97 my $size = -s $file;
1576              
1577 6 50       15 if (ref $file) { # filehandle passed
1578 0         0 $fh = $file;
1579             } else {
1580 6 50       12 if ( !$size ) {
1581 0         0 $@ = "File is empty";
1582 0         0 return undef;
1583             }
1584            
1585 6 50       209 if (not open $fh, '<', $file) {
1586 0         0 $@ = "Can't open $file: $!";
1587 0         0 return undef;
1588             }
1589             }
1590              
1591 6         10 $off = 0;
1592 6         8 $tot = 8192;
1593              
1594             # Let the caller change how far we seek in looking for a header.
1595 6 50       16 if ($try_harder) {
1596 0         0 $tot *= $try_harder;
1597             }
1598              
1599 6         11 binmode $fh;
1600 6         29 seek $fh, $off, SEEK_SET;
1601 6         95 read $fh, $byte, 4;
1602              
1603 6 50       14 if (my $v2h = _get_v2head($fh)) {
1604 0         0 $tot += $off += $v2h->{tag_size};
1605            
1606 0 0       0 if ( $off > $size - 10 ) {
1607             # Invalid v2 tag size
1608 0         0 $off = 0;
1609             }
1610            
1611 0         0 seek $fh, $off, SEEK_SET;
1612 0         0 read $fh, $byte, 4;
1613             }
1614              
1615 6         12 $h = _get_head($byte);
1616 6         15 my $is_mp3 = _is_mp3($h);
1617              
1618             # the head wasn't where we were expecting it.. dig deeper.
1619 6 50       15 unless ($is_mp3) {
1620              
1621             # do only one read - it's _much_ faster
1622 6         7 $off++;
1623 6         47 seek $fh, $off, SEEK_SET;
1624 6         95 read $fh, $byte, $tot;
1625            
1626 6         8 my $i;
1627            
1628             # now walk the bytes looking for the head
1629 6         18 for ($i = 0; $i < $tot; $i++) {
1630              
1631 1944 50       3100 last if ($tot - $i) < 4;
1632            
1633 1944   50     3523 my $head = substr($byte, $i, 4) || last;
1634            
1635 1944 100       4957 next if (ord($head) != 0xff);
1636            
1637 66         91 $h = _get_head($head);
1638 66         239 $is_mp3 = _is_mp3($h);
1639 66 100       193 last if $is_mp3;
1640             }
1641            
1642             # adjust where we are for _get_vbr()
1643 6         9 $off += $i;
1644              
1645 6 50 33     15 if ($off > $tot && !$try_harder) {
1646 0         0 _close($file, $fh);
1647 0         0 $@ = "Couldn't find MP3 header (perhaps set " .
1648             '$MP3::Info::try_harder and retry)';
1649 0         0 return undef;
1650             }
1651             }
1652            
1653 6         12 $h->{offset} = $off;
1654              
1655 6         16 my $vbr = _get_vbr($fh, $h, \$off);
1656 6         17 my $lame = _get_lame($fh, $h, \$off);
1657            
1658 6         47 seek $fh, 0, SEEK_END;
1659 6         11 $eof = tell $fh;
1660 6         26 seek $fh, -128, SEEK_END;
1661 6 50       94 $eof -= 128 if <$fh> =~ /^TAG/ ? 1 : 0;
    50          
1662              
1663             # JRF: Check for an ID3v2.4 footer and if present, remove it from
1664             # the size.
1665 6         31 seek($fh, $eof, SEEK_SET);
1666              
1667 6 50       13 if (my $v2f = _get_v2foot($fh)) {
1668 0         0 $eof -= $v2f->{tag_size};
1669             }
1670              
1671 6         15 _close($file, $fh);
1672              
1673 6         13 $h->{size} = $eof - $off;
1674              
1675 6         17 return _get_info($h, $vbr, $lame);
1676             }
1677              
1678             sub _get_info {
1679 6     6   11 my($h, $vbr, $lame) = @_;
1680 6         6 my $i;
1681              
1682             # No bitrate or sample rate? Something's wrong.
1683 6 50 33     37 unless ($h->{bitrate} && $h->{fs}) {
1684 0         0 return {};
1685             }
1686              
1687 6 0       28 $i->{VERSION} = $h->{IDR} == 2 ? 2 : $h->{IDR} == 3 ? 1 : $h->{IDR} == 0 ? 2.5 : 0;
    50          
    100          
1688 6         16 $i->{LAYER} = 4 - $h->{layer};
1689              
1690 6 50 33     33 if (ref($vbr) eq 'HASH' and $vbr->{is_vbr} == 1) {
1691 0         0 $i->{VBR} = 1;
1692             } else {
1693 6         12 $i->{VBR} = 0;
1694             }
1695              
1696 6 50       16 $i->{COPYRIGHT} = $h->{copyright} ? 1 : 0;
1697 6 50       16 $i->{PADDING} = $h->{padding_bit} ? 1 : 0;
1698 6 100       17 $i->{STEREO} = $h->{mode} == 3 ? 0 : 1;
1699 6         14 $i->{MODE} = $h->{mode};
1700              
1701 6 50 33     28 $i->{SIZE} = $i->{VBR} == 1 && $vbr->{bytes} ? $vbr->{bytes} : $h->{size};
1702 6         10 $i->{OFFSET} = $h->{offset};
1703              
1704 6 100       22 my $mfs = $h->{fs} / ($h->{ID} ? 144000 : 72000);
1705 6 50 33     36 $i->{FRAMES} = int($i->{VBR} == 1 && $vbr->{frames}
1706             ? $vbr->{frames}
1707             : $i->{SIZE} / ($h->{bitrate} / $mfs)
1708             );
1709              
1710 6 50       22 if ($i->{VBR} == 1) {
1711 0 0       0 $i->{VBR_SCALE} = $vbr->{scale} if $vbr->{scale};
1712 0         0 $h->{bitrate} = $i->{SIZE} / $i->{FRAMES} * $mfs;
1713 0 0       0 if (not $h->{bitrate}) {
1714 0         0 $@ = "Couldn't determine VBR bitrate";
1715 0         0 return undef;
1716             }
1717             }
1718              
1719 6         22 $h->{'length'} = ($i->{SIZE} * 8) / $h->{bitrate} / 10;
1720 6         13 $i->{SECS} = $h->{'length'} / 100;
1721 6         17 $i->{MM} = int $i->{SECS} / 60;
1722 6         15 $i->{SS} = int $i->{SECS} % 60;
1723 6         21 $i->{MS} = (($i->{SECS} - ($i->{MM} * 60) - $i->{SS}) * 1000);
1724             # $i->{LF} = ($i->{MS} / 1000) * ($i->{FRAMES} / $i->{SECS});
1725             # int($i->{MS} / 100 * 75); # is this right?
1726 6         8 $i->{TIME} = sprintf "%.2d:%.2d", @{$i}{'MM', 'SS'};
  6         38  
1727              
1728 6         22 $i->{BITRATE} = int $h->{bitrate};
1729             # should we just return if ! FRAMES?
1730 6 50       26 $i->{FRAME_LENGTH} = int($h->{size} / $i->{FRAMES}) if $i->{FRAMES};
1731 6         19 $i->{FREQUENCY} = $frequency_tbl[3 * $h->{IDR} + $h->{sampling_freq}];
1732            
1733 6 50       21 if ($lame) {
1734 0         0 $i->{LAME} = $lame;
1735             }
1736              
1737 6         60 return $i;
1738             }
1739              
1740             sub _get_head {
1741 72     72   87 my($byte) = @_;
1742 72         65 my($bytes, $h);
1743              
1744 72         111 $bytes = _unpack_head($byte);
1745 72         688 @$h{qw(IDR ID layer protection_bit
1746             bitrate_index sampling_freq padding_bit private_bit
1747             mode mode_extension copyright original
1748             emphasis version_index bytes)} = (
1749             ($bytes>>19)&3, ($bytes>>19)&1, ($bytes>>17)&3, ($bytes>>16)&1,
1750             ($bytes>>12)&15, ($bytes>>10)&3, ($bytes>>9)&1, ($bytes>>8)&1,
1751             ($bytes>>6)&3, ($bytes>>4)&3, ($bytes>>3)&1, ($bytes>>2)&1,
1752             $bytes&3, ($bytes>>19)&3, $bytes
1753             );
1754              
1755 72         294 $h->{bitrate} = $t_bitrate[$h->{ID}][3 - $h->{layer}][$h->{bitrate_index}];
1756 72         141 $h->{fs} = $t_sampling_freq[$h->{IDR}][$h->{sampling_freq}];
1757              
1758 72         116 return $h;
1759             }
1760              
1761             sub _is_mp3 {
1762 72 50   72   179 my $h = $_[0] or return undef;
1763             return ! ( # all below must be false
1764 72   33     651 $h->{bitrate_index} == 0
1765             ||
1766             $h->{version_index} == 1
1767             ||
1768             ($h->{bytes} & 0xFFE00000) != 0xFFE00000
1769             ||
1770             !$h->{fs}
1771             ||
1772             !$h->{bitrate}
1773             ||
1774             $h->{bitrate_index} == 15
1775             ||
1776             !$h->{layer}
1777             ||
1778             $h->{sampling_freq} == 3
1779             ||
1780             $h->{emphasis} == 2
1781             ||
1782             !$h->{bitrate_index}
1783             ||
1784             ($h->{bytes} & 0xFFFF0000) == 0xFFFE0000
1785             ||
1786             ($h->{ID} == 1 && $h->{layer} == 3 && $h->{protection_bit} == 1)
1787             # mode extension should only be applicable when mode = 1
1788             # however, failing just becuase mode extension is used when unneeded is a bit strict
1789             # ||
1790             #($h->{mode_extension} != 0 && $h->{mode} != 1)
1791             );
1792             }
1793              
1794             sub _vbr_seek {
1795 12     12   17 my $fh = shift;
1796 12         14 my $off = shift;
1797 12         12 my $bytes = shift;
1798 12   100     38 my $n = shift || 4;
1799              
1800 12         97 seek $fh, $$off, SEEK_SET;
1801 12         94 read $fh, $$bytes, $n;
1802              
1803 12         74 $$off += $n;
1804             }
1805              
1806             sub _get_vbr {
1807 6     6   11 my ($fh, $h, $roff) = @_;
1808 6         13 my ($off, $bytes, @bytes);
1809 6         17 my %vbr = (is_vbr => 0);
1810              
1811 6         8 $off = $$roff;
1812              
1813 6         7 $off += 4;
1814              
1815 6 100       15 if ($h->{ID}) { # MPEG1
1816 3 50       14 $off += $h->{mode} == 3 ? 17 : 32;
1817             } else { # MPEG2
1818 3 50       10 $off += $h->{mode} == 3 ? 9 : 17;
1819             }
1820              
1821 6         15 _vbr_seek($fh, \$off, \$bytes);
1822              
1823 6 50       43 if ($bytes =~ /(?:Xing|Info)/) {
    50          
1824             # Info is CBR
1825 0 0       0 $vbr{is_vbr} = 1 if $bytes =~ /Xing/;
1826              
1827 0         0 _vbr_seek($fh, \$off, \$bytes);
1828 0         0 $vbr{flags} = _unpack_head($bytes);
1829            
1830 0 0       0 if ($vbr{flags} & 1) {
1831 0         0 _vbr_seek($fh, \$off, \$bytes);
1832 0         0 $vbr{frames} = _unpack_head($bytes);
1833             }
1834            
1835 0 0       0 if ($vbr{flags} & 2) {
1836 0         0 _vbr_seek($fh, \$off, \$bytes);
1837 0         0 $vbr{bytes} = _unpack_head($bytes);
1838             }
1839            
1840 0 0       0 if ($vbr{flags} & 4) {
1841 0         0 _vbr_seek($fh, \$off, \$bytes, 100);
1842             # Not used right now ...
1843             #$vbr{toc} = _unpack_head($bytes);
1844             }
1845            
1846 0 0       0 if ($vbr{flags} & 8) { # (quality ind., 0=best 100=worst)
1847 0         0 _vbr_seek($fh, \$off, \$bytes);
1848 0         0 $vbr{scale} = _unpack_head($bytes);
1849             } else {
1850 0         0 $vbr{scale} = -1;
1851             }
1852              
1853 0         0 $$roff = $off;
1854             } elsif ($bytes =~ /(?:VBRI)/) {
1855 0         0 $vbr{is_vbr} = 1;
1856            
1857             # Fraunhofer encoder uses VBRI format
1858             # start with quality factor at position 8
1859 0         0 _vbr_seek($fh, \$off, \$bytes, 4);
1860 0         0 _vbr_seek($fh, \$off, \$bytes, 2);
1861 0         0 $vbr{scale} = unpack('l', pack('L', unpack('n', $bytes)));
1862              
1863             # Then Bytes, as position 10
1864 0         0 _vbr_seek($fh, \$off, \$bytes);
1865 0         0 $vbr{bytes} = _unpack_head($bytes);
1866              
1867             # Finally Frames at position 14
1868 0         0 _vbr_seek($fh, \$off, \$bytes);
1869 0         0 $vbr{frames} = _unpack_head($bytes);
1870              
1871 0         0 $$roff = $off;
1872             }
1873              
1874 6         15 return \%vbr;
1875             }
1876              
1877             # Read LAME info tag
1878             # http://gabriel.mp3-tech.org/mp3infotag.html
1879             sub _get_lame {
1880 6     6   9 my($fh, $h, $roff) = @_;
1881            
1882 6         8 my($off, $bytes, @bytes, %lame);
1883              
1884 6         8 $off = $$roff;
1885            
1886             # Encode version, 9 bytes
1887 6         14 _vbr_seek($fh, \$off, \$bytes, 9);
1888 6         15 $lame{encoder_version} = $bytes;
1889              
1890 6 50       26 return unless $bytes =~ /^LAME/;
1891              
1892             # There's some stuff here but it's not too useful
1893 0         0 _vbr_seek($fh, \$off, \$bytes, 12);
1894            
1895             # Encoder delays (used for gapless decoding)
1896 0         0 _vbr_seek($fh, \$off, \$bytes, 3);
1897 0         0 my $bin = unpack 'B*', $bytes;
1898 0         0 $lame{start_delay} = unpack('N', pack('B32', substr('0' x 32 . substr($bin, 0, 12), -32)));
1899 0         0 $lame{end_padding} = unpack('N', pack('B32', substr('0' x 32 . substr($bin, 12, 12), -32)));
1900            
1901 0         0 return \%lame;
1902             }
1903              
1904             # _get_v2head(file handle, start offset in file);
1905             # The start offset can be used to check ID3v2 headers anywhere
1906             # in the MP3 (eg for 'update' frames).
1907             sub _get_v2head {
1908 36 50   36   98 my $fh = $_[0] or return;
1909              
1910 36   50     228 my $v2h = {
1911             'offset' => $_[1] || 0,
1912             'tag_size' => 0,
1913             };
1914              
1915             # check first three bytes for 'ID3'
1916 36         256 seek($fh, $v2h->{offset}, SEEK_SET);
1917 36         293 read($fh, my $header, 10);
1918              
1919 36         73 my $tag = substr($header, 0, 3);
1920              
1921             # (Note: Footers are dealt with in v2foot)
1922 36 50       105 if ($v2h->{offset} == 0) {
1923              
1924             # JRF: Only check for special headers if we're at the start of the file.
1925 36 50 33     169 if ($tag eq 'RIF' || $tag eq 'FOR') {
1926 0 0       0 _find_id3_chunk($fh, $tag) or return;
1927 0         0 $v2h->{offset} = tell $fh;
1928              
1929 0         0 read($fh, $header, 10);
1930 0         0 $tag = substr($header, 0, 3);
1931             }
1932             }
1933              
1934 36 100       147 return if $tag ne 'ID3';
1935              
1936             # get version
1937 12         51 my ($major, $minor, $flags) = unpack ("x3CCC", $header);
1938              
1939 12         59 $v2h->{version} = sprintf("ID3v2.%d.%d", $major, $minor);
1940 12         23 $v2h->{major_version} = $major;
1941 12         21 $v2h->{minor_version} = $minor;
1942              
1943             # get flags
1944 12         92 my @bits = split(//, unpack('b8', pack('v', $flags)));
1945              
1946 12 100       41 if ($v2h->{major_version} == 2) {
1947 4         11 $v2h->{unsync} = $bits[7];
1948 4         12 $v2h->{compression} = $bits[6]; # Should be ignored - no defined form
1949 4         13 $v2h->{ext_header} = 0;
1950 4         11 $v2h->{experimental} = 0;
1951             } else {
1952 8         17 $v2h->{unsync} = $bits[7];
1953 8         16 $v2h->{ext_header} = $bits[6];
1954 8         24 $v2h->{experimental} = $bits[5];
1955 8 100       25 $v2h->{footer} = $bits[4] if $v2h->{major_version} == 4;
1956             }
1957              
1958             # get ID3v2 tag length from bytes 7-10
1959 12         25 my $rawsize = substr($header, 6, 4);
1960              
1961 12         39 for my $b (unpack('C4', $rawsize)) {
1962              
1963 48         91 $v2h->{tag_size} = ($v2h->{tag_size} << 7) + $b;
1964             }
1965              
1966 12         19 $v2h->{tag_size} += 10; # include ID3v2 header size
1967 12 50       29 $v2h->{tag_size} += 10 if $v2h->{footer};
1968              
1969             # JRF: I think this is done wrongly - this should be part of the main frame,
1970             # and therefore under ID3v2.3 it's subject to unsynchronisation
1971             # (ID3v2.3, section 3.2).
1972             # FIXME.
1973              
1974             # get extended header size (2.3/2.4 only)
1975 12         22 $v2h->{ext_header_size} = 0;
1976              
1977 12 50       41 if ($v2h->{ext_header}) {
1978 0         0 my $filesize = -s $fh;
1979              
1980 0         0 read $fh, my $bytes, 4;
1981 0         0 my @bytes = reverse unpack 'C4', $bytes;
1982              
1983             # use syncsafe bytes if using version 2.4
1984 0 0       0 my $bytesize = ($v2h->{major_version} > 3) ? 128 : 256;
1985 0         0 for my $i (0..3) {
1986 0         0 $v2h->{ext_header_size} += $bytes[$i] * $bytesize ** $i;
1987             }
1988              
1989             # Bug 4486
1990             # Don't try to read past the end of the file if we have a
1991             # bogus extended header size.
1992 0 0       0 if (($v2h->{ext_header_size} - 10 ) > -s $fh) {
1993              
1994 0         0 return $v2h;
1995             }
1996              
1997             # Read the extended header
1998 0         0 my $ext_data;
1999 0 0       0 if ($v2h->{major_version} == 3) {
    0          
2000             # On ID3v2.3 the extended header size excludes the whole header
2001 0         0 read $fh, $bytes, 6 + $v2h->{ext_header_size};
2002 0         0 my @bits = split //, unpack 'b16', substr $bytes, 0, 2;
2003 0         0 $v2h->{crc_present} = $bits[15];
2004 0         0 my $padding_size;
2005 0         0 for my $i (0..3) {
2006              
2007 0 0       0 if (defined $bytes[2 + $i]) {
2008 0         0 $padding_size += $bytes[2 + $i] * $bytesize ** $i;
2009             }
2010             }
2011 0         0 $ext_data = substr $bytes, 6, $v2h->{ext_header_size} - $padding_size;
2012             }
2013             elsif ($v2h->{major_version} == 4) {
2014             # On ID3v2.4, the extended header size includes the whole header
2015 0         0 read $fh, $bytes, $v2h->{ext_header_size} - 4;
2016 0         0 my @bits = split //, unpack 'b8', substr $bytes, 5, 1;
2017 0         0 $v2h->{update} = $bits[6];
2018 0         0 $v2h->{crc_present} = $bits[5];
2019 0         0 $v2h->{tag_restrictions} = $bits[4];
2020 0         0 $ext_data = substr $bytes, 2, $v2h->{ext_header_size} - 6;
2021             }
2022              
2023             # JRF: I'm not actually working out what the CRC or the tag
2024             # restrictions are just yet. It doesn't seem to be
2025             # all that worthwhile.
2026             # However, if this is implemented...
2027             # Under ID3v2.3, the CRC is not sync-safe (4 bytes).
2028             # Under ID3v2.4, the CRC is sync-safe (5 bytes, excluding the flag data
2029             # length)
2030             # Under ID3v2.4, every flag byte that's set is given a flag data byte
2031             # in the extended data area, the first byte of which is the size of
2032             # the flag data (see ID3v2.4 section 3.2).
2033             }
2034              
2035 12         46 return $v2h;
2036             }
2037              
2038             # JRF: We assume that we have seeked to the expected EOF (ie start of the ID3v1 tag)
2039             # The 'offset' value will hold the start of the ID3v1 header (NOT the footer)
2040             # The 'tag_size' value will hold the entire tag size, including the footer.
2041             sub _get_v2foot {
2042 20 50   20   61 my $fh = $_[0] or return;
2043 20         22 my($v2h, $bytes, @bytes);
2044 0         0 my $eof;
2045              
2046 20         29 $eof = tell $fh;
2047              
2048             # check first three bytes for 'ID3'
2049 20         100 seek $fh, $eof-10, SEEK_SET; # back 10 bytes for footer
2050 20         108 read $fh, $bytes, 3;
2051              
2052 20 50       102 return undef unless $bytes eq '3DI';
2053              
2054             # get version
2055 0         0 read $fh, $bytes, 2;
2056 0         0 $v2h->{version} = sprintf "ID3v2.%d.%d",
2057             @$v2h{qw[major_version minor_version]} =
2058             unpack 'c2', $bytes;
2059              
2060             # get flags
2061 0         0 read $fh, $bytes, 1;
2062 0         0 my @bits = split //, unpack 'b8', $bytes;
2063 0 0       0 if ($v2h->{major_version} != 4) {
2064             # JRF: This should never happen - only v4 tags should have footers.
2065             # Think about raising some warnings or something ?
2066             # print STDERR "Invalid ID3v2 footer version number\n";
2067             } else {
2068 0         0 $v2h->{unsync} = $bits[7];
2069 0         0 $v2h->{ext_header} = $bits[6];
2070 0         0 $v2h->{experimental} = $bits[5];
2071 0         0 $v2h->{footer} = $bits[4];
2072 0 0       0 if (!$v2h->{footer})
2073             {
2074             # JRF: This is an invalid footer marker; it doesn't make sense
2075             # for the footer to not be marked as the tag having a footer
2076             # so strictly it's an invalid tag.
2077             # A warning might be nice, but for now we'll ignore.
2078             # print STDERR "Warning: Footer doesn't have footer bit set\n";
2079             }
2080             }
2081              
2082             # get ID3v2 tag length from bytes 7-10
2083 0         0 $v2h->{tag_size} = 10; # include ID3v2 header size
2084 0         0 $v2h->{tag_size} += 10; # always account for the footer
2085 0         0 read $fh, $bytes, 4;
2086 0         0 @bytes = reverse unpack 'C4', $bytes;
2087 0         0 foreach my $i (0 .. 3) {
2088             # whoaaaaaa nellllllyyyyyy!
2089 0         0 $v2h->{tag_size} += $bytes[$i] * 128 ** $i;
2090             }
2091              
2092             # Note that there are no extended header details on the footer; it's
2093             # just a copy of it so that clients can seek backward to find the
2094             # footer's start.
2095              
2096 0         0 $v2h->{offset} = $eof - $v2h->{tag_size};
2097              
2098             # Just to be really sure, read the start of the ID3v2.4 header here.
2099 0         0 seek $fh, $v2h->{offset}, 0; # SEEK_SET
2100 0         0 read $fh, $bytes, 3;
2101 0 0       0 if ($bytes ne "ID3") {
2102             # Not really an ID3v2.4 tag header; a warning would be nice but ignore
2103             # for now.
2104             # print STDERR "Invalid ID3v2 footer (header check) at " . $v2h->{offset} . "\n";
2105 0         0 return undef;
2106             }
2107              
2108             # We could check more of the header. I'm not sure it's really worth it
2109             # right now but at some point in the future checking the details match
2110             # would be nice.
2111              
2112 0         0 return $v2h;
2113            
2114             };
2115              
2116             sub _find_id3_chunk {
2117 0     0   0 my($fh, $filetype) = @_;
2118 0         0 my($bytes, $size, $tag, $pat, @mat);
2119              
2120             # CHANGE 10616 introduced a read optimization in _get_v2head:
2121             # 10 bytes are read, not 3, so reading one here hoping to get the last letter of the
2122             # tag is a bad idea, as it always fails...
2123            
2124             # read $fh, $bytes, 1;
2125 0 0       0 if ($filetype eq 'RIF') { # WAV
    0          
2126             # return 0 if $bytes ne 'F';
2127 0         0 $pat = 'a4V';
2128 0         0 @mat = ('id3 ', 'ID32');
2129             } elsif ($filetype eq 'FOR') { # AIFF
2130             # return 0 if $bytes ne 'M';
2131 0         0 $pat = 'a4N';
2132 0         0 @mat = ('ID3 ', 'ID32');
2133             }
2134 0         0 seek $fh, 12, SEEK_SET; # skip to the first chunk
2135              
2136 0         0 while ((read $fh, $bytes, 8) == 8) {
2137 0         0 ($tag, $size) = unpack $pat, $bytes;
2138 0         0 for my $mat ( @mat ) {
2139 0 0       0 return 1 if $tag eq $mat;
2140             }
2141 0         0 seek $fh, $size, SEEK_CUR;
2142             }
2143              
2144 0         0 return 0;
2145             }
2146              
2147             sub _unpack_head {
2148 72     72   242 unpack('l', pack('L', unpack('N', $_[0])));
2149             }
2150              
2151             sub _grab_int_16 {
2152 0     0   0 my $data = shift;
2153 0         0 my $value = unpack('s', pack('S', unpack('n',substr($$data,0,2))));
2154 0         0 $$data = substr($$data,2);
2155 0         0 return $value;
2156             }
2157              
2158             sub _grab_uint_16 {
2159 0     0   0 my $data = shift;
2160 0         0 my $value = unpack('S',substr($$data,0,2));
2161 0         0 $$data = substr($$data,2);
2162 0         0 return $value;
2163             }
2164              
2165             sub _grab_int_32 {
2166 0     0   0 my $data = shift;
2167 0         0 my $value = unpack('V',substr($$data,0,4));
2168 0         0 $$data = substr($$data,4);
2169 0         0 return $value;
2170             }
2171              
2172             # From getid3 - lyrics
2173             #
2174             # Just get the size and offset, so the APE tag can be parsed.
2175             sub _parse_lyrics3_tag {
2176 0     0   0 my ($fh, $filesize, $info) = @_;
2177              
2178             # end - ID3v1 - LYRICSEND - [Lyrics3size]
2179 0         0 seek($fh, (0 - 128 - 9 - 6), SEEK_END);
2180 0         0 read($fh, my $lyrics3_id3v1, 128 + 9 + 6);
2181              
2182 0         0 my $lyrics3_lsz = substr($lyrics3_id3v1, 0, 6); # Lyrics3size
2183 0         0 my $lyrics3_end = substr($lyrics3_id3v1, 6, 9); # LYRICSEND or LYRICS200
2184 0         0 my $id3v1_tag = substr($lyrics3_id3v1, 15, 128); # ID3v1
2185              
2186 0         0 my ($lyrics3_size, $lyrics3_offset, $lyrics3_version);
2187              
2188             # Lyrics3v1, ID3v1, no APE
2189 0 0       0 if ($lyrics3_end eq 'LYRICSEND') {
    0          
    0          
    0          
2190              
2191 0         0 $lyrics3_size = 5100;
2192 0         0 $lyrics3_offset = $filesize - 128 - $lyrics3_size;
2193 0         0 $lyrics3_version = 1;
2194              
2195             } elsif ($lyrics3_end eq 'LYRICS200') {
2196              
2197             # Lyrics3v2, ID3v1, no APE
2198             # LSZ = lyrics + 'LYRICSBEGIN'; add 6-byte size field; add 'LYRICS200'
2199 0         0 $lyrics3_size = $lyrics3_lsz + 6 + length('LYRICS200');
2200 0         0 $lyrics3_offset = $filesize - 128 - $lyrics3_size;
2201 0         0 $lyrics3_version = 2;
2202              
2203             } elsif (substr(reverse($lyrics3_id3v1), 0, 9) eq 'DNESCIRYL') {
2204              
2205             # Lyrics3v1, no ID3v1, no APE
2206 0         0 $lyrics3_size = 5100;
2207 0         0 $lyrics3_offset = $filesize - $lyrics3_size;
2208 0         0 $lyrics3_version = 1;
2209 0         0 $lyrics3_offset = $filesize - $lyrics3_size;
2210              
2211             } elsif (substr(reverse($lyrics3_id3v1), 0, 9) eq '002SCIRYL') {
2212              
2213             # Lyrics3v2, no ID3v1, no APE
2214             # LSZ = lyrics + 'LYRICSBEGIN'; add 6-byte size field; add 'LYRICS200' > 15 = 6 + strlen('LYRICS200')
2215 0         0 $lyrics3_size = reverse(substr(reverse($lyrics3_id3v1), 9, 6)) + 15;
2216 0         0 $lyrics3_offset = $filesize - $lyrics3_size;
2217 0         0 $lyrics3_version = 2;
2218             }
2219              
2220 0         0 return $lyrics3_offset;
2221             }
2222              
2223             sub _parse_ape_tag {
2224 0     0   0 my ($fh, $filesize, $info) = @_;
2225              
2226 0         0 my $ape_tag_id = 'APETAGEX';
2227 0         0 my $id3v1_tag_size = 128;
2228 0         0 my $ape_tag_header_size = 32;
2229 0         0 my $lyrics3_tag_size = 10;
2230 0         0 my $tag_offset_start = 0;
2231 0         0 my $tag_offset_end = 0;
2232              
2233 0 0       0 if (my $offset = _parse_lyrics3_tag($fh, $filesize, $info)) {
2234              
2235 0         0 seek($fh, $offset - $ape_tag_header_size, SEEK_SET);
2236 0         0 $tag_offset_end = $offset;
2237              
2238             } else {
2239              
2240 0         0 seek($fh, (0 - $id3v1_tag_size - $ape_tag_header_size - $lyrics3_tag_size), SEEK_END);
2241              
2242 0         0 read($fh, my $ape_footer_id3v1, $id3v1_tag_size + $ape_tag_header_size + $lyrics3_tag_size);
2243              
2244 0 0       0 if (substr($ape_footer_id3v1, (length($ape_footer_id3v1) - $id3v1_tag_size - $ape_tag_header_size), 8) eq $ape_tag_id) {
    0          
2245              
2246 0         0 $tag_offset_end = $filesize - $id3v1_tag_size;
2247              
2248             } elsif (substr($ape_footer_id3v1, (length($ape_footer_id3v1) - $ape_tag_header_size), 8) eq $ape_tag_id) {
2249              
2250 0         0 $tag_offset_end = $filesize;
2251             }
2252              
2253 0         0 seek($fh, $tag_offset_end - $ape_tag_header_size, SEEK_SET);
2254             }
2255              
2256 0         0 read($fh, my $ape_footer_data, $ape_tag_header_size);
2257              
2258 0         0 my $ape_footer = _parse_ape_header_or_footer($ape_footer_data);
2259              
2260 0 0       0 if (keys %{$ape_footer}) {
  0         0  
2261              
2262 0         0 my $ape_tag_data = '';
2263              
2264 0 0       0 if ($ape_footer->{'flags'}->{'header'}) {
2265              
2266 0         0 seek($fh, ($tag_offset_end - $ape_footer->{'tag_size'} - $ape_tag_header_size), SEEK_SET);
2267              
2268 0         0 $tag_offset_start = tell($fh);
2269              
2270 0         0 read($fh, $ape_tag_data, $ape_footer->{'tag_size'} + $ape_tag_header_size);
2271              
2272             } else {
2273              
2274 0         0 $tag_offset_start = $tag_offset_end - $ape_footer->{'tag_size'};
2275              
2276 0         0 seek($fh, $tag_offset_start, SEEK_SET);
2277              
2278 0         0 read($fh, $ape_tag_data, $ape_footer->{'tag_size'});
2279             }
2280              
2281 0         0 my $ape_header_data = substr($ape_tag_data, 0, $ape_tag_header_size, '');
2282 0         0 my $ape_header = _parse_ape_header_or_footer($ape_header_data);
2283            
2284 0 0       0 if ( defined $ape_header->{'version'} ) {
2285 0 0       0 if ( $ape_header->{'version'} == 2000 ) {
2286 0         0 $info->{'TAGVERSION'} = 'APEv2';
2287             }
2288             else {
2289 0         0 $info->{'TAGVERSION'} = 'APEv1';
2290             }
2291             }
2292              
2293 0 0 0     0 if (defined $ape_header->{'tag_items'} && $ape_header->{'tag_items'} =~ /^\d+$/) {
2294              
2295 0         0 for (my $c = 0; $c < $ape_header->{'tag_items'}; $c++) {
2296            
2297             # Loop through the tag items
2298 0         0 my $tag_len = _grab_int_32(\$ape_tag_data);
2299 0         0 my $tag_flags = _grab_int_32(\$ape_tag_data);
2300              
2301 0         0 $ape_tag_data =~ s/^(.*?)\0//;
2302              
2303 0   0     0 my $tag_item_key = uc($1 || 'UNKNOWN');
2304              
2305 0         0 $info->{$tag_item_key} = substr($ape_tag_data, 0, $tag_len, '');
2306             }
2307             }
2308             }
2309              
2310 0         0 seek($fh, 0, SEEK_SET);
2311              
2312 0         0 return 1;
2313             }
2314              
2315             sub _parse_ape_header_or_footer {
2316 0     0   0 my $bytes = shift;
2317 0         0 my %data = ();
2318              
2319 0 0       0 if (substr($bytes, 0, 8, '') eq 'APETAGEX') {
2320              
2321 0         0 $data{'version'} = _grab_int_32(\$bytes);
2322 0         0 $data{'tag_size'} = _grab_int_32(\$bytes);
2323 0         0 $data{'tag_items'} = _grab_int_32(\$bytes);
2324 0         0 $data{'global_flags'} = _grab_int_32(\$bytes);
2325              
2326             # trim the reseved bytes
2327 0         0 _grab_int_32(\$bytes);
2328 0         0 _grab_int_32(\$bytes);
2329              
2330 0 0       0 $data{'flags'}->{'header'} = ($data{'global_flags'} & 0x80000000) ? 1 : 0;
2331 0 0       0 $data{'flags'}->{'footer'} = ($data{'global_flags'} & 0x40000000) ? 1 : 0;
2332 0 0       0 $data{'flags'}->{'is_header'} = ($data{'global_flags'} & 0x20000000) ? 1 : 0;
2333             }
2334              
2335 0         0 return \%data;
2336             }
2337              
2338             sub _close {
2339 41     41   64 my($file, $fh) = @_;
2340 41 50       89 unless (ref $file) { # filehandle not passed
2341 41 50       780 close $fh or carp "Problem closing '$file': $!";
2342             }
2343             }
2344              
2345             BEGIN {
2346 4     4   43405 @mp3_genres = (
2347             'Blues',
2348             'Classic Rock',
2349             'Country',
2350             'Dance',
2351             'Disco',
2352             'Funk',
2353             'Grunge',
2354             'Hip-Hop',
2355             'Jazz',
2356             'Metal',
2357             'New Age',
2358             'Oldies',
2359             'Other',
2360             'Pop',
2361             'R&B',
2362             'Rap',
2363             'Reggae',
2364             'Rock',
2365             'Techno',
2366             'Industrial',
2367             'Alternative',
2368             'Ska',
2369             'Death Metal',
2370             'Pranks',
2371             'Soundtrack',
2372             'Euro-Techno',
2373             'Ambient',
2374             'Trip-Hop',
2375             'Vocal',
2376             'Jazz+Funk',
2377             'Fusion',
2378             'Trance',
2379             'Classical',
2380             'Instrumental',
2381             'Acid',
2382             'House',
2383             'Game',
2384             'Sound Clip',
2385             'Gospel',
2386             'Noise',
2387             'AlternRock',
2388             'Bass',
2389             'Soul',
2390             'Punk',
2391             'Space',
2392             'Meditative',
2393             'Instrumental Pop',
2394             'Instrumental Rock',
2395             'Ethnic',
2396             'Gothic',
2397             'Darkwave',
2398             'Techno-Industrial',
2399             'Electronic',
2400             'Pop-Folk',
2401             'Eurodance',
2402             'Dream',
2403             'Southern Rock',
2404             'Comedy',
2405             'Cult',
2406             'Gangsta',
2407             'Top 40',
2408             'Christian Rap',
2409             'Pop/Funk',
2410             'Jungle',
2411             'Native American',
2412             'Cabaret',
2413             'New Wave',
2414             'Psychadelic',
2415             'Rave',
2416             'Showtunes',
2417             'Trailer',
2418             'Lo-Fi',
2419             'Tribal',
2420             'Acid Punk',
2421             'Acid Jazz',
2422             'Polka',
2423             'Retro',
2424             'Musical',
2425             'Rock & Roll',
2426             'Hard Rock',
2427             );
2428              
2429 4         111 @winamp_genres = (
2430             @mp3_genres,
2431             'Folk',
2432             'Folk-Rock',
2433             'National Folk',
2434             'Swing',
2435             'Fast Fusion',
2436             'Bebop',
2437             'Latin',
2438             'Revival',
2439             'Celtic',
2440             'Bluegrass',
2441             'Avantgarde',
2442             'Gothic Rock',
2443             'Progressive Rock',
2444             'Psychedelic Rock',
2445             'Symphonic Rock',
2446             'Slow Rock',
2447             'Big Band',
2448             'Chorus',
2449             'Easy Listening',
2450             'Acoustic',
2451             'Humour',
2452             'Speech',
2453             'Chanson',
2454             'Opera',
2455             'Chamber Music',
2456             'Sonata',
2457             'Symphony',
2458             'Booty Bass',
2459             'Primus',
2460             'Porn Groove',
2461             'Satire',
2462             'Slow Jam',
2463             'Club',
2464             'Tango',
2465             'Samba',
2466             'Folklore',
2467             'Ballad',
2468             'Power Ballad',
2469             'Rhythmic Soul',
2470             'Freestyle',
2471             'Duet',
2472             'Punk Rock',
2473             'Drum Solo',
2474             'Acapella',
2475             'Euro-House',
2476             'Dance Hall',
2477             'Goa',
2478             'Drum & Bass',
2479             'Club-House',
2480             'Hardcore',
2481             'Terror',
2482             'Indie',
2483             'BritPop',
2484             'Negerpunk',
2485             'Polsk Punk',
2486             'Beat',
2487             'Christian Gangsta Rap',
2488             'Heavy Metal',
2489             'Black Metal',
2490             'Crossover',
2491             'Contemporary Christian',
2492             'Christian Rock',
2493             'Merengue',
2494             'Salsa',
2495             'Thrash Metal',
2496             'Anime',
2497             'JPop',
2498             'Synthpop',
2499             );
2500              
2501 4         47 @t_bitrate = ([
2502             [0, 32, 48, 56, 64, 80, 96, 112, 128, 144, 160, 176, 192, 224, 256],
2503             [0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160],
2504             [0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160]
2505             ],[
2506             [0, 32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448],
2507             [0, 32, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320, 384],
2508             [0, 32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320]
2509             ]);
2510              
2511 4         53 @t_sampling_freq = (
2512             [11025, 12000, 8000],
2513             [undef, undef, undef], # reserved
2514             [22050, 24000, 16000],
2515             [44100, 48000, 32000]
2516             );
2517              
2518 48 100       1667 @frequency_tbl = map { $_ ? eval "${_}e-3" : 0 }
  16         42  
2519 4         14 map { @$_ } @t_sampling_freq;
2520              
2521 4         28 @mp3_info_fields = qw(
2522             VERSION
2523             LAYER
2524             STEREO
2525             VBR
2526             BITRATE
2527             FREQUENCY
2528             SIZE
2529             OFFSET
2530             SECS
2531             MM
2532             SS
2533             MS
2534             TIME
2535             COPYRIGHT
2536             PADDING
2537             MODE
2538             FRAMES
2539             FRAME_LENGTH
2540             VBR_SCALE
2541             );
2542              
2543 4         57 %rva2_channel_types = (
2544             0x00 => 'OTHER',
2545             0x01 => 'MASTER',
2546             0x02 => 'FRONT_RIGHT',
2547             0x03 => 'FRONT_LEFT',
2548             0x04 => 'BACK_RIGHT',
2549             0x05 => 'BACK_LEFT',
2550             0x06 => 'FRONT_CENTER',
2551             0x07 => 'BACK_CENTER',
2552             0x08 => 'SUBWOOFER',
2553             );
2554              
2555 4         30 %v1_tag_fields =
2556             (TITLE => 30, ARTIST => 30, ALBUM => 30, COMMENT => 30, YEAR => 4);
2557              
2558 4         13 @v1_tag_names = qw(TITLE ARTIST ALBUM YEAR COMMENT TRACKNUM GENRE);
2559              
2560 4         56 %v2_to_v1_names = (
2561             # v2.2 tags
2562             'TT2' => 'TITLE',
2563             'TP1' => 'ARTIST',
2564             'TAL' => 'ALBUM',
2565             'TYE' => 'YEAR',
2566             'COM' => 'COMMENT',
2567             'TRK' => 'TRACKNUM',
2568             'TCO' => 'GENRE', # not clean mapping, but ...
2569             # v2.3 tags
2570             'TIT2' => 'TITLE',
2571             'TPE1' => 'ARTIST',
2572             'TALB' => 'ALBUM',
2573             'TYER' => 'YEAR',
2574             'COMM' => 'COMMENT',
2575             'TRCK' => 'TRACKNUM',
2576             'TCON' => 'GENRE',
2577             # v2.3 tags - needed for MusicBrainz
2578             'UFID' => 'Unique file identifier',
2579             'TXXX' => 'User defined text information frame',
2580             );
2581              
2582 4         759 %v2_tag_names = (
2583             # v2.2 tags
2584             'BUF' => 'Recommended buffer size',
2585             'CNT' => 'Play counter',
2586             'COM' => 'Comments',
2587             'CRA' => 'Audio encryption',
2588             'CRM' => 'Encrypted meta frame',
2589             'ETC' => 'Event timing codes',
2590             'EQU' => 'Equalization',
2591             'GEO' => 'General encapsulated object',
2592             'IPL' => 'Involved people list',
2593             'LNK' => 'Linked information',
2594             'MCI' => 'Music CD Identifier',
2595             'MLL' => 'MPEG location lookup table',
2596             'PIC' => 'Attached picture',
2597             'POP' => 'Popularimeter',
2598             'REV' => 'Reverb',
2599             'RVA' => 'Relative volume adjustment',
2600             'SLT' => 'Synchronized lyric/text',
2601             'STC' => 'Synced tempo codes',
2602             'TAL' => 'Album/Movie/Show title',
2603             'TBP' => 'BPM (Beats Per Minute)',
2604             'TCM' => 'Composer',
2605             'TCO' => 'Content type',
2606             'TCR' => 'Copyright message',
2607             'TDA' => 'Date',
2608             'TDY' => 'Playlist delay',
2609             'TEN' => 'Encoded by',
2610             'TFT' => 'File type',
2611             'TIM' => 'Time',
2612             'TKE' => 'Initial key',
2613             'TLA' => 'Language(s)',
2614             'TLE' => 'Length',
2615             'TMT' => 'Media type',
2616             'TOA' => 'Original artist(s)/performer(s)',
2617             'TOF' => 'Original filename',
2618             'TOL' => 'Original Lyricist(s)/text writer(s)',
2619             'TOR' => 'Original release year',
2620             'TOT' => 'Original album/Movie/Show title',
2621             'TP1' => 'Lead artist(s)/Lead performer(s)/Soloist(s)/Performing group',
2622             'TP2' => 'Band/Orchestra/Accompaniment',
2623             'TP3' => 'Conductor/Performer refinement',
2624             'TP4' => 'Interpreted, remixed, or otherwise modified by',
2625             'TPA' => 'Part of a set',
2626             'TPB' => 'Publisher',
2627             'TRC' => 'ISRC (International Standard Recording Code)',
2628             'TRD' => 'Recording dates',
2629             'TRK' => 'Track number/Position in set',
2630             'TSI' => 'Size',
2631             'TSS' => 'Software/hardware and settings used for encoding',
2632             'TT1' => 'Content group description',
2633             'TT2' => 'Title/Songname/Content description',
2634             'TT3' => 'Subtitle/Description refinement',
2635             'TXT' => 'Lyricist/text writer',
2636             'TXX' => 'User defined text information frame',
2637             'TYE' => 'Year',
2638             'UFI' => 'Unique file identifier',
2639             'ULT' => 'Unsychronized lyric/text transcription',
2640             'WAF' => 'Official audio file webpage',
2641             'WAR' => 'Official artist/performer webpage',
2642             'WAS' => 'Official audio source webpage',
2643             'WCM' => 'Commercial information',
2644             'WCP' => 'Copyright/Legal information',
2645             'WPB' => 'Publishers official webpage',
2646             'WXX' => 'User defined URL link frame',
2647              
2648             # v2.3 tags
2649             'AENC' => 'Audio encryption',
2650             'APIC' => 'Attached picture',
2651             'COMM' => 'Comments',
2652             'COMR' => 'Commercial frame',
2653             'ENCR' => 'Encryption method registration',
2654             'EQUA' => 'Equalization',
2655             'ETCO' => 'Event timing codes',
2656             'GEOB' => 'General encapsulated object',
2657             'GRID' => 'Group identification registration',
2658             'IPLS' => 'Involved people list',
2659             'LINK' => 'Linked information',
2660             'MCDI' => 'Music CD identifier',
2661             'MLLT' => 'MPEG location lookup table',
2662             'OWNE' => 'Ownership frame',
2663             'PCNT' => 'Play counter',
2664             'POPM' => 'Popularimeter',
2665             'POSS' => 'Position synchronisation frame',
2666             'PRIV' => 'Private frame',
2667             'RBUF' => 'Recommended buffer size',
2668             'RVAD' => 'Relative volume adjustment',
2669             'RVRB' => 'Reverb',
2670             'SYLT' => 'Synchronized lyric/text',
2671             'SYTC' => 'Synchronized tempo codes',
2672             'TALB' => 'Album/Movie/Show title',
2673             'TBPM' => 'BPM (beats per minute)',
2674             'TCOM' => 'Composer',
2675             'TCON' => 'Content type',
2676             'TCOP' => 'Copyright message',
2677             'TDAT' => 'Date',
2678             'TDLY' => 'Playlist delay',
2679             'TENC' => 'Encoded by',
2680             'TEXT' => 'Lyricist/Text writer',
2681             'TFLT' => 'File type',
2682             'TIME' => 'Time',
2683             'TIT1' => 'Content group description',
2684             'TIT2' => 'Title/songname/content description',
2685             'TIT3' => 'Subtitle/Description refinement',
2686             'TKEY' => 'Initial key',
2687             'TLAN' => 'Language(s)',
2688             'TLEN' => 'Length',
2689             'TMED' => 'Media type',
2690             'TOAL' => 'Original album/movie/show title',
2691             'TOFN' => 'Original filename',
2692             'TOLY' => 'Original lyricist(s)/text writer(s)',
2693             'TOPE' => 'Original artist(s)/performer(s)',
2694             'TORY' => 'Original release year',
2695             'TOWN' => 'File owner/licensee',
2696             'TPE1' => 'Lead performer(s)/Soloist(s)',
2697             'TPE2' => 'Band/orchestra/accompaniment',
2698             'TPE3' => 'Conductor/performer refinement',
2699             'TPE4' => 'Interpreted, remixed, or otherwise modified by',
2700             'TPOS' => 'Part of a set',
2701             'TPUB' => 'Publisher',
2702             'TRCK' => 'Track number/Position in set',
2703             'TRDA' => 'Recording dates',
2704             'TRSN' => 'Internet radio station name',
2705             'TRSO' => 'Internet radio station owner',
2706             'TSIZ' => 'Size',
2707             'TSRC' => 'ISRC (international standard recording code)',
2708             'TSSE' => 'Software/Hardware and settings used for encoding',
2709             'TXXX' => 'User defined text information frame',
2710             'TYER' => 'Year',
2711             'UFID' => 'Unique file identifier',
2712             'USER' => 'Terms of use',
2713             'USLT' => 'Unsychronized lyric/text transcription',
2714             'WCOM' => 'Commercial information',
2715             'WCOP' => 'Copyright/Legal information',
2716             'WOAF' => 'Official audio file webpage',
2717             'WOAR' => 'Official artist/performer webpage',
2718             'WOAS' => 'Official audio source webpage',
2719             'WORS' => 'Official internet radio station homepage',
2720             'WPAY' => 'Payment',
2721             'WPUB' => 'Publishers official webpage',
2722             'WXXX' => 'User defined URL link frame',
2723              
2724             # v2.4 additional tags
2725             # note that we don't restrict tags from 2.3 or 2.4,
2726             'ASPI' => 'Audio seek point index',
2727             'EQU2' => 'Equalisation (2)',
2728             'RVA2' => 'Relative volume adjustment (2)',
2729             'SEEK' => 'Seek frame',
2730             'SIGN' => 'Signature frame',
2731             'TDEN' => 'Encoding time',
2732             'TDOR' => 'Original release time',
2733             'TDRC' => 'Recording time',
2734             'TDRL' => 'Release time',
2735             'TDTG' => 'Tagging time',
2736             'TIPL' => 'Involved people list',
2737             'TMCL' => 'Musician credits list',
2738             'TMOO' => 'Mood',
2739             'TPRO' => 'Produced notice',
2740             'TSOA' => 'Album sort order',
2741             'TSOP' => 'Performer sort order',
2742             'TSOT' => 'Title sort order',
2743             'TSST' => 'Set subtitle',
2744              
2745             # grrrrrrr
2746             'COM ' => 'Broken iTunes comments',
2747             );
2748             }
2749              
2750             1;
2751              
2752             __END__