File Coverage

blib/lib/MP3/Info.pm
Criterion Covered Total %
statement 432 896 48.2
branch 191 524 36.4
condition 77 254 30.3
subroutine 29 43 67.4
pod 7 8 87.5
total 736 1725 42.6


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