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                 no strict 'refs';
 567                 *{$AUTOLOAD} = $sub;
 568                 goto &$AUTOLOAD;
 569
 570         } else {
 571                 warn(sprintf "No method '$name' available in package %s.",
 572                         __PACKAGE__);
 573         }
 574 }
 575
 576 sub DESTROY {
 577
 578 }
 579
 580
 581 =item use_mp3_utf8([STATUS])
 582
 583 Tells MP3::Info to (or not) return TAG info in UTF-8.
 584 TRUE is 1, FALSE is 0.  Default is FALSE.
 585
 586 Will only be able to it on if Unicode::String is available.  ID3v2
 587 tags will be converted to UTF-8 according to the encoding specified
 588 in each tag; ID3v1 tags will be assumed Latin-1 and converted
 589 to UTF-8.
 590
 591 Function returns status (TRUE/FALSE).  If no argument is supplied,
 592 or an unaccepted argument is supplied, function merely returns status.
 593
 594 This function is not exported by default, but may be exported
 595 with the C<:utf8> or C<:all> export tag.
 596
 597 =cut
 598
 599 my $unicode_module = eval { require Unicode::String };
 600 my $UNICODE = 0;
 601
 602 sub use_mp3_utf8 {
 603         my($val) = @_;
 604         if ($val == 1) {
 605                 $UNICODE = 1 if $unicode_module;
 606         } elsif ($val == 0) {
 607                 $UNICODE = 0;
 608         }
 609         return $UNICODE;
 610 }
 611
 612 =pod
 613
 614 =item use_winamp_genres()
 615
 616 Puts WinAmp genres into C<@mp3_genres> and C<%mp3_genres>
 617 (adds 68 additional genres to the default list of 80).
 618 This is a separate function because these are non-standard
 619 genres, but they are included because they are widely used.
 620
 621 You can import the data structures with one of:
 622
 623         use MP3::Info qw(:genres);
 624         use MP3::Info qw(:DEFAULT :genres);
 625         use MP3::Info qw(:all);
 626
 627 =cut
 628
 629 sub use_winamp_genres {
 630         %mp3_genres = %winamp_genres;
 631         @mp3_genres = @winamp_genres;
 632         return 1;
 633 }
 634
 635 =pod
 636
 637 =item remove_mp3tag (FILE [, VERSION, BUFFER])
 638
 639 Can remove ID3v1 or ID3v2 tags.  VERSION should be C<1> for ID3v1,
 640 C<2> for ID3v2, and C<ALL> for both.
 641
 642 For ID3v1, removes last 128 bytes from file if those last 128 bytes begin
 643 with the text 'TAG'.  File will be 128 bytes shorter.
 644
 645 For ID3v2, removes ID3v2 tag.  Because an ID3v2 tag is at the
 646 beginning of the file, we rewrite the file after removing the tag data.
 647 The buffer for rewriting the file is 4MB.  BUFFER (in bytes) ca
 648 change the buffer size.
 649
 650 Returns the number of bytes removed, or -1 if no tag removed,
 651 or undef if there is an error.
 652
 653 =cut
 654
 655 sub remove_mp3tag {
 656         my($file, $version, $buf) = @_;
 657         my($fh, $return);
 658
 659         $buf ||= 4096*1024;  # the bigger the faster
 660         $version ||= 1;
 661
 662         if (not (defined $file && $file ne '')) {
 663                 $@ = "No file specified";
 664                 return undef;
 665         }
 666
 667         if (not -s $file) {
 668                 $@ = "File is empty";
 669                 return undef;
 670         }
 671
 672         if (ref $file) { # filehandle passed
 673                 $fh = $file;
 674         } else {
 675                 $fh = gensym;
 676                 if (not open $fh, "+< $file\0") {
 677                         $@ = "Can't open $file: $!";
 678                         return undef;
 679                 }
 680         }
 681
 682         binmode $fh;
 683
 684         if ($version eq 1 || $version eq 'ALL') {
 685                 seek $fh, -128, 2;
 686                 my $tell = tell $fh;
 687                 if (<$fh> =~ /^TAG/) {
 688                         truncate $fh, $tell or warn "Can't truncate '$file': $!";
 689                         $return += 128;
 690                 }
 691         }
 692
 693         if ($version eq 2 || $version eq 'ALL') {
 694                 my $h = _get_v2head($fh);
 695                 if ($h) {
 696                         local $\;
 697                         seek $fh, 0, 2;
 698                         my $eof = tell $fh;
 699                         my $off = $h->{tag_size};
 700
 701                         while ($off < $eof) {
 702                                 seek $fh, $off, 0;
 703                                 read $fh, my($bytes), $buf;
 704                                 seek $fh, $off - $h->{tag_size}, 0;
 705                                 print $fh $bytes;
 706                                 $off += $buf;
 707                         }
 708
 709                         truncate $fh, $eof - $h->{tag_size}
 710                                 or warn "Can't truncate '$file': $!";
 711                         $return += $h->{tag_size};
 712                 }
 713         }
 714
 715         _close($file, $fh);
 716
 717         return $return || -1;
 718 }
 719
 720
 721 =pod
 722
 723 =item set_mp3tag (FILE, TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE [, TRACKNUM])
 724
 725 =item set_mp3tag (FILE, $HASHREF)
 726
 727 Adds/changes tag information in an MP3 audio file.  Will clobber
 728 any existing information in file.
 729
 730 Fields are TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE.  All fields have
 731 a 30-byte limit, except for YEAR, which has a four-byte limit, and GENRE,
 732 which is one byte in the file.  The GENRE passed in the function is a
 733 case-insensitive text string representing a genre found in C<@mp3_genres>.
 734
 735 Will accept either a list of values, or a hashref of the type
 736 returned by C<get_mp3tag>.
 737
 738 If TRACKNUM is present (for ID3v1.1), then the COMMENT field can only be
 739 28 bytes.
 740
 741 ID3v2 support may come eventually.  Note that if you set a tag on a file
 742 with ID3v2, the set tag will be for ID3v1[.1] only, and if you call
 743 C<get_mp3_tag> on the file, it will show you the (unchanged) ID3v2 tags,
 744 unless you specify ID3v1.
 745
 746 =cut
 747
 748 sub set_mp3tag {
 749         my($file, $title, $artist, $album, $year, $comment, $genre, $tracknum) = @_;
 750         my(%info, $oldfh, $ref, $fh);
 751         local %v1_tag_fields = %v1_tag_fields;
 752
 753         # set each to '' if undef
 754         for ($title, $artist, $album, $year, $comment, $tracknum, $genre,
 755                 (@info{@v1_tag_names}))
 756                 {$_ = defined() ? $_ : ''}
 757
 758         ($ref) = (overload::StrVal($title) =~ /^(?:.*\=)?([^=]*)\((?:[^\(]*)\)$/)
 759                 if ref $title;
 760         # populate data to hashref if hashref is not passed
 761         if (!$ref) {
 762                 (@info{@v1_tag_names}) =
 763                         ($title, $artist, $album, $year, $comment, $tracknum, $genre);
 764
 765         # put data from hashref into hashref if hashref is passed
 766         } elsif ($ref eq 'HASH') {
 767                 %info = %$title;
 768
 769         # return otherwise
 770         } else {
 771                 warn(<<'EOT');
 772 Usage: set_mp3tag (FILE, TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE [, TRACKNUM])
 773        set_mp3tag (FILE, $HASHREF)
 774 EOT
 775                 return undef;
 776         }
 777
 778         if (not (defined $file && $file ne '')) {
 779                 $@ = "No file specified";
 780                 return undef;
 781         }
 782
 783         if (not -s $file) {
 784                 $@ = "File is empty";
 785                 return undef;
 786         }
 787
 788         # comment field length 28 if ID3v1.1
 789         $v1_tag_fields{COMMENT} = 28 if $info{TRACKNUM};
 790
 791
 792         # only if -w is on
 793         if ($^W) {
 794                 # warn if fields too long
 795                 foreach my $field (keys %v1_tag_fields) {
 796                         $info{$field} = '' unless defined $info{$field};
 797                         if (length($info{$field}) > $v1_tag_fields{$field}) {
 798                                 warn "Data too long for field $field: truncated to " .
 799                                          "$v1_tag_fields{$field}";
 800                         }
 801                 }
 802
 803                 if ($info{GENRE}) {
 804                         warn "Genre `$info{GENRE}' does not exist\n"
 805                                 unless exists $mp3_genres{$info{GENRE}};
 806                 }
 807         }
 808
 809         if ($info{TRACKNUM}) {
 810                 $info{TRACKNUM} =~ s/^(\d+)\/(\d+)$/$1/;
 811                 unless ($info{TRACKNUM} =~ /^\d+$/ &&
 812                         $info{TRACKNUM} > 0 && $info{TRACKNUM} < 256) {
 813                         warn "Tracknum `$info{TRACKNUM}' must be an integer " .
 814                                 "from 1 and 255\n" if $^W;
 815                         $info{TRACKNUM} = '';
 816                 }
 817         }
 818
 819         if (ref $file) { # filehandle passed
 820                 $fh = $file;
 821         } else {
 822                 $fh = gensym;
 823                 if (not open $fh, "+< $file\0") {
 824                         $@ = "Can't open $file: $!";
 825                         return undef;
 826                 }
 827         }
 828
 829         binmode $fh;
 830         $oldfh = select $fh;
 831         seek $fh, -128, 2;
 832         # go to end of file if no tag, beginning of file if tag
 833         seek $fh, (<$fh> =~ /^TAG/ ? -128 : 0), 2;
 834
 835         # get genre value
 836         $info{GENRE} = $info{GENRE} && exists $mp3_genres{$info{GENRE}} ?
 837                 $mp3_genres{$info{GENRE}} : 255;  # some default genre
 838
 839         local $\;
 840         # print TAG to file
 841         if ($info{TRACKNUM}) {
 842                 print pack "a3a30a30a30a4a28xCC", 'TAG', @info{@v1_tag_names};
 843         } else {
 844                 print pack "a3a30a30a30a4a30C", 'TAG', @info{@v1_tag_names[0..4, 6]};
 845         }
 846
 847         select $oldfh;
 848
 849         _close($file, $fh);
 850
 851         return 1;
 852 }
 853
 854 =pod
 855
 856 =item get_mp3tag (FILE [, VERSION, RAW_V2])
 857
 858 Returns hash reference containing tag information in MP3 file.  The keys
 859 returned are the same as those supplied for C<set_mp3tag>, except in the
 860 case of RAW_V2 being set.
 861
 862 If VERSION is C<1>, the information is taken from the ID3v1 tag (if present).
 863 If VERSION is C<2>, the information is taken from the ID3v2 tag (if present).
 864 If VERSION is not supplied, or is false, the ID3v1 tag is read if present, and
 865 then, if present, the ID3v2 tag information will override any existing ID3v1
 866 tag info.
 867
 868 If RAW_V2 is C<1>, the raw ID3v2 tag data is returned, without any manipulation
 869 of text encoding.  The key name is the same as the frame ID (ID to name mappings
 870 are in the global %v2_tag_names).
 871
 872 If RAW_V2 is C<2>, the ID3v2 tag data is returned, manipulating for Unicode if
 873 necessary, etc.  It also takes multiple values for a given key (such as comments)
 874 and puts them in an arrayref.
 875
 876 If the ID3v2 version is older than ID3v2.2.0 or newer than ID3v2.4.0, it will
 877 not be read.
 878
 879 Strings returned will be in Latin-1, unless UTF-8 is specified (L<use_mp3_utf8>),
 880 (unless RAW_V2 is C<1>).
 881
 882 Also returns a TAGVERSION key, containing the ID3 version used for the returned
 883 data (if TAGVERSION argument is C<0>, may contain two versions).
 884
 885 =cut
 886
 887 sub get_mp3tag {
 888     my($file, $ver, $raw_v2) = @_;
 889     my($tag, $v1, $v2, $v2h, %info, @array, $fh);
 890     $raw_v2 ||= 0;
 891     $ver = !$ver ? 0 : ($ver == 2 || $ver == 1) ? $ver : 0;
 892
 893     if (not (defined $file && $file ne '')) {
 894         $@ = "No file specified";
 895         return undef;
 896     }
 897
 898     if (not -s $file) {
 899         $@ = "File is empty";
 900         return undef;
 901     }
 902
 903     if (ref $file) { # filehandle passed
 904         $fh = $file;
 905     } else {
 906         $fh = gensym;
 907         if (not open $fh, "< $file\0") {
 908             $@ = "Can't open $file: $!";
 909             return undef;
 910         }
 911     }
 912
 913     binmode $fh;
 914
 915     if ($ver < 2) {
 916         seek $fh, -128, 2;
 917         while(defined(my $line = <$fh>)) { $tag .= $line }
 918
 919         if ($tag =~ /^TAG/) {
 920             $v1 = 1;
 921             if (substr($tag, -3, 2) =~ /\000[^\000]/) {
 922                 (undef, @info{@v1_tag_names}) =
 923                     (unpack('a3a30a30a30a4a28', $tag),
 924                      ord(substr($tag, -2, 1)),
 925                      $mp3_genres[ord(substr $tag, -1)]);
 926                 $info{TAGVERSION} = 'ID3v1.1';
 927             } else {
 928                 (undef, @info{@v1_tag_names[0..4, 6]}) =
 929                     (unpack('a3a30a30a30a4a30', $tag),
 930                      $mp3_genres[ord(substr $tag, -1)]);
 931                 $info{TAGVERSION} = 'ID3v1';
 932             }
 933             if ($UNICODE) {
 934                 for my $key (keys %info) {
 935                     next unless $info{$key};
 936                     my $u = Unicode::String::latin1($info{$key});
 937                     $info{$key} = $u->utf8;
 938                 }
 939             }
 940         } elsif ($ver == 1) {
 941             _close($file, $fh);
 942             $@ = "No ID3v1 tag found";
 943             return undef;
 944         }
 945     }
 946
 947     ($v2, $v2h) = _get_v2tag($fh);
 948
 949     unless ($v1 || $v2) {
 950         _close($file, $fh);
 951         $@ = "No ID3 tag found";
 952         return undef;
 953     }
 954
 955     if (($ver == 0 || $ver == 2) && $v2) {
 956         if ($raw_v2 == 1 && $ver == 2) {
 957             %info = %$v2;
 958             $info{TAGVERSION} = $v2h->{version};
 959         } else {
 960             my $hash = $raw_v2 == 2 ? { map { ($_, $_) } keys %v2_tag_names } : \%v2_to_v1_names;
 961             for my $id (keys %$hash) {
 962                 if (exists $v2->{$id}) {
 963                     if ($id =~ /^TCON?$/ && $v2->{$id} =~ /^.?\((\d+)\)/) {
 964                         $info{$hash->{$id}} = $mp3_genres[$1];
 965                     } else {
 966                         my $data1 = $v2->{$id};
 967
 968                         # this is tricky ... if this is an arrayref, we want
 969                         # to only return one, so we pick the first one.  but
 970                         # if it is a comment, we pick the first one where the
 971                         # first charcter after the language is NULL and not an
 972                         # additional sub-comment, because that is most likely
 973                         # to be the user-supplied comment
 974
 975                         if (ref $data1 && !$raw_v2) {
 976                             if ($id =~ /^COMM?$/) {
 977                                 my($newdata) = grep /^(....\000)/, @{$data1};
 978                                 $data1 = $newdata || $data1->[0];
 979                             } else {
 980                                 $data1 = $data1->[0];
 981                             }
 982                         }
 983
 984                         $data1 = [ $data1 ] if ! ref $data1;
 985
 986                         for my $data (@$data1) {
 987                             $data =~ s/^(.)//; # strip first char (text encoding)
 988                             my $encoding = $1;
 989                             my $desc;
 990                             if ($id =~ /^COM[M ]?$/) {
 991                                 $data =~ s/^(?:...)//;          # strip language
 992                                 $data =~ s/^(.*?)\000+//;       # strip up to first NULL(s),
 993                                 # for sub-comment
 994                                 $desc = $1;
 995                             }
 996
 997                             if ($UNICODE) {
 998                                 if ($encoding eq "\001" || $encoding eq "\002") {  # UTF-16, UTF-16BE
 999                                     my $u = Unicode::String::utf16($data);
1000                                     $data = $u->utf8;
1001                                     $data =~ s/^\xEF\xBB\xBF//; # strip BOM
1002                                 } elsif ($encoding eq "\000") {
1003                                     my $u = Unicode::String::latin1($data);
1004                                     $data = $u->utf8;
1005                                 }
1006                             }
1007
1008                             if ($raw_v2 == 2 && $desc) {
1009                                 $data = { $desc => $data };
1010                             }
1011
1012                             if ($raw_v2 == 2 && exists $info{$hash->{$id}}) {
1013                                 if (ref $info{$hash->{$id}} eq 'ARRAY') {
1014                                     push @{$info{$hash->{$id}}}, $data;
1015                                 } else {
1016                                     $info{$hash->{$id}} = [ $info{$hash->{$id}}, $data ];
1017                                 }
1018                             } else {
1019                                 $info{$hash->{$id}} = $data;
1020                             }
1021                         }
1022                     }
1023                 }
1024             }
1025             if ($ver == 0 && $info{TAGVERSION}) {
1026                 $info{TAGVERSION} .= ' / ' . $v2h->{version};
1027             } else {
1028                 $info{TAGVERSION} = $v2h->{version};
1029             }
1030         }
1031     }
1032
1033     unless ($raw_v2 && $ver == 2) {
1034         foreach my $key (keys %info) {
1035             if (defined $info{$key}) {
1036                 $info{$key} =~ s/\000+.*//g;
1037                 $info{$key} =~ s/\s+$//;
1038             }
1039         }
1040
1041         for (@v1_tag_names) {
1042             $info{$_} = '' unless defined $info{$_};
1043         }
1044     }
1045
1046     if (keys %info && exists $info{GENRE} && ! defined $info{GENRE}) {
1047         $info{GENRE} = '';
1048     }
1049
1050     _close($file, $fh);
1051
1052     return keys %info ? {%info} : undef;
1053 }
1054
1055 sub _get_v2tag {
1056     my($fh) = @_;
1057     my($off, $myseek, $myseek_22, $myseek_23, $v2, $h, $hlen, $num);
1058     $h = {};
1059
1060     $v2 = _get_v2head($fh) or return;
1061     if ($v2->{major_version} < 2) {
1062         warn "This is $v2->{version}; " .
1063             "ID3v2 versions older than ID3v2.2.0 not supported\n"
1064             if $^W;
1065         return;
1066     }
1067
1068     if ($v2->{major_version} == 2) {
1069         $hlen = 6;
1070         $num = 3;
1071     } else {
1072         $hlen = 10;
1073         $num = 4;
1074     }
1075
1076     $myseek = sub {
1077         seek $fh, $off, 0;
1078         read $fh, my($bytes), $hlen;
1079         return unless $bytes =~ /^([A-Z0-9]{$num})/
1080             || ($num == 4 && $bytes =~ /^(COM )/);  # stupid iTunes
1081         my($id, $size) = ($1, $hlen);
1082         my @bytes = reverse unpack "C$num", substr($bytes, $num, $num);
1083         for my $i (0 .. ($num - 1)) {
1084             $size += $bytes[$i] * 256 ** $i;
1085         }
1086         return($id, $size);
1087     };
1088
1089     $off = $v2->{ext_header_size} + 10;
1090
1091     while ($off < $v2->{tag_size}) {
1092         my($id, $size) = &$myseek or last;
1093         seek $fh, $off + $hlen, 0;
1094         read $fh, my($bytes), $size - $hlen;
1095         if (exists $h->{$id}) {
1096             if (ref $h->{$id} eq 'ARRAY') {
1097                 push @{$h->{$id}}, $bytes;
1098             } else {
1099                 $h->{$id} = [$h->{$id}, $bytes];
1100             }
1101         } else {
1102             $h->{$id} = $bytes;
1103         }
1104         $off += $size;
1105     }
1106
1107     return($h, $v2);
1108 }
1109
1110
1111 =pod
1112
1113 =item get_mp3info (FILE)
1114
1115 Returns hash reference containing file information for MP3 file.
1116 This data cannot be changed.  Returned data:
1117
1118         VERSION         MPEG audio version (1, 2, 2.5)
1119         LAYER           MPEG layer description (1, 2, 3)
1120         STEREO          boolean for audio is in stereo
1121
1122         VBR             boolean for variable bitrate
1123         BITRATE         bitrate in kbps (average for VBR files)
1124         FREQUENCY       frequency in kHz
1125         SIZE            bytes in audio stream
1126
1127         SECS            total seconds
1128         MM              minutes
1129         SS              leftover seconds
1130         MS              leftover milliseconds
1131         TIME            time in MM:SS
1132
1133         COPYRIGHT       boolean for audio is copyrighted
1134         PADDING         boolean for MP3 frames are padded
1135         MODE            channel mode (0 = stereo, 1 = joint stereo,
1136                         2 = dual channel, 3 = single channel)
1137         FRAMES          approximate number of frames
1138         FRAME_LENGTH    approximate length of a frame
1139         VBR_SCALE       VBR scale from VBR header
1140
1141 On error, returns nothing and sets C<$@>.
1142
1143 =cut
1144
1145 sub get_mp3info {
1146     my($file) = @_;
1147     my($off, $myseek, $byte, $eof, $h, $tot, $fh);
1148
1149     if (not (defined $file && $file ne '')) {
1150         $@ = "No file specified";
1151         return undef;
1152     }
1153
1154     if (not -s $file) {
1155         $@ = "File is empty";
1156         return undef;
1157     }
1158
1159     if (ref $file) { # filehandle passed
1160         $fh = $file;
1161     } else {
1162         $fh = gensym;
1163         if (not open $fh, "< $file\0") {
1164             $@ = "Can't open $file: $!";
1165             return undef;
1166         }
1167     }
1168
1169     $off = 0;
1170     $tot = 4096;
1171
1172     $myseek = sub {
1173         seek $fh, $off, 0;
1174         read $fh, $byte, 4;
1175     };
1176
1177     binmode $fh;
1178     &$myseek;
1179
1180     if ($off == 0) {
1181         if (my $id3v2 = _get_v2head($fh)) {
1182             $tot += $off += $id3v2->{tag_size};
1183             &$myseek;
1184         }
1185     }
1186
1187     $h = _get_head($byte);
1188     until (_is_mp3($h)) {
1189         $off++;
1190         &$myseek;
1191         $h = _get_head($byte);
1192         if ($off > $tot && !$try_harder) {
1193             _close($file, $fh);
1194             $@ = "Couldn't find MP3 header (perhaps set " .
1195                 '$MP3::Info::try_harder and retry)';
1196             return undef;
1197         }
1198     }
1199
1200     my $vbr = _get_vbr($fh, $h, \$off);
1201
1202     seek $fh, 0, 2;
1203     $eof = tell $fh;
1204     seek $fh, -128, 2;
1205     $off += 128 if <$fh> =~ /^TAG/ ? 1 : 0;
1206
1207     _close($file, $fh);
1208
1209     $h->{size} = $eof - $off;
1210
1211     return _get_info($h, $vbr);
1212 }
1213
1214 sub _get_info {
1215     my($h, $vbr) = @_;
1216     my $i;
1217
1218     $i->{VERSION}       = $h->{IDR} == 2 ? 2 : $h->{IDR} == 3 ? 1 :
1219         $h->{IDR} == 0 ? 2.5 : 0;
1220     $i->{LAYER} = 4 - $h->{layer};
1221     $i->{VBR}   = defined $vbr ? 1 : 0;
1222
1223     $i->{COPYRIGHT}     = $h->{copyright} ? 1 : 0;
1224     $i->{PADDING}       = $h->{padding_bit} ? 1 : 0;
1225     $i->{STEREO}        = $h->{mode} == 3 ? 0 : 1;
1226     $i->{MODE}  = $h->{mode};
1227
1228     $i->{SIZE}  = $vbr && $vbr->{bytes} ? $vbr->{bytes} : $h->{size};
1229
1230     my $mfs             = $h->{fs} / ($h->{ID} ? 144000 : 72000);
1231     $i->{FRAMES}        = int($vbr && $vbr->{frames}
1232                               ? $vbr->{frames}
1233                               : $i->{SIZE} / $h->{bitrate} / $mfs
1234                               );
1235
1236     if ($vbr) {
1237         $i->{VBR_SCALE} = $vbr->{scale} if $vbr->{scale};
1238         $h->{bitrate}   = $i->{SIZE} / $i->{FRAMES} * $mfs;
1239         if (not $h->{bitrate}) {
1240             $@ = "Couldn't determine VBR bitrate";
1241             return undef;
1242         }
1243     }
1244
1245     $h->{'length'}      = ($i->{SIZE} * 8) / $h->{bitrate} / 10;
1246     $i->{SECS}  = $h->{'length'} / 100;
1247     $i->{MM}    = int $i->{SECS} / 60;
1248     $i->{SS}    = int $i->{SECS} % 60;
1249     $i->{MS}    = (($i->{SECS} - ($i->{MM} * 60) - $i->{SS}) * 1000);
1250 #       $i->{LF}        = ($i->{MS} / 1000) * ($i->{FRAMES} / $i->{SECS});
1251 #       int($i->{MS} / 100 * 75);  # is this right?
1252     $i->{TIME}  = sprintf "%.2d:%.2d", @{$i}{'MM', 'SS'};
1253
1254     $i->{BITRATE}               = int $h->{bitrate};
1255         # should we just return if ! FRAMES?
1256     $i->{FRAME_LENGTH}  = int($h->{size} / $i->{FRAMES}) if $i->{FRAMES};
1257     $i->{FREQUENCY}             = $frequency_tbl[3 * $h->{IDR} + $h->{sampling_freq}];
1258
1259     return $i;
1260 }
1261
1262 sub _get_head {
1263     my($byte) = @_;
1264     my($bytes, $h);
1265
1266     $bytes = _unpack_head($byte);
1267     @$h{qw(IDR ID layer protection_bit
1268            bitrate_index sampling_freq padding_bit private_bit
1269            mode mode_extension copyright original
1270            emphasis version_index bytes)} = (
1271                 ($bytes>>19)&3, ($bytes>>19)&1, ($bytes>>17)&3, ($bytes>>16)&1,
1272                 ($bytes>>12)&15, ($bytes>>10)&3, ($bytes>>9)&1, ($bytes>>8)&1,
1273                 ($bytes>>6)&3, ($bytes>>4)&3, ($bytes>>3)&1, ($bytes>>2)&1,
1274                 $bytes&3, ($bytes>>19)&3, $bytes
1275         );
1276
1277     $h->{bitrate} = $t_bitrate[$h->{ID}][3 - $h->{layer}][$h->{bitrate_index}];
1278     $h->{fs} = $t_sampling_freq[$h->{IDR}][$h->{sampling_freq}];
1279
1280     return $h;
1281 }
1282
1283 sub _is_mp3 {
1284     my $h = $_[0] or return undef;
1285     return ! (  # all below must be false
1286                 $h->{bitrate_index} == 0
1287                 ||
1288                 $h->{version_index} == 1
1289                 ||
1290                 ($h->{bytes} & 0xFFE00000) != 0xFFE00000
1291                 ||
1292                 !$h->{fs}
1293                 ||
1294                 !$h->{bitrate}
1295                 ||
1296                 $h->{bitrate_index} == 15
1297                 ||
1298                 !$h->{layer}
1299                 ||
1300                 $h->{sampling_freq} == 3
1301                 ||
1302                 $h->{emphasis} == 2
1303                 ||
1304                 !$h->{bitrate_index}
1305                 ||
1306                 ($h->{bytes} & 0xFFFF0000) == 0xFFFE0000
1307                 ||
1308                 ($h->{ID} == 1 && $h->{layer} == 3 && $h->{protection_bit} == 1)
1309                 ||
1310                 ($h->{mode_extension} != 0 && $h->{mode} != 1)
1311                 );
1312 }
1313
1314 sub _get_vbr {
1315     my($fh, $h, $roff) = @_;
1316     my($off, $bytes, @bytes, $myseek, %vbr);
1317
1318     $off = $$roff;
1319     @_ = ();    # closure confused if we don't do this
1320
1321     $myseek = sub {
1322         my $n = $_[0] || 4;
1323         seek $fh, $off, 0;
1324         read $fh, $bytes, $n;
1325         $off += $n;
1326     };
1327
1328     $off += 4;
1329
1330     if ($h->{ID}) {     # MPEG1
1331         $off += $h->{mode} == 3 ? 17 : 32;
1332     } else {    # MPEG2
1333         $off += $h->{mode} == 3 ? 9 : 17;
1334     }
1335
1336     &$myseek;
1337     return unless $bytes eq 'Xing';
1338
1339     &$myseek;
1340     $vbr{flags} = _unpack_head($bytes);
1341
1342     if ($vbr{flags} & 1) {
1343         &$myseek;
1344         $vbr{frames} = _unpack_head($bytes);
1345     }
1346
1347     if ($vbr{flags} & 2) {
1348         &$myseek;
1349         $vbr{bytes} = _unpack_head($bytes);
1350     }
1351
1352     if ($vbr{flags} & 4) {
1353         $myseek->(100);
1354 # Not used right now ...
1355 #               $vbr{toc} = _unpack_head($bytes);
1356     }
1357
1358     if ($vbr{flags} & 8) { # (quality ind., 0=best 100=worst)
1359         &$myseek;
1360         $vbr{scale} = _unpack_head($bytes);
1361     } else {
1362         $vbr{scale} = -1;
1363     }
1364
1365     $$roff = $off;
1366     return \%vbr;
1367 }
1368
1369 sub _get_v2head {
1370     my $fh = $_[0] or return;
1371     my($h, $bytes, @bytes);
1372
1373     # check first three bytes for 'ID3'
1374     seek $fh, 0, 0;
1375     read $fh, $bytes, 3;
1376     return unless $bytes eq 'ID3';
1377
1378     # get version
1379     read $fh, $bytes, 2;
1380     $h->{version} = sprintf "ID3v2.%d.%d",
1381     @$h{qw[major_version minor_version]} =
1382         unpack 'c2', $bytes;
1383
1384     # get flags
1385     read $fh, $bytes, 1;
1386     if ($h->{major_version} == 2) {
1387         @$h{qw[unsync compression]} =
1388             (unpack 'b8', $bytes)[7, 6];
1389         $h->{ext_header} = 0;
1390         $h->{experimental} = 0;
1391     } else {
1392         @$h{qw[unsync ext_header experimental]} =
1393             (unpack 'b8', $bytes)[7, 6, 5];
1394     }
1395
1396     # get ID3v2 tag length from bytes 7-10
1397     $h->{tag_size} = 10;        # include ID3v2 header size
1398     read $fh, $bytes, 4;
1399     @bytes = reverse unpack 'C4', $bytes;
1400     foreach my $i (0 .. 3) {
1401         # whoaaaaaa nellllllyyyyyy!
1402         $h->{tag_size} += $bytes[$i] * 128 ** $i;
1403     }
1404
1405     # get extended header size
1406     $h->{ext_header_size} = 0;
1407     if ($h->{ext_header}) {
1408         $h->{ext_header_size} += 10;
1409         read $fh, $bytes, 4;
1410         @bytes = reverse unpack 'C4', $bytes;
1411         for my $i (0..3) {
1412             $h->{ext_header_size} += $bytes[$i] * 256 ** $i;
1413         }
1414     }
1415
1416     return $h;
1417 }
1418
1419 sub _unpack_head {
1420     unpack('l', pack('L', unpack('N', $_[0])));
1421 }
1422
1423 sub _close {
1424     my($file, $fh) = @_;
1425     unless (ref $file) { # filehandle not passed
1426         close $fh or warn "Problem closing '$file': $!";
1427     }
1428 }
1429
1430 BEGIN {
1431     @mp3_genres = (
1432                 'Blues',
1433                 'Classic Rock',
1434                 'Country',
1435                 'Dance',
1436                 'Disco',
1437                 'Funk',
1438                 'Grunge',
1439                 'Hip-Hop',
1440                 'Jazz',
1441                 'Metal',
1442                 'New Age',
1443                 'Oldies',
1444                 'Other',
1445                 'Pop',
1446                 'R&B',
1447                 'Rap',
1448                 'Reggae',
1449                 'Rock',
1450                 'Techno',
1451                 'Industrial',
1452                 'Alternative',
1453                 'Ska',
1454                 'Death Metal',
1455                 'Pranks',
1456                 'Soundtrack',
1457                 'Euro-Techno',
1458                 'Ambient',
1459                 'Trip-Hop',
1460                 'Vocal',
1461                 'Jazz+Funk',
1462                 'Fusion',
1463                 'Trance',
1464                 'Classical',
1465                 'Instrumental',
1466                 'Acid',
1467                 'House',
1468                 'Game',
1469                 'Sound Clip',
1470                 'Gospel',
1471                 'Noise',
1472                 'AlternRock',
1473                 'Bass',
1474                 'Soul',
1475                 'Punk',
1476                 'Space',
1477                 'Meditative',
1478                 'Instrumental Pop',
1479                 'Instrumental Rock',
1480                 'Ethnic',
1481                 'Gothic',
1482                 'Darkwave',
1483                 'Techno-Industrial',
1484                 'Electronic',
1485                 'Pop-Folk',
1486                 'Eurodance',
1487                 'Dream',
1488                 'Southern Rock',
1489                 'Comedy',
1490                 'Cult',
1491                 'Gangsta',
1492                 'Top 40',
1493                 'Christian Rap',
1494                 'Pop/Funk',
1495                 'Jungle',
1496                 'Native American',
1497                 'Cabaret',
1498                 'New Wave',
1499                 'Psychadelic',
1500                 'Rave',
1501                 'Showtunes',
1502                 'Trailer',
1503                 'Lo-Fi',
1504                 'Tribal',
1505                 'Acid Punk',
1506                 'Acid Jazz',
1507                 'Polka',
1508                 'Retro',
1509                 'Musical',
1510                 'Rock & Roll',
1511                 'Hard Rock',
1512         );
1513
1514         @winamp_genres = (
1515                 @mp3_genres,
1516                 'Folk',
1517                 'Folk-Rock',
1518                 'National Folk',
1519                 'Swing',
1520                 'Fast Fusion',
1521                 'Bebob',
1522                 'Latin',
1523                 'Revival',
1524                 'Celtic',
1525                 'Bluegrass',
1526                 'Avantgarde',
1527                 'Gothic Rock',
1528                 'Progressive Rock',
1529                 'Psychedelic Rock',
1530                 'Symphonic Rock',
1531                 'Slow Rock',
1532                 'Big Band',
1533                 'Chorus',
1534                 'Easy Listening',
1535                 'Acoustic',
1536                 'Humour',
1537                 'Speech',
1538                 'Chanson',
1539                 'Opera',
1540                 'Chamber Music',
1541                 'Sonata',
1542                 'Symphony',
1543                 'Booty Bass',
1544                 'Primus',
1545                 'Porn Groove',
1546                 'Satire',
1547                 'Slow Jam',
1548                 'Club',
1549                 'Tango',
1550                 'Samba',
1551                 'Folklore',
1552                 'Ballad',
1553                 'Power Ballad',
1554                 'Rhythmic Soul',
1555                 'Freestyle',
1556                 'Duet',
1557                 'Punk Rock',
1558                 'Drum Solo',
1559                 'Acapella',
1560                 'Euro-House',
1561                 'Dance Hall',
1562                 'Goa',
1563                 'Drum & Bass',
1564                 'Club-House',
1565                 'Hardcore',
1566                 'Terror',
1567                 'Indie',
1568                 'BritPop',
1569                 'Negerpunk',
1570                 'Polsk Punk',
1571                 'Beat',
1572                 'Christian Gangsta Rap',
1573                 'Heavy Metal',
1574                 'Black Metal',
1575                 'Crossover',
1576                 'Contemporary Christian',
1577                 'Christian Rock',
1578                 'Merengue',
1579                 'Salsa',
1580                 'Thrash Metal',
1581                 'Anime',
1582                 'JPop',
1583                 'Synthpop',
1584         );
1585
1586     @t_bitrate = ([
1587                 [0, 32, 48, 56,  64,  80,  96, 112, 128, 144, 160, 176, 192, 224, 256],
1588                 [0,  8, 16, 24,  32,  40,  48,  56,  64,  80,  96, 112, 128, 144, 160],
1589                 [0,  8, 16, 24,  32,  40,  48,  56,  64,  80,  96, 112, 128, 144, 160]
1590         ],[
1591                 [0, 32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448],
1592                 [0, 32, 48, 56,  64,  80,  96, 112, 128, 160, 192, 224, 256, 320, 384],
1593                 [0, 32, 40, 48,  56,  64,  80,  96, 112, 128, 160, 192, 224, 256, 320]
1594         ]);
1595
1596     @t_sampling_freq = (
1597                         [11025, 12000,  8000],
1598                         [undef, undef, undef],  # reserved
1599                         [22050, 24000, 16000],
1600                         [44100, 48000, 32000]
1601                         );
1602
1603     @frequency_tbl = map { $_ ? eval "${_}e-3" : 0 }
1604                 map { @$_ } @t_sampling_freq;
1605
1606     @mp3_info_fields = qw(
1607                 VERSION
1608                 LAYER
1609                 STEREO
1610                 VBR
1611                 BITRATE
1612                 FREQUENCY
1613                 SIZE
1614                 SECS
1615                 MM
1616                 SS
1617                 MS
1618                 TIME
1619                 COPYRIGHT
1620                 PADDING
1621                 MODE
1622                 FRAMES
1623                 FRAME_LENGTH
1624                 VBR_SCALE
1625         );
1626
1627     %v1_tag_fields =
1628         (TITLE => 30, ARTIST => 30, ALBUM => 30, COMMENT => 30, YEAR => 4);
1629
1630     @v1_tag_names = qw(TITLE ARTIST ALBUM YEAR COMMENT TRACKNUM GENRE);
1631
1632     %v2_to_v1_names = (
1633                 # v2.2 tags
1634                 'TT2' => 'TITLE',
1635                 'TP1' => 'ARTIST',
1636                 'TAL' => 'ALBUM',
1637                 'TYE' => 'YEAR',
1638                 'COM' => 'COMMENT',
1639                 'TRK' => 'TRACKNUM',
1640                 'TCO' => 'GENRE', # not clean mapping, but ...
1641                 # v2.3 tags
1642                 'TIT2' => 'TITLE',
1643                 'TPE1' => 'ARTIST',
1644                 'TALB' => 'ALBUM',
1645                 'TYER' => 'YEAR',
1646                 'COMM' => 'COMMENT',
1647                 'TRCK' => 'TRACKNUM',
1648                 'TCON' => 'GENRE',
1649         );
1650
1651     %v2_tag_names = (
1652                 # v2.2 tags
1653                 'BUF' => 'Recommended buffer size',
1654                 'CNT' => 'Play counter',
1655                 'COM' => 'Comments',
1656                 'CRA' => 'Audio encryption',
1657                 'CRM' => 'Encrypted meta frame',
1658                 'ETC' => 'Event timing codes',
1659                 'EQU' => 'Equalization',
1660                 'GEO' => 'General encapsulated object',
1661                 'IPL' => 'Involved people list',
1662                 'LNK' => 'Linked information',
1663                 'MCI' => 'Music CD Identifier',
1664                 'MLL' => 'MPEG location lookup table',
1665                 'PIC' => 'Attached picture',
1666                 'POP' => 'Popularimeter',
1667                 'REV' => 'Reverb',
1668                 'RVA' => 'Relative volume adjustment',
1669                 'SLT' => 'Synchronized lyric/text',
1670                 'STC' => 'Synced tempo codes',
1671                 'TAL' => 'Album/Movie/Show title',
1672                 'TBP' => 'BPM (Beats Per Minute)',
1673                 'TCM' => 'Composer',
1674                 'TCO' => 'Content type',
1675                 'TCR' => 'Copyright message',
1676                 'TDA' => 'Date',
1677                 'TDY' => 'Playlist delay',
1678                 'TEN' => 'Encoded by',
1679                 'TFT' => 'File type',
1680                 'TIM' => 'Time',
1681                 'TKE' => 'Initial key',
1682                 'TLA' => 'Language(s)',
1683                 'TLE' => 'Length',
1684                 'TMT' => 'Media type',
1685                 'TOA' => 'Original artist(s)/performer(s)',
1686                 'TOF' => 'Original filename',
1687                 'TOL' => 'Original Lyricist(s)/text writer(s)',
1688                 'TOR' => 'Original release year',
1689                 'TOT' => 'Original album/Movie/Show title',
1690                 'TP1' => 'Lead artist(s)/Lead performer(s)/Soloist(s)/Performing group',
1691                 'TP2' => 'Band/Orchestra/Accompaniment',
1692                 'TP3' => 'Conductor/Performer refinement',
1693                 'TP4' => 'Interpreted, remixed, or otherwise modified by',
1694                 'TPA' => 'Part of a set',
1695                 'TPB' => 'Publisher',
1696                 'TRC' => 'ISRC (International Standard Recording Code)',
1697                 'TRD' => 'Recording dates',
1698                 'TRK' => 'Track number/Position in set',
1699                 'TSI' => 'Size',
1700                 'TSS' => 'Software/hardware and settings used for encoding',
1701                 'TT1' => 'Content group description',
1702                 'TT2' => 'Title/Songname/Content description',
1703                 'TT3' => 'Subtitle/Description refinement',
1704                 'TXT' => 'Lyricist/text writer',
1705                 'TXX' => 'User defined text information frame',
1706                 'TYE' => 'Year',
1707                 'UFI' => 'Unique file identifier',
1708                 'ULT' => 'Unsychronized lyric/text transcription',
1709                 'WAF' => 'Official audio file webpage',
1710                 'WAR' => 'Official artist/performer webpage',
1711                 'WAS' => 'Official audio source webpage',
1712                 'WCM' => 'Commercial information',
1713                 'WCP' => 'Copyright/Legal information',
1714                 'WPB' => 'Publishers official webpage',
1715                 'WXX' => 'User defined URL link frame',
1716
1717                 # v2.3 tags
1718                 'AENC' => 'Audio encryption',
1719                 'APIC' => 'Attached picture',
1720                 'COMM' => 'Comments',
1721                 'COMR' => 'Commercial frame',
1722                 'ENCR' => 'Encryption method registration',
1723                 'EQUA' => 'Equalization',
1724                 'ETCO' => 'Event timing codes',
1725                 'GEOB' => 'General encapsulated object',
1726                 'GRID' => 'Group identification registration',
1727                 'IPLS' => 'Involved people list',
1728                 'LINK' => 'Linked information',
1729                 'MCDI' => 'Music CD identifier',
1730                 'MLLT' => 'MPEG location lookup table',
1731                 'OWNE' => 'Ownership frame',
1732                 'PCNT' => 'Play counter',
1733                 'POPM' => 'Popularimeter',
1734                 'POSS' => 'Position synchronisation frame',
1735                 'PRIV' => 'Private frame',
1736                 'RBUF' => 'Recommended buffer size',
1737                 'RVAD' => 'Relative volume adjustment',
1738                 'RVRB' => 'Reverb',
1739                 'SYLT' => 'Synchronized lyric/text',
1740                 'SYTC' => 'Synchronized tempo codes',
1741                 'TALB' => 'Album/Movie/Show title',
1742                 'TBPM' => 'BPM (beats per minute)',
1743                 'TCOM' => 'Composer',
1744                 'TCON' => 'Content type',
1745                 'TCOP' => 'Copyright message',
1746                 'TDAT' => 'Date',
1747                 'TDLY' => 'Playlist delay',
1748                 'TENC' => 'Encoded by',
1749                 'TEXT' => 'Lyricist/Text writer',
1750                 'TFLT' => 'File type',
1751                 'TIME' => 'Time',
1752                 'TIT1' => 'Content group description',
1753                 'TIT2' => 'Title/songname/content description',
1754                 'TIT3' => 'Subtitle/Description refinement',
1755                 'TKEY' => 'Initial key',
1756                 'TLAN' => 'Language(s)',
1757                 'TLEN' => 'Length',
1758                 'TMED' => 'Media type',
1759                 'TOAL' => 'Original album/movie/show title',
1760                 'TOFN' => 'Original filename',
1761                 'TOLY' => 'Original lyricist(s)/text writer(s)',
1762                 'TOPE' => 'Original artist(s)/performer(s)',
1763                 'TORY' => 'Original release year',
1764                 'TOWN' => 'File owner/licensee',
1765                 'TPE1' => 'Lead performer(s)/Soloist(s)',
1766                 'TPE2' => 'Band/orchestra/accompaniment',
1767                 'TPE3' => 'Conductor/performer refinement',
1768                 'TPE4' => 'Interpreted, remixed, or otherwise modified by',
1769                 'TPOS' => 'Part of a set',
1770                 'TPUB' => 'Publisher',
1771                 'TRCK' => 'Track number/Position in set',
1772                 'TRDA' => 'Recording dates',
1773                 'TRSN' => 'Internet radio station name',
1774                 'TRSO' => 'Internet radio station owner',
1775                 'TSIZ' => 'Size',
1776                 'TSRC' => 'ISRC (international standard recording code)',
1777                 'TSSE' => 'Software/Hardware and settings used for encoding',
1778                 'TXXX' => 'User defined text information frame',
1779                 'TYER' => 'Year',
1780                 'UFID' => 'Unique file identifier',
1781                 'USER' => 'Terms of use',
1782                 'USLT' => 'Unsychronized lyric/text transcription',
1783                 'WCOM' => 'Commercial information',
1784                 'WCOP' => 'Copyright/Legal information',
1785                 'WOAF' => 'Official audio file webpage',
1786                 'WOAR' => 'Official artist/performer webpage',
1787                 'WOAS' => 'Official audio source webpage',
1788                 'WORS' => 'Official internet radio station homepage',
1789                 'WPAY' => 'Payment',
1790                 'WPUB' => 'Publishers official webpage',
1791                 'WXXX' => 'User defined URL link frame',
1792
1793                 # v2.4 additional tags
1794                 # note that we don't restrict tags from 2.3 or 2.4,
1795                 'ASPI' => 'Audio seek point index',
1796                 'EQU2' => 'Equalisation (2)',
1797                 'RVA2' => 'Relative volume adjustment (2)',
1798                 'SEEK' => 'Seek frame',
1799                 'SIGN' => 'Signature frame',
1800                 'TDEN' => 'Encoding time',
1801                 'TDOR' => 'Original release time',
1802                 'TDRC' => 'Recording time',
1803                 'TDRL' => 'Release time',
1804                 'TDTG' => 'Tagging time',
1805                 'TIPL' => 'Involved people list',
1806                 'TMCL' => 'Musician credits list',
1807                 'TMOO' => 'Mood',
1808                 'TPRO' => 'Produced notice',
1809                 'TSOA' => 'Album sort order',
1810                 'TSOP' => 'Performer sort order',
1811                 'TSOT' => 'Title sort order',
1812                 'TSST' => 'Set subtitle',
1813
1814                 # grrrrrrr
1815                 'COM ' => 'Broken iTunes comments',
1816         );
1817 }
1818
1819 1;
1820
1821 __END__
1822
1823 =pod
1824
1825 =back
1826
1827 =head1 TROUBLESHOOTING
1828
1829 If you find a bug, please send me a patch (see the project page in L<"SEE ALSO">).
1830 If you cannot figure out why it does not work for you, please put the MP3 file in
1831 a place where I can get it (preferably via FTP, or HTTP, or .Mac iDisk) and send me
1832 mail regarding where I can get the file, with a detailed description of the problem.
1833
1834 If I download the file, after debugging the problem I will not keep the MP3 file
1835 if it is not legal for me to have it.  Just let me know if it is legal for me to
1836 keep it or not.
1837
1838
1839 =head1 TODO
1840
1841 =over 4
1842
1843 =item ID3v2 Support
1844
1845 Still need to do more for reading tags, such as using Compress::Zlib to decompress
1846 compressed tags.  But until I see this in use more, I won't bother.  If something
1847 does not work properly with reading, follow the instructions above for
1848 troubleshooting.
1849
1850 ID3v2 I<writing> is coming soon.
1851
1852 =item Get data from scalar
1853
1854 Instead of passing a file spec or filehandle, pass the
1855 data itself.  Would take some work, converting the seeks, etc.
1856
1857 =item Padding bit ?
1858
1859 Do something with padding bit.
1860
1861 =item Test suite
1862
1863 Test suite could use a bit of an overhaul and update.  Patches very welcome.
1864
1865 =over 4
1866
1867 =item *
1868
1869 Revamp getset.t.  Test all the various get_mp3tag args.
1870
1871 =item *
1872
1873 Test Unicode.
1874
1875 =item *
1876
1877 Test OOP API.
1878
1879 =item *
1880
1881 Test error handling, check more for missing files, bad MP3s, etc.
1882
1883 =back
1884
1885 =item Other VBR
1886
1887 Right now, only Xing VBR is supported.
1888
1889 =back
1890
1891
1892 =head1 THANKS
1893
1894 Edward Allen E<lt>allenej@c51844-a.spokn1.wa.home.comE<gt>,
1895 Vittorio Bertola E<lt>v.bertola@vitaminic.comE<gt>,
1896 Michael Blakeley E<lt>mike@blakeley.comE<gt>,
1897 Per Bolmstedt E<lt>tomten@kol14.comE<gt>,
1898 Tony Bowden E<lt>tony@tmtm.comE<gt>,
1899 Tom Brown E<lt>thecap@usa.netE<gt>,
1900 Sergio Camarena E<lt>scamarena@users.sourceforge.netE<gt>,
1901 Chris Dawson E<lt>cdawson@webiphany.comE<gt>,
1902 Luke Drumm E<lt>lukedrumm@mypad.comE<gt>,
1903 Kyle Farrell E<lt>kyle@cantametrix.comE<gt>,
1904 Jeffrey Friedl E<lt>jfriedl@yahoo.comE<gt>,
1905 brian d foy E<lt>comdog@panix.comE<gt>,
1906 Ben Gertzfield E<lt>che@debian.orgE<gt>,
1907 Brian Goodwin E<lt>brian@fuddmain.comE<gt>,
1908 Todd Hanneken E<lt>thanneken@hds.harvard.eduE<gt>,
1909 Todd Harris E<lt>harris@cshl.orgE<gt>,
1910 Woodrow Hill E<lt>asim@mindspring.comE<gt>,
1911 Kee Hinckley E<lt>nazgul@somewhere.comE<gt>,
1912 Roman Hodek E<lt>Roman.Hodek@informatik.uni-erlangen.deE<gt>,
1913 Peter Kovacs E<lt>kovacsp@egr.uri.eduE<gt>,
1914 Johann Lindvall,
1915 Peter Marschall E<lt>peter.marschall@mayn.deE<gt>,
1916 Trond Michelsen E<lt>mike@crusaders.noE<gt>,
1917 Dave O'Neill E<lt>dave@nexus.carleton.caE<gt>,
1918 Christoph Oberauer E<lt>christoph.oberauer@sbg.ac.atE<gt>,
1919 Jake Palmer E<lt>jake.palmer@db.comE<gt>,
1920 Andrew Phillips E<lt>asp@wasteland.orgE<gt>,
1921 David Reuteler E<lt>reuteler@visi.comE<gt>,
1922 John Ruttenberg E<lt>rutt@chezrutt.comE<gt>,
1923 Matthew Sachs E<lt>matthewg@zevils.comE<gt>,
1924 E<lt>scfc_de@users.sf.netE<gt>,
1925 Hermann Schwaerzler E<lt>Hermann.Schwaerzler@uibk.ac.atE<gt>,
1926 Chris Sidi E<lt>sidi@angband.orgE<gt>,
1927 Roland Steinbach E<lt>roland@support-system.comE<gt>,
1928 Stuart E<lt>schneis@users.sourceforge.netE<gt>,
1929 Jeffery Sumler E<lt>jsumler@mediaone.netE<gt>,
1930 Predrag Supurovic E<lt>mpgtools@dv.co.yuE<gt>,
1931 Bogdan Surdu E<lt>tim@go.roE<gt>,
1932 E<lt>tim@tim-landscheidt.deE<gt>,
1933 Pass F. B. Travis E<lt>pftravis@bellsouth.netE<gt>,
1934 Tobias Wagener E<lt>tobias@wagener.nuE<gt>,
1935 Ronan Waide E<lt>waider@stepstone.ieE<gt>,
1936 Andy Waite E<lt>andy@mailroute.comE<gt>,
1937 Ken Williams E<lt>ken@forum.swarthmore.eduE<gt>,
1938 Meng Weng Wong E<lt>mengwong@pobox.comE<gt>.
1939
1940
1941 =head1 AUTHOR AND COPYRIGHT
1942
1943 Chris Nandor E<lt>pudge@pobox.comE<gt>, http://pudge.net/
1944
1945 Copyright (c) 1998-2003 Chris Nandor.  All rights reserved.  This program is
1946 free software; you can redistribute it and/or modify it under the terms
1947 of the Artistic License, distributed with Perl.
1948
1949
1950 =head1 SEE ALSO
1951
1952 =over 4
1953
1954 =item MP3::Info Project Page
1955
1956         http://projects.pudge.net/
1957
1958 =item mp3tools
1959
1960         http://www.zevils.com/linux/mp3tools/
1961
1962 =item mpgtools
1963
1964         http://www.dv.co.yu/mpgscript/mpgtools.htm
1965         http://www.dv.co.yu/mpgscript/mpeghdr.htm
1966
1967 =item mp3tool
1968
1969         http://www.dtek.chalmers.se/~d2linjo/mp3/mp3tool.html
1970
1971 =item ID3v2
1972
1973         http://www.id3.org/
1974
1975 =item Xing Variable Bitrate
1976
1977         http://www.xingtech.com/support/partner_developer/mp3/vbr_sdk/
1978
1979 =item MP3Ext
1980
1981         http://rupert.informatik.uni-stuttgart.de/~mutschml/MP3ext/
1982
1983 =item Xmms
1984
1985         http://www.xmms.org/
1986
1987
1988 =back
1989
1990 =head1 VERSION
1991
1992 v1.02, Sunday, March 2, 2003
1993
1994 =cut