tools/songdb.pl

   1 #!/usr/bin/perl
   2 #
   3 # Rockbox song database docs:
   4 # http://www.rockbox.org/twiki/bin/view/Main/TagDatabase
   5 #
   6 # MP3::Info by Chris Nandor is included verbatim in this script to make
   7 # it runnable standalone on removable drives. See below.
   8 #
   9
  10 my $db = "rockbox.id3db";
  11 my $dir;
  12 my $strip;
  13 my $verbose;
  14 my $help;
  15
  16 while($ARGV[0]) {
  17     if($ARGV[0] eq "--db") {
  18         $db = $ARGV[1];
  19         shift @ARGV;
  20         shift @ARGV;
  21     }
  22     elsif($ARGV[0] eq "--path") {
  23         $dir = $ARGV[1];
  24         shift @ARGV;
  25         shift @ARGV;
  26     }
  27     elsif($ARGV[0] eq "--strip") {
  28         $strip = $ARGV[1];
  29         shift @ARGV;
  30         shift @ARGV;
  31     }
  32     elsif($ARGV[0] eq "--verbose") {
  33         $verbose = 1;
  34         shift @ARGV;
  35     }
  36     elsif($ARGV[0] eq "--help" or ($ARGV[0] eq "-h")) {
  37         $help = 1;
  38         shift @ARGV;
  39     }
  40     else {
  41         shift @ARGV;
  42     }
  43 }
  44 my %entries;
  45 my %genres;
  46 my %albums;
  47 my %years;
  48 my %filename;
  49
  50 my $dbver = 1;
  51
  52 if(! -d $dir or $help) {
  53     print "'$dir' is not a directory\n" if ($dir ne "" and ! -d $dir);
  54     print "songdb --path <dir> [--db <file>] [--strip <path>] [--verbose] [--help]\n";
  55     exit;
  56 }
  57
  58 # return ALL directory entries in the given dir
  59 sub getdir {
  60     my ($dir) = @_;
  61
  62     if (opendir(DIR, $dir)) {
  63         #   my @mp3 = grep { /\.mp3$/ && -f "$dir/$_" } readdir(DIR);
  64         my @all = readdir(DIR);
  65         closedir DIR;
  66         return @all;
  67     }
  68     else {
  69         warn "can't opendir $dir: $!\n";
  70     }
  71 }
  72
  73 sub extractmp3 {
  74     my ($dir, @files) = @_;
  75     my @mp3;
  76     for(@files) {
  77         if( /\.mp[23]$/ && -f "$dir/$_" ) {
  78             push @mp3, $_;
  79         }
  80     }
  81     return @mp3;
  82 }
  83
  84 sub extractdirs {
  85     my ($dir, @files) = @_;
  86     my @dirs;
  87     for(@files) {
  88         if( -d "$dir/$_" && ($_ !~ /^\.(|\.)$/)) {
  89             push @dirs, $_;
  90         }
  91     }
  92     return @dirs;
  93 }
  94
  95 sub singlefile {
  96     my ($file) = @_;
  97
  98 #    print "Check $file\n";
  99
 100     my $hash = get_mp3tag($file);
 101   #  my $hash = get_mp3info($file);
 102
 103 #    for(keys %$hash) {
 104 #        print "Info: $_ ".$hash->{$_}."\n";
 105 #    }
 106     return $hash; # a hash reference
 107 }
 108
 109 my $maxsongperalbum;
 110
 111 sub dodir {
 112     my ($dir)=@_;
 113
 114     print "$dir\n";
 115
 116     # getdir() returns all entries in the given dir
 117     my @a = getdir($dir);
 118
 119     # extractmp3 filters out only the mp3 files from all given entries
 120     my @m = extractmp3($dir, @a);
 121
 122     my $f;
 123
 124     for $f (sort @m) {
 125
 126         my $id3 = singlefile("$dir/$f");
 127
 128         # ARTIST
 129         # COMMENT
 130         # ALBUM
 131         # TITLE
 132         # GENRE
 133         # TRACKNUM
 134         # YEAR
 135
 136         # don't index songs without tags
 137         if (not defined $$id3{'ARTIST'} and
 138             not defined $$id3{'ALBUM'} and
 139             not defined $$id3{'TITLE'})
 140         {
 141             next;
 142         }
 143
 144         #printf "Artist: %s\n", $id3->{'ARTIST'};
 145         my $path = "$dir/$f";
 146         if ($strip ne "" and $path =~ /^$strip(.*)/) {
 147             $path = $1;
 148         }
 149
 150         $entries{$path}= $id3;
 151         $artists{$id3->{'ARTIST'}}++ if($id3->{'ARTIST'});
 152         $genres{$id3->{'GENRE'}}++ if($id3->{'GENRE'});
 153         $years{$id3->{'YEAR'}}++ if($id3->{'YEAR'});
 154
 155         # fallback names
 156         $$id3{'ARTIST'} = "<no artist tag>" if ($$id3{'ARTIST'} eq "");
 157         $$id3{'ALBUM'} = "<no album tag>" if ($$id3{'ALBUM'} eq "");
 158         $$id3{'TITLE'} = "<no title tag>" if ($$id3{'TITLE'} eq "");
 159
 160         # prepend Artist name to handle duplicate album names from other
 161         # artists
 162         my $albumid = $id3->{'ALBUM'}."___".$id3->{'ARTIST'};
 163         if($albumid ne "<no album tag>___<no artist tag>") {
 164             my $num = ++$albums{$albumid};
 165             if($num > $maxsongperalbum) {
 166                 $maxsongperalbum = $num;
 167                 $longestalbum = $albumid;
 168             }
 169             $album2songs{$albumid}{$$id3{TITLE}} = $id3;
 170             $artist2albums{$$id3{ARTIST}}{$$id3{ALBUM}} = $id3;
 171         }
 172     }
 173
 174     # extractdirs filters out only subdirectories from all given entries
 175     my @d = extractdirs($dir, @a);
 176
 177     for $d (sort @d) {
 178         #print "Subdir: $d\n";
 179         dodir("$dir/$d");
 180     }
 181 }
 182
 183
 184 dodir($dir);
 185 print "\n";
 186
 187 print "File name table\n" if ($verbose);
 188 my $fc;
 189 for(sort keys %entries) {
 190     printf("  %s\n", $_) if ($verbose);
 191     $fc += length($_)+1;
 192 }
 193
 194 my $maxsonglen = 0;
 195 my $sc;
 196 print "\nSong title table\n" if ($verbose);
 197
 198 for(sort {$entries{$a}->{'TITLE'} cmp $entries{$b}->{'TITLE'}} keys %entries) {
 199     printf("  %s\n", $entries{$_}->{'TITLE'} ) if ($verbose);
 200     my $l = length($entries{$_}->{'TITLE'});
 201     if($l > $maxsonglen) {
 202         $maxsonglen = $l;
 203         $longestsong = $entries{$_}->{'TITLE'};
 204     }
 205 }
 206 $maxsonglen++; # include zero termination byte
 207 while($maxsonglen&3) {
 208     $maxsonglen++;
 209 }
 210
 211 my $maxartistlen = 0;
 212 print "\nArtist table\n" if ($verbose);
 213 my $i=0;
 214 my %artistcount;
 215 for(sort keys %artists) {
 216     printf("  %s\n", $_) if ($verbose);
 217     $artistcount{$_}=$i++;
 218     my $l = length($_);
 219     if($l > $maxartistlen) {
 220         $maxartistlen = $l;
 221         $longestartist = $_;
 222     }
 223
 224     $l = scalar keys %{$artist2albums{$_}};
 225     if ($l > $maxalbumsperartist) {
 226         $maxalbumsperartist = $l;
 227     }
 228 }
 229 $maxartistlen++; # include zero termination byte
 230 while($maxartistlen&3) {
 231     $maxartistlen++;
 232 }
 233
 234 if ($verbose) {
 235     print "\nGenre table\n";
 236     for(sort keys %genres) {
 237         printf("  %s\n", $_);
 238     }
 239
 240     print "\nYear table\n";
 241     for(sort keys %years) {
 242         printf("  %s\n", $_);
 243     }
 244 }
 245
 246 print "\nAlbum table\n" if ($verbose);
 247 my $maxalbumlen = 0;
 248 my %albumcount;
 249 $i=0;
 250 for(sort keys %albums) {
 251     my @moo=split(/___/, $_);
 252     printf("  %s\n", $moo[0]) if ($verbose);
 253     $albumcount{$_} = $i++;
 254     my $l = length($moo[0]);
 255     if($l > $maxalbumlen) {
 256         $maxalbumlen = $l;
 257         $longestalbumname = $moo[0];
 258     }
 259 }
 260 $maxalbumlen++; # include zero termination byte
 261 while($maxalbumlen&3) {
 262     $maxalbumlen++;
 263 }
 264
 265
 266
 267 sub dumpint {
 268     my ($num)=@_;
 269
 270 #    print "int: $num\n";
 271
 272     printf DB ("%c%c%c%c",
 273                $num>>24,
 274                ($num&0xff0000)>>16,
 275                ($num&0xff00)>>8,
 276                ($num&0xff));
 277 }
 278
 279 if (!scalar keys %entries) {
 280     print "No songs found. Did you specify the right --path ?\n";
 281     print "Use the --help parameter to see all options.\n";
 282     exit;
 283 }
 284
 285 if ($db) {
 286     my $songentrysize = $maxsonglen + 12;
 287     my $albumentrysize = $maxalbumlen + 4 + $maxsongperalbum*4;
 288     my $artistentrysize = $maxartistlen + $maxalbumsperartist*4;
 289
 290     printf "Number of artists  : %d\n", scalar keys %artists;
 291     printf "Number of albums   : %d\n", scalar keys %albums;
 292     printf "Number of songs    : %d\n", scalar keys %entries;
 293     print "Max artist length  : $maxartistlen ($longestartist)\n";
 294     print "Max album length   : $maxalbumlen ($longestalbumname)\n";
 295     print "Max song length    : $maxsonglen ($longestsong)\n";
 296     print "Max songs per album: $maxsongperalbum ($longestalbum)\n";
 297     print "Database version: $dbver\n" if ($verbose);
 298
 299     open(DB, ">$db") || die "couldn't make $db";
 300     printf DB "RDB%c", $dbver;
 301
 302     $pathindex = 48; # paths always start at index 48
 303
 304     $songindex = $pathindex + $fc; # fc is size of all paths
 305     $songindex++ while ($songindex & 3); # align to 32 bits
 306
 307     dumpint($songindex); # file position index of song table
 308     dumpint(scalar(keys %entries)); # number of songs
 309     dumpint($maxsonglen); # length of song name field
 310
 311     # set total size of song title table
 312     $sc = scalar(keys %entries) * $songentrysize;
 313
 314     $albumindex = $songindex + $sc; # sc is size of all songs
 315     dumpint($albumindex); # file position index of album table
 316     dumpint(scalar(keys %albums)); # number of albums
 317     dumpint($maxalbumlen); # length of album name field
 318     dumpint($maxsongperalbum); # number of entries in songs-per-album array
 319
 320     my $ac = scalar(keys %albums) * $albumentrysize;
 321
 322     $artistindex = $albumindex + $ac; # ac is size of all albums
 323     dumpint($artistindex); # file position index of artist table
 324     dumpint(scalar(keys %artists)); # number of artists
 325     dumpint($maxartistlen); # length of artist name field
 326     dumpint($maxalbumsperartist); # number of entries in albums-per-artist array
 327
 328     my $l=0;
 329
 330     #### TABLE of file names ###
 331     # path1
 332
 333     my %filenamepos;
 334     for $f (sort keys %entries) {
 335         printf DB ("%s\x00", $f);
 336         $filenamepos{$f}= $l;
 337         $l += length($f)+1;
 338     }
 339     while ($l & 3) {
 340         print DB "\x00";
 341         $l++;
 342     }
 343
 344     #### TABLE of songs ###
 345     # title of song1
 346     # pointer to artist of song1
 347     # pointer to album of song1
 348     # pointer to filename of song1
 349
 350     my $offset = $songindex;
 351     for(sort {$entries{$a}->{'TITLE'} cmp $entries{$b}->{'TITLE'}} keys %entries) {
 352         my $f = $_;
 353         my $id3 = $entries{$f};
 354         my $t = $id3->{'TITLE'};
 355         my $str = $t."\x00" x ($maxsonglen- length($t));
 356
 357         print DB $str; # title
 358
 359         my $a = $artistcount{$id3->{'ARTIST'}} * $artistentrysize;
 360         dumpint($a + $artistindex); # pointer to artist of this song
 361
 362         $a = $albumcount{"$$id3{ALBUM}___$$id3{ARTIST}"} * $albumentrysize;
 363         dumpint($a + $albumindex); # pointer to album of this song
 364
 365         # pointer to filename of this song
 366         dumpint($filenamepos{$f} + $pathindex);
 367
 368         $$id3{'songoffset'} = $offset;
 369         $offset += $songentrysize;
 370     }
 371
 372     #### TABLE of albums ###
 373     # name of album1
 374     # pointers to artists of album1
 375     # pointers to songs on album1
 376
 377     for(sort keys %albums) {
 378         my $albumid = $_;
 379         my @moo=split(/___/, $_);
 380         my $t = $moo[0];
 381         my $str =  $t."\x00" x ($maxalbumlen - length($t));
 382         print DB $str;
 383
 384         my $aoffset = $artistcount{$moo[0]} * $artistentrysize;
 385         dumpint($aoffset + $artistindex); # pointer to artist of this album
 386
 387         my @songlist = keys %{$album2songs{$albumid}};
 388         my $id3 = $album2songs{$albumid}{$songlist[0]};
 389         if (defined $id3->{'TRACKNUM'}) {
 390             @songlist = sort {
 391                 $album2songs{$albumid}{$a}->{'TRACKNUM'} <=>
 392                     $album2songs{$albumid}{$b}->{'TRACKNUM'}
 393             } @songlist;
 394         }
 395         else {
 396             @songlist = sort @songlist;
 397         }
 398
 399         for (@songlist) {
 400             my $id3 = $album2songs{$albumid}{$_};
 401             dumpint($$id3{'songoffset'});
 402         }
 403
 404         for (scalar keys %{$album2songs{$albumid}} .. $maxsongperalbum-1) {
 405             print DB "\x00\x00\x00\x00";
 406         }
 407     }
 408
 409     #### TABLE of artists ###
 410     # name of artist1
 411     # pointers to albums of artist1
 412
 413     for (sort keys %artists) {
 414         my $artist = $_;
 415         my $str =  $_."\x00" x ($maxartistlen - length($_));
 416         print DB $str;
 417
 418         for (sort keys %{$artist2albums{$artist}}) {
 419             my $id3 = $artist2albums{$artist}{$_};
 420             my $a = $albumcount{"$$id3{'ALBUM'}___$$id3{'ARTIST'}"} * $albumentrysize;
 421             dumpint($a + $albumindex);
 422         }
 423
 424         for (scalar keys %{$artist2albums{$artist}} .. $maxalbumsperartist-1) {
 425             print DB "\x00\x00\x00\x00";
 426         }
 427
 428     }
 429
 430     close(DB);
 431 }
 432
 433 ###
 434 ### Here follows module MP3::Info Copyright (c) 1998-2004 Chris Nandor
 435 ### Modified by Björn Stenberg to remove use of external libraries
 436 ###
 437
 438 our(
 439         @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION, $REVISION,
 440         @mp3_genres, %mp3_genres, @winamp_genres, %winamp_genres, $try_harder,
 441         @t_bitrate, @t_sampling_freq, @frequency_tbl, %v1_tag_fields,
 442         @v1_tag_names, %v2_tag_names, %v2_to_v1_names, $AUTOLOAD,
 443         @mp3_info_fields
 444 );
 445
 446 @ISA = 'Exporter';
 447 @EXPORT = qw(
 448         set_mp3tag get_mp3tag get_mp3info remove_mp3tag
 449         use_winamp_genres
 450 );
 451 @EXPORT_OK = qw(@mp3_genres %mp3_genres use_mp3_utf8);
 452 %EXPORT_TAGS = (
 453         genres  => [qw(@mp3_genres %mp3_genres)],
 454         utf8    => [qw(use_mp3_utf8)],
 455         all     => [@EXPORT, @EXPORT_OK]
 456 );
 457
 458 # $Id$
 459 ($REVISION) = ' $Revision$ ' =~ /\$Revision:\s+([^\s]+)/;
 460 $VERSION = '1.02';
 461
 462 =pod
 463
 464 =head1 NAME
 465
 466 MP3::Info - Manipulate / fetch info from MP3 audio files
 467
 468 =head1 SYNOPSIS
 469
 470         #!perl -w
 471         use MP3::Info;
 472         my $file = 'Pearls_Before_Swine.mp3';
 473         set_mp3tag($file, 'Pearls Before Swine', q"77's",
 474                 'Sticks and Stones', '1990',
 475                 q"(c) 1990 77's LTD.", 'rock & roll');
 476
 477         my $tag = get_mp3tag($file) or die "No TAG info";
 478         $tag->{GENRE} = 'rock';
 479         set_mp3tag($file, $tag);
 480
 481         my $info = get_mp3info($file);
 482         printf "$file length is %d:%d\n", $info->{MM}, $info->{SS};
 483
 484 =cut
 485
 486 {
 487         my $c = -1;
 488         # set all lower-case and regular-cased versions of genres as keys
 489         # with index as value of each key
 490         %mp3_genres = map {($_, ++$c, lc, $c)} @mp3_genres;
 491
 492         # do it again for winamp genres
 493         $c = -1;
 494         %winamp_genres = map {($_, ++$c, lc, $c)} @winamp_genres;
 495 }
 496
 497 =pod
 498
 499         my $mp3 = new MP3::Info $file;
 500         $mp3->title('Perls Before Swine');
 501         printf "$file length is %s, title is %s\n",
 502                 $mp3->time, $mp3->title;
 503
 504
 505 =head1 DESCRIPTION
 506
 507 =over 4
 508
 509 =item $mp3 = MP3::Info-E<gt>new(FILE)
 510
 511 OOP interface to the rest of the module.  The same keys
 512 available via get_mp3info and get_mp3tag are available
 513 via the returned object (using upper case or lower case;
 514 but note that all-caps "VERSION" will return the module
 515 version, not the MP3 version).
 516
 517 Passing a value to one of the methods will set the value
 518 for that tag in the MP3 file, if applicable.
 519
 520 =cut
 521
 522 sub new {
 523         my($pack, $file) = @_;
 524
 525         my $info = get_mp3info($file) or return undef;
 526         my $tags = get_mp3tag($file) || { map { ($_ => undef) } @v1_tag_names };
 527         my %self = (
 528                 FILE            => $file,
 529                 TRY_HARDER      => 0
 530         );
 531
 532         @self{@mp3_info_fields, @v1_tag_names, 'file'} = (
 533                 @{$info}{@mp3_info_fields},
 534                 @{$tags}{@v1_tag_names},
 535                 $file
 536         );
 537
 538         return bless \%self, $pack;
 539 }
 540
 541 sub can {
 542         my $self = shift;
 543         return $self->SUPER::can(@_) unless ref $self;
 544         my $name = uc shift;
 545         return sub { $self->$name(@_) } if exists $self->{$name};
 546         return undef;
 547 }
 548
 549 sub AUTOLOAD {
 550         my($self) = @_;
 551         (my $name = uc $AUTOLOAD) =~ s/^.*://;
 552
 553         if (exists $self->{$name}) {
 554                 my $sub = exists $v1_tag_fields{$name}
 555                         ? sub {
 556                                 if (defined $_[1]) {
 557                                         $_[0]->{$name} = $_[1];
 558                                         set_mp3tag($_[0]->{FILE}, $_[0]);
 559                                 }
 560                                 return $_[0]->{$name};
 561                         }
 562                         : sub {
 563                                 return $_[0]->{$name}
 564                         };
 565
 566                 *{$AUTOLOAD} = $sub;
 567                 goto &$AUTOLOAD;
 568
 569         } else {
 570                 warn(sprintf "No method '$name' available in package %s.",
 571                         __PACKAGE__);
 572         }
 573 }
 574
 575 sub DESTROY {
 576
 577 }
 578
 579
 580 =item use_mp3_utf8([STATUS])
 581
 582 Tells MP3::Info to (or not) return TAG info in UTF-8.
 583 TRUE is 1, FALSE is 0.  Default is FALSE.
 584
 585 Will only be able to it on if Unicode::String is available.  ID3v2
 586 tags will be converted to UTF-8 according to the encoding specified
 587 in each tag; ID3v1 tags will be assumed Latin-1 and converted
 588 to UTF-8.
 589
 590 Function returns status (TRUE/FALSE).  If no argument is supplied,
 591 or an unaccepted argument is supplied, function merely returns status.
 592
 593 This function is not exported by default, but may be exported
 594 with the C<:utf8> or C<:all> export tag.
 595
 596 =cut
 597
 598 my $unicode_module = eval { require Unicode::String };
 599 my $UNICODE = 0;
 600
 601 sub use_mp3_utf8 {
 602         my($val) = @_;
 603         if ($val == 1) {
 604                 $UNICODE = 1 if $unicode_module;
 605         } elsif ($val == 0) {
 606                 $UNICODE = 0;
 607         }
 608         return $UNICODE;
 609 }
 610
 611 =pod
 612
 613 =item use_winamp_genres()
 614
 615 Puts WinAmp genres into C<@mp3_genres> and C<%mp3_genres>
 616 (adds 68 additional genres to the default list of 80).
 617 This is a separate function because these are non-standard
 618 genres, but they are included because they are widely used.
 619
 620 You can import the data structures with one of:
 621
 622         use MP3::Info qw(:genres);
 623         use MP3::Info qw(:DEFAULT :genres);
 624         use MP3::Info qw(:all);
 625
 626 =cut
 627
 628 sub use_winamp_genres {
 629         %mp3_genres = %winamp_genres;
 630         @mp3_genres = @winamp_genres;
 631         return 1;
 632 }
 633
 634 =pod
 635
 636 =item remove_mp3tag (FILE [, VERSION, BUFFER])
 637
 638 Can remove ID3v1 or ID3v2 tags.  VERSION should be C<1> for ID3v1,
 639 C<2> for ID3v2, and C<ALL> for both.
 640
 641 For ID3v1, removes last 128 bytes from file if those last 128 bytes begin
 642 with the text 'TAG'.  File will be 128 bytes shorter.
 643
 644 For ID3v2, removes ID3v2 tag.  Because an ID3v2 tag is at the
 645 beginning of the file, we rewrite the file after removing the tag data.
 646 The buffer for rewriting the file is 4MB.  BUFFER (in bytes) ca
 647 change the buffer size.
 648
 649 Returns the number of bytes removed, or -1 if no tag removed,
 650 or undef if there is an error.
 651
 652 =cut
 653
 654 sub remove_mp3tag {
 655         my($file, $version, $buf) = @_;
 656         my($fh, $return);
 657
 658         $buf ||= 4096*1024;  # the bigger the faster
 659         $version ||= 1;
 660
 661         if (not (defined $file && $file ne '')) {
 662                 $@ = "No file specified";
 663                 return undef;
 664         }
 665
 666         if (not -s $file) {
 667                 $@ = "File is empty";
 668                 return undef;
 669         }
 670
 671         if (ref $file) { # filehandle passed
 672                 $fh = $file;
 673         } else {
 674                 $fh = gensym;
 675                 if (not open $fh, "+< $file\0") {
 676                         $@ = "Can't open $file: $!";
 677                         return undef;
 678                 }
 679         }
 680
 681         binmode $fh;
 682
 683         if ($version eq 1 || $version eq 'ALL') {
 684                 seek $fh, -128, 2;
 685                 my $tell = tell $fh;
 686                 if (<$fh> =~ /^TAG/) {
 687                         truncate $fh, $tell or warn "Can't truncate '$file': $!";
 688                         $return += 128;
 689                 }
 690         }
 691
 692         if ($version eq 2 || $version eq 'ALL') {
 693                 my $h = _get_v2head($fh);
 694                 if ($h) {
 695                         local $\;
 696                         seek $fh, 0, 2;
 697                         my $eof = tell $fh;
 698                         my $off = $h->{tag_size};
 699
 700                         while ($off < $eof) {
 701                                 seek $fh, $off, 0;
 702                                 read $fh, my($bytes), $buf;
 703                                 seek $fh, $off - $h->{tag_size}, 0;
 704                                 print $fh $bytes;
 705                                 $off += $buf;
 706                         }
 707
 708                         truncate $fh, $eof - $h->{tag_size}
 709                                 or warn "Can't truncate '$file': $!";
 710                         $return += $h->{tag_size};
 711                 }
 712         }
 713
 714         _close($file, $fh);
 715
 716         return $return || -1;
 717 }
 718
 719
 720 =pod
 721
 722 =item set_mp3tag (FILE, TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE [, TRACKNUM])
 723
 724 =item set_mp3tag (FILE, $HASHREF)
 725
 726 Adds/changes tag information in an MP3 audio file.  Will clobber
 727 any existing information in file.
 728
 729 Fields are TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE.  All fields have
 730 a 30-byte limit, except for YEAR, which has a four-byte limit, and GENRE,
 731 which is one byte in the file.  The GENRE passed in the function is a
 732 case-insensitive text string representing a genre found in C<@mp3_genres>.
 733
 734 Will accept either a list of values, or a hashref of the type
 735 returned by C<get_mp3tag>.
 736
 737 If TRACKNUM is present (for ID3v1.1), then the COMMENT field can only be
 738 28 bytes.
 739
 740 ID3v2 support may come eventually.  Note that if you set a tag on a file
 741 with ID3v2, the set tag will be for ID3v1[.1] only, and if you call
 742 C<get_mp3_tag> on the file, it will show you the (unchanged) ID3v2 tags,
 743 unless you specify ID3v1.
 744
 745 =cut
 746
 747 sub set_mp3tag {
 748         my($file, $title, $artist, $album, $year, $comment, $genre, $tracknum) = @_;
 749         my(%info, $oldfh, $ref, $fh);
 750         local %v1_tag_fields = %v1_tag_fields;
 751
 752         # set each to '' if undef
 753         for ($title, $artist, $album, $year, $comment, $tracknum, $genre,
 754                 (@info{@v1_tag_names}))
 755                 {$_ = defined() ? $_ : ''}
 756
 757         ($ref) = (overload::StrVal($title) =~ /^(?:.*\=)?([^=]*)\((?:[^\(]*)\)$/)
 758                 if ref $title;
 759         # populate data to hashref if hashref is not passed
 760         if (!$ref) {
 761                 (@info{@v1_tag_names}) =
 762                         ($title, $artist, $album, $year, $comment, $tracknum, $genre);
 763
 764         # put data from hashref into hashref if hashref is passed
 765         } elsif ($ref eq 'HASH') {
 766                 %info = %$title;
 767
 768         # return otherwise
 769         } else {
 770                 warn(<<'EOT');
 771 Usage: set_mp3tag (FILE, TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE [, TRACKNUM])
 772        set_mp3tag (FILE, $HASHREF)
 773 EOT
 774                 return undef;
 775         }
 776
 777         if (not (defined $file && $file ne '')) {
 778                 $@ = "No file specified";
 779                 return undef;
 780         }
 781
 782         if (not -s $file) {
 783                 $@ = "File is empty";
 784                 return undef;
 785         }
 786
 787         # comment field length 28 if ID3v1.1
 788         $v1_tag_fields{COMMENT} = 28 if $info{TRACKNUM};
 789
 790
 791         # only if -w is on
 792         if ($^W) {
 793                 # warn if fields too long
 794                 foreach my $field (keys %v1_tag_fields) {
 795                         $info{$field} = '' unless defined $info{$field};
 796                         if (length($info{$field}) > $v1_tag_fields{$field}) {
 797                                 warn "Data too long for field $field: truncated to " .
 798                                          "$v1_tag_fields{$field}";
 799                         }
 800                 }
 801
 802                 if ($info{GENRE}) {
 803                         warn "Genre `$info{GENRE}' does not exist\n"
 804                                 unless exists $mp3_genres{$info{GENRE}};
 805                 }
 806         }
 807
 808         if ($info{TRACKNUM}) {
 809                 $info{TRACKNUM} =~ s/^(\d+)\/(\d+)$/$1/;
 810                 unless ($info{TRACKNUM} =~ /^\d+$/ &&
 811                         $info{TRACKNUM} > 0 && $info{TRACKNUM} < 256) {
 812                         warn "Tracknum `$info{TRACKNUM}' must be an integer " .
 813                                 "from 1 and 255\n" if $^W;
 814                         $info{TRACKNUM} = '';
 815                 }
 816         }
 817
 818         if (ref $file) { # filehandle passed
 819                 $fh = $file;
 820         } else {
 821                 $fh = gensym;
 822                 if (not open $fh, "+< $file\0") {
 823                         $@ = "Can't open $file: $!";
 824                         return undef;
 825                 }
 826         }
 827
 828         binmode $fh;
 829         $oldfh = select $fh;
 830         seek $fh, -128, 2;
 831         # go to end of file if no tag, beginning of file if tag
 832         seek $fh, (<$fh> =~ /^TAG/ ? -128 : 0), 2;
 833
 834         # get genre value
 835         $info{GENRE} = $info{GENRE} && exists $mp3_genres{$info{GENRE}} ?
 836                 $mp3_genres{$info{GENRE}} : 255;  # some default genre
 837
 838         local $\;
 839         # print TAG to file
 840         if ($info{TRACKNUM}) {
 841                 print pack "a3a30a30a30a4a28xCC", 'TAG', @info{@v1_tag_names};
 842         } else {
 843                 print pack "a3a30a30a30a4a30C", 'TAG', @info{@v1_tag_names[0..4, 6]};
 844         }
 845
 846         select $oldfh;
 847
 848         _close($file, $fh);
 849
 850         return 1;
 851 }
 852
 853 =pod
 854
 855 =item get_mp3tag (FILE [, VERSION, RAW_V2])
 856
 857 Returns hash reference containing tag information in MP3 file.  The keys
 858 returned are the same as those supplied for C<set_mp3tag>, except in the
 859 case of RAW_V2 being set.
 860
 861 If VERSION is C<1>, the information is taken from the ID3v1 tag (if present).
 862 If VERSION is C<2>, the information is taken from the ID3v2 tag (if present).
 863 If VERSION is not supplied, or is false, the ID3v1 tag is read if present, and
 864 then, if present, the ID3v2 tag information will override any existing ID3v1
 865 tag info.
 866
 867 If RAW_V2 is C<1>, the raw ID3v2 tag data is returned, without any manipulation
 868 of text encoding.  The key name is the same as the frame ID (ID to name mappings
 869 are in the global %v2_tag_names).
 870
 871 If RAW_V2 is C<2>, the ID3v2 tag data is returned, manipulating for Unicode if
 872 necessary, etc.  It also takes multiple values for a given key (such as comments)
 873 and puts them in an arrayref.
 874
 875 If the ID3v2 version is older than ID3v2.2.0 or newer than ID3v2.4.0, it will
 876 not be read.
 877
 878 Strings returned will be in Latin-1, unless UTF-8 is specified (L<use_mp3_utf8>),
 879 (unless RAW_V2 is C<1>).
 880
 881 Also returns a TAGVERSION key, containing the ID3 version used for the returned
 882 data (if TAGVERSION argument is C<0>, may contain two versions).
 883
 884 =cut
 885
 886 sub get_mp3tag {
 887     my($file, $ver, $raw_v2) = @_;
 888     my($tag, $v1, $v2, $v2h, %info, @array, $fh);
 889     $raw_v2 ||= 0;
 890     $ver = !$ver ? 0 : ($ver == 2 || $ver == 1) ? $ver : 0;
 891
 892     if (not (defined $file && $file ne '')) {
 893         $@ = "No file specified";
 894         return undef;
 895     }
 896
 897     if (not -s $file) {
 898         $@ = "File is empty";
 899         return undef;
 900     }
 901
 902     if (ref $file) { # filehandle passed
 903         $fh = $file;
 904     } else {
 905         $fh = gensym;
 906         if (not open $fh, "< $file\0") {
 907             $@ = "Can't open $file: $!";
 908             return undef;
 909         }
 910     }
 911
 912     binmode $fh;
 913
 914     if ($ver < 2) {
 915         seek $fh, -128, 2;
 916         while(defined(my $line = <$fh>)) { $tag .= $line }
 917
 918         if ($tag =~ /^TAG/) {
 919             $v1 = 1;
 920             if (substr($tag, -3, 2) =~ /\000[^\000]/) {
 921                 (undef, @info{@v1_tag_names}) =
 922                     (unpack('a3a30a30a30a4a28', $tag),
 923                      ord(substr($tag, -2, 1)),
 924                      $mp3_genres[ord(substr $tag, -1)]);
 925                 $info{TAGVERSION} = 'ID3v1.1';
 926             } else {
 927                 (undef, @info{@v1_tag_names[0..4, 6]}) =
 928                     (unpack('a3a30a30a30a4a30', $tag),
 929                      $mp3_genres[ord(substr $tag, -1)]);
 930                 $info{TAGVERSION} = 'ID3v1';
 931             }
 932             if ($UNICODE) {
 933                 for my $key (keys %info) {
 934                     next unless $info{$key};
 935                     my $u = Unicode::String::latin1($info{$key});
 936                     $info{$key} = $u->utf8;
 937                 }
 938             }
 939         } elsif ($ver == 1) {
 940             _close($file, $fh);
 941             $@ = "No ID3v1 tag found";
 942             return undef;
 943         }
 944     }
 945
 946     ($v2, $v2h) = _get_v2tag($fh);
 947
 948     unless ($v1 || $v2) {
 949         _close($file, $fh);
 950         $@ = "No ID3 tag found";
 951         return undef;
 952     }
 953
 954     if (($ver == 0 || $ver == 2) && $v2) {
 955         if ($raw_v2 == 1 && $ver == 2) {
 956             %info = %$v2;
 957             $info{TAGVERSION} = $v2h->{version};
 958         } else {
 959             my $hash = $raw_v2 == 2 ? { map { ($_, $_) } keys %v2_tag_names } : \%v2_to_v1_names;
 960             for my $id (keys %$hash) {
 961                 if (exists $v2->{$id}) {
 962                     if ($id =~ /^TCON?$/ && $v2->{$id} =~ /^.?\((\d+)\)/) {
 963                         $info{$hash->{$id}} = $mp3_genres[$1];
 964                     } else {
 965                         my $data1 = $v2->{$id};
 966
 967                         # this is tricky ... if this is an arrayref, we want
 968                         # to only return one, so we pick the first one.  but
 969                         # if it is a comment, we pick the first one where the
 970                         # first charcter after the language is NULL and not an
 971                         # additional sub-comment, because that is most likely
 972                         # to be the user-supplied comment
 973
 974                         if (ref $data1 && !$raw_v2) {
 975                             if ($id =~ /^COMM?$/) {
 976                                 my($newdata) = grep /^(....\000)/, @{$data1};
 977                                 $data1 = $newdata || $data1->[0];
 978                             } else {
 979                                 $data1 = $data1->[0];
 980                             }
 981                         }
 982
 983                         $data1 = [ $data1 ] if ! ref $data1;
 984
 985                         for my $data (@$data1) {
 986                             $data =~ s/^(.)//; # strip first char (text encoding)
 987                             my $encoding = $1;
 988                             my $desc;
 989                             if ($id =~ /^COM[M ]?$/) {
 990                                 $data =~ s/^(?:...)//;          # strip language
 991                                 $data =~ s/^(.*?)\000+//;       # strip up to first NULL(s),
 992                                 # for sub-comment
 993                                 $desc = $1;
 994                             }
 995
 996                             if ($UNICODE) {
 997                                 if ($encoding eq "\001" || $encoding eq "\002") {  # UTF-16, UTF-16BE
 998                                     my $u = Unicode::String::utf16($data);
 999                                     $data = $u->utf8;
1000                                     $data =~ s/^\xEF\xBB\xBF//; # strip BOM
1001                                 } elsif ($encoding eq "\000") {
1002                                     my $u = Unicode::String::latin1($data);
1003                                     $data = $u->utf8;
1004                                 }
1005                             }
1006
1007                             if ($raw_v2 == 2 && $desc) {
1008                                 $data = { $desc => $data };
1009                             }
1010
1011                             if ($raw_v2 == 2 && exists $info{$hash->{$id}}) {
1012                                 if (ref $info{$hash->{$id}} eq 'ARRAY') {
1013                                     push @{$info{$hash->{$id}}}, $data;
1014                                 } else {
1015                                     $info{$hash->{$id}} = [ $info{$hash->{$id}}, $data ];
1016                                 }
1017                             } else {
1018                                 $info{$hash->{$id}} = $data;
1019                             }
1020                         }
1021                     }
1022                 }
1023             }
1024             if ($ver == 0 && $info{TAGVERSION}) {
1025                 $info{TAGVERSION} .= ' / ' . $v2h->{version};
1026             } else {
1027                 $info{TAGVERSION} = $v2h->{version};
1028             }
1029         }
1030     }
1031
1032     unless ($raw_v2 && $ver == 2) {
1033         foreach my $key (keys %info) {
1034             if (defined $info{$key}) {
1035                 $info{$key} =~ s/\000+.*//g;
1036                 $info{$key} =~ s/\s+$//;
1037             }
1038         }
1039
1040         for (@v1_tag_names) {
1041             $info{$_} = '' unless defined $info{$_};
1042         }
1043     }
1044
1045     if (keys %info && exists $info{GENRE} && ! defined $info{GENRE}) {
1046         $info{GENRE} = '';
1047     }
1048
1049     _close($file, $fh);
1050
1051     return keys %info ? {%info} : undef;
1052 }
1053
1054 sub _get_v2tag {
1055     my($fh) = @_;
1056     my($off, $myseek, $myseek_22, $myseek_23, $v2, $h, $hlen, $num);
1057     $h = {};
1058
1059     $v2 = _get_v2head($fh) or return;
1060     if ($v2->{major_version} < 2) {
1061         warn "This is $v2->{version}; " .
1062             "ID3v2 versions older than ID3v2.2.0 not supported\n"
1063             if $^W;
1064         return;
1065     }
1066
1067     if ($v2->{major_version} == 2) {
1068         $hlen = 6;
1069         $num = 3;
1070     } else {
1071         $hlen = 10;
1072         $num = 4;
1073     }
1074
1075     $myseek = sub {
1076         seek $fh, $off, 0;
1077         read $fh, my($bytes), $hlen;
1078         return unless $bytes =~ /^([A-Z0-9]{$num})/
1079             || ($num == 4 && $bytes =~ /^(COM )/);  # stupid iTunes
1080         my($id, $size) = ($1, $hlen);
1081         my @bytes = reverse unpack "C$num", substr($bytes, $num, $num);
1082         for my $i (0 .. ($num - 1)) {
1083             $size += $bytes[$i] * 256 ** $i;
1084         }
1085         return($id, $size);
1086     };
1087
1088     $off = $v2->{ext_header_size} + 10;
1089
1090     while ($off < $v2->{tag_size}) {
1091         my($id, $size) = &$myseek or last;
1092         seek $fh, $off + $hlen, 0;
1093         read $fh, my($bytes), $size - $hlen;
1094         if (exists $h->{$id}) {
1095             if (ref $h->{$id} eq 'ARRAY') {
1096                 push @{$h->{$id}}, $bytes;
1097             } else {
1098                 $h->{$id} = [$h->{$id}, $bytes];
1099             }
1100         } else {
1101             $h->{$id} = $bytes;
1102         }
1103         $off += $size;
1104     }
1105
1106     return($h, $v2);
1107 }
1108
1109
1110 =pod
1111
1112 =item get_mp3info (FILE)
1113
1114 Returns hash reference containing file information for MP3 file.
1115 This data cannot be changed.  Returned data:
1116
1117         VERSION         MPEG audio version (1, 2, 2.5)
1118         LAYER           MPEG layer description (1, 2, 3)
1119         STEREO          boolean for audio is in stereo
1120
1121         VBR             boolean for variable bitrate
1122         BITRATE         bitrate in kbps (average for VBR files)
1123         FREQUENCY       frequency in kHz
1124         SIZE            bytes in audio stream
1125
1126         SECS            total seconds
1127         MM              minutes
1128         SS              leftover seconds
1129         MS              leftover milliseconds
1130         TIME            time in MM:SS
1131
1132         COPYRIGHT       boolean for audio is copyrighted
1133         PADDING         boolean for MP3 frames are padded
1134         MODE            channel mode (0 = stereo, 1 = joint stereo,
1135                         2 = dual channel, 3 = single channel)
1136         FRAMES          approximate number of frames
1137         FRAME_LENGTH    approximate length of a frame
1138         VBR_SCALE       VBR scale from VBR header
1139
1140 On error, returns nothing and sets C<$@>.
1141
1142 =cut
1143
1144 sub get_mp3info {
1145     my($file) = @_;
1146     my($off, $myseek, $byte, $eof, $h, $tot, $fh);
1147
1148     if (not (defined $file && $file ne '')) {
1149         $@ = "No file specified";
1150         return undef;
1151     }
1152
1153     if (not -s $file) {
1154         $@ = "File is empty";
1155         return undef;
1156     }
1157
1158     if (ref $file) { # filehandle passed
1159         $fh = $file;
1160     } else {
1161         $fh = gensym;
1162         if (not open $fh, "< $file\0") {
1163             $@ = "Can't open $file: $!";
1164             return undef;
1165         }
1166     }
1167
1168     $off = 0;
1169     $tot = 4096;
1170
1171     $myseek = sub {
1172         seek $fh, $off, 0;
1173         read $fh, $byte, 4;
1174     };
1175
1176     binmode $fh;
1177     &$myseek;
1178
1179     if ($off == 0) {
1180         if (my $id3v2 = _get_v2head($fh)) {
1181             $tot += $off += $id3v2->{tag_size};
1182             &$myseek;
1183         }
1184     }
1185
1186     $h = _get_head($byte);
1187     until (_is_mp3($h)) {
1188         $off++;
1189         &$myseek;
1190         $h = _get_head($byte);
1191         if ($off > $tot && !$try_harder) {
1192             _close($file, $fh);
1193             $@ = "Couldn't find MP3 header (perhaps set " .
1194                 '$MP3::Info::try_harder and retry)';
1195             return undef;
1196         }
1197     }
1198
1199     my $vbr = _get_vbr($fh, $h, \$off);
1200
1201     seek $fh, 0, 2;
1202     $eof = tell $fh;
1203     seek $fh, -128, 2;
1204     $off += 128 if <$fh> =~ /^TAG/ ? 1 : 0;
1205
1206     _close($file, $fh);
1207
1208     $h->{size} = $eof - $off;
1209
1210     return _get_info($h, $vbr);
1211 }
1212
1213 sub _get_info {
1214     my($h, $vbr) = @_;
1215     my $i;
1216
1217     $i->{VERSION}       = $h->{IDR} == 2 ? 2 : $h->{IDR} == 3 ? 1 :
1218         $h->{IDR} == 0 ? 2.5 : 0;
1219     $i->{LAYER} = 4 - $h->{layer};
1220     $i->{VBR}   = defined $vbr ? 1 : 0;
1221
1222     $i->{COPYRIGHT}     = $h->{copyright} ? 1 : 0;
1223     $i->{PADDING}       = $h->{padding_bit} ? 1 : 0;
1224     $i->{STEREO}        = $h->{mode} == 3 ? 0 : 1;
1225     $i->{MODE}  = $h->{mode};
1226
1227     $i->{SIZE}  = $vbr && $vbr->{bytes} ? $vbr->{bytes} : $h->{size};
1228
1229     my $mfs             = $h->{fs} / ($h->{ID} ? 144000 : 72000);
1230     $i->{FRAMES}        = int($vbr && $vbr->{frames}
1231                               ? $vbr->{frames}
1232                               : $i->{SIZE} / $h->{bitrate} / $mfs
1233                               );
1234
1235     if ($vbr) {
1236         $i->{VBR_SCALE} = $vbr->{scale} if $vbr->{scale};
1237         $h->{bitrate}   = $i->{SIZE} / $i->{FRAMES} * $mfs;
1238         if (not $h->{bitrate}) {
1239             $@ = "Couldn't determine VBR bitrate";
1240             return undef;
1241         }
1242     }
1243
1244     $h->{'length'}      = ($i->{SIZE} * 8) / $h->{bitrate} / 10;
1245     $i->{SECS}  = $h->{'length'} / 100;
1246     $i->{MM}    = int $i->{SECS} / 60;
1247     $i->{SS}    = int $i->{SECS} % 60;
1248     $i->{MS}    = (($i->{SECS} - ($i->{MM} * 60) - $i->{SS}) * 1000);
1249 #       $i->{LF}        = ($i->{MS} / 1000) * ($i->{FRAMES} / $i->{SECS});
1250 #       int($i->{MS} / 100 * 75);  # is this right?
1251     $i->{TIME}  = sprintf "%.2d:%.2d", @{$i}{'MM', 'SS'};
1252
1253     $i->{BITRATE}               = int $h->{bitrate};
1254         # should we just return if ! FRAMES?
1255     $i->{FRAME_LENGTH}  = int($h->{size} / $i->{FRAMES}) if $i->{FRAMES};
1256     $i->{FREQUENCY}             = $frequency_tbl[3 * $h->{IDR} + $h->{sampling_freq}];
1257
1258     return $i;
1259 }
1260
1261 sub _get_head {
1262     my($byte) = @_;
1263     my($bytes, $h);
1264
1265     $bytes = _unpack_head($byte);
1266     @$h{qw(IDR ID layer protection_bit
1267            bitrate_index sampling_freq padding_bit private_bit
1268            mode mode_extension copyright original
1269            emphasis version_index bytes)} = (
1270                 ($bytes>>19)&3, ($bytes>>19)&1, ($bytes>>17)&3, ($bytes>>16)&1,
1271                 ($bytes>>12)&15, ($bytes>>10)&3, ($bytes>>9)&1, ($bytes>>8)&1,
1272                 ($bytes>>6)&3, ($bytes>>4)&3, ($bytes>>3)&1, ($bytes>>2)&1,
1273                 $bytes&3, ($bytes>>19)&3, $bytes
1274         );
1275
1276     $h->{bitrate} = $t_bitrate[$h->{ID}][3 - $h->{layer}][$h->{bitrate_index}];
1277     $h->{fs} = $t_sampling_freq[$h->{IDR}][$h->{sampling_freq}];
1278
1279     return $h;
1280 }
1281
1282 sub _is_mp3 {
1283     my $h = $_[0] or return undef;
1284     return ! (  # all below must be false
1285                 $h->{bitrate_index} == 0
1286                 ||
1287                 $h->{version_index} == 1
1288                 ||
1289                 ($h->{bytes} & 0xFFE00000) != 0xFFE00000
1290                 ||
1291                 !$h->{fs}
1292                 ||
1293                 !$h->{bitrate}
1294                 ||
1295                 $h->{bitrate_index} == 15
1296                 ||
1297                 !$h->{layer}
1298                 ||
1299                 $h->{sampling_freq} == 3
1300                 ||
1301                 $h->{emphasis} == 2
1302                 ||
1303                 !$h->{bitrate_index}
1304                 ||
1305                 ($h->{bytes} & 0xFFFF0000) == 0xFFFE0000
1306                 ||
1307                 ($h->{ID} == 1 && $h->{layer} == 3 && $h->{protection_bit} == 1)
1308                 ||
1309                 ($h->{mode_extension} != 0 && $h->{mode} != 1)
1310                 );
1311 }
1312
1313 sub _get_vbr {
1314     my($fh, $h, $roff) = @_;
1315     my($off, $bytes, @bytes, $myseek, %vbr);
1316
1317     $off = $$roff;
1318     @_ = ();    # closure confused if we don't do this
1319
1320     $myseek = sub {
1321         my $n = $_[0] || 4;
1322         seek $fh, $off, 0;
1323         read $fh, $bytes, $n;
1324         $off += $n;
1325     };
1326
1327     $off += 4;
1328
1329     if ($h->{ID}) {     # MPEG1
1330         $off += $h->{mode} == 3 ? 17 : 32;
1331     } else {    # MPEG2
1332         $off += $h->{mode} == 3 ? 9 : 17;
1333     }
1334
1335     &$myseek;
1336     return unless $bytes eq 'Xing';
1337
1338     &$myseek;
1339     $vbr{flags} = _unpack_head($bytes);
1340
1341     if ($vbr{flags} & 1) {
1342         &$myseek;
1343         $vbr{frames} = _unpack_head($bytes);
1344     }
1345
1346     if ($vbr{flags} & 2) {
1347         &$myseek;
1348         $vbr{bytes} = _unpack_head($bytes);
1349     }
1350
1351     if ($vbr{flags} & 4) {
1352         $myseek->(100);
1353 # Not used right now ...
1354 #               $vbr{toc} = _unpack_head($bytes);
1355     }
1356
1357     if ($vbr{flags} & 8) { # (quality ind., 0=best 100=worst)
1358         &$myseek;
1359         $vbr{scale} = _unpack_head($bytes);
1360     } else {
1361         $vbr{scale} = -1;
1362     }
1363
1364     $$roff = $off;
1365     return \%vbr;
1366 }
1367
1368 sub _get_v2head {
1369     my $fh = $_[0] or return;
1370     my($h, $bytes, @bytes);
1371
1372     # check first three bytes for 'ID3'
1373     seek $fh, 0, 0;
1374     read $fh, $bytes, 3;
1375     return unless $bytes eq 'ID3';
1376
1377     # get version
1378     read $fh, $bytes, 2;
1379     $h->{version} = sprintf "ID3v2.%d.%d",
1380     @$h{qw[major_version minor_version]} =
1381         unpack 'c2', $bytes;
1382
1383     # get flags
1384     read $fh, $bytes, 1;
1385     if ($h->{major_version} == 2) {
1386         @$h{qw[unsync compression]} =
1387             (unpack 'b8', $bytes)[7, 6];
1388         $h->{ext_header} = 0;
1389         $h->{experimental} = 0;
1390     } else {
1391         @$h{qw[unsync ext_header experimental]} =
1392             (unpack 'b8', $bytes)[7, 6, 5];
1393     }
1394
1395     # get ID3v2 tag length from bytes 7-10
1396     $h->{tag_size} = 10;        # include ID3v2 header size
1397     read $fh, $bytes, 4;
1398     @bytes = reverse unpack 'C4', $bytes;
1399     foreach my $i (0 .. 3) {
1400         # whoaaaaaa nellllllyyyyyy!
1401         $h->{tag_size} += $bytes[$i] * 128 ** $i;
1402     }
1403
1404     # get extended header size
1405     $h->{ext_header_size} = 0;
1406     if ($h->{ext_header}) {
1407         $h->{ext_header_size} += 10;
1408         read $fh, $bytes, 4;
1409         @bytes = reverse unpack 'C4', $bytes;
1410         for my $i (0..3) {
1411             $h->{ext_header_size} += $bytes[$i] * 256 ** $i;
1412         }
1413     }
1414
1415     return $h;
1416 }
1417
1418 sub _unpack_head {
1419     unpack('l', pack('L', unpack('N', $_[0])));
1420 }
1421
1422 sub _close {
1423     my($file, $fh) = @_;
1424     unless (ref $file) { # filehandle not passed
1425         close $fh or warn "Problem closing '$file': $!";
1426     }
1427 }
1428
1429 BEGIN {
1430     @mp3_genres = (
1431                 'Blues',
1432                 'Classic Rock',
1433                 'Country',
1434                 'Dance',
1435                 'Disco',
1436                 'Funk',
1437                 'Grunge',
1438                 'Hip-Hop',
1439                 'Jazz',
1440                 'Metal',
1441                 'New Age',
1442                 'Oldies',
1443                 'Other',
1444                 'Pop',
1445                 'R&B',
1446                 'Rap',
1447                 'Reggae',
1448                 'Rock',
1449                 'Techno',
1450                 'Industrial',
1451                 'Alternative',
1452                 'Ska',
1453                 'Death Metal',
1454                 'Pranks',
1455                 'Soundtrack',
1456                 'Euro-Techno',
1457                 'Ambient',
1458                 'Trip-Hop',
1459                 'Vocal',
1460                 'Jazz+Funk',
1461                 'Fusion',
1462                 'Trance',
1463                 'Classical',
1464                 'Instrumental',
1465                 'Acid',
1466                 'House',
1467                 'Game',
1468                 'Sound Clip',
1469                 'Gospel',
1470                 'Noise',
1471                 'AlternRock',
1472                 'Bass',
1473                 'Soul',
1474                 'Punk',
1475                 'Space',
1476                 'Meditative',
1477                 'Instrumental Pop',
1478                 'Instrumental Rock',
1479                 'Ethnic',
1480                 'Gothic',
1481                 'Darkwave',
1482                 'Techno-Industrial',
1483                 'Electronic',
1484                 'Pop-Folk',
1485                 'Eurodance',
1486                 'Dream',
1487                 'Southern Rock',
1488                 'Comedy',
1489                 'Cult',
1490                 'Gangsta',
1491                 'Top 40',
1492                 'Christian Rap',
1493                 'Pop/Funk',
1494                 'Jungle',
1495                 'Native American',
1496                 'Cabaret',
1497                 'New Wave',
1498                 'Psychadelic',
1499                 'Rave',
1500                 'Showtunes',
1501                 'Trailer',
1502                 'Lo-Fi',
1503                 'Tribal',
1504                 'Acid Punk',
1505                 'Acid Jazz',
1506                 'Polka',
1507                 'Retro',
1508                 'Musical',
1509                 'Rock & Roll',
1510                 'Hard Rock',
1511         );
1512
1513         @winamp_genres = (
1514                 @mp3_genres,
1515                 'Folk',
1516                 'Folk-Rock',
1517                 'National Folk',
1518                 'Swing',
1519                 'Fast Fusion',
1520                 'Bebob',
1521                 'Latin',
1522                 'Revival',
1523                 'Celtic',
1524                 'Bluegrass',
1525                 'Avantgarde',
1526                 'Gothic Rock',
1527                 'Progressive Rock',
1528                 'Psychedelic Rock',
1529                 'Symphonic Rock',
1530                 'Slow Rock',
1531                 'Big Band',
1532                 'Chorus',
1533                 'Easy Listening',
1534                 'Acoustic',
1535                 'Humour',
1536                 'Speech',
1537                 'Chanson',
1538                 'Opera',
1539                 'Chamber Music',
1540                 'Sonata',
1541                 'Symphony',
1542                 'Booty Bass',
1543                 'Primus',
1544                 'Porn Groove',
1545                 'Satire',
1546                 'Slow Jam',
1547                 'Club',
1548                 'Tango',
1549                 'Samba',
1550                 'Folklore',
1551                 'Ballad',
1552                 'Power Ballad',
1553                 'Rhythmic Soul',
1554                 'Freestyle',
1555                 'Duet',
1556                 'Punk Rock',
1557                 'Drum Solo',
1558                 'Acapella',
1559                 'Euro-House',
1560                 'Dance Hall',
1561                 'Goa',
1562                 'Drum & Bass',
1563                 'Club-House',
1564                 'Hardcore',
1565                 'Terror',
1566                 'Indie',
1567                 'BritPop',
1568                 'Negerpunk',
1569                 'Polsk Punk',
1570                 'Beat',
1571                 'Christian Gangsta Rap',
1572                 'Heavy Metal',
1573                 'Black Metal',
1574                 'Crossover',
1575                 'Contemporary Christian',
1576                 'Christian Rock',
1577                 'Merengue',
1578                 'Salsa',
1579                 'Thrash Metal',
1580                 'Anime',
1581                 'JPop',
1582                 'Synthpop',
1583         );
1584
1585     @t_bitrate = ([
1586                 [0, 32, 48, 56,  64,  80,  96, 112, 128, 144, 160, 176, 192, 224, 256],
1587                 [0,  8, 16, 24,  32,  40,  48,  56,  64,  80,  96, 112, 128, 144, 160],
1588                 [0,  8, 16, 24,  32,  40,  48,  56,  64,  80,  96, 112, 128, 144, 160]
1589         ],[
1590                 [0, 32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448],
1591                 [0, 32, 48, 56,  64,  80,  96, 112, 128, 160, 192, 224, 256, 320, 384],
1592                 [0, 32, 40, 48,  56,  64,  80,  96, 112, 128, 160, 192, 224, 256, 320]
1593         ]);
1594
1595     @t_sampling_freq = (
1596                         [11025, 12000,  8000],
1597                         [undef, undef, undef],  # reserved
1598                         [22050, 24000, 16000],
1599                         [44100, 48000, 32000]
1600                         );
1601
1602     @frequency_tbl = map { $_ ? eval "${_}e-3" : 0 }
1603                 map { @$_ } @t_sampling_freq;
1604
1605     @mp3_info_fields = qw(
1606                 VERSION
1607                 LAYER
1608                 STEREO
1609                 VBR
1610                 BITRATE
1611                 FREQUENCY
1612                 SIZE
1613                 SECS
1614                 MM
1615                 SS
1616                 MS
1617                 TIME
1618                 COPYRIGHT
1619                 PADDING
1620                 MODE
1621                 FRAMES
1622                 FRAME_LENGTH
1623                 VBR_SCALE
1624         );
1625
1626     %v1_tag_fields =
1627         (TITLE => 30, ARTIST => 30, ALBUM => 30, COMMENT => 30, YEAR => 4);
1628
1629     @v1_tag_names = qw(TITLE ARTIST ALBUM YEAR COMMENT TRACKNUM GENRE);
1630
1631     %v2_to_v1_names = (
1632                 # v2.2 tags
1633                 'TT2' => 'TITLE',
1634                 'TP1' => 'ARTIST',
1635                 'TAL' => 'ALBUM',
1636                 'TYE' => 'YEAR',
1637                 'COM' => 'COMMENT',
1638                 'TRK' => 'TRACKNUM',
1639                 'TCO' => 'GENRE', # not clean mapping, but ...
1640                 # v2.3 tags
1641                 'TIT2' => 'TITLE',
1642                 'TPE1' => 'ARTIST',
1643                 'TALB' => 'ALBUM',
1644                 'TYER' => 'YEAR',
1645                 'COMM' => 'COMMENT',
1646                 'TRCK' => 'TRACKNUM',
1647                 'TCON' => 'GENRE',
1648         );
1649
1650     %v2_tag_names = (
1651                 # v2.2 tags
1652                 'BUF' => 'Recommended buffer size',
1653                 'CNT' => 'Play counter',
1654                 'COM' => 'Comments',
1655                 'CRA' => 'Audio encryption',
1656                 'CRM' => 'Encrypted meta frame',
1657                 'ETC' => 'Event timing codes',
1658                 'EQU' => 'Equalization',
1659                 'GEO' => 'General encapsulated object',
1660                 'IPL' => 'Involved people list',
1661                 'LNK' => 'Linked information',
1662                 'MCI' => 'Music CD Identifier',
1663                 'MLL' => 'MPEG location lookup table',
1664                 'PIC' => 'Attached picture',
1665                 'POP' => 'Popularimeter',
1666                 'REV' => 'Reverb',
1667                 'RVA' => 'Relative volume adjustment',
1668                 'SLT' => 'Synchronized lyric/text',
1669                 'STC' => 'Synced tempo codes',
1670                 'TAL' => 'Album/Movie/Show title',
1671                 'TBP' => 'BPM (Beats Per Minute)',
1672                 'TCM' => 'Composer',
1673                 'TCO' => 'Content type',
1674                 'TCR' => 'Copyright message',
1675                 'TDA' => 'Date',
1676                 'TDY' => 'Playlist delay',
1677                 'TEN' => 'Encoded by',
1678                 'TFT' => 'File type',
1679                 'TIM' => 'Time',
1680                 'TKE' => 'Initial key',
1681                 'TLA' => 'Language(s)',
1682                 'TLE' => 'Length',
1683                 'TMT' => 'Media type',
1684                 'TOA' => 'Original artist(s)/performer(s)',
1685                 'TOF' => 'Original filename',
1686                 'TOL' => 'Original Lyricist(s)/text writer(s)',
1687                 'TOR' => 'Original release year',
1688                 'TOT' => 'Original album/Movie/Show title',
1689                 'TP1' => 'Lead artist(s)/Lead performer(s)/Soloist(s)/Performing group',
1690                 'TP2' => 'Band/Orchestra/Accompaniment',
1691                 'TP3' => 'Conductor/Performer refinement',
1692                 'TP4' => 'Interpreted, remixed, or otherwise modified by',
1693                 'TPA' => 'Part of a set',
1694                 'TPB' => 'Publisher',
1695                 'TRC' => 'ISRC (International Standard Recording Code)',
1696                 'TRD' => 'Recording dates',
1697                 'TRK' => 'Track number/Position in set',
1698                 'TSI' => 'Size',
1699                 'TSS' => 'Software/hardware and settings used for encoding',
1700                 'TT1' => 'Content group description',
1701                 'TT2' => 'Title/Songname/Content description',
1702                 'TT3' => 'Subtitle/Description refinement',
1703                 'TXT' => 'Lyricist/text writer',
1704                 'TXX' => 'User defined text information frame',
1705                 'TYE' => 'Year',
1706                 'UFI' => 'Unique file identifier',
1707                 'ULT' => 'Unsychronized lyric/text transcription',
1708                 'WAF' => 'Official audio file webpage',
1709                 'WAR' => 'Official artist/performer webpage',
1710                 'WAS' => 'Official audio source webpage',
1711                 'WCM' => 'Commercial information',
1712                 'WCP' => 'Copyright/Legal information',
1713                 'WPB' => 'Publishers official webpage',
1714                 'WXX' => 'User defined URL link frame',
1715
1716                 # v2.3 tags
1717                 'AENC' => 'Audio encryption',
1718                 'APIC' => 'Attached picture',
1719                 'COMM' => 'Comments',
1720                 'COMR' => 'Commercial frame',
1721                 'ENCR' => 'Encryption method registration',
1722                 'EQUA' => 'Equalization',
1723                 'ETCO' => 'Event timing codes',
1724                 'GEOB' => 'General encapsulated object',
1725                 'GRID' => 'Group identification registration',
1726                 'IPLS' => 'Involved people list',
1727                 'LINK' => 'Linked information',
1728                 'MCDI' => 'Music CD identifier',
1729                 'MLLT' => 'MPEG location lookup table',
1730                 'OWNE' => 'Ownership frame',
1731                 'PCNT' => 'Play counter',
1732                 'POPM' => 'Popularimeter',
1733                 'POSS' => 'Position synchronisation frame',
1734                 'PRIV' => 'Private frame',
1735                 'RBUF' => 'Recommended buffer size',
1736                 'RVAD' => 'Relative volume adjustment',
1737                 'RVRB' => 'Reverb',
1738                 'SYLT' => 'Synchronized lyric/text',
1739                 'SYTC' => 'Synchronized tempo codes',
1740                 'TALB' => 'Album/Movie/Show title',
1741                 'TBPM' => 'BPM (beats per minute)',
1742                 'TCOM' => 'Composer',
1743                 'TCON' => 'Content type',
1744                 'TCOP' => 'Copyright message',
1745                 'TDAT' => 'Date',
1746                 'TDLY' => 'Playlist delay',
1747                 'TENC' => 'Encoded by',
1748                 'TEXT' => 'Lyricist/Text writer',
1749                 'TFLT' => 'File type',
1750                 'TIME' => 'Time',
1751                 'TIT1' => 'Content group description',
1752                 'TIT2' => 'Title/songname/content description',
1753                 'TIT3' => 'Subtitle/Description refinement',
1754                 'TKEY' => 'Initial key',
1755                 'TLAN' => 'Language(s)',
1756                 'TLEN' => 'Length',
1757                 'TMED' => 'Media type',
1758                 'TOAL' => 'Original album/movie/show title',
1759                 'TOFN' => 'Original filename',
1760                 'TOLY' => 'Original lyricist(s)/text writer(s)',
1761                 'TOPE' => 'Original artist(s)/performer(s)',
1762                 'TORY' => 'Original release year',
1763                 'TOWN' => 'File owner/licensee',
1764                 'TPE1' => 'Lead performer(s)/Soloist(s)',
1765                 'TPE2' => 'Band/orchestra/accompaniment',
1766                 'TPE3' => 'Conductor/performer refinement',
1767                 'TPE4' => 'Interpreted, remixed, or otherwise modified by',
1768                 'TPOS' => 'Part of a set',
1769                 'TPUB' => 'Publisher',
1770                 'TRCK' => 'Track number/Position in set',
1771                 'TRDA' => 'Recording dates',
1772                 'TRSN' => 'Internet radio station name',
1773                 'TRSO' => 'Internet radio station owner',
1774                 'TSIZ' => 'Size',
1775                 'TSRC' => 'ISRC (international standard recording code)',
1776                 'TSSE' => 'Software/Hardware and settings used for encoding',
1777                 'TXXX' => 'User defined text information frame',
1778                 'TYER' => 'Year',
1779                 'UFID' => 'Unique file identifier',
1780                 'USER' => 'Terms of use',
1781                 'USLT' => 'Unsychronized lyric/text transcription',
1782                 'WCOM' => 'Commercial information',
1783                 'WCOP' => 'Copyright/Legal information',
1784                 'WOAF' => 'Official audio file webpage',
1785                 'WOAR' => 'Official artist/performer webpage',
1786                 'WOAS' => 'Official audio source webpage',
1787                 'WORS' => 'Official internet radio station homepage',
1788                 'WPAY' => 'Payment',
1789                 'WPUB' => 'Publishers official webpage',
1790                 'WXXX' => 'User defined URL link frame',
1791
1792                 # v2.4 additional tags
1793                 # note that we don't restrict tags from 2.3 or 2.4,
1794                 'ASPI' => 'Audio seek point index',
1795                 'EQU2' => 'Equalisation (2)',
1796                 'RVA2' => 'Relative volume adjustment (2)',
1797                 'SEEK' => 'Seek frame',
1798                 'SIGN' => 'Signature frame',
1799                 'TDEN' => 'Encoding time',
1800                 'TDOR' => 'Original release time',
1801                 'TDRC' => 'Recording time',
1802                 'TDRL' => 'Release time',
1803                 'TDTG' => 'Tagging time',
1804                 'TIPL' => 'Involved people list',
1805                 'TMCL' => 'Musician credits list',
1806                 'TMOO' => 'Mood',
1807                 'TPRO' => 'Produced notice',
1808                 'TSOA' => 'Album sort order',
1809                 'TSOP' => 'Performer sort order',
1810                 'TSOT' => 'Title sort order',
1811                 'TSST' => 'Set subtitle',
1812
1813                 # grrrrrrr
1814                 'COM ' => 'Broken iTunes comments',
1815         );
1816 }
1817
1818 1;
1819
1820 __END__
1821
1822 =pod
1823
1824 =back
1825
1826 =head1 TROUBLESHOOTING
1827
1828 If you find a bug, please send me a patch (see the project page in L<"SEE ALSO">).
1829 If you cannot figure out why it does not work for you, please put the MP3 file in
1830 a place where I can get it (preferably via FTP, or HTTP, or .Mac iDisk) and send me
1831 mail regarding where I can get the file, with a detailed description of the problem.
1832
1833 If I download the file, after debugging the problem I will not keep the MP3 file
1834 if it is not legal for me to have it.  Just let me know if it is legal for me to
1835 keep it or not.
1836
1837
1838 =head1 TODO
1839
1840 =over 4
1841
1842 =item ID3v2 Support
1843
1844 Still need to do more for reading tags, such as using Compress::Zlib to decompress
1845 compressed tags.  But until I see this in use more, I won't bother.  If something
1846 does not work properly with reading, follow the instructions above for
1847 troubleshooting.
1848
1849 ID3v2 I<writing> is coming soon.
1850
1851 =item Get data from scalar
1852
1853 Instead of passing a file spec or filehandle, pass the
1854 data itself.  Would take some work, converting the seeks, etc.
1855
1856 =item Padding bit ?
1857
1858 Do something with padding bit.
1859
1860 =item Test suite
1861
1862 Test suite could use a bit of an overhaul and update.  Patches very welcome.
1863
1864 =over 4
1865
1866 =item *
1867
1868 Revamp getset.t.  Test all the various get_mp3tag args.
1869
1870 =item *
1871
1872 Test Unicode.
1873
1874 =item *
1875
1876 Test OOP API.
1877
1878 =item *
1879
1880 Test error handling, check more for missing files, bad MP3s, etc.
1881
1882 =back
1883
1884 =item Other VBR
1885
1886 Right now, only Xing VBR is supported.
1887
1888 =back
1889
1890
1891 =head1 THANKS
1892
1893 Edward Allen E<lt>allenej@c51844-a.spokn1.wa.home.comE<gt>,
1894 Vittorio Bertola E<lt>v.bertola@vitaminic.comE<gt>,
1895 Michael Blakeley E<lt>mike@blakeley.comE<gt>,
1896 Per Bolmstedt E<lt>tomten@kol14.comE<gt>,
1897 Tony Bowden E<lt>tony@tmtm.comE<gt>,
1898 Tom Brown E<lt>thecap@usa.netE<gt>,
1899 Sergio Camarena E<lt>scamarena@users.sourceforge.netE<gt>,
1900 Chris Dawson E<lt>cdawson@webiphany.comE<gt>,
1901 Luke Drumm E<lt>lukedrumm@mypad.comE<gt>,
1902 Kyle Farrell E<lt>kyle@cantametrix.comE<gt>,
1903 Jeffrey Friedl E<lt>jfriedl@yahoo.comE<gt>,
1904 brian d foy E<lt>comdog@panix.comE<gt>,
1905 Ben Gertzfield E<lt>che@debian.orgE<gt>,
1906 Brian Goodwin E<lt>brian@fuddmain.comE<gt>,
1907 Todd Hanneken E<lt>thanneken@hds.harvard.eduE<gt>,
1908 Todd Harris E<lt>harris@cshl.orgE<gt>,
1909 Woodrow Hill E<lt>asim@mindspring.comE<gt>,
1910 Kee Hinckley E<lt>nazgul@somewhere.comE<gt>,
1911 Roman Hodek E<lt>Roman.Hodek@informatik.uni-erlangen.deE<gt>,
1912 Peter Kovacs E<lt>kovacsp@egr.uri.eduE<gt>,
1913 Johann Lindvall,
1914 Peter Marschall E<lt>peter.marschall@mayn.deE<gt>,
1915 Trond Michelsen E<lt>mike@crusaders.noE<gt>,
1916 Dave O'Neill E<lt>dave@nexus.carleton.caE<gt>,
1917 Christoph Oberauer E<lt>christoph.oberauer@sbg.ac.atE<gt>,
1918 Jake Palmer E<lt>jake.palmer@db.comE<gt>,
1919 Andrew Phillips E<lt>asp@wasteland.orgE<gt>,
1920 David Reuteler E<lt>reuteler@visi.comE<gt>,
1921 John Ruttenberg E<lt>rutt@chezrutt.comE<gt>,
1922 Matthew Sachs E<lt>matthewg@zevils.comE<gt>,
1923 E<lt>scfc_de@users.sf.netE<gt>,
1924 Hermann Schwaerzler E<lt>Hermann.Schwaerzler@uibk.ac.atE<gt>,
1925 Chris Sidi E<lt>sidi@angband.orgE<gt>,
1926 Roland Steinbach E<lt>roland@support-system.comE<gt>,
1927 Stuart E<lt>schneis@users.sourceforge.netE<gt>,
1928 Jeffery Sumler E<lt>jsumler@mediaone.netE<gt>,
1929 Predrag Supurovic E<lt>mpgtools@dv.co.yuE<gt>,
1930 Bogdan Surdu E<lt>tim@go.roE<gt>,
1931 E<lt>tim@tim-landscheidt.deE<gt>,
1932 Pass F. B. Travis E<lt>pftravis@bellsouth.netE<gt>,
1933 Tobias Wagener E<lt>tobias@wagener.nuE<gt>,
1934 Ronan Waide E<lt>waider@stepstone.ieE<gt>,
1935 Andy Waite E<lt>andy@mailroute.comE<gt>,
1936 Ken Williams E<lt>ken@forum.swarthmore.eduE<gt>,
1937 Meng Weng Wong E<lt>mengwong@pobox.comE<gt>.
1938
1939
1940 =head1 AUTHOR AND COPYRIGHT
1941
1942 Chris Nandor E<lt>pudge@pobox.comE<gt>, http://pudge.net/
1943
1944 Copyright (c) 1998-2003 Chris Nandor.  All rights reserved.  This program is
1945 free software; you can redistribute it and/or modify it under the terms
1946 of the Artistic License, distributed with Perl.
1947
1948
1949 =head1 SEE ALSO
1950
1951 =over 4
1952
1953 =item MP3::Info Project Page
1954
1955         http://projects.pudge.net/
1956
1957 =item mp3tools
1958
1959         http://www.zevils.com/linux/mp3tools/
1960
1961 =item mpgtools
1962
1963         http://www.dv.co.yu/mpgscript/mpgtools.htm
1964         http://www.dv.co.yu/mpgscript/mpeghdr.htm
1965
1966 =item mp3tool
1967
1968         http://www.dtek.chalmers.se/~d2linjo/mp3/mp3tool.html
1969
1970 =item ID3v2
1971
1972         http://www.id3.org/
1973
1974 =item Xing Variable Bitrate
1975
1976         http://www.xingtech.com/support/partner_developer/mp3/vbr_sdk/
1977
1978 =item MP3Ext
1979
1980         http://rupert.informatik.uni-stuttgart.de/~mutschml/MP3ext/
1981
1982 =item Xmms
1983
1984         http://www.xmms.org/
1985
1986
1987 =back
1988
1989 =head1 VERSION
1990
1991 v1.02, Sunday, March 2, 2003
1992
1993 =cut