diff options
Diffstat (limited to 'tools')
-rwxr-xr-x | tools/songdb.pl | 2123 | ||||
-rw-r--r-- | tools/vorbiscomm.pm | 732 |
2 files changed, 0 insertions, 2855 deletions
diff --git a/tools/songdb.pl b/tools/songdb.pl deleted file mode 100755 index dad7e10496..0000000000 --- a/tools/songdb.pl +++ /dev/null @@ -1,2123 +0,0 @@ -#!/usr/bin/perl -# -# Rockbox song database docs: -# http://www.rockbox.org/twiki/bin/view/Main/TagDatabase -# -# MP3::Info by Chris Nandor is included verbatim in this script to make -# it runnable standalone on removable drives. See below. -# - -use vorbiscomm; - -my $db = "rockbox.tagdb"; -my $dir; -my $strip; -my $add; -my $verbose; -my $help; -my $dirisalbum; -my $dirisalbumname; -my $crc = 1; - -while($ARGV[0]) { - if($ARGV[0] eq "--db") { - $db = $ARGV[1]; - shift @ARGV; - shift @ARGV; - } - elsif($ARGV[0] eq "--path") { - $dir = $ARGV[1]; - shift @ARGV; - shift @ARGV; - } - elsif($ARGV[0] eq "--strip") { - $strip = $ARGV[1]; - shift @ARGV; - shift @ARGV; - } - elsif($ARGV[0] eq "--add") { - $add = $ARGV[1]; - shift @ARGV; - shift @ARGV; - } - elsif($ARGV[0] eq "--verbose") { - $verbose = 1; - shift @ARGV; - } - elsif($ARGV[0] eq "--nocrc") { - $crc = 0; - shift @ARGV; - } - elsif($ARGV[0] eq "--dirisalbum") { - $dirisalbum = 1; - shift @ARGV; - } - elsif($ARGV[0] eq "--dirisalbumname") { - $dirisalbumname = 1; - shift @ARGV; - } - elsif($ARGV[0] eq "--help" or ($ARGV[0] eq "-h")) { - $help = 1; - shift @ARGV; - } - else { - shift @ARGV; - } -} -my %entries; -my %genres; -my %albums; -my %years; -my %filename; - -my %lcartists; -my %lcalbums; - -my %dir2albumname; - -my $dbver = 3; - -if(! -d $dir or $help) { - print "'$dir' is not a directory\n" if ($dir ne "" and ! -d $dir); - print <<MOO - -songdb --path <dir> [--dirisalbum] [--dirisalbumname] [--db <file>] [--strip <path>] [--add <path>] [--verbose] [--help] - -Options: - - --path <dir> Where your music collection is found - --dirisalbum Use dir name as album name if the album name is missing in the - tags - --dirisalbumname Uh, isn\'t this the same as the above? - --db <file> What to call the output file. Defaults to rockbox.tagdb - --strip <path> Removes this string from the left of all file names - --add <path> Adds this string to the left of all file names - --nocrc Disables the CRC32 checksums. It makes the output database not - suitable for runtimedb but it makes this script run much - faster. - --verbose Shows more details while working - --help This text -MOO -; - exit; -} - -sub get_oggtag { - my $fn = shift; - my %hash; - - my $ogg = vorbiscomm->new($fn); - - my $h= $ogg->load; - - # Convert this format into the same format used by the id3 parser hash - - foreach my $k ($ogg->comment_tags()) - { - foreach my $cmmt ($ogg->comment($k)) - { - my $n; - if($k =~ /^artist$/i) { - $n = 'ARTIST'; - } - elsif($k =~ /^album$/i) { - $n = 'ALBUM'; - } - elsif($k =~ /^title$/i) { - $n = 'TITLE'; - } - $hash{$n}=$cmmt if($n); - } - } - - return \%hash; -} - -sub get_ogginfo { - my $fn = shift; - my %hash; - - my $ogg = vorbiscomm->new($fn); - - my $h= $ogg->load; - - return $ogg->{'INFO'}; -} - -# return ALL directory entries in the given dir -sub getdir { - my ($dir) = @_; - - $dir =~ s|/$|| if ($dir ne "/"); - - if (opendir(DIR, $dir)) { - my @all = readdir(DIR); - closedir DIR; - return @all; - } - else { - warn "can't opendir $dir: $!\n"; - } -} - -sub extractmp3 { - my ($dir, @files) = @_; - my @mp3; - for(@files) { - if( (/\.mp[23]$/i || /\.ogg$/i) && -f "$dir/$_" ) { - push @mp3, $_; - } - } - return @mp3; -} - -sub extractdirs { - my ($dir, @files) = @_; - $dir =~ s|/$||; - my @dirs; - for(@files) { - if( -d "$dir/$_" && ($_ !~ /^\.(|\.)$/)) { - push @dirs, $_; - } - } - return @dirs; -} - -# CRC32 32KB of data (use less if there isn't 32KB available) - -sub crc32 { - my ($filename, $index) = @_; - - my $len = 32*1024; - - if(!$crc) { - return 0; # fixed bad CRC when disabled! - # The runtimedb treats a CRC zero as CRC disabled! - } - - if(!open(FILE, "<$filename")) { - print "failed to open \"$filename\" $!\n"; - return 0; - } - - # read $data from index $index to $buffer from the file, may return fewer - # bytes when dealing with a very small file. - # - # TODO: make sure we don't include a trailer with metadata when doing this. - # Like a id3v1 tag. - my $nread = sysread FILE, $buffer, $len, $index; - - close(FILE); - - my @crc_table = - ( # CRC32 lookup table for polynomial 0x04C11DB7 - 0x00000000, 0x04C11DB7, 0x09823B6E, 0x0D4326D9, 0x130476DC, 0x17C56B6B, - 0x1A864DB2, 0x1E475005, 0x2608EDB8, 0x22C9F00F, 0x2F8AD6D6, 0x2B4BCB61, - 0x350C9B64, 0x31CD86D3, 0x3C8EA00A, 0x384FBDBD, 0x4C11DB70, 0x48D0C6C7, - 0x4593E01E, 0x4152FDA9, 0x5F15ADAC, 0x5BD4B01B, 0x569796C2, 0x52568B75, - 0x6A1936C8, 0x6ED82B7F, 0x639B0DA6, 0x675A1011, 0x791D4014, 0x7DDC5DA3, - 0x709F7B7A, 0x745E66CD, 0x9823B6E0, 0x9CE2AB57, 0x91A18D8E, 0x95609039, - 0x8B27C03C, 0x8FE6DD8B, 0x82A5FB52, 0x8664E6E5, 0xBE2B5B58, 0xBAEA46EF, - 0xB7A96036, 0xB3687D81, 0xAD2F2D84, 0xA9EE3033, 0xA4AD16EA, 0xA06C0B5D, - 0xD4326D90, 0xD0F37027, 0xDDB056FE, 0xD9714B49, 0xC7361B4C, 0xC3F706FB, - 0xCEB42022, 0xCA753D95, 0xF23A8028, 0xF6FB9D9F, 0xFBB8BB46, 0xFF79A6F1, - 0xE13EF6F4, 0xE5FFEB43, 0xE8BCCD9A, 0xEC7DD02D, 0x34867077, 0x30476DC0, - 0x3D044B19, 0x39C556AE, 0x278206AB, 0x23431B1C, 0x2E003DC5, 0x2AC12072, - 0x128E9DCF, 0x164F8078, 0x1B0CA6A1, 0x1FCDBB16, 0x018AEB13, 0x054BF6A4, - 0x0808D07D, 0x0CC9CDCA, 0x7897AB07, 0x7C56B6B0, 0x71159069, 0x75D48DDE, - 0x6B93DDDB, 0x6F52C06C, 0x6211E6B5, 0x66D0FB02, 0x5E9F46BF, 0x5A5E5B08, - 0x571D7DD1, 0x53DC6066, 0x4D9B3063, 0x495A2DD4, 0x44190B0D, 0x40D816BA, - 0xACA5C697, 0xA864DB20, 0xA527FDF9, 0xA1E6E04E, 0xBFA1B04B, 0xBB60ADFC, - 0xB6238B25, 0xB2E29692, 0x8AAD2B2F, 0x8E6C3698, 0x832F1041, 0x87EE0DF6, - 0x99A95DF3, 0x9D684044, 0x902B669D, 0x94EA7B2A, 0xE0B41DE7, 0xE4750050, - 0xE9362689, 0xEDF73B3E, 0xF3B06B3B, 0xF771768C, 0xFA325055, 0xFEF34DE2, - 0xC6BCF05F, 0xC27DEDE8, 0xCF3ECB31, 0xCBFFD686, 0xD5B88683, 0xD1799B34, - 0xDC3ABDED, 0xD8FBA05A, 0x690CE0EE, 0x6DCDFD59, 0x608EDB80, 0x644FC637, - 0x7A089632, 0x7EC98B85, 0x738AAD5C, 0x774BB0EB, 0x4F040D56, 0x4BC510E1, - 0x46863638, 0x42472B8F, 0x5C007B8A, 0x58C1663D, 0x558240E4, 0x51435D53, - 0x251D3B9E, 0x21DC2629, 0x2C9F00F0, 0x285E1D47, 0x36194D42, 0x32D850F5, - 0x3F9B762C, 0x3B5A6B9B, 0x0315D626, 0x07D4CB91, 0x0A97ED48, 0x0E56F0FF, - 0x1011A0FA, 0x14D0BD4D, 0x19939B94, 0x1D528623, 0xF12F560E, 0xF5EE4BB9, - 0xF8AD6D60, 0xFC6C70D7, 0xE22B20D2, 0xE6EA3D65, 0xEBA91BBC, 0xEF68060B, - 0xD727BBB6, 0xD3E6A601, 0xDEA580D8, 0xDA649D6F, 0xC423CD6A, 0xC0E2D0DD, - 0xCDA1F604, 0xC960EBB3, 0xBD3E8D7E, 0xB9FF90C9, 0xB4BCB610, 0xB07DABA7, - 0xAE3AFBA2, 0xAAFBE615, 0xA7B8C0CC, 0xA379DD7B, 0x9B3660C6, 0x9FF77D71, - 0x92B45BA8, 0x9675461F, 0x8832161A, 0x8CF30BAD, 0x81B02D74, 0x857130C3, - 0x5D8A9099, 0x594B8D2E, 0x5408ABF7, 0x50C9B640, 0x4E8EE645, 0x4A4FFBF2, - 0x470CDD2B, 0x43CDC09C, 0x7B827D21, 0x7F436096, 0x7200464F, 0x76C15BF8, - 0x68860BFD, 0x6C47164A, 0x61043093, 0x65C52D24, 0x119B4BE9, 0x155A565E, - 0x18197087, 0x1CD86D30, 0x029F3D35, 0x065E2082, 0x0B1D065B, 0x0FDC1BEC, - 0x3793A651, 0x3352BBE6, 0x3E119D3F, 0x3AD08088, 0x2497D08D, 0x2056CD3A, - 0x2D15EBE3, 0x29D4F654, 0xC5A92679, 0xC1683BCE, 0xCC2B1D17, 0xC8EA00A0, - 0xD6AD50A5, 0xD26C4D12, 0xDF2F6BCB, 0xDBEE767C, 0xE3A1CBC1, 0xE760D676, - 0xEA23F0AF, 0xEEE2ED18, 0xF0A5BD1D, 0xF464A0AA, 0xF9278673, 0xFDE69BC4, - 0x89B8FD09, 0x8D79E0BE, 0x803AC667, 0x84FBDBD0, 0x9ABC8BD5, 0x9E7D9662, - 0x933EB0BB, 0x97FFAD0C, 0xAFB010B1, 0xAB710D06, 0xA6322BDF, 0xA2F33668, - 0xBCB4666D, 0xB8757BDA, 0xB5365D03, 0xB1F740B4 - ); - - my $crc = 0xffffffff; - for ($i = 0; $i < $nread; $i++) { - # get the numeric for the byte of the $i index - $buf = ord(substr($buffer, $i, 1)); - - $crc = ($crc << 8) ^ $crc_table[(($crc >> 24) ^ $buf) & 0xFF]; - - # printf("%08x\n", $crc); - } - - if($crc == 0) { - # rule out the very small risk that this actually returns a zero, as - # the current rockbox code assumes a zero CRC means it is disabled! - # TODO: fix the Rockbox code. This is just a hack. - return 1; - } - - return $crc; -} - -sub singlefile { - my ($file) = @_; - my $hash; - my $info; - - if($file =~ /\.ogg$/i) { - $hash = get_oggtag($file); - - $info = get_ogginfo($file); - - $hash->{FILECRC} = crc32($file, $info->{audio_offset}); - } - else { - $hash = get_mp3tag($file); - - $info = get_mp3info($file); - - $hash->{FILECRC} = crc32($file, $info->{headersize}); - } - - return $hash; # a hash reference -} - -my $maxsongperalbum; - -sub dodir { - my ($dir)=@_; - - print "$dir\n"; - - # getdir() returns all entries in the given dir - my @a = getdir($dir); - - # extractmp3 filters out only the mp3 files from all given entries - my @m = extractmp3($dir, @a); - - my $f; - - for $f (sort @m) { - - my $id3 = singlefile("$dir/$f"); - - # ARTIST - # COMMENT - # ALBUM - # TITLE - # GENRE - # TRACKNUM - # YEAR - - # don't index songs without tags - # um. yes we do. - if (not defined $$id3{'ARTIST'} and - not defined $$id3{'ALBUM'} and - not defined $$id3{'TITLE'}) - { - next; - } - - #printf "Artist: %s\n", $id3->{'ARTIST'}; - my $path = "$dir/$f"; - if ($strip ne "" and $path =~ /^$strip(.*)/) { - $path = $1; - } - - if ($add ne "") { - $path = $add . $path; - } - - # Only use one case-variation of each album/artist - if (exists($lcalbums{lc($$id3{'ALBUM'})})) { - # if another album with different case exists - # use that case (store it in $$id3{'ALBUM'} - $$id3{'ALBUM'} = $lcalbums{lc($$id3{'ALBUM'})}; - } - else { - # else create a new entry in the hash - $lcalbums{lc($$id3{'ALBUM'})} = $$id3{'ALBUM'}; - } - - if (exists($lcartists{lc($$id3{'ARTIST'})})) { - $$id3{'ARTIST'} = $lcartists{lc($$id3{'ARTIST'})}; - } - else { - $lcartists{lc($$id3{'ARTIST'})} = $$id3{'ARTIST'}; - } - - $entries{$path}= $id3; - $artists{$id3->{'ARTIST'}}++ if($id3->{'ARTIST'}); - $genres{$id3->{'GENRE'}}++ if($id3->{'GENRE'}); - $years{$id3->{'YEAR'}}++ if($id3->{'YEAR'}); - - # fallback names - $$id3{'ARTIST'} = "<no artist tag>" if ($$id3{'ARTIST'} eq ""); - # Fall back on the directory name (not full path dirname), - # if no album tag - if ($dirisalbum) { - if($dir2albumname{$dir} eq "") { - $dir2albumname{$dir} = $$id3{'ALBUM'}; - } - elsif($dir2albumname{$dir} ne $$id3{'ALBUM'}) { - $dir2albumname{$dir} = (split m[/], $dir)[-1]; - } - } - # if no directory - if ($dirisalbumname) { - $$id3{'ALBUM'} = (split m[/], $dir)[-1] if ($$id3{'ALBUM'} eq ""); - } - $$id3{'ALBUM'} = "<no album tag>" if ($$id3{'ALBUM'} eq ""); - # fall back on basename of the file if no title tag. - my $base; - ($base = $f) =~ s/\.\w+$//; - $$id3{'TITLE'} = $base if ($$id3{'TITLE'} eq ""); - - # Append dirname, to handle multi-artist albums - $$id3{'DIR'} = $dir; - my $albumid; - if ($dirisalbum) { - $albumid=$$id3{'DIR'}; - } - else { - $albumid= $id3->{'ALBUM'}."___".$$id3{'DIR'}; - } - #printf "album id: %s\n", $albumid; - -# if($id3->{'ALBUM'}."___".$id3->{'DIR'} ne "<no album tag>___<no artist tag>") { - my $num = ++$albums{$albumid}; - if($num > $maxsongperalbum) { - $maxsongperalbum = $num; - $longestalbum = $albumid; - } - $album2songs{$albumid}{$$id3{TITLE}} = $id3; - if($dirisalbum) { - $artist2albums{$$id3{ARTIST}}{$$id3{DIR}} = $id3; - } - else { - $artist2albums{$$id3{ARTIST}}{$$id3{ALBUM}} = $id3; - } -# } - } - - if($dirisalbum and $dir2albumname{$dir} eq "") { - $dir2albumname{$dir} = (split m[/], $dir)[-1]; - printf "%s\n", $dir2albumname{$dir}; - } - - # extractdirs filters out only subdirectories from all given entries - my @d = extractdirs($dir, @a); - - for $d (sort @d) { - $dir =~ s|/$||; - dodir("$dir/$d"); - } -} - - -dodir($dir); -print "\n"; - -print "File name table\n" if ($verbose); -for(sort keys %entries) { - printf(" %s\n", $_) if ($verbose); - my $l = length($_); - if($l > $maxfilelen) { - $maxfilelen = $l; - $longestfilename = $_; - } -} -$maxfilelen++; # include zero termination byte -while($maxfilelen&3) { - $maxfilelen++; -} - -my $maxsonglen = 0; -my $sc; -print "\nSong title table\n" if ($verbose); - -for(sort {uc($entries{$a}->{'TITLE'}) cmp uc($entries{$b}->{'TITLE'})} keys %entries) { - printf(" %s\n", $entries{$_}->{'TITLE'} ) if ($verbose); - my $l = length($entries{$_}->{'TITLE'}); - if($l > $maxsonglen) { - $maxsonglen = $l; - $longestsong = $entries{$_}->{'TITLE'}; - } -} -$maxsonglen++; # include zero termination byte -while($maxsonglen&3) { - $maxsonglen++; -} - -my $maxartistlen = 0; -print "\nArtist table\n" if ($verbose); -my $i=0; -my %artistcount; -for(sort {uc($a) cmp uc($b)} keys %artists) { - printf(" %s: %d\n", $_, $i) if ($verbose); - $artistcount{$_}=$i++; - my $l = length($_); - if($l > $maxartistlen) { - $maxartistlen = $l; - $longestartist = $_; - } - - $l = scalar keys %{$artist2albums{$_}}; - if ($l > $maxalbumsperartist) { - $maxalbumsperartist = $l; - $longestartistalbum = $_; - } -} -$maxartistlen++; # include zero termination byte -while($maxartistlen&3) { - $maxartistlen++; -} - -print "\nGenre table\n" if ($verbose); -for(sort keys %genres) { - my $l = length($_); - if($l > $maxgenrelen) { - $maxgenrelen = $l; - $longestgenrename = $_; - } -} - -$maxgenrelen++; #include zero termination byte -while($maxgenrelen&3) { - $maxgenrelen++; -} - - -if ($verbose) { - print "\nYear table\n"; - for(sort keys %years) { - printf(" %s\n", $_); - } -} - -print "\nAlbum table\n" if ($verbose); -my $maxalbumlen = 0; -my %albumcount; -$i=0; -my @albumssort; -if($dirisalbum) { - @albumssort = sort {uc($dir2albumname{$a}) cmp uc($dir2albumname{$b})} keys %albums; -} -else { - @albumssort = sort {uc($a) cmp uc($b)} keys %albums; -} -for(@albumssort) { - my @moo=split(/___/, $_); - printf(" %s\n", $moo[0]) if ($verbose); - $albumcount{$_} = $i++; - my $l; - if($dirisalbum) { - $l = length($dir2albumname{$_}); - } - else { - $l = length($moo[0]); - } - if($l > $maxalbumlen) { - $maxalbumlen = $l; - if($dirisalbum) { - $longestalbumname = $dir2albumname{$_}; - } - else { - $longestalbumname = $moo[0]; - } - } -} -$maxalbumlen++; # include zero termination byte -while($maxalbumlen&3) { - $maxalbumlen++; -} - - - -sub dumpshort { - my ($num)=@_; - - # print "int: $num\n"; - - print DB pack "n", $num; -} - -sub dumpint { - my ($num)=@_; - -# print "int: $num\n"; - - print DB pack "N", $num; -} - -if (!scalar keys %entries) { - print "No songs found. Did you specify the right --path ?\n"; - print "Use the --help parameter to see all options.\n"; - exit; -} - -if ($db) { - my $songentrysize = $maxsonglen + 12 + $maxgenrelen+ 12; - my $albumentrysize = $maxalbumlen + 4 + $maxsongperalbum*4; - my $artistentrysize = $maxartistlen + $maxalbumsperartist*4; - my $fileentrysize = $maxfilelen + 12; - - printf "Number of artists : %d\n", scalar keys %artists; - printf "Number of albums : %d\n", scalar keys %albums; - printf "Number of songs / files : %d\n", scalar keys %entries; - print "Max artist length : $maxartistlen ($longestartist)\n"; - print "Max album length : $maxalbumlen ($longestalbumname)\n"; - print "Max song length : $maxsonglen ($longestsong)\n"; - print "Max songs per album : $maxsongperalbum ($longestalbum)\n"; - print "Max albums per artist: $maxalbumsperartist ($longestartistalbum)\n"; - print "Max genre length : $maxgenrelen ($longestgenrename)\n"; - print "Max file length : $maxfilelen ($longestfilename)\n"; - print "Database version: $dbver\n" if ($verbose); - print "Song Entry Size : $songentrysize ($maxsonglen + 12 + $maxgenrelen + 4)\n" if ($verbose); - print "Album Entry Size: $albumentrysize ($maxalbumlen + 4 + $maxsongperalbum * 4)\n" if ($verbose); - print "Artist Entry Size: $artistentrysize ($maxartistlen + $maxalbumsperartist * 4)\n" if ($verbose); - print "File Entry Size: $fileentrysize ($maxfilelen + 12)\n" if ($verbose); - - - open(DB, ">$db") || die "couldn't make $db"; - binmode(DB); - printf DB "RDB%c", $dbver; - - $pathindex = 68; # paths always start at index 68 - - $artistindex = $pathindex; - - # set total size of song title table - $sc = scalar(keys %entries) * $songentrysize; - my $ac = scalar(keys %albums) * $albumentrysize; - my $arc = scalar(keys %artists) * $artistentrysize; - $albumindex = $artistindex + $arc; # arc is size of all artists - $songindex = $albumindex + $ac; # ac is size of all albums - my $fileindex = $songindex + $sc; # sc is size of all songs - - dumpint($artistindex); # file position index of artist table - dumpint($albumindex); # file position index of album table - dumpint($songindex); # file position index of song table - dumpint($fileindex); # file position index of file table - dumpint(scalar(keys %artists)); # number of artists - dumpint(scalar(keys %albums)); # number of albums - dumpint(scalar(keys %entries)); # number of songs - dumpint(scalar(keys %entries)); # number of files - dumpint($maxartistlen); # length of artist name field - dumpint($maxalbumlen); # length of album name field - dumpint($maxsonglen); # length of song name field - dumpint($maxgenrelen); #length of genre field - dumpint($maxfilelen); # length of file field - dumpint($maxsongperalbum); # number of entries in songs-per-album array - dumpint($maxalbumsperartist); # number of entries in albums-per-artist array - dumpint(-1); # rundb dirty - - #### TABLE of artists ### - # name of artist1 - # pointers to albums of artist1 - - for (sort {uc($a) cmp uc($b)} keys %artists) { - my $artist = $_; - my $str = $_."\x00" x ($maxartistlen - length($_)); - print DB $str; - - for (sort keys %{$artist2albums{$artist}}) { - my $id3 = $artist2albums{$artist}{$_}; - my $a; - if($dirisalbum) { - $a = $albumcount{"$$id3{'DIR'}"} * $albumentrysize; - } - else { - $a = $albumcount{"$$id3{'ALBUM'}___$$id3{'DIR'}"} * $albumentrysize; - } - dumpint($a + $albumindex); - } - - for (scalar keys %{$artist2albums{$artist}} .. $maxalbumsperartist-1) { - print DB "\x00\x00\x00\x00"; - } - - } - - ### Build song offset info. - my $offset = $songindex; - for(sort {uc($entries{$a}->{'TITLE'}) cmp uc($entries{$b}->{'TITLE'})} keys %entries) { - my $id3 = $entries{$_}; - $$id3{'songoffset'} = $offset; - $offset += $songentrysize; - } - - - #### TABLE of albums ### - # name of album1 - # pointers to artists of album1 - # pointers to songs on album1 - - for(@albumssort) { - my $albumid = $_; - my @moo=split(/___/, $_); - my $t; - my $str; - if($dirisalbum) { - $t = $dir2albumname{$albumid}; - } - else { - $t = $moo[0]; - } - $str = $t."\x00" x ($maxalbumlen - length($t)); - print DB $str; - - my @songlist = keys %{$album2songs{$albumid}}; - my $id3 = $album2songs{$albumid}{$songlist[0]}; - - #printf "(d) albumid: %s artist: %s\n",$albumid, $id3->{'ARTIST'}; - - my $aoffset = $artistcount{$id3->{'ARTIST'}} * $artistentrysize; - dumpint($aoffset + $artistindex); # pointer to artist of this album - - if (defined $id3->{'TRACKNUM'}) { - @songlist = sort { - $album2songs{$albumid}{$a}->{'TRACKNUM'} <=> - $album2songs{$albumid}{$b}->{'TRACKNUM'} - } @songlist; - } - else { - @songlist = sort @songlist; - } - - for (@songlist) { - my $id3 = $album2songs{$albumid}{$_}; - dumpint($$id3{'songoffset'}); - } - - for (scalar keys %{$album2songs{$albumid}} .. $maxsongperalbum-1) { - print DB "\x00\x00\x00\x00"; - } - } - - #### Build filename offset info - my $l=$fileindex; - my %filenamepos; - for $f (sort {uc($a) cmp uc($b)} keys %entries) { - $filenamepos{$f}= $l; - $l += $fileentrysize; - } - - #### TABLE of songs ### - # title of song1 - # pointer to artist of song1 - # pointer to album of song1 - # pointer to filename of song1 - - for(sort {uc($entries{$a}->{'TITLE'}) cmp uc($entries{$b}->{'TITLE'})} keys %entries) { - my $f = $_; - my $id3 = $entries{$f}; - my $t = $id3->{'TITLE'}; - my $g = $id3->{'GENRE'}; - my $str = $t."\x00" x ($maxsonglen- length($t)); - - print DB $str; # title - $str = $g."\x00" x ($maxgenrelen - length($g)); - - my $a = $artistcount{$id3->{'ARTIST'}} * $artistentrysize; - dumpint($a + $artistindex); # pointer to artist of this song - - if($dirisalbum) { - $a = $albumcount{"$$id3{DIR}"} * $albumentrysize; - } - else { - $a = $albumcount{"$$id3{ALBUM}___$$id3{DIR}"} * $albumentrysize; - } - dumpint($a + $albumindex); # pointer to album of this song - - # pointer to filename of this song - dumpint($filenamepos{$f}); - print DB $str; #genre - dumpshort(-1); - dumpshort($id3->{'YEAR'}); - dumpint(-1); - dumpshort($id3->{'TRACKNUM'}); - dumpshort(-1); - } - - #### TABLE of file names ### - # path1 - - for $f (sort {uc($a) cmp uc($b)} %entries) { - my $str = $f."\x00" x ($maxfilelen- length($f)); - my $id3 = $entries{$f}; - print DB $str; - #print STDERR "CRC: ".."\n"; - dumpint($id3->{'FILECRC'}); # CRC32 of the song data - dumpint($id3->{'songoffset'}); # offset to song data - dumpint(-1); # offset to rundb data. always set to -1. this is updated by rockbox code on the player. - } - - close(DB); -} - -### -### Here follows module MP3::Info Copyright (c) 1998-2004 Chris Nandor -### Modified by Björn Stenberg to remove use of external libraries -### - -our( - @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION, $REVISION, - @mp3_genres, %mp3_genres, @winamp_genres, %winamp_genres, $try_harder, - @t_bitrate, @t_sampling_freq, @frequency_tbl, %v1_tag_fields, - @v1_tag_names, %v2_tag_names, %v2_to_v1_names, $AUTOLOAD, - @mp3_info_fields -); - -@ISA = 'Exporter'; -@EXPORT = qw( - set_mp3tag get_mp3tag get_mp3info remove_mp3tag - use_winamp_genres -); -@EXPORT_OK = qw(@mp3_genres %mp3_genres use_mp3_utf8); -%EXPORT_TAGS = ( - genres => [qw(@mp3_genres %mp3_genres)], - utf8 => [qw(use_mp3_utf8)], - all => [@EXPORT, @EXPORT_OK] -); - -# $Id$ -($REVISION) = ' $Revision$ ' =~ /\$Revision:\s+([^\s]+)/; -$VERSION = '1.02'; - -=pod - -=head1 NAME - -MP3::Info - Manipulate / fetch info from MP3 audio files - -=head1 SYNOPSIS - - #!perl -w - use MP3::Info; - my $file = 'Pearls_Before_Swine.mp3'; - set_mp3tag($file, 'Pearls Before Swine', q"77's", - 'Sticks and Stones', '1990', - q"(c) 1990 77's LTD.", 'rock & roll'); - - my $tag = get_mp3tag($file) or die "No TAG info"; - $tag->{GENRE} = 'rock'; - set_mp3tag($file, $tag); - - my $info = get_mp3info($file); - printf "$file length is %d:%d\n", $info->{MM}, $info->{SS}; - -=cut - -{ - my $c = -1; - # set all lower-case and regular-cased versions of genres as keys - # with index as value of each key - %mp3_genres = map {($_, ++$c, lc, $c)} @mp3_genres; - - # do it again for winamp genres - $c = -1; - %winamp_genres = map {($_, ++$c, lc, $c)} @winamp_genres; -} - -=pod - - my $mp3 = new MP3::Info $file; - $mp3->title('Perls Before Swine'); - printf "$file length is %s, title is %s\n", - $mp3->time, $mp3->title; - - -=head1 DESCRIPTION - -=over 4 - -=item $mp3 = MP3::Info-E<gt>new(FILE) - -OOP interface to the rest of the module. The same keys -available via get_mp3info and get_mp3tag are available -via the returned object (using upper case or lower case; -but note that all-caps "VERSION" will return the module -version, not the MP3 version). - -Passing a value to one of the methods will set the value -for that tag in the MP3 file, if applicable. - -=cut - -sub new { - my($pack, $file) = @_; - - my $info = get_mp3info($file) or return undef; - my $tags = get_mp3tag($file) || { map { ($_ => undef) } @v1_tag_names }; - my %self = ( - FILE => $file, - TRY_HARDER => 0 - ); - - @self{@mp3_info_fields, @v1_tag_names, 'file'} = ( - @{$info}{@mp3_info_fields}, - @{$tags}{@v1_tag_names}, - $file - ); - - return bless \%self, $pack; -} - -sub can { - my $self = shift; - return $self->SUPER::can(@_) unless ref $self; - my $name = uc shift; - return sub { $self->$name(@_) } if exists $self->{$name}; - return undef; -} - -sub AUTOLOAD { - my($self) = @_; - (my $name = uc $AUTOLOAD) =~ s/^.*://; - - if (exists $self->{$name}) { - my $sub = exists $v1_tag_fields{$name} - ? sub { - if (defined $_[1]) { - $_[0]->{$name} = $_[1]; - set_mp3tag($_[0]->{FILE}, $_[0]); - } - return $_[0]->{$name}; - } - : sub { - return $_[0]->{$name} - }; - - *{$AUTOLOAD} = $sub; - goto &$AUTOLOAD; - - } else { - warn(sprintf "No method '$name' available in package %s.", - __PACKAGE__); - } -} - -sub DESTROY { - -} - - -=item use_mp3_utf8([STATUS]) - -Tells MP3::Info to (or not) return TAG info in UTF-8. -TRUE is 1, FALSE is 0. Default is FALSE. - -Will only be able to it on if Unicode::String is available. ID3v2 -tags will be converted to UTF-8 according to the encoding specified -in each tag; ID3v1 tags will be assumed Latin-1 and converted -to UTF-8. - -Function returns status (TRUE/FALSE). If no argument is supplied, -or an unaccepted argument is supplied, function merely returns status. - -This function is not exported by default, but may be exported -with the C<:utf8> or C<:all> export tag. - -=cut - -my $unicode_module = eval { require Unicode::String }; -my $UNICODE = 0; - -sub use_mp3_utf8 { - my($val) = @_; - if ($val == 1) { - $UNICODE = 1 if $unicode_module; - } elsif ($val == 0) { - $UNICODE = 0; - } - return $UNICODE; -} - -=pod - -=item use_winamp_genres() - -Puts WinAmp genres into C<@mp3_genres> and C<%mp3_genres> -(adds 68 additional genres to the default list of 80). -This is a separate function because these are non-standard -genres, but they are included because they are widely used. - -You can import the data structures with one of: - - use MP3::Info qw(:genres); - use MP3::Info qw(:DEFAULT :genres); - use MP3::Info qw(:all); - -=cut - -sub use_winamp_genres { - %mp3_genres = %winamp_genres; - @mp3_genres = @winamp_genres; - return 1; -} - -=pod - -=pod - -=item get_mp3tag (FILE [, VERSION, RAW_V2]) - -Returns hash reference containing tag information in MP3 file. The keys -returned are the same as those supplied for C<set_mp3tag>, except in the -case of RAW_V2 being set. - -If VERSION is C<1>, the information is taken from the ID3v1 tag (if present). -If VERSION is C<2>, the information is taken from the ID3v2 tag (if present). -If VERSION is not supplied, or is false, the ID3v1 tag is read if present, and -then, if present, the ID3v2 tag information will override any existing ID3v1 -tag info. - -If RAW_V2 is C<1>, the raw ID3v2 tag data is returned, without any manipulation -of text encoding. The key name is the same as the frame ID (ID to name mappings -are in the global %v2_tag_names). - -If RAW_V2 is C<2>, the ID3v2 tag data is returned, manipulating for Unicode if -necessary, etc. It also takes multiple values for a given key (such as comments) -and puts them in an arrayref. - -If the ID3v2 version is older than ID3v2.2.0 or newer than ID3v2.4.0, it will -not be read. - -Strings returned will be in Latin-1, unless UTF-8 is specified (L<use_mp3_utf8>), -(unless RAW_V2 is C<1>). - -Also returns a TAGVERSION key, containing the ID3 version used for the returned -data (if TAGVERSION argument is C<0>, may contain two versions). - -=cut - -sub get_mp3tag { - my($file, $ver, $raw_v2) = @_; - my($tag, $v1, $v2, $v2h, %info, @array, $fh); - $raw_v2 ||= 0; - $ver = !$ver ? 0 : ($ver == 2 || $ver == 1) ? $ver : 0; - - if (not (defined $file && $file ne '')) { - $@ = "No file specified"; - return undef; - } - - if (not -s $file) { - $@ = "File is empty"; - return undef; - } - - if (ref $file) { # filehandle passed - $fh = $file; - } else { - $fh = gensym; - if (not open $fh, "< $file\0") { - $@ = "Can't open $file: $!"; - return undef; - } - } - - binmode $fh; - - if ($ver < 2) { - seek $fh, -128, 2; - while(defined(my $line = <$fh>)) { $tag .= $line } - - if ($tag =~ /^TAG/) { - $v1 = 1; - if (substr($tag, -3, 2) =~ /\000[^\000]/) { - (undef, @info{@v1_tag_names}) = - (unpack('a3a30a30a30a4a28', $tag), - ord(substr($tag, -2, 1)), - $mp3_genres[ord(substr $tag, -1)]); - $info{TAGVERSION} = 'ID3v1.1'; - } else { - (undef, @info{@v1_tag_names[0..4, 6]}) = - (unpack('a3a30a30a30a4a30', $tag), - $mp3_genres[ord(substr $tag, -1)]); - $info{TAGVERSION} = 'ID3v1'; - } - if ($UNICODE) { - for my $key (keys %info) { - next unless $info{$key}; - my $u = Unicode::String::latin1($info{$key}); - $info{$key} = $u->utf8; - } - } - } elsif ($ver == 1) { - _close($file, $fh); - $@ = "No ID3v1 tag found"; - return undef; - } - } - - ($v2, $v2h) = _get_v2tag($fh); - - unless ($v1 || $v2) { - _close($file, $fh); - $@ = "No ID3 tag found"; - return undef; - } - - if (($ver == 0 || $ver == 2) && $v2) { - if ($raw_v2 == 1 && $ver == 2) { - %info = %$v2; - $info{TAGVERSION} = $v2h->{version}; - } else { - my $hash = $raw_v2 == 2 ? { map { ($_, $_) } keys %v2_tag_names } : \%v2_to_v1_names; - for my $id (keys %$hash) { - if (exists $v2->{$id}) { - if ($id =~ /^TCON?$/ && $v2->{$id} =~ /^.?\((\d+)\)/) { - $info{$hash->{$id}} = $mp3_genres[$1]; - } else { - my $data1 = $v2->{$id}; - - # this is tricky ... if this is an arrayref, we want - # to only return one, so we pick the first one. but - # if it is a comment, we pick the first one where the - # first charcter after the language is NULL and not an - # additional sub-comment, because that is most likely - # to be the user-supplied comment - - if (ref $data1 && !$raw_v2) { - if ($id =~ /^COMM?$/) { - my($newdata) = grep /^(....\000)/, @{$data1}; - $data1 = $newdata || $data1->[0]; - } else { - $data1 = $data1->[0]; - } - } - - $data1 = [ $data1 ] if ! ref $data1; - - for my $data (@$data1) { - $data =~ s/^(.)//; # strip first char (text encoding) - my $encoding = $1; - my $desc; - if ($id =~ /^COM[M ]?$/) { - $data =~ s/^(?:...)//; # strip language - $data =~ s/^(.*?)\000+//; # strip up to first NULL(s), - # for sub-comment - $desc = $1; - } - - if ($UNICODE) { - if ($encoding eq "\001" || $encoding eq "\002") { # UTF-16, UTF-16BE - my $u = Unicode::String::utf16($data); - $data = $u->utf8; - $data =~ s/^\xEF\xBB\xBF//; # strip BOM - } elsif ($encoding eq "\000") { - my $u = Unicode::String::latin1($data); - $data = $u->utf8; - } - } - - if ($raw_v2 == 2 && $desc) { - $data = { $desc => $data }; - } - - if ($raw_v2 == 2 && exists $info{$hash->{$id}}) { - if (ref $info{$hash->{$id}} eq 'ARRAY') { - push @{$info{$hash->{$id}}}, $data; - } else { - $info{$hash->{$id}} = [ $info{$hash->{$id}}, $data ]; - } - } else { - $info{$hash->{$id}} = $data; - } - } - } - } - } - if ($ver == 0 && $info{TAGVERSION}) { - $info{TAGVERSION} .= ' / ' . $v2h->{version}; - } else { - $info{TAGVERSION} = $v2h->{version}; - } - } - } - - unless ($raw_v2 && $ver == 2) { - foreach my $key (keys %info) { - if (defined $info{$key}) { - $info{$key} =~ s/\000+.*//g; - $info{$key} =~ s/\s+$//; - } - } - - for (@v1_tag_names) { - $info{$_} = '' unless defined $info{$_}; - } - } - - if (keys %info && exists $info{GENRE} && ! defined $info{GENRE}) { - $info{GENRE} = ''; - } - - _close($file, $fh); - - return keys %info ? {%info} : undef; -} - -sub _get_v2tag { - my($fh) = @_; - my($off, $myseek, $myseek_22, $myseek_23, $v2, $h, $hlen, $num); - $h = {}; - - $v2 = _get_v2head($fh) or return; - if ($v2->{major_version} < 2) { - warn "This is $v2->{version}; " . - "ID3v2 versions older than ID3v2.2.0 not supported\n" - if $^W; - return; - } - - if ($v2->{major_version} == 2) { - $hlen = 6; - $num = 3; - } else { - $hlen = 10; - $num = 4; - } - - $myseek = sub { - seek $fh, $off, 0; - read $fh, my($bytes), $hlen; - return unless $bytes =~ /^([A-Z0-9]{$num})/ - || ($num == 4 && $bytes =~ /^(COM )/); # stupid iTunes - my($id, $size) = ($1, $hlen); - my @bytes = reverse unpack "C$num", substr($bytes, $num, $num); - for my $i (0 .. ($num - 1)) { - $size += $bytes[$i] * 256 ** $i; - } - return($id, $size); - }; - - $off = $v2->{ext_header_size} + 10; - - while ($off < $v2->{tag_size}) { - my($id, $size) = &$myseek or last; - seek $fh, $off + $hlen, 0; - read $fh, my($bytes), $size - $hlen; - if (exists $h->{$id}) { - if (ref $h->{$id} eq 'ARRAY') { - push @{$h->{$id}}, $bytes; - } else { - $h->{$id} = [$h->{$id}, $bytes]; - } - } else { - $h->{$id} = $bytes; - } - $off += $size; - } - - return($h, $v2); -} - - -=pod - -=item get_mp3info (FILE) - -Returns hash reference containing file information for MP3 file. -This data cannot be changed. Returned data: - - VERSION MPEG audio version (1, 2, 2.5) - LAYER MPEG layer description (1, 2, 3) - STEREO boolean for audio is in stereo - - VBR boolean for variable bitrate - BITRATE bitrate in kbps (average for VBR files) - FREQUENCY frequency in kHz - SIZE bytes in audio stream - - SECS total seconds - MM minutes - SS leftover seconds - MS leftover milliseconds - TIME time in MM:SS - - COPYRIGHT boolean for audio is copyrighted - PADDING boolean for MP3 frames are padded - MODE channel mode (0 = stereo, 1 = joint stereo, - 2 = dual channel, 3 = single channel) - FRAMES approximate number of frames - FRAME_LENGTH approximate length of a frame - VBR_SCALE VBR scale from VBR header - -On error, returns nothing and sets C<$@>. - -=cut - -sub get_mp3info { - my($file) = @_; - my($off, $myseek, $byte, $eof, $h, $tot, $fh); - - if (not (defined $file && $file ne '')) { - $@ = "No file specified"; - return undef; - } - - if (not -s $file) { - $@ = "File is empty"; - return undef; - } - - if (ref $file) { # filehandle passed - $fh = $file; - } else { - $fh = gensym; - if (not open $fh, "< $file\0") { - $@ = "Can't open $file: $!"; - return undef; - } - } - - $off = 0; - $tot = 4096; - - $myseek = sub { - seek $fh, $off, 0; - read $fh, $byte, 4; - }; - - binmode $fh; - &$myseek; - - if ($off == 0) { - if (my $id3v2 = _get_v2head($fh)) { - $tot += $off += $id3v2->{tag_size}; - &$myseek; - } - } - - $h = _get_head($byte); - until (_is_mp3($h)) { - $off++; - &$myseek; - $h = _get_head($byte); - if ($off > $tot && !$try_harder) { - _close($file, $fh); - $@ = "Couldn't find MP3 header (perhaps set " . - '$MP3::Info::try_harder and retry)'; - return undef; - } - } - - my $vbr = _get_vbr($fh, $h, \$off); - - $h->{headersize}=$off; # data size prepending the actual mp3 data - - seek $fh, 0, 2; - $eof = tell $fh; - seek $fh, -128, 2; - $off += 128 if <$fh> =~ /^TAG/ ? 1 : 0; - - _close($file, $fh); - - $h->{size} = $eof - $off; - - return _get_info($h, $vbr); -} - -sub _get_info { - my($h, $vbr) = @_; - my $i; - - $i->{VERSION} = $h->{IDR} == 2 ? 2 : $h->{IDR} == 3 ? 1 : - $h->{IDR} == 0 ? 2.5 : 0; - $i->{LAYER} = 4 - $h->{layer}; - $i->{VBR} = defined $vbr ? 1 : 0; - - $i->{COPYRIGHT} = $h->{copyright} ? 1 : 0; - $i->{PADDING} = $h->{padding_bit} ? 1 : 0; - $i->{STEREO} = $h->{mode} == 3 ? 0 : 1; - $i->{MODE} = $h->{mode}; - - $i->{SIZE} = $vbr && $vbr->{bytes} ? $vbr->{bytes} : $h->{size}; - - my $mfs = $h->{fs} / ($h->{ID} ? 144000 : 72000); - $i->{FRAMES} = int($vbr && $vbr->{frames} - ? $vbr->{frames} - : $i->{SIZE} / $h->{bitrate} / $mfs - ); - - if ($vbr) { - $i->{VBR_SCALE} = $vbr->{scale} if $vbr->{scale}; - $h->{bitrate} = $i->{SIZE} / $i->{FRAMES} * $mfs; - if (not $h->{bitrate}) { - $@ = "Couldn't determine VBR bitrate"; - return undef; - } - } - - $h->{'length'} = ($i->{SIZE} * 8) / $h->{bitrate} / 10; - $i->{SECS} = $h->{'length'} / 100; - $i->{MM} = int $i->{SECS} / 60; - $i->{SS} = int $i->{SECS} % 60; - $i->{MS} = (($i->{SECS} - ($i->{MM} * 60) - $i->{SS}) * 1000); -# $i->{LF} = ($i->{MS} / 1000) * ($i->{FRAMES} / $i->{SECS}); -# int($i->{MS} / 100 * 75); # is this right? - $i->{TIME} = sprintf "%.2d:%.2d", @{$i}{'MM', 'SS'}; - - $i->{BITRATE} = int $h->{bitrate}; - # should we just return if ! FRAMES? - $i->{FRAME_LENGTH} = int($h->{size} / $i->{FRAMES}) if $i->{FRAMES}; - $i->{FREQUENCY} = $frequency_tbl[3 * $h->{IDR} + $h->{sampling_freq}]; - - $i->{headersize} = $h->{headersize}; - - return $i; -} - -sub _get_head { - my($byte) = @_; - my($bytes, $h); - - $bytes = _unpack_head($byte); - @$h{qw(IDR ID layer protection_bit - bitrate_index sampling_freq padding_bit private_bit - mode mode_extension copyright original - emphasis version_index bytes)} = ( - ($bytes>>19)&3, ($bytes>>19)&1, ($bytes>>17)&3, ($bytes>>16)&1, - ($bytes>>12)&15, ($bytes>>10)&3, ($bytes>>9)&1, ($bytes>>8)&1, - ($bytes>>6)&3, ($bytes>>4)&3, ($bytes>>3)&1, ($bytes>>2)&1, - $bytes&3, ($bytes>>19)&3, $bytes - ); - - $h->{bitrate} = $t_bitrate[$h->{ID}][3 - $h->{layer}][$h->{bitrate_index}]; - $h->{fs} = $t_sampling_freq[$h->{IDR}][$h->{sampling_freq}]; - - return $h; -} - -sub _is_mp3 { - my $h = $_[0] or return undef; - return ! ( # all below must be false - $h->{bitrate_index} == 0 - || - $h->{version_index} == 1 - || - ($h->{bytes} & 0xFFE00000) != 0xFFE00000 - || - !$h->{fs} - || - !$h->{bitrate} - || - $h->{bitrate_index} == 15 - || - !$h->{layer} - || - $h->{sampling_freq} == 3 - || - $h->{emphasis} == 2 - || - !$h->{bitrate_index} - || - ($h->{bytes} & 0xFFFF0000) == 0xFFFE0000 - || - ($h->{ID} == 1 && $h->{layer} == 3 && $h->{protection_bit} == 1) - || - ($h->{mode_extension} != 0 && $h->{mode} != 1) - ); -} - -sub _get_vbr { - my($fh, $h, $roff) = @_; - my($off, $bytes, @bytes, $myseek, %vbr); - - $off = $$roff; - @_ = (); # closure confused if we don't do this - - $myseek = sub { - my $n = $_[0] || 4; - seek $fh, $off, 0; - read $fh, $bytes, $n; - $off += $n; - }; - - $off += 4; - - if ($h->{ID}) { # MPEG1 - $off += $h->{mode} == 3 ? 17 : 32; - } else { # MPEG2 - $off += $h->{mode} == 3 ? 9 : 17; - } - - &$myseek; - return unless $bytes eq 'Xing'; - - &$myseek; - $vbr{flags} = _unpack_head($bytes); - - if ($vbr{flags} & 1) { - &$myseek; - $vbr{frames} = _unpack_head($bytes); - } - - if ($vbr{flags} & 2) { - &$myseek; - $vbr{bytes} = _unpack_head($bytes); - } - - if ($vbr{flags} & 4) { - $myseek->(100); -# Not used right now ... -# $vbr{toc} = _unpack_head($bytes); - } - - if ($vbr{flags} & 8) { # (quality ind., 0=best 100=worst) - &$myseek; - $vbr{scale} = _unpack_head($bytes); - } else { - $vbr{scale} = -1; - } - - $$roff = $off; - return \%vbr; -} - -sub _get_v2head { - my $fh = $_[0] or return; - my($h, $bytes, @bytes); - - # check first three bytes for 'ID3' - seek $fh, 0, 0; - read $fh, $bytes, 3; - return unless $bytes eq 'ID3'; - - # get version - read $fh, $bytes, 2; - $h->{version} = sprintf "ID3v2.%d.%d", - @$h{qw[major_version minor_version]} = - unpack 'c2', $bytes; - - # get flags - read $fh, $bytes, 1; - if ($h->{major_version} == 2) { - @$h{qw[unsync compression]} = - (unpack 'b8', $bytes)[7, 6]; - $h->{ext_header} = 0; - $h->{experimental} = 0; - } else { - @$h{qw[unsync ext_header experimental]} = - (unpack 'b8', $bytes)[7, 6, 5]; - } - - # get ID3v2 tag length from bytes 7-10 - $h->{tag_size} = 10; # include ID3v2 header size - read $fh, $bytes, 4; - @bytes = reverse unpack 'C4', $bytes; - foreach my $i (0 .. 3) { - # whoaaaaaa nellllllyyyyyy! - $h->{tag_size} += $bytes[$i] * 128 ** $i; - } - - # get extended header size - $h->{ext_header_size} = 0; - if ($h->{ext_header}) { - $h->{ext_header_size} += 10; - read $fh, $bytes, 4; - @bytes = reverse unpack 'C4', $bytes; - for my $i (0..3) { - $h->{ext_header_size} += $bytes[$i] * 256 ** $i; - } - } - - return $h; -} - -sub _unpack_head { - unpack('l', pack('L', unpack('N', $_[0]))); -} - -sub _close { - my($file, $fh) = @_; - unless (ref $file) { # filehandle not passed - close $fh or warn "Problem closing '$file': $!"; - } -} - -BEGIN { - @mp3_genres = ( - 'Blues', - 'Classic Rock', - 'Country', - 'Dance', - 'Disco', - 'Funk', - 'Grunge', - 'Hip-Hop', - 'Jazz', - 'Metal', - 'New Age', - 'Oldies', - 'Other', - 'Pop', - 'R&B', - 'Rap', - 'Reggae', - 'Rock', - 'Techno', - 'Industrial', - 'Alternative', - 'Ska', - 'Death Metal', - 'Pranks', - 'Soundtrack', - 'Euro-Techno', - 'Ambient', - 'Trip-Hop', - 'Vocal', - 'Jazz+Funk', - 'Fusion', - 'Trance', - 'Classical', - 'Instrumental', - 'Acid', - 'House', - 'Game', - 'Sound Clip', - 'Gospel', - 'Noise', - 'AlternRock', - 'Bass', - 'Soul', - 'Punk', - 'Space', - 'Meditative', - 'Instrumental Pop', - 'Instrumental Rock', - 'Ethnic', - 'Gothic', - 'Darkwave', - 'Techno-Industrial', - 'Electronic', - 'Pop-Folk', - 'Eurodance', - 'Dream', - 'Southern Rock', - 'Comedy', - 'Cult', - 'Gangsta', - 'Top 40', - 'Christian Rap', - 'Pop/Funk', - 'Jungle', - 'Native American', - 'Cabaret', - 'New Wave', - 'Psychadelic', - 'Rave', - 'Showtunes', - 'Trailer', - 'Lo-Fi', - 'Tribal', - 'Acid Punk', - 'Acid Jazz', - 'Polka', - 'Retro', - 'Musical', - 'Rock & Roll', - 'Hard Rock', - ); - - @winamp_genres = ( - @mp3_genres, - 'Folk', - 'Folk-Rock', - 'National Folk', - 'Swing', - 'Fast Fusion', - 'Bebob', - 'Latin', - 'Revival', - 'Celtic', - 'Bluegrass', - 'Avantgarde', - 'Gothic Rock', - 'Progressive Rock', - 'Psychedelic Rock', - 'Symphonic Rock', - 'Slow Rock', - 'Big Band', - 'Chorus', - 'Easy Listening', - 'Acoustic', - 'Humour', - 'Speech', - 'Chanson', - 'Opera', - 'Chamber Music', - 'Sonata', - 'Symphony', - 'Booty Bass', - 'Primus', - 'Porn Groove', - 'Satire', - 'Slow Jam', - 'Club', - 'Tango', - 'Samba', - 'Folklore', - 'Ballad', - 'Power Ballad', - 'Rhythmic Soul', - 'Freestyle', - 'Duet', - 'Punk Rock', - 'Drum Solo', - 'Acapella', - 'Euro-House', - 'Dance Hall', - 'Goa', - 'Drum & Bass', - 'Club-House', - 'Hardcore', - 'Terror', - 'Indie', - 'BritPop', - 'Negerpunk', - 'Polsk Punk', - 'Beat', - 'Christian Gangsta Rap', - 'Heavy Metal', - 'Black Metal', - 'Crossover', - 'Contemporary Christian', - 'Christian Rock', - 'Merengue', - 'Salsa', - 'Thrash Metal', - 'Anime', - 'JPop', - 'Synthpop', - ); - - @t_bitrate = ([ - [0, 32, 48, 56, 64, 80, 96, 112, 128, 144, 160, 176, 192, 224, 256], - [0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160], - [0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160] - ],[ - [0, 32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448], - [0, 32, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320, 384], - [0, 32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320] - ]); - - @t_sampling_freq = ( - [11025, 12000, 8000], - [undef, undef, undef], # reserved - [22050, 24000, 16000], - [44100, 48000, 32000] - ); - - @frequency_tbl = map { $_ ? eval "${_}e-3" : 0 } - map { @$_ } @t_sampling_freq; - - @mp3_info_fields = qw( - VERSION - LAYER - STEREO - VBR - BITRATE - FREQUENCY - SIZE - SECS - MM - SS - MS - TIME - COPYRIGHT - PADDING - MODE - FRAMES - FRAME_LENGTH - VBR_SCALE - ); - - %v1_tag_fields = - (TITLE => 30, ARTIST => 30, ALBUM => 30, COMMENT => 30, YEAR => 4); - - @v1_tag_names = qw(TITLE ARTIST ALBUM YEAR COMMENT TRACKNUM GENRE); - - %v2_to_v1_names = ( - # v2.2 tags - 'TT2' => 'TITLE', - 'TP1' => 'ARTIST', - 'TAL' => 'ALBUM', - 'TYE' => 'YEAR', - 'COM' => 'COMMENT', - 'TRK' => 'TRACKNUM', - 'TCO' => 'GENRE', # not clean mapping, but ... - # v2.3 tags - 'TIT2' => 'TITLE', - 'TPE1' => 'ARTIST', - 'TALB' => 'ALBUM', - 'TYER' => 'YEAR', - 'COMM' => 'COMMENT', - 'TRCK' => 'TRACKNUM', - 'TCON' => 'GENRE', - ); - - %v2_tag_names = ( - # v2.2 tags - 'BUF' => 'Recommended buffer size', - 'CNT' => 'Play counter', - 'COM' => 'Comments', - 'CRA' => 'Audio encryption', - 'CRM' => 'Encrypted meta frame', - 'ETC' => 'Event timing codes', - 'EQU' => 'Equalization', - 'GEO' => 'General encapsulated object', - 'IPL' => 'Involved people list', - 'LNK' => 'Linked information', - 'MCI' => 'Music CD Identifier', - 'MLL' => 'MPEG location lookup table', - 'PIC' => 'Attached picture', - 'POP' => 'Popularimeter', - 'REV' => 'Reverb', - 'RVA' => 'Relative volume adjustment', - 'SLT' => 'Synchronized lyric/text', - 'STC' => 'Synced tempo codes', - 'TAL' => 'Album/Movie/Show title', - 'TBP' => 'BPM (Beats Per Minute)', - 'TCM' => 'Composer', - 'TCO' => 'Content type', - 'TCR' => 'Copyright message', - 'TDA' => 'Date', - 'TDY' => 'Playlist delay', - 'TEN' => 'Encoded by', - 'TFT' => 'File type', - 'TIM' => 'Time', - 'TKE' => 'Initial key', - 'TLA' => 'Language(s)', - 'TLE' => 'Length', - 'TMT' => 'Media type', - 'TOA' => 'Original artist(s)/performer(s)', - 'TOF' => 'Original filename', - 'TOL' => 'Original Lyricist(s)/text writer(s)', - 'TOR' => 'Original release year', - 'TOT' => 'Original album/Movie/Show title', - 'TP1' => 'Lead artist(s)/Lead performer(s)/Soloist(s)/Performing group', - 'TP2' => 'Band/Orchestra/Accompaniment', - 'TP3' => 'Conductor/Performer refinement', - 'TP4' => 'Interpreted, remixed, or otherwise modified by', - 'TPA' => 'Part of a set', - 'TPB' => 'Publisher', - 'TRC' => 'ISRC (International Standard Recording Code)', - 'TRD' => 'Recording dates', - 'TRK' => 'Track number/Position in set', - 'TSI' => 'Size', - 'TSS' => 'Software/hardware and settings used for encoding', - 'TT1' => 'Content group description', - 'TT2' => 'Title/Songname/Content description', - 'TT3' => 'Subtitle/Description refinement', - 'TXT' => 'Lyricist/text writer', - 'TXX' => 'User defined text information frame', - 'TYE' => 'Year', - 'UFI' => 'Unique file identifier', - 'ULT' => 'Unsychronized lyric/text transcription', - 'WAF' => 'Official audio file webpage', - 'WAR' => 'Official artist/performer webpage', - 'WAS' => 'Official audio source webpage', - 'WCM' => 'Commercial information', - 'WCP' => 'Copyright/Legal information', - 'WPB' => 'Publishers official webpage', - 'WXX' => 'User defined URL link frame', - - # v2.3 tags - 'AENC' => 'Audio encryption', - 'APIC' => 'Attached picture', - 'COMM' => 'Comments', - 'COMR' => 'Commercial frame', - 'ENCR' => 'Encryption method registration', - 'EQUA' => 'Equalization', - 'ETCO' => 'Event timing codes', - 'GEOB' => 'General encapsulated object', - 'GRID' => 'Group identification registration', - 'IPLS' => 'Involved people list', - 'LINK' => 'Linked information', - 'MCDI' => 'Music CD identifier', - 'MLLT' => 'MPEG location lookup table', - 'OWNE' => 'Ownership frame', - 'PCNT' => 'Play counter', - 'POPM' => 'Popularimeter', - 'POSS' => 'Position synchronisation frame', - 'PRIV' => 'Private frame', - 'RBUF' => 'Recommended buffer size', - 'RVAD' => 'Relative volume adjustment', - 'RVRB' => 'Reverb', - 'SYLT' => 'Synchronized lyric/text', - 'SYTC' => 'Synchronized tempo codes', - 'TALB' => 'Album/Movie/Show title', - 'TBPM' => 'BPM (beats per minute)', - 'TCOM' => 'Composer', - 'TCON' => 'Content type', - 'TCOP' => 'Copyright message', - 'TDAT' => 'Date', - 'TDLY' => 'Playlist delay', - 'TENC' => 'Encoded by', - 'TEXT' => 'Lyricist/Text writer', - 'TFLT' => 'File type', - 'TIME' => 'Time', - 'TIT1' => 'Content group description', - 'TIT2' => 'Title/songname/content description', - 'TIT3' => 'Subtitle/Description refinement', - 'TKEY' => 'Initial key', - 'TLAN' => 'Language(s)', - 'TLEN' => 'Length', - 'TMED' => 'Media type', - 'TOAL' => 'Original album/movie/show title', - 'TOFN' => 'Original filename', - 'TOLY' => 'Original lyricist(s)/text writer(s)', - 'TOPE' => 'Original artist(s)/performer(s)', - 'TORY' => 'Original release year', - 'TOWN' => 'File owner/licensee', - 'TPE1' => 'Lead performer(s)/Soloist(s)', - 'TPE2' => 'Band/orchestra/accompaniment', - 'TPE3' => 'Conductor/performer refinement', - 'TPE4' => 'Interpreted, remixed, or otherwise modified by', - 'TPOS' => 'Part of a set', - 'TPUB' => 'Publisher', - 'TRCK' => 'Track number/Position in set', - 'TRDA' => 'Recording dates', - 'TRSN' => 'Internet radio station name', - 'TRSO' => 'Internet radio station owner', - 'TSIZ' => 'Size', - 'TSRC' => 'ISRC (international standard recording code)', - 'TSSE' => 'Software/Hardware and settings used for encoding', - 'TXXX' => 'User defined text information frame', - 'TYER' => 'Year', - 'UFID' => 'Unique file identifier', - 'USER' => 'Terms of use', - 'USLT' => 'Unsychronized lyric/text transcription', - 'WCOM' => 'Commercial information', - 'WCOP' => 'Copyright/Legal information', - 'WOAF' => 'Official audio file webpage', - 'WOAR' => 'Official artist/performer webpage', - 'WOAS' => 'Official audio source webpage', - 'WORS' => 'Official internet radio station homepage', - 'WPAY' => 'Payment', - 'WPUB' => 'Publishers official webpage', - 'WXXX' => 'User defined URL link frame', - - # v2.4 additional tags - # note that we don't restrict tags from 2.3 or 2.4, - 'ASPI' => 'Audio seek point index', - 'EQU2' => 'Equalisation (2)', - 'RVA2' => 'Relative volume adjustment (2)', - 'SEEK' => 'Seek frame', - 'SIGN' => 'Signature frame', - 'TDEN' => 'Encoding time', - 'TDOR' => 'Original release time', - 'TDRC' => 'Recording time', - 'TDRL' => 'Release time', - 'TDTG' => 'Tagging time', - 'TIPL' => 'Involved people list', - 'TMCL' => 'Musician credits list', - 'TMOO' => 'Mood', - 'TPRO' => 'Produced notice', - 'TSOA' => 'Album sort order', - 'TSOP' => 'Performer sort order', - 'TSOT' => 'Title sort order', - 'TSST' => 'Set subtitle', - - # grrrrrrr - 'COM ' => 'Broken iTunes comments', - ); -} - -1; - -__END__ - -=pod - -=back - -=head1 TROUBLESHOOTING - -If you find a bug, please send me a patch (see the project page in L<"SEE ALSO">). -If you cannot figure out why it does not work for you, please put the MP3 file in -a place where I can get it (preferably via FTP, or HTTP, or .Mac iDisk) and send me -mail regarding where I can get the file, with a detailed description of the problem. - -If I download the file, after debugging the problem I will not keep the MP3 file -if it is not legal for me to have it. Just let me know if it is legal for me to -keep it or not. - - -=head1 TODO - -=over 4 - -=item ID3v2 Support - -Still need to do more for reading tags, such as using Compress::Zlib to decompress -compressed tags. But until I see this in use more, I won't bother. If something -does not work properly with reading, follow the instructions above for -troubleshooting. - -ID3v2 I<writing> is coming soon. - -=item Get data from scalar - -Instead of passing a file spec or filehandle, pass the -data itself. Would take some work, converting the seeks, etc. - -=item Padding bit ? - -Do something with padding bit. - -=item Test suite - -Test suite could use a bit of an overhaul and update. Patches very welcome. - -=over 4 - -=item * - -Revamp getset.t. Test all the various get_mp3tag args. - -=item * - -Test Unicode. - -=item * - -Test OOP API. - -=item * - -Test error handling, check more for missing files, bad MP3s, etc. - -=back - -=item Other VBR - -Right now, only Xing VBR is supported. - -=back - - -=head1 THANKS - -Edward Allen E<lt>allenej@c51844-a.spokn1.wa.home.comE<gt>, -Vittorio Bertola E<lt>v.bertola@vitaminic.comE<gt>, -Michael Blakeley E<lt>mike@blakeley.comE<gt>, -Per Bolmstedt E<lt>tomten@kol14.comE<gt>, -Tony Bowden E<lt>tony@tmtm.comE<gt>, -Tom Brown E<lt>thecap@usa.netE<gt>, -Sergio Camarena E<lt>scamarena@users.sourceforge.netE<gt>, -Chris Dawson E<lt>cdawson@webiphany.comE<gt>, -Luke Drumm E<lt>lukedrumm@mypad.comE<gt>, -Kyle Farrell E<lt>kyle@cantametrix.comE<gt>, -Jeffrey Friedl E<lt>jfriedl@yahoo.comE<gt>, -brian d foy E<lt>comdog@panix.comE<gt>, -Ben Gertzfield E<lt>che@debian.orgE<gt>, -Brian Goodwin E<lt>brian@fuddmain.comE<gt>, -Todd Hanneken E<lt>thanneken@hds.harvard.eduE<gt>, -Todd Harris E<lt>harris@cshl.orgE<gt>, -Woodrow Hill E<lt>asim@mindspring.comE<gt>, -Kee Hinckley E<lt>nazgul@somewhere.comE<gt>, -Roman Hodek E<lt>Roman.Hodek@informatik.uni-erlangen.deE<gt>, -Peter Kovacs E<lt>kovacsp@egr.uri.eduE<gt>, -Johann Lindvall, -Peter Marschall E<lt>peter.marschall@mayn.deE<gt>, -Trond Michelsen E<lt>mike@crusaders.noE<gt>, -Dave O'Neill E<lt>dave@nexus.carleton.caE<gt>, -Christoph Oberauer E<lt>christoph.oberauer@sbg.ac.atE<gt>, -Jake Palmer E<lt>jake.palmer@db.comE<gt>, -Andrew Phillips E<lt>asp@wasteland.orgE<gt>, -David Reuteler E<lt>reuteler@visi.comE<gt>, -John Ruttenberg E<lt>rutt@chezrutt.comE<gt>, -Matthew Sachs E<lt>matthewg@zevils.comE<gt>, -E<lt>scfc_de@users.sf.netE<gt>, -Hermann Schwaerzler E<lt>Hermann.Schwaerzler@uibk.ac.atE<gt>, -Chris Sidi E<lt>sidi@angband.orgE<gt>, -Roland Steinbach E<lt>roland@support-system.comE<gt>, -Stuart E<lt>schneis@users.sourceforge.netE<gt>, -Jeffery Sumler E<lt>jsumler@mediaone.netE<gt>, -Predrag Supurovic E<lt>mpgtools@dv.co.yuE<gt>, -Bogdan Surdu E<lt>tim@go.roE<gt>, -E<lt>tim@tim-landscheidt.deE<gt>, -Pass F. B. Travis E<lt>pftravis@bellsouth.netE<gt>, -Tobias Wagener E<lt>tobias@wagener.nuE<gt>, -Ronan Waide E<lt>waider@stepstone.ieE<gt>, -Andy Waite E<lt>andy@mailroute.comE<gt>, -Ken Williams E<lt>ken@forum.swarthmore.eduE<gt>, -Meng Weng Wong E<lt>mengwong@pobox.comE<gt>. - - -=head1 AUTHOR AND COPYRIGHT - -Chris Nandor E<lt>pudge@pobox.comE<gt>, http://pudge.net/ - -Copyright (c) 1998-2003 Chris Nandor. All rights reserved. This program is -free software; you can redistribute it and/or modify it under the terms -of the Artistic License, distributed with Perl. - - -=head1 SEE ALSO - -=over 4 - -=item MP3::Info Project Page - - http://projects.pudge.net/ - -=item mp3tools - - http://www.zevils.com/linux/mp3tools/ - -=item mpgtools - - http://www.dv.co.yu/mpgscript/mpgtools.htm - http://www.dv.co.yu/mpgscript/mpeghdr.htm - -=item mp3tool - - http://www.dtek.chalmers.se/~d2linjo/mp3/mp3tool.html - -=item ID3v2 - - http://www.id3.org/ - -=item Xing Variable Bitrate - - http://www.xingtech.com/support/partner_developer/mp3/vbr_sdk/ - -=item MP3Ext - - http://rupert.informatik.uni-stuttgart.de/~mutschml/MP3ext/ - -=item Xmms - - http://www.xmms.org/ - - -=back - -=head1 VERSION - -v1.02, Sunday, March 2, 2003 - -=cut diff --git a/tools/vorbiscomm.pm b/tools/vorbiscomm.pm deleted file mode 100644 index f2e48e8632..0000000000 --- a/tools/vorbiscomm.pm +++ /dev/null @@ -1,732 +0,0 @@ -############################################################################# -# This is -# http://search.cpan.org/~amolloy/Ogg-Vorbis-Header-PurePerl-0.07/PurePerl.pm -# written by Andrew Molloy -# Code under GNU GENERAL PUBLIC LICENCE v2 -# $Id$ -############################################################################# - -package vorbiscomm; - -use 5.005; -use strict; -use warnings; - -use Fcntl qw/SEEK_END/; - -our $VERSION = '0.07'; - -sub new -{ - my $class = shift; - my $file = shift; - - return load($class, $file); -} - -sub load -{ - my $class = shift; - my $file = shift; - my $from_new = shift; - my %data; - my $self; - - # there must be a better way... - if ($class eq 'vorbiscomm') - { - $self = bless \%data, $class; - } - else - { - $self = $class; - } - - if ($self->{'FILE_LOADED'}) - { - return $self; - } - - $self->{'FILE_LOADED'} = 1; - - # check that the file exists and is readable - unless ( -e $file && -r _ ) - { - warn "File does not exist or cannot be read."; - # file does not exist, can't do anything - return undef; - } - # open up the file - open FILE, $file; - # make sure dos-type systems can handle it... - binmode FILE; - - $data{'filename'} = $file; - $data{'fileHandle'} = \*FILE; - - if (_init(\%data)) { - _loadInfo(\%data); - _loadComments(\%data); - _calculateTrackLength(\%data); - } - - close FILE; - - return $self; -} - -sub info -{ - my $self = shift; - my $key = shift; - - # if the user did not supply a key, return the entire hash - unless ($key) - { - return $self->{'INFO'}; - } - - # otherwise, return the value for the given key - return $self->{'INFO'}{lc $key}; -} - -sub comment_tags -{ - my $self = shift; - - if ( $self && $self->{'COMMENT_KEYS'} ) { - return @{$self->{'COMMENT_KEYS'}}; - } - - return undef; -} - -sub comment -{ - my $self = shift; - my $key = shift; - - # if the user supplied key does not exist, return undef - unless($self->{'COMMENTS'}{lc $key}) - { - return undef; - } - - return @{$self->{'COMMENTS'}{lc $key}}; -} - -sub add_comments -{ - warn "Ogg::Vorbis::Header::PurePerl add_comments() unimplemented."; -} - -sub edit_comment -{ - warn "Ogg::Vorbis::Header::PurePerl edit_comment() unimplemented."; -} - -sub delete_comment -{ - warn "Ogg::Vorbis::Header::PurePerl delete_comment() unimplemented."; -} - -sub clear_comments -{ - warn "Ogg::Vorbis::Header::PurePerl clear_comments() unimplemented."; -} - -sub path -{ - my $self = shift; - - return $self->{'fileName'}; -} - -sub write_vorbis -{ - warn "Ogg::Vorbis::Header::PurePerl write_vorbis unimplemented."; -} - -# "private" methods - -sub _init -{ - my $data = shift; - my $fh = $data->{'fileHandle'}; - my $byteCount = 0; - - # check the header to make sure this is actually an Ogg-Vorbis file - $byteCount = _checkHeader($data); - - unless($byteCount) - { - # if it's not, we can't do anything - return undef; - } - - $data->{'startInfoHeader'} = $byteCount; - return 1; # Success -} - -sub _checkHeader -{ - my $data = shift; - my $fh = $data->{'fileHandle'}; - my $buffer; - my $pageSegCount; - my $byteCount = 0; # stores how far into the file we've read, - # so later reads into the file can skip right - # past all of the header stuff - - # check that the first four bytes are 'OggS' - read($fh, $buffer, 4); - if ($buffer ne 'OggS') - { - warn "This is not an Ogg bitstream (no OggS header)."; - return undef; - } - $byteCount += 4; - - # check the stream structure version (1 byte, should be 0x00) - read($fh, $buffer, 1); - if (ord($buffer) != 0x00) - { - warn "This is not an Ogg bitstream (invalid structure version)."; - return undef; - } - $byteCount += 1; - - # check the header type flag - # This is a bitfield, so technically we should check all of the bits - # that could potentially be set. However, the only value this should - # possibly have at the beginning of a proper Ogg-Vorbis file is 0x02, - # so we just check for that. If it's not that, we go on anyway, but - # give a warning (this behavior may (should?) be modified in the future. - read($fh, $buffer, 1); - if (ord($buffer) != 0x02) - { - warn "Invalid header type flag (trying to go ahead anyway)."; - } - $byteCount += 1; - - # skip to the page_segments count - read($fh, $buffer, 20); - $byteCount += 20; - # we do nothing with this data - - # read the number of page segments - read($fh, $buffer, 1); - $pageSegCount = ord($buffer); - $byteCount += 1; - - # read $pageSegCount bytes, then throw 'em out - read($fh, $buffer, $pageSegCount); - $byteCount += $pageSegCount; - - # check packet type. Should be 0x01 (for indentification header) - read($fh, $buffer, 1); - if (ord($buffer) != 0x01) - { - warn "Wrong vorbis header type, giving up."; - return undef; - } - $byteCount += 1; - - # check that the packet identifies itself as 'vorbis' - read($fh, $buffer, 6); - if ($buffer ne 'vorbis') - { - warn "This does not appear to be a vorbis stream, giving up."; - return undef; - } - $byteCount += 6; - - # at this point, we assume the bitstream is valid - return $byteCount; -} - -sub _loadInfo -{ - my $data = shift; - my $start = $data->{'startInfoHeader'}; - my $fh = $data->{'fileHandle'}; - my $buffer; - my $byteCount = $start; - my %info; - - seek $fh, $start, 0; - - # read the vorbis version - read($fh, $buffer, 4); - $info{'version'} = _decodeInt($buffer); - $byteCount += 4; - - # read the number of audio channels - read($fh, $buffer, 1); - $info{'channels'} = ord($buffer); - $byteCount += 1; - - # read the sample rate - read($fh, $buffer, 4); - $info{'rate'} = _decodeInt($buffer); - $byteCount += 4; - - # read the bitrate maximum - read($fh, $buffer, 4); - $info{'bitrate_upper'} = _decodeInt($buffer); - $byteCount += 4; - - # read the bitrate nominal - read($fh, $buffer, 4); - $info{'bitrate_nominal'} = _decodeInt($buffer); - $byteCount += 4; - - # read the bitrate minimal - read($fh, $buffer, 4); - $info{'bitrate_lower'} = _decodeInt($buffer); - $byteCount += 4; - - # read the blocksize_0 and blocksize_1 - read($fh, $buffer, 1); - # these are each 4 bit fields, whose actual value is 2 to the power - # of the value of the field - $info{'blocksize_0'} = 2 << ((ord($buffer) & 0xF0) >> 4); - $info{'blocksize_1'} = 2 << (ord($buffer) & 0x0F); - $byteCount += 1; - - # read the framing_flag - read($fh, $buffer, 1); - $info{'framing_flag'} = ord($buffer); - $byteCount += 1; - - # bitrate_window is -1 in the current version of vorbisfile - $info{'bitrate_window'} = -1; - - $data->{'startCommentHeader'} = $byteCount; - - $data->{'INFO'} = \%info; -} - -sub _loadComments -{ - my $data = shift; - my $fh = $data->{'fileHandle'}; - my $start = $data->{'startCommentHeader'}; - my $buffer; - my $page_segments; - my $vendor_length; - my $user_comment_count; - my $byteCount = $start; - my %comments; - - seek $fh, $start, 0; - - # check that the first four bytes are 'OggS' - read($fh, $buffer, 4); - if ($buffer ne 'OggS') - { - warn "No comment header?"; - return undef; - } - $byteCount += 4; - - # skip over next ten bytes - read($fh, $buffer, 10); - $byteCount += 10; - - # read the stream serial number - read($fh, $buffer, 4); - push @{$data->{'commentSerialNumber'}}, _decodeInt($buffer); - $byteCount += 4; - - # read the page sequence number (should be 0x01) - read($fh, $buffer, 4); - if (_decodeInt($buffer) != 0x01) - { - warn "Comment header page sequence number is not 0x01: " + - _decodeInt($buffer); - warn "Going to keep going anyway."; - } - $byteCount += 4; - - # and ignore the page checksum for now - read($fh, $buffer, 4); - $byteCount += 4; - - # get the number of entries in the segment_table... - read($fh, $buffer, 1); - $page_segments = _decodeInt($buffer); - $byteCount += 1; - # then skip on past it - read($fh, $buffer, $page_segments); - $byteCount += $page_segments; - - # check the header type (should be 0x03) - read($fh, $buffer, 1); - if (ord($buffer) != 0x03) - { - warn "Wrong header type: " . ord($buffer); - } - $byteCount += 1; - - # now we should see 'vorbis' - read($fh, $buffer, 6); - if ($buffer ne 'vorbis') - { - warn "Missing comment header. Should have found 'vorbis', found " . - $buffer; - } - $byteCount += 6; - - # get the vendor length - read($fh, $buffer, 4); - $vendor_length = _decodeInt($buffer); - $byteCount += 4; - - # read in the vendor - read($fh, $buffer, $vendor_length); - $comments{'vendor'} = $buffer; - $byteCount += $vendor_length; - - # read in the number of user comments - read($fh, $buffer, 4); - $user_comment_count = _decodeInt($buffer); - $byteCount += 4; - - $data->{'COMMENT_KEYS'} = []; - - # finally, read the comments - for (my $i = 0; $i < $user_comment_count; $i++) - { - # first read the length - read($fh, $buffer, 4); - my $comment_length = _decodeInt($buffer); - $byteCount += 4; - - # then the comment itself - read($fh, $buffer, $comment_length); - $byteCount += $comment_length; - - my ($key) = $buffer =~ /^([^=]+)/; - my ($value) = $buffer =~ /=(.*)$/; - - push @{$comments{lc $key}}, $value; - push @{$data->{'COMMENT_KEYS'}}, lc $key; - } - - # read past the framing_bit - read($fh, $buffer, 1); - $byteCount += 1; - - $data->{'INFO'}{'offset'} = $byteCount; - - $data->{'COMMENTS'} = \%comments; - - # Now find the offset of the first page - # with audio data. - while(_findPage($fh)) - { - $byteCount = tell($fh) - 4; - - # version flag - read($fh, $buffer, 1); - if (ord($buffer) != 0x00) - { - warn "Invalid stream structure version: " . - sprintf("%x", ord($buffer)); - return; - } - - # header type flag - read($fh, $buffer, 1); - # Audio data starts as a fresh packet on a new page, so - # if header_type is odd it's not a fresh packet - next if ( ord($buffer) % 2 ); - - # skip past granule position, stream_serial_number, - # page_sequence_number, and crc - read($fh, $buffer, 20); - - # page_segments - read($fh, $buffer, 1); - my $page_segments = ord($buffer); - - # skip past the segment table - read($fh, $buffer, $page_segments); - - # read packet_type byte - read($fh, $buffer, 1); - - # Not an audio packet. All audio packet numbers are even - next if ( ord($buffer) % 2 ); - - # Found the first audio packet - last; - } - - $data->{'INFO'}{'audio_offset'} = $byteCount; -} - -sub _calculateTrackLength -{ - my $data = shift; - my $fh = $data->{'fileHandle'}; - my $buffer; - my $pageSize; - my $granule_position; - - seek($fh,-8500,SEEK_END); # that magic number is from vorbisfile.c - # in the constant CHUNKSIZE, which comes - # with the comment /* a shade over 8k; - # anyone using pages well over 8k gets - # what they deserve */ - - # we just keep looking through the headers until we get to the last one - # (there might be a couple of blocks here) - while(_findPage($fh)) - { - # stream structure version - must be 0x00 - read($fh, $buffer, 1); - if (ord($buffer) != 0x00) - { - warn "Invalid stream structure version: " . - sprintf("%x", ord($buffer)); - return; - } - - # header type flag - read($fh, $buffer, 1); - # we should check this, but for now we'll just ignore it - - # absolute granule position - this is what we need! - read($fh, $buffer, 8); - $granule_position = _decodeInt($buffer); - - # skip past stream_serial_number, page_sequence_number, and crc - read($fh, $buffer, 12); - - # page_segments - read($fh, $buffer, 1); - my $page_segments = ord($buffer); - - # reset pageSize - $pageSize = 0; - - # calculate approx. page size - for (my $i = 0; $i < $page_segments; $i++) - { - read($fh, $buffer, 1); - $pageSize += ord($buffer); - } - - seek $fh, $pageSize, 1; - } - - $data->{'INFO'}{'length'} = - int($granule_position / $data->{'INFO'}{'rate'}); -} - -sub _findPage -{ - # search forward in the file for the 'OggS' page header - my $fh = shift; - my $char; - my $curStr = ''; - - while (read($fh, $char, 1)) - { - $curStr = $char . $curStr; - $curStr = substr($curStr, 0, 4); - - # we are actually looking for the string 'SggO' because we - # tack character on to our test string backwards, to make - # trimming it to 4 characters easier. - if ($curStr eq 'SggO') - { - return 1; - } - } - - return undef; -} - -sub _decodeInt -{ - my $bytes = shift; - my $num = 0; - my @byteList = split //, $bytes; - my $numBytes = @byteList; - my $mult = 1; - - for (my $i = 0; $i < $numBytes; $i ++) - { - $num += ord($byteList[$i]) * $mult; - $mult *= 256; - } - - return $num; -} - -sub _decodeInt5Bit -{ - my $byte = ord(shift); - - $byte = $byte & 0xF8; # clear out the bottm 3 bits - $byte = $byte >> 3; # and shifted down to where it belongs - - return $byte; -} - -sub _decodeInt4Bit -{ - my $byte = ord(shift); - - $byte = $byte & 0xFC; # clear out the bottm 4 bits - $byte = $byte >> 4; # and shifted down to where it belongs - - return $byte; -} - -sub _ilog -{ - my $x = shift; - my $ret = 0; - - unless ($x > 0) - { - return 0; - } - - while ($x > 0) - { - $ret++; - $x = $x >> 1; - } - - return $ret; -} - -1; -__DATA__ - -=head1 NAME - -Ogg::Vorbis::Header::PurePerl - An object-oriented interface to Ogg Vorbis -information and comment fields, implemented entirely in Perl. Intended to be -a drop in replacement for Ogg::Vobis::Header. - -Unlike Ogg::Vorbis::Header, this module will go ahead and fill in all of the -information fields as soon as you construct the object. In other words, -the C<new> and C<load> constructors have identical behavior. - -=head1 SYNOPSIS - - use Ogg::Vorbis::Header::PurePerl; - my $ogg = Ogg::Vorbis::Header::PurePerl->new("song.ogg"); - while (my ($k, $v) = each %{$ogg->info}) { - print "$k: $v\n"; - } - foreach my $com ($ogg->comment_tags) { - print "$com: $_\n" foreach $ogg->comment($com); - } - -=head1 DESCRIPTION - -This module is intended to be a drop in replacement for Ogg::Vorbis::Header, -implemented entirely in Perl. It provides an object-oriented interface to -Ogg Vorbis information and comment fields. (NOTE: This module currently -supports only read operations). - -=head1 CONSTRUCTORS - -=head2 C<new ($filename)> - -Opens an Ogg Vorbis file, ensuring that it exists and is actually an -Ogg Vorbis stream. This method does not actually read any of the -information or comment fields, and closes the file immediately. - -=head2 C<load ([$filename])> - -Opens an Ogg Vorbis file, ensuring that it exists and is actually an -Ogg Vorbis stream, then loads the information and comment fields. This -method can also be used without a filename to load the information -and fields of an already constructed instance. - -=head1 INSTANCE METHODS - -=head2 C<info ([$key])> - -Returns a hashref containing information about the Ogg Vorbis file from -the file's information header. Hash fields are: version, channels, rate, -bitrate_upper, bitrate_nominal, bitrate_lower, bitrate_window, and length. -The bitrate_window value is not currently used by the vorbis codec, and -will always be -1. - -The optional parameter, key, allows you to retrieve a single value from -the object's hash. Returns C<undef> if the key is not found. - -=head2 C<comment_tags ()> - -Returns an array containing the key values for the comment fields. -These values can then be passed to C<comment> to retrieve their values. - -=head2 C<comment ($key)> - -Returns an array of comment values associated with the given key. - -=head2 C<add_comments ($key, $value, [$key, $value, ...])> - -Unimplemented. - -=head2 C<edit_comment ($key, $value, [$num])> - -Unimplemented. - -=head2 C<delete_comment ($key, [$num])> - -Unimplemented. - -=head2 C<clear_comments ([@keys])> - -Unimplemented. - -=head2 C<write_vorbis ()> - -Unimplemented. - -=head2 C<path ()> - -Returns the path/filename of the file the object represents. - -=head1 NOTE - -This is ALPHA SOFTWARE. It may very well be very broken. Do not use it in -a production environment. You have been warned. - -=head1 ACKNOWLEDGEMENTS - -Dave Brown <cpan@dagbrown.com> made this module significantly faster -at calculating the length of ogg files. - -Robert Moser II <rlmoser@earthlink.net> fixed a problem with files that -have no comments. - -=head1 AUTHOR - -Andrew Molloy E<lt>amolloy@kaizolabs.comE<gt> - -=head1 COPYRIGHT - -Copyright (c) 2003, Andrew Molloy. All Rights Reserved. - -This program is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2 of the License, or (at -your option) any later version. A copy of this license is included -with this module (LICENSE.GPL). - -=head1 SEE ALSO - -L<Ogg::Vorbis::Header>, L<Ogg::Vorbis::Decoder> - -=cut |