+2184

tools/mp3info.pm

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

+448

tools/songdb.pl

··· 1 1 + #!/usr/bin/perl 2 2 + # 3 3 + # Rockbox song database docs: 4 4 + # http://www.rockbox.org/twiki/bin/view/Main/TagCache 5 5 + # 6 6 + 7 7 + use mp3info; 8 8 + use vorbiscomm; 9 9 + 10 10 + # configuration settings 11 11 + my $db = "tagcache"; 12 12 + my $dir; 13 13 + my $strip; 14 14 + my $add; 15 15 + my $verbose; 16 16 + my $help; 17 17 + my $dirisalbum; 18 18 + my $littleendian = 0; 19 19 + my $dbver = 0x54434804; 20 20 + 21 21 + # file data 22 22 + my %entries; 23 23 + 24 24 + while($ARGV[0]) { 25 25 + if($ARGV[0] eq "--path") { 26 26 + $dir = $ARGV[1]; 27 27 + shift @ARGV; 28 28 + shift @ARGV; 29 29 + } 30 30 + elsif($ARGV[0] eq "--db") { 31 31 + $db = $ARGV[1]; 32 32 + shift @ARGV; 33 33 + shift @ARGV; 34 34 + } 35 35 + elsif($ARGV[0] eq "--strip") { 36 36 + $strip = $ARGV[1]; 37 37 + shift @ARGV; 38 38 + shift @ARGV; 39 39 + } 40 40 + elsif($ARGV[0] eq "--add") { 41 41 + $add = $ARGV[1]; 42 42 + shift @ARGV; 43 43 + shift @ARGV; 44 44 + } 45 45 + elsif($ARGV[0] eq "--dirisalbum") { 46 46 + $dirisalbum = 1; 47 47 + shift @ARGV; 48 48 + } 49 49 + elsif($ARGV[0] eq "--littleendian") { 50 50 + $littleendian = 1; 51 51 + shift @ARGV; 52 52 + } 53 53 + elsif($ARGV[0] eq "--verbose") { 54 54 + $verbose = 1; 55 55 + shift @ARGV; 56 56 + } 57 57 + elsif($ARGV[0] eq "--help" or ($ARGV[0] eq "-h")) { 58 58 + $help = 1; 59 59 + shift @ARGV; 60 60 + } 61 61 + else { 62 62 + shift @ARGV; 63 63 + } 64 64 + } 65 65 + 66 66 + if(! -d $dir or $help) { 67 67 + print "'$dir' is not a directory\n" if ($dir ne "" and ! -d $dir); 68 68 + print <<MOO 69 69 + 70 70 + songdb --path <dir> [--db <file>] [--strip <path>] [--add <path>] [--dirisalbum] [--littleendian] [--verbose] [--help] 71 71 + 72 72 + Options: 73 73 + 74 74 + --path <dir> Where your music collection is found 75 75 + --db <file> Prefix for output files. Defaults to tagcache. 76 76 + --strip <path> Removes this string from the left of all file names 77 77 + --add <path> Adds this string to the left of all file names 78 78 + --dirisalbum Use dir name as album name if the album name is missing in the 79 79 + tags 80 80 + --littleendian Write out data as little endian (for simulator) 81 81 + --verbose Shows more details while working 82 82 + --help This text 83 83 + MOO 84 84 + ; 85 85 + exit; 86 86 + } 87 87 + 88 88 + sub get_oggtag { 89 89 + my $fn = shift; 90 90 + my %hash; 91 91 + 92 92 + my $ogg = vorbiscomm->new($fn); 93 93 + 94 94 + my $h= $ogg->load; 95 95 + 96 96 + # Convert this format into the same format used by the id3 parser hash 97 97 + 98 98 + foreach my $k ($ogg->comment_tags()) 99 99 + { 100 100 + foreach my $cmmt ($ogg->comment($k)) 101 101 + { 102 102 + my $n; 103 103 + if($k =~ /^artist$/i) { 104 104 + $n = 'ARTIST'; 105 105 + } 106 106 + elsif($k =~ /^album$/i) { 107 107 + $n = 'ALBUM'; 108 108 + } 109 109 + elsif($k =~ /^title$/i) { 110 110 + $n = 'TITLE'; 111 111 + } 112 112 + $hash{$n}=$cmmt if($n); 113 113 + } 114 114 + } 115 115 + 116 116 + return \%hash; 117 117 + } 118 118 + 119 119 + sub get_ogginfo { 120 120 + my $fn = shift; 121 121 + my %hash; 122 122 + 123 123 + my $ogg = vorbiscomm->new($fn); 124 124 + 125 125 + my $h= $ogg->load; 126 126 + 127 127 + return $ogg->{'INFO'}; 128 128 + } 129 129 + 130 130 + # return ALL directory entries in the given dir 131 131 + sub getdir { 132 132 + my ($dir) = @_; 133 133 + 134 134 + $dir =~ s|/$|| if ($dir ne "/"); 135 135 + 136 136 + if (opendir(DIR, $dir)) { 137 137 + my @all = readdir(DIR); 138 138 + closedir DIR; 139 139 + return @all; 140 140 + } 141 141 + else { 142 142 + warn "can't opendir $dir: $!\n"; 143 143 + } 144 144 + } 145 145 + 146 146 + sub extractmp3 { 147 147 + my ($dir, @files) = @_; 148 148 + my @mp3; 149 149 + for(@files) { 150 150 + if( (/\.mp[23]$/i || /\.ogg$/i) && -f "$dir/$_" ) { 151 151 + push @mp3, $_; 152 152 + } 153 153 + } 154 154 + return @mp3; 155 155 + } 156 156 + 157 157 + sub extractdirs { 158 158 + my ($dir, @files) = @_; 159 159 + $dir =~ s|/$||; 160 160 + my @dirs; 161 161 + for(@files) { 162 162 + if( -d "$dir/$_" && ($_ !~ /^\.(|\.)$/)) { 163 163 + push @dirs, $_; 164 164 + } 165 165 + } 166 166 + return @dirs; 167 167 + } 168 168 + 169 169 + sub singlefile { 170 170 + my ($file) = @_; 171 171 + my $hash; 172 172 + my $info; 173 173 + 174 174 + if($file =~ /\.ogg$/i) { 175 175 + $hash = get_oggtag($file); 176 176 + $info = get_ogginfo($file); 177 177 + } 178 178 + else { 179 179 + $hash = get_mp3tag($file); 180 180 + $info = get_mp3info($file); 181 181 + if (defined $$info{'BITRATE'}) { 182 182 + $$hash{'BITRATE'} = $$info{'BITRATE'}; 183 183 + } 184 184 + 185 185 + if (defined $$info{'SECS'}) { 186 186 + $$hash{'SECS'} = $$info{'SECS'}; 187 187 + } 188 188 + } 189 189 + 190 190 + return $hash; 191 191 + } 192 192 + 193 193 + sub dodir { 194 194 + my ($dir)=@_; 195 195 + 196 196 + my %lcartists; 197 197 + my %lcalbums; 198 198 + 199 199 + print "$dir\n"; 200 200 + 201 201 + # getdir() returns all entries in the given dir 202 202 + my @a = getdir($dir); 203 203 + 204 204 + # extractmp3 filters out only the mp3 files from all given entries 205 205 + my @m = extractmp3($dir, @a); 206 206 + 207 207 + my $f; 208 208 + 209 209 + for $f (sort @m) { 210 210 + 211 211 + my $id3 = singlefile("$dir/$f"); 212 212 + 213 213 + if (not defined $$id3{'ARTIST'} or $$id3{'ARTIST'} eq "") { 214 214 + $$id3{'ARTIST'} = "<Untagged>"; 215 215 + } 216 216 + 217 217 + # Only use one case-variation of each artist 218 218 + if (exists($lcartists{lc($$id3{'ARTIST'})})) { 219 219 + $$id3{'ARTIST'} = $lcartists{lc($$id3{'ARTIST'})}; 220 220 + } 221 221 + else { 222 222 + $lcartists{lc($$id3{'ARTIST'})} = $$id3{'ARTIST'}; 223 223 + } 224 224 + #printf "Artist: %s\n", $$id3{'ARTIST'}; 225 225 + 226 226 + if (not defined $$id3{'ALBUM'} or $$id3{'ALBUM'} eq "") { 227 227 + $$id3{'ALBUM'} = "<Untagged>"; 228 228 + if ($dirisalbum) { 229 229 + $$id3{'ALBUM'} = $dir; 230 230 + } 231 231 + } 232 232 + 233 233 + # Only use one case-variation of each album 234 234 + if (exists($lcalbums{lc($$id3{'ALBUM'})})) { 235 235 + $$id3{'ALBUM'} = $lcalbums{lc($$id3{'ALBUM'})}; 236 236 + } 237 237 + else { 238 238 + $lcalbums{lc($$id3{'ALBUM'})} = $$id3{'ALBUM'}; 239 239 + } 240 240 + #printf "Album: %s\n", $$id3{'ALBUM'}; 241 241 + 242 242 + if (not defined $$id3{'GENRE'} or $$id3{'GENRE'} eq "") { 243 243 + $$id3{'GENRE'} = "<Untagged>"; 244 244 + } 245 245 + #printf "Genre: %s\n", $$id3{'GENRE'}; 246 246 + 247 247 + if (not defined $$id3{'TITLE'} or $$id3{'TITLE'} eq "") { 248 248 + # fall back on basename of the file if no title tag. 249 249 + ($$id3{'TITLE'} = $f) =~ s/\.\w+$//; 250 250 + } 251 251 + #printf "Title: %s\n", $$id3{'TITLE'}; 252 252 + 253 253 + my $path = "$dir/$f"; 254 254 + if ($strip ne "" and $path =~ /^$strip(.*)/) { 255 255 + $path = $1; 256 256 + } 257 257 + 258 258 + if ($add ne "") { 259 259 + $path = $add . $path; 260 260 + } 261 261 + #printf "Path: %s\n", $path; 262 262 + 263 263 + if (not defined $$id3{'COMPOSER'} or $$id3{'COMPOSER'} eq "") { 264 264 + $$id3{'COMPOSER'} = "<Untagged>"; 265 265 + } 266 266 + #printf "Composer: %s\n", $$id3{'COMPOSER'}; 267 267 + 268 268 + if (not defined $$id3{'YEAR'} or $$id3{'YEAR'} eq "") { 269 269 + $$id3{'YEAR'} = "-1"; 270 270 + } 271 271 + #printf "Year: %s\n", $$id3{'YEAR'}; 272 272 + 273 273 + if (not defined $$id3{'TRACKNUM'} or $$id3{'TRACKNUM'} eq "") { 274 274 + $$id3{'TRACKNUM'} = "-1"; 275 275 + } 276 276 + #printf "Track num: %s\n", $$id3{'TRACKNUM'}; 277 277 + 278 278 + if (not defined $$id3{'BITRATE'} or $$id3{'BITRATE'} eq "") { 279 279 + $$id3{'BITRATE'} = "-1"; 280 280 + } 281 281 + #printf "Bitrate: %s\n", $$id3{'BITRATE'}; 282 282 + 283 283 + if (not defined $$id3{'SECS'} or $$id3{'SECS'} eq "") { 284 284 + $$id3{'SECS'} = "-1"; 285 285 + } 286 286 + #printf "Length: %s\n", $$id3{'SECS'}; 287 287 + 288 288 + $$id3{'PATH'} = $path; 289 289 + $entries{$path} = $id3; 290 290 + } 291 291 + 292 292 + # extractdirs filters out only subdirectories from all given entries 293 293 + my @d = extractdirs($dir, @a); 294 294 + my $d; 295 295 + 296 296 + for $d (sort @d) { 297 297 + $dir =~ s|/$||; 298 298 + dodir("$dir/$d"); 299 299 + } 300 300 + } 301 301 + 302 302 + use_mp3_utf8(1); 303 303 + dodir($dir); 304 304 + print "\n"; 305 305 + 306 306 + sub dumpshort { 307 307 + my ($num)=@_; 308 308 + 309 309 + # print "int: $num\n"; 310 310 + 311 311 + if ($littleendian) { 312 312 + print DB pack "v", $num; 313 313 + } 314 314 + else { 315 315 + print DB pack "n", $num; 316 316 + } 317 317 + } 318 318 + 319 319 + sub dumpint { 320 320 + my ($num)=@_; 321 321 + 322 322 + # print "int: $num\n"; 323 323 + 324 324 + if ($littleendian) { 325 325 + print DB pack "V", $num; 326 326 + } 327 327 + else { 328 328 + print DB pack "N", $num; 329 329 + } 330 330 + } 331 331 + 332 332 + sub dump_tag_string { 333 333 + my ($s, $index) = @_; 334 334 + 335 335 + my $strlen = length($s)+1; 336 336 + my $padding = $strlen%4; 337 337 + if ($padding > 0) { 338 338 + $padding = 4 - $padding; 339 339 + $strlen += $padding; 340 340 + } 341 341 + 342 342 + dumpshort($strlen); 343 343 + dumpshort($index); 344 344 + print DB $s."\0"; 345 345 + 346 346 + for (my $i = 0; $i < $padding; $i++) { 347 347 + print DB "X"; 348 348 + } 349 349 + } 350 350 + 351 351 + sub dump_tag_header { 352 352 + my ($entry_count) = @_; 353 353 + 354 354 + my $size = tell(DB) - 12; 355 355 + seek(DB, 0, 0); 356 356 + 357 357 + dumpint($dbver); 358 358 + dumpint($size); 359 359 + dumpint($entry_count); 360 360 + } 361 361 + 362 362 + sub openfile { 363 363 + my ($f) = @_; 364 364 + open(DB, "> $f") || die "couldn't open $f"; 365 365 + binmode(DB); 366 366 + } 367 367 + 368 368 + sub create_tagcache_index_file { 369 369 + my ($index, $key, $unique) = @_; 370 370 + 371 371 + my $num = 0; 372 372 + my $prev = ""; 373 373 + my $offset = 12; 374 374 + 375 375 + openfile $db ."_".$index.".tcd"; 376 376 + dump_tag_header(0); 377 377 + 378 378 + for(sort {uc($entries{$a}->{$key}) cmp uc($entries{$b}->{$key})} keys %entries) { 379 379 + if (!$unique || !($entries{$_}->{$key} eq $prev)) { 380 380 + my $index; 381 381 + 382 382 + $num++; 383 383 + $prev = $entries{$_}->{$key}; 384 384 + $offset = tell(DB); 385 385 + printf(" %s\n", $prev) if ($verbose); 386 386 + 387 387 + if ($unique) { 388 388 + $index = 0xFFFF; 389 389 + } 390 390 + else { 391 391 + $index = $entries{$_}->{'INDEX'}; 392 392 + } 393 393 + dump_tag_string($prev, $index); 394 394 + } 395 395 + $entries{$_}->{$key."_OFFSET"} = $offset; 396 396 + } 397 397 + 398 398 + dump_tag_header($num); 399 399 + close(DB); 400 400 + } 401 401 + 402 402 + if (!scalar keys %entries) { 403 403 + print "No songs found. Did you specify the right --path ?\n"; 404 404 + print "Use the --help parameter to see all options.\n"; 405 405 + exit; 406 406 + } 407 407 + 408 408 + my $i = 0; 409 409 + for (sort keys %entries) { 410 410 + $entries{$_}->{'INDEX'} = $i; 411 411 + $i++; 412 412 + } 413 413 + 414 414 + if ($db) { 415 415 + # Artists 416 416 + create_tagcache_index_file(0, 'ARTIST', 1); 417 417 + # Albums 418 418 + create_tagcache_index_file(1, 'ALBUM', 1); 419 419 + # Genres 420 420 + create_tagcache_index_file(2, 'GENRE', 1); 421 421 + # Titles 422 422 + create_tagcache_index_file(3, 'TITLE', 0); 423 423 + # Filenames 424 424 + create_tagcache_index_file(4, 'PATH', 0); 425 425 + # Composers 426 426 + create_tagcache_index_file(5, 'COMPOSER', 1); 427 427 + 428 428 + # Master index file 429 429 + openfile $db ."_idx.tcd"; 430 430 + dump_tag_header(0); 431 431 + 432 432 + for (sort keys %entries) { 433 433 + dumpint($entries{$_}->{'ARTIST_OFFSET'}); 434 434 + dumpint($entries{$_}->{'ALBUM_OFFSET'}); 435 435 + dumpint($entries{$_}->{'GENRE_OFFSET'}); 436 436 + dumpint($entries{$_}->{'TITLE_OFFSET'}); 437 437 + dumpint($entries{$_}->{'PATH_OFFSET'}); 438 438 + dumpint($entries{$_}->{'COMPOSER_OFFSET'}); 439 439 + dumpint($entries{$_}->{'YEAR'}); 440 440 + dumpint($entries{$_}->{'TRACKNUM'}); 441 441 + dumpint($entries{$_}->{'BITRATE'}); 442 442 + dumpint($entries{$_}->{'SECS'}); 443 443 + dumpint(0); 444 444 + } 445 445 + 446 446 + dump_tag_header(scalar keys %entries); 447 447 + close(DB); 448 448 + }

+732

tools/vorbiscomm.pm

··· 1 1 + ############################################################################# 2 2 + # This is 3 3 + # http://search.cpan.org/~amolloy/Ogg-Vorbis-Header-PurePerl-0.07/PurePerl.pm 4 4 + # written by Andrew Molloy 5 5 + # Code under GNU GENERAL PUBLIC LICENCE v2 6 6 + # $Id$ 7 7 + ############################################################################# 8 8 + 9 9 + package vorbiscomm; 10 10 + 11 11 + use 5.005; 12 12 + use strict; 13 13 + use warnings; 14 14 + 15 15 + use Fcntl qw/SEEK_END/; 16 16 + 17 17 + our $VERSION = '0.07'; 18 18 + 19 19 + sub new 20 20 + { 21 21 + my $class = shift; 22 22 + my $file = shift; 23 23 + 24 24 + return load($class, $file); 25 25 + } 26 26 + 27 27 + sub load 28 28 + { 29 29 + my $class = shift; 30 30 + my $file = shift; 31 31 + my $from_new = shift; 32 32 + my %data; 33 33 + my $self; 34 34 + 35 35 + # there must be a better way... 36 36 + if ($class eq 'vorbiscomm') 37 37 + { 38 38 + $self = bless \%data, $class; 39 39 + } 40 40 + else 41 41 + { 42 42 + $self = $class; 43 43 + } 44 44 + 45 45 + if ($self->{'FILE_LOADED'}) 46 46 + { 47 47 + return $self; 48 48 + } 49 49 + 50 50 + $self->{'FILE_LOADED'} = 1; 51 51 + 52 52 + # check that the file exists and is readable 53 53 + unless ( -e $file && -r _ ) 54 54 + { 55 55 + warn "File does not exist or cannot be read."; 56 56 + # file does not exist, can't do anything 57 57 + return undef; 58 58 + } 59 59 + # open up the file 60 60 + open FILE, $file; 61 61 + # make sure dos-type systems can handle it... 62 62 + binmode FILE; 63 63 + 64 64 + $data{'filename'} = $file; 65 65 + $data{'fileHandle'} = \*FILE; 66 66 + 67 67 + if (_init(\%data)) { 68 68 + _loadInfo(\%data); 69 69 + _loadComments(\%data); 70 70 + _calculateTrackLength(\%data); 71 71 + } 72 72 + 73 73 + close FILE; 74 74 + 75 75 + return $self; 76 76 + } 77 77 + 78 78 + sub info 79 79 + { 80 80 + my $self = shift; 81 81 + my $key = shift; 82 82 + 83 83 + # if the user did not supply a key, return the entire hash 84 84 + unless ($key) 85 85 + { 86 86 + return $self->{'INFO'}; 87 87 + } 88 88 + 89 89 + # otherwise, return the value for the given key 90 90 + return $self->{'INFO'}{lc $key}; 91 91 + } 92 92 + 93 93 + sub comment_tags 94 94 + { 95 95 + my $self = shift; 96 96 + 97 97 + if ( $self && $self->{'COMMENT_KEYS'} ) { 98 98 + return @{$self->{'COMMENT_KEYS'}}; 99 99 + } 100 100 + 101 101 + return undef; 102 102 + } 103 103 + 104 104 + sub comment 105 105 + { 106 106 + my $self = shift; 107 107 + my $key = shift; 108 108 + 109 109 + # if the user supplied key does not exist, return undef 110 110 + unless($self->{'COMMENTS'}{lc $key}) 111 111 + { 112 112 + return undef; 113 113 + } 114 114 + 115 115 + return @{$self->{'COMMENTS'}{lc $key}}; 116 116 + } 117 117 + 118 118 + sub add_comments 119 119 + { 120 120 + warn "Ogg::Vorbis::Header::PurePerl add_comments() unimplemented."; 121 121 + } 122 122 + 123 123 + sub edit_comment 124 124 + { 125 125 + warn "Ogg::Vorbis::Header::PurePerl edit_comment() unimplemented."; 126 126 + } 127 127 + 128 128 + sub delete_comment 129 129 + { 130 130 + warn "Ogg::Vorbis::Header::PurePerl delete_comment() unimplemented."; 131 131 + } 132 132 + 133 133 + sub clear_comments 134 134 + { 135 135 + warn "Ogg::Vorbis::Header::PurePerl clear_comments() unimplemented."; 136 136 + } 137 137 + 138 138 + sub path 139 139 + { 140 140 + my $self = shift; 141 141 + 142 142 + return $self->{'fileName'}; 143 143 + } 144 144 + 145 145 + sub write_vorbis 146 146 + { 147 147 + warn "Ogg::Vorbis::Header::PurePerl write_vorbis unimplemented."; 148 148 + } 149 149 + 150 150 + # "private" methods 151 151 + 152 152 + sub _init 153 153 + { 154 154 + my $data = shift; 155 155 + my $fh = $data->{'fileHandle'}; 156 156 + my $byteCount = 0; 157 157 + 158 158 + # check the header to make sure this is actually an Ogg-Vorbis file 159 159 + $byteCount = _checkHeader($data); 160 160 + 161 161 + unless($byteCount) 162 162 + { 163 163 + # if it's not, we can't do anything 164 164 + return undef; 165 165 + } 166 166 + 167 167 + $data->{'startInfoHeader'} = $byteCount; 168 168 + return 1; # Success 169 169 + } 170 170 + 171 171 + sub _checkHeader 172 172 + { 173 173 + my $data = shift; 174 174 + my $fh = $data->{'fileHandle'}; 175 175 + my $buffer; 176 176 + my $pageSegCount; 177 177 + my $byteCount = 0; # stores how far into the file we've read, 178 178 + # so later reads into the file can skip right 179 179 + # past all of the header stuff 180 180 + 181 181 + # check that the first four bytes are 'OggS' 182 182 + read($fh, $buffer, 4); 183 183 + if ($buffer ne 'OggS') 184 184 + { 185 185 + warn "This is not an Ogg bitstream (no OggS header)."; 186 186 + return undef; 187 187 + } 188 188 + $byteCount += 4; 189 189 + 190 190 + # check the stream structure version (1 byte, should be 0x00) 191 191 + read($fh, $buffer, 1); 192 192 + if (ord($buffer) != 0x00) 193 193 + { 194 194 + warn "This is not an Ogg bitstream (invalid structure version)."; 195 195 + return undef; 196 196 + } 197 197 + $byteCount += 1; 198 198 + 199 199 + # check the header type flag 200 200 + # This is a bitfield, so technically we should check all of the bits 201 201 + # that could potentially be set. However, the only value this should 202 202 + # possibly have at the beginning of a proper Ogg-Vorbis file is 0x02, 203 203 + # so we just check for that. If it's not that, we go on anyway, but 204 204 + # give a warning (this behavior may (should?) be modified in the future. 205 205 + read($fh, $buffer, 1); 206 206 + if (ord($buffer) != 0x02) 207 207 + { 208 208 + warn "Invalid header type flag (trying to go ahead anyway)."; 209 209 + } 210 210 + $byteCount += 1; 211 211 + 212 212 + # skip to the page_segments count 213 213 + read($fh, $buffer, 20); 214 214 + $byteCount += 20; 215 215 + # we do nothing with this data 216 216 + 217 217 + # read the number of page segments 218 218 + read($fh, $buffer, 1); 219 219 + $pageSegCount = ord($buffer); 220 220 + $byteCount += 1; 221 221 + 222 222 + # read $pageSegCount bytes, then throw 'em out 223 223 + read($fh, $buffer, $pageSegCount); 224 224 + $byteCount += $pageSegCount; 225 225 + 226 226 + # check packet type. Should be 0x01 (for indentification header) 227 227 + read($fh, $buffer, 1); 228 228 + if (ord($buffer) != 0x01) 229 229 + { 230 230 + warn "Wrong vorbis header type, giving up."; 231 231 + return undef; 232 232 + } 233 233 + $byteCount += 1; 234 234 + 235 235 + # check that the packet identifies itself as 'vorbis' 236 236 + read($fh, $buffer, 6); 237 237 + if ($buffer ne 'vorbis') 238 238 + { 239 239 + warn "This does not appear to be a vorbis stream, giving up."; 240 240 + return undef; 241 241 + } 242 242 + $byteCount += 6; 243 243 + 244 244 + # at this point, we assume the bitstream is valid 245 245 + return $byteCount; 246 246 + } 247 247 + 248 248 + sub _loadInfo 249 249 + { 250 250 + my $data = shift; 251 251 + my $start = $data->{'startInfoHeader'}; 252 252 + my $fh = $data->{'fileHandle'}; 253 253 + my $buffer; 254 254 + my $byteCount = $start; 255 255 + my %info; 256 256 + 257 257 + seek $fh, $start, 0; 258 258 + 259 259 + # read the vorbis version 260 260 + read($fh, $buffer, 4); 261 261 + $info{'version'} = _decodeInt($buffer); 262 262 + $byteCount += 4; 263 263 + 264 264 + # read the number of audio channels 265 265 + read($fh, $buffer, 1); 266 266 + $info{'channels'} = ord($buffer); 267 267 + $byteCount += 1; 268 268 + 269 269 + # read the sample rate 270 270 + read($fh, $buffer, 4); 271 271 + $info{'rate'} = _decodeInt($buffer); 272 272 + $byteCount += 4; 273 273 + 274 274 + # read the bitrate maximum 275 275 + read($fh, $buffer, 4); 276 276 + $info{'bitrate_upper'} = _decodeInt($buffer); 277 277 + $byteCount += 4; 278 278 + 279 279 + # read the bitrate nominal 280 280 + read($fh, $buffer, 4); 281 281 + $info{'bitrate_nominal'} = _decodeInt($buffer); 282 282 + $byteCount += 4; 283 283 + 284 284 + # read the bitrate minimal 285 285 + read($fh, $buffer, 4); 286 286 + $info{'bitrate_lower'} = _decodeInt($buffer); 287 287 + $byteCount += 4; 288 288 + 289 289 + # read the blocksize_0 and blocksize_1 290 290 + read($fh, $buffer, 1); 291 291 + # these are each 4 bit fields, whose actual value is 2 to the power 292 292 + # of the value of the field 293 293 + $info{'blocksize_0'} = 2 << ((ord($buffer) & 0xF0) >> 4); 294 294 + $info{'blocksize_1'} = 2 << (ord($buffer) & 0x0F); 295 295 + $byteCount += 1; 296 296 + 297 297 + # read the framing_flag 298 298 + read($fh, $buffer, 1); 299 299 + $info{'framing_flag'} = ord($buffer); 300 300 + $byteCount += 1; 301 301 + 302 302 + # bitrate_window is -1 in the current version of vorbisfile 303 303 + $info{'bitrate_window'} = -1; 304 304 + 305 305 + $data->{'startCommentHeader'} = $byteCount; 306 306 + 307 307 + $data->{'INFO'} = \%info; 308 308 + } 309 309 + 310 310 + sub _loadComments 311 311 + { 312 312 + my $data = shift; 313 313 + my $fh = $data->{'fileHandle'}; 314 314 + my $start = $data->{'startCommentHeader'}; 315 315 + my $buffer; 316 316 + my $page_segments; 317 317 + my $vendor_length; 318 318 + my $user_comment_count; 319 319 + my $byteCount = $start; 320 320 + my %comments; 321 321 + 322 322 + seek $fh, $start, 0; 323 323 + 324 324 + # check that the first four bytes are 'OggS' 325 325 + read($fh, $buffer, 4); 326 326 + if ($buffer ne 'OggS') 327 327 + { 328 328 + warn "No comment header?"; 329 329 + return undef; 330 330 + } 331 331 + $byteCount += 4; 332 332 + 333 333 + # skip over next ten bytes 334 334 + read($fh, $buffer, 10); 335 335 + $byteCount += 10; 336 336 + 337 337 + # read the stream serial number 338 338 + read($fh, $buffer, 4); 339 339 + push @{$data->{'commentSerialNumber'}}, _decodeInt($buffer); 340 340 + $byteCount += 4; 341 341 + 342 342 + # read the page sequence number (should be 0x01) 343 343 + read($fh, $buffer, 4); 344 344 + if (_decodeInt($buffer) != 0x01) 345 345 + { 346 346 + warn "Comment header page sequence number is not 0x01: " + 347 347 + _decodeInt($buffer); 348 348 + warn "Going to keep going anyway."; 349 349 + } 350 350 + $byteCount += 4; 351 351 + 352 352 + # and ignore the page checksum for now 353 353 + read($fh, $buffer, 4); 354 354 + $byteCount += 4; 355 355 + 356 356 + # get the number of entries in the segment_table... 357 357 + read($fh, $buffer, 1); 358 358 + $page_segments = _decodeInt($buffer); 359 359 + $byteCount += 1; 360 360 + # then skip on past it 361 361 + read($fh, $buffer, $page_segments); 362 362 + $byteCount += $page_segments; 363 363 + 364 364 + # check the header type (should be 0x03) 365 365 + read($fh, $buffer, 1); 366 366 + if (ord($buffer) != 0x03) 367 367 + { 368 368 + warn "Wrong header type: " . ord($buffer); 369 369 + } 370 370 + $byteCount += 1; 371 371 + 372 372 + # now we should see 'vorbis' 373 373 + read($fh, $buffer, 6); 374 374 + if ($buffer ne 'vorbis') 375 375 + { 376 376 + warn "Missing comment header. Should have found 'vorbis', found " . 377 377 + $buffer; 378 378 + } 379 379 + $byteCount += 6; 380 380 + 381 381 + # get the vendor length 382 382 + read($fh, $buffer, 4); 383 383 + $vendor_length = _decodeInt($buffer); 384 384 + $byteCount += 4; 385 385 + 386 386 + # read in the vendor 387 387 + read($fh, $buffer, $vendor_length); 388 388 + $comments{'vendor'} = $buffer; 389 389 + $byteCount += $vendor_length; 390 390 + 391 391 + # read in the number of user comments 392 392 + read($fh, $buffer, 4); 393 393 + $user_comment_count = _decodeInt($buffer); 394 394 + $byteCount += 4; 395 395 + 396 396 + $data->{'COMMENT_KEYS'} = []; 397 397 + 398 398 + # finally, read the comments 399 399 + for (my $i = 0; $i < $user_comment_count; $i++) 400 400 + { 401 401 + # first read the length 402 402 + read($fh, $buffer, 4); 403 403 + my $comment_length = _decodeInt($buffer); 404 404 + $byteCount += 4; 405 405 + 406 406 + # then the comment itself 407 407 + read($fh, $buffer, $comment_length); 408 408 + $byteCount += $comment_length; 409 409 + 410 410 + my ($key) = $buffer =~ /^([^=]+)/; 411 411 + my ($value) = $buffer =~ /=(.*)$/; 412 412 + 413 413 + push @{$comments{lc $key}}, $value; 414 414 + push @{$data->{'COMMENT_KEYS'}}, lc $key; 415 415 + } 416 416 + 417 417 + # read past the framing_bit 418 418 + read($fh, $buffer, 1); 419 419 + $byteCount += 1; 420 420 + 421 421 + $data->{'INFO'}{'offset'} = $byteCount; 422 422 + 423 423 + $data->{'COMMENTS'} = \%comments; 424 424 + 425 425 + # Now find the offset of the first page 426 426 + # with audio data. 427 427 + while(_findPage($fh)) 428 428 + { 429 429 + $byteCount = tell($fh) - 4; 430 430 + 431 431 + # version flag 432 432 + read($fh, $buffer, 1); 433 433 + if (ord($buffer) != 0x00) 434 434 + { 435 435 + warn "Invalid stream structure version: " . 436 436 + sprintf("%x", ord($buffer)); 437 437 + return; 438 438 + } 439 439 + 440 440 + # header type flag 441 441 + read($fh, $buffer, 1); 442 442 + # Audio data starts as a fresh packet on a new page, so 443 443 + # if header_type is odd it's not a fresh packet 444 444 + next if ( ord($buffer) % 2 ); 445 445 + 446 446 + # skip past granule position, stream_serial_number, 447 447 + # page_sequence_number, and crc 448 448 + read($fh, $buffer, 20); 449 449 + 450 450 + # page_segments 451 451 + read($fh, $buffer, 1); 452 452 + my $page_segments = ord($buffer); 453 453 + 454 454 + # skip past the segment table 455 455 + read($fh, $buffer, $page_segments); 456 456 + 457 457 + # read packet_type byte 458 458 + read($fh, $buffer, 1); 459 459 + 460 460 + # Not an audio packet. All audio packet numbers are even 461 461 + next if ( ord($buffer) % 2 ); 462 462 + 463 463 + # Found the first audio packet 464 464 + last; 465 465 + } 466 466 + 467 467 + $data->{'INFO'}{'audio_offset'} = $byteCount; 468 468 + } 469 469 + 470 470 + sub _calculateTrackLength 471 471 + { 472 472 + my $data = shift; 473 473 + my $fh = $data->{'fileHandle'}; 474 474 + my $buffer; 475 475 + my $pageSize; 476 476 + my $granule_position; 477 477 + 478 478 + seek($fh,-8500,SEEK_END); # that magic number is from vorbisfile.c 479 479 + # in the constant CHUNKSIZE, which comes 480 480 + # with the comment /* a shade over 8k; 481 481 + # anyone using pages well over 8k gets 482 482 + # what they deserve */ 483 483 + 484 484 + # we just keep looking through the headers until we get to the last one 485 485 + # (there might be a couple of blocks here) 486 486 + while(_findPage($fh)) 487 487 + { 488 488 + # stream structure version - must be 0x00 489 489 + read($fh, $buffer, 1); 490 490 + if (ord($buffer) != 0x00) 491 491 + { 492 492 + warn "Invalid stream structure version: " . 493 493 + sprintf("%x", ord($buffer)); 494 494 + return; 495 495 + } 496 496 + 497 497 + # header type flag 498 498 + read($fh, $buffer, 1); 499 499 + # we should check this, but for now we'll just ignore it 500 500 + 501 501 + # absolute granule position - this is what we need! 502 502 + read($fh, $buffer, 8); 503 503 + $granule_position = _decodeInt($buffer); 504 504 + 505 505 + # skip past stream_serial_number, page_sequence_number, and crc 506 506 + read($fh, $buffer, 12); 507 507 + 508 508 + # page_segments 509 509 + read($fh, $buffer, 1); 510 510 + my $page_segments = ord($buffer); 511 511 + 512 512 + # reset pageSize 513 513 + $pageSize = 0; 514 514 + 515 515 + # calculate approx. page size 516 516 + for (my $i = 0; $i < $page_segments; $i++) 517 517 + { 518 518 + read($fh, $buffer, 1); 519 519 + $pageSize += ord($buffer); 520 520 + } 521 521 + 522 522 + seek $fh, $pageSize, 1; 523 523 + } 524 524 + 525 525 + $data->{'INFO'}{'length'} = 526 526 + int($granule_position / $data->{'INFO'}{'rate'}); 527 527 + } 528 528 + 529 529 + sub _findPage 530 530 + { 531 531 + # search forward in the file for the 'OggS' page header 532 532 + my $fh = shift; 533 533 + my $char; 534 534 + my $curStr = ''; 535 535 + 536 536 + while (read($fh, $char, 1)) 537 537 + { 538 538 + $curStr = $char . $curStr; 539 539 + $curStr = substr($curStr, 0, 4); 540 540 + 541 541 + # we are actually looking for the string 'SggO' because we 542 542 + # tack character on to our test string backwards, to make 543 543 + # trimming it to 4 characters easier. 544 544 + if ($curStr eq 'SggO') 545 545 + { 546 546 + return 1; 547 547 + } 548 548 + } 549 549 + 550 550 + return undef; 551 551 + } 552 552 + 553 553 + sub _decodeInt 554 554 + { 555 555 + my $bytes = shift; 556 556 + my $num = 0; 557 557 + my @byteList = split //, $bytes; 558 558 + my $numBytes = @byteList; 559 559 + my $mult = 1; 560 560 + 561 561 + for (my $i = 0; $i < $numBytes; $i ++) 562 562 + { 563 563 + $num += ord($byteList[$i]) * $mult; 564 564 + $mult *= 256; 565 565 + } 566 566 + 567 567 + return $num; 568 568 + } 569 569 + 570 570 + sub _decodeInt5Bit 571 571 + { 572 572 + my $byte = ord(shift); 573 573 + 574 574 + $byte = $byte & 0xF8; # clear out the bottm 3 bits 575 575 + $byte = $byte >> 3; # and shifted down to where it belongs 576 576 + 577 577 + return $byte; 578 578 + } 579 579 + 580 580 + sub _decodeInt4Bit 581 581 + { 582 582 + my $byte = ord(shift); 583 583 + 584 584 + $byte = $byte & 0xFC; # clear out the bottm 4 bits 585 585 + $byte = $byte >> 4; # and shifted down to where it belongs 586 586 + 587 587 + return $byte; 588 588 + } 589 589 + 590 590 + sub _ilog 591 591 + { 592 592 + my $x = shift; 593 593 + my $ret = 0; 594 594 + 595 595 + unless ($x > 0) 596 596 + { 597 597 + return 0; 598 598 + } 599 599 + 600 600 + while ($x > 0) 601 601 + { 602 602 + $ret++; 603 603 + $x = $x >> 1; 604 604 + } 605 605 + 606 606 + return $ret; 607 607 + } 608 608 + 609 609 + 1; 610 610 + __DATA__ 611 611 + 612 612 + =head1 NAME 613 613 + 614 614 + Ogg::Vorbis::Header::PurePerl - An object-oriented interface to Ogg Vorbis 615 615 + information and comment fields, implemented entirely in Perl. Intended to be 616 616 + a drop in replacement for Ogg::Vobis::Header. 617 617 + 618 618 + Unlike Ogg::Vorbis::Header, this module will go ahead and fill in all of the 619 619 + information fields as soon as you construct the object. In other words, 620 620 + the C<new> and C<load> constructors have identical behavior. 621 621 + 622 622 + =head1 SYNOPSIS 623 623 + 624 624 + use Ogg::Vorbis::Header::PurePerl; 625 625 + my $ogg = Ogg::Vorbis::Header::PurePerl->new("song.ogg"); 626 626 + while (my ($k, $v) = each %{$ogg->info}) { 627 627 + print "$k: $v\n"; 628 628 + } 629 629 + foreach my $com ($ogg->comment_tags) { 630 630 + print "$com: $_\n" foreach $ogg->comment($com); 631 631 + } 632 632 + 633 633 + =head1 DESCRIPTION 634 634 + 635 635 + This module is intended to be a drop in replacement for Ogg::Vorbis::Header, 636 636 + implemented entirely in Perl. It provides an object-oriented interface to 637 637 + Ogg Vorbis information and comment fields. (NOTE: This module currently 638 638 + supports only read operations). 639 639 + 640 640 + =head1 CONSTRUCTORS 641 641 + 642 642 + =head2 C<new ($filename)> 643 643 + 644 644 + Opens an Ogg Vorbis file, ensuring that it exists and is actually an 645 645 + Ogg Vorbis stream. This method does not actually read any of the 646 646 + information or comment fields, and closes the file immediately. 647 647 + 648 648 + =head2 C<load ([$filename])> 649 649 + 650 650 + Opens an Ogg Vorbis file, ensuring that it exists and is actually an 651 651 + Ogg Vorbis stream, then loads the information and comment fields. This 652 652 + method can also be used without a filename to load the information 653 653 + and fields of an already constructed instance. 654 654 + 655 655 + =head1 INSTANCE METHODS 656 656 + 657 657 + =head2 C<info ([$key])> 658 658 + 659 659 + Returns a hashref containing information about the Ogg Vorbis file from 660 660 + the file's information header. Hash fields are: version, channels, rate, 661 661 + bitrate_upper, bitrate_nominal, bitrate_lower, bitrate_window, and length. 662 662 + The bitrate_window value is not currently used by the vorbis codec, and 663 663 + will always be -1. 664 664 + 665 665 + The optional parameter, key, allows you to retrieve a single value from 666 666 + the object's hash. Returns C<undef> if the key is not found. 667 667 + 668 668 + =head2 C<comment_tags ()> 669 669 + 670 670 + Returns an array containing the key values for the comment fields. 671 671 + These values can then be passed to C<comment> to retrieve their values. 672 672 + 673 673 + =head2 C<comment ($key)> 674 674 + 675 675 + Returns an array of comment values associated with the given key. 676 676 + 677 677 + =head2 C<add_comments ($key, $value, [$key, $value, ...])> 678 678 + 679 679 + Unimplemented. 680 680 + 681 681 + =head2 C<edit_comment ($key, $value, [$num])> 682 682 + 683 683 + Unimplemented. 684 684 + 685 685 + =head2 C<delete_comment ($key, [$num])> 686 686 + 687 687 + Unimplemented. 688 688 + 689 689 + =head2 C<clear_comments ([@keys])> 690 690 + 691 691 + Unimplemented. 692 692 + 693 693 + =head2 C<write_vorbis ()> 694 694 + 695 695 + Unimplemented. 696 696 + 697 697 + =head2 C<path ()> 698 698 + 699 699 + Returns the path/filename of the file the object represents. 700 700 + 701 701 + =head1 NOTE 702 702 + 703 703 + This is ALPHA SOFTWARE. It may very well be very broken. Do not use it in 704 704 + a production environment. You have been warned. 705 705 + 706 706 + =head1 ACKNOWLEDGEMENTS 707 707 + 708 708 + Dave Brown <cpan@dagbrown.com> made this module significantly faster 709 709 + at calculating the length of ogg files. 710 710 + 711 711 + Robert Moser II <rlmoser@earthlink.net> fixed a problem with files that 712 712 + have no comments. 713 713 + 714 714 + =head1 AUTHOR 715 715 + 716 716 + Andrew Molloy E<lt>amolloy@kaizolabs.comE<gt> 717 717 + 718 718 + =head1 COPYRIGHT 719 719 + 720 720 + Copyright (c) 2003, Andrew Molloy. All Rights Reserved. 721 721 + 722 722 + This program is free software; you can redistribute it and/or modify it 723 723 + under the terms of the GNU General Public License as published by the 724 724 + Free Software Foundation; either version 2 of the License, or (at 725 725 + your option) any later version. A copy of this license is included 726 726 + with this module (LICENSE.GPL). 727 727 + 728 728 + =head1 SEE ALSO 729 729 + 730 730 + L<Ogg::Vorbis::Header>, L<Ogg::Vorbis::Decoder> 731 731 + 732 732 + =cut