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