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