1package Audio::FLAC::Header; 2 3# $Id$ 4 5use strict; 6use File::Basename; 7 8our $VERSION = '2.4'; 9our $HAVE_XS = 0; 10 11# First four bytes of stream are always fLaC 12my $FLACHEADERFLAG = 'fLaC'; 13my $ID3HEADERFLAG = 'ID3'; 14 15# Masks for METADATA_BLOCK_HEADER 16my $LASTBLOCKFLAG = 0x80000000; 17my $BLOCKTYPEFLAG = 0x7F000000; 18my $BLOCKLENFLAG = 0x00FFFFFF; 19 20# Enumerated Block Types 21my $BT_STREAMINFO = 0; 22my $BT_PADDING = 1; 23my $BT_APPLICATION = 2; 24my $BT_SEEKTABLE = 3; 25my $BT_VORBIS_COMMENT = 4; 26my $BT_CUESHEET = 5; 27my $BT_PICTURE = 6; 28 29my $VENDOR_STRING = __PACKAGE__ . " v$VERSION"; 30 31my %BLOCK_TYPES = ( 32 $BT_STREAMINFO => '_parseStreamInfo', 33 $BT_APPLICATION => '_parseAppBlock', 34# The seektable isn't actually useful yet, and is a big performance hit. 35# $BT_SEEKTABLE => '_parseSeekTable', 36 $BT_VORBIS_COMMENT => '_parseVorbisComments', 37 $BT_CUESHEET => '_parseCueSheet', 38 $BT_PICTURE => '_parsePicture', 39); 40 41XS_BOOT: { 42 # If I inherit DynaLoader then I inherit AutoLoader 43 require DynaLoader; 44 45 # DynaLoader calls dl_load_flags as a static method. 46 *dl_load_flags = DynaLoader->can('dl_load_flags'); 47 48 $HAVE_XS = eval { 49 50 do {__PACKAGE__->can('bootstrap') || \&DynaLoader::bootstrap}->(__PACKAGE__, $VERSION); 51 52 return 1; 53 }; 54 55 # Try to use the faster code first. 56 if ($HAVE_XS) { 57 *new = \&_new_XS; 58 *write = \&_write_XS; 59 } else { 60 *new = \&_new_PP; 61 *write = \&_write_PP; 62 } 63} 64 65sub _new_PP { 66 my ($class, $file) = @_; 67 68 # open up the file 69 open(my $fh, $file) or die "[$file] does not exist or cannot be read: $!"; 70 71 # make sure dos-type systems can handle it... 72 binmode($fh); 73 74 my $self = { 75 'fileSize' => -s $file, 76 'filename' => $file, 77 }; 78 79 bless $self, $class; 80 81 # check the header to make sure this is actually a FLAC file 82 my $byteCount = $self->_checkHeader($fh) || 0; 83 84 if ($byteCount <= 0) { 85 86 close($fh); 87 die "[$file] does not appear to be a FLAC file!"; 88 } 89 90 $self->{'startMetadataBlocks'} = $byteCount; 91 92 # Grab the metadata blocks from the FLAC file 93 if (!$self->_getMetadataBlocks($fh)) { 94 95 close($fh); 96 die "[$file] Unable to read metadata from FLAC!"; 97 }; 98 99 # Always set to empty hash in the case of no comments. 100 $self->{'tags'} = {}; 101 102 for my $block (@{$self->{'metadataBlocks'}}) { 103 104 my $method = $BLOCK_TYPES{ $block->{'blockType'} } || next; 105 106 $self->$method($block); 107 } 108 109 close($fh); 110 111 return $self; 112} 113 114sub info { 115 my $self = shift; 116 my $key = shift; 117 118 # if the user did not supply a key, return a hashref 119 return $self->{'info'} unless $key; 120 121 # otherwise, return the value for the given key 122 return $self->{'info'}->{$key}; 123} 124 125sub tags { 126 my $self = shift; 127 my $key = shift; 128 129 # if the user did not supply a key, return a hashref 130 return $self->{'tags'} unless $key; 131 132 # otherwise, return the value for the given key 133 return $self->{'tags'}->{$key}; 134} 135 136sub cuesheet { 137 my $self = shift; 138 139 # if the cuesheet block exists, return it as an arrayref 140 return $self->{'cuesheet'} if exists($self->{'cuesheet'}); 141 142 # otherwise, return an empty arrayref 143 return []; 144} 145 146sub seektable { 147 my $self = shift; 148 149 # if the seekpoint table block exists, return it as an arrayref 150 return $self->{'seektable'} if exists($self->{'seektable'}); 151 152 # otherwise, return an empty arrayref 153 return []; 154} 155 156sub application { 157 my $self = shift; 158 my $appID = shift || "default"; 159 160 # if the application block exists, return it's content 161 return $self->{'application'}->{$appID} if exists($self->{'application'}->{$appID}); 162 163 # otherwise, return nothing 164 return undef; 165} 166 167sub picture { 168 my $self = shift; 169 my $type = shift; 170 $type = 3 unless defined ($type); # defaults to front cover 171 172 if ($type eq 'all') { 173 return $self->{'allpictures'} if exists($self->{'allpictures'}); 174 } 175 176 # Also look for other types of images 177 # http://flac.sourceforge.net/format.html#metadata_block_picture 178 my @types = ($type, 4, 0, 5..20); 179 180 # if the picture block exists, return it's content 181 for (@types) { 182 return $self->{'picture'}->{$_} if exists $self->{'picture'}->{$_}; 183 } 184 185 # otherwise, return nothing 186 return undef; 187} 188 189sub vendor_string { 190 my $self = shift; 191 192 return $self->{'tags'}->{'VENDOR'} || ''; 193} 194 195sub set_vendor_string { 196 my $self = shift; 197 my $value = shift || $VENDOR_STRING; 198 199 return $self->{'tags'}->{'VENDOR'} = $value; 200} 201 202sub set_separator { 203 my $self = shift; 204 205 $self->{'separator'} = shift; 206} 207 208sub _write_PP { 209 my $self = shift; 210 211 my @tagString = (); 212 my $numTags = 0; 213 my $numBlocks = 0; 214 215 my ($idxVorbis,$idxPadding); 216 my $totalAvail = 0; 217 my $metadataBlocks = $FLACHEADERFLAG; 218 my $tmpnum; 219 220 # Make a list of the tags and lengths for packing into the vorbis metadata block 221 foreach (keys %{$self->{'tags'}}) { 222 223 unless (/^VENDOR$/) { 224 push @tagString, $_ . "=" . $self->{'tags'}{$_}; 225 $numTags++; 226 } 227 } 228 229 # Create the contents of the vorbis comment metablock with the number of tags 230 my $vorbisComment = ""; 231 232 # Vendor comment must come first. 233 _addStringToComment(\$vorbisComment, ($self->{'tags'}->{'VENDOR'} || $VENDOR_STRING)); 234 235 $vorbisComment .= _packInt32($numTags); 236 237 # Finally, each tag string (with length) 238 foreach (@tagString) { 239 _addStringToComment(\$vorbisComment, $_); 240 } 241 242 # Is there enough space for this new header? 243 # Determine the length of the old comment block and the length of the padding available 244 $idxVorbis = $self->_findMetadataIndex($BT_VORBIS_COMMENT); 245 $idxPadding = $self->_findMetadataIndex($BT_PADDING); 246 247 if ($idxVorbis >= 0) { 248 # Add the length of the block 249 $totalAvail += $self->{'metadataBlocks'}[$idxVorbis]->{'blockSize'}; 250 } else { 251 # Subtract 4 (min size of block when added) 252 $totalAvail -= 4; 253 } 254 255 if ($idxPadding >= 0) { 256 # Add the length of the block 257 $totalAvail += $self->{'metadataBlocks'}[$idxPadding]->{'blockSize'}; 258 } else { 259 # Subtract 4 (min size of block when added) 260 $totalAvail -= 4; 261 } 262 263 # Check for not enough space to write tag without 264 # re-writing entire file (not within scope) 265 if ($totalAvail - length($vorbisComment) < 0) { 266 warn "Unable to write Vorbis tags - not enough header space!"; 267 return 0; 268 } 269 270 # Modify the metadata blocks to reflect new header sizes 271 272 # Is there a Vorbis metadata block? 273 if ($idxVorbis < 0) { 274 # no vorbis block, so add one 275 _addNewMetadataBlock($self, $BT_VORBIS_COMMENT, $vorbisComment); 276 } else { 277 # update the vorbis block 278 _updateMetadataBlock($self, $idxVorbis, $vorbisComment); 279 } 280 281 # Is there a Padding block? 282 # Change the padding to reflect the new vorbis comment size 283 if ($idxPadding < 0) { 284 # no padding block 285 _addNewMetadataBlock($self, $BT_PADDING , "\0" x ($totalAvail - length($vorbisComment))); 286 } else { 287 # update the padding block 288 _updateMetadataBlock($self, $idxPadding, "\0" x ($totalAvail - length($vorbisComment))); 289 } 290 291 $numBlocks = @{$self->{'metadataBlocks'}}; 292 293 # Sort so that all the padding is at the end. 294 # Our version of FLAC__metadata_chain_sort_padding() 295 for (my $i = 0; $i < $numBlocks; $i++) { 296 297 my $block = $self->{'metadataBlocks'}->[$i]; 298 299 if ($block->{'blockType'} == $BT_PADDING) { 300 301 if (my $next = splice(@{$self->{'metadataBlocks'}}, $i+1, 1)) { 302 splice(@{$self->{'metadataBlocks'}}, $i, 1, $next); 303 push @{$self->{'metadataBlocks'}}, $block; 304 } 305 } 306 } 307 308 # Now set the last block. 309 $self->{'metadataBlocks'}->[-1]->{'lastBlockFlag'} = 1; 310 311 # Create the metadata block structure for the FLAC file 312 foreach (@{$self->{'metadataBlocks'}}) { 313 $tmpnum = $_->{'lastBlockFlag'} << 31; 314 $tmpnum |= $_->{'blockType'} << 24; 315 $tmpnum |= $_->{'blockSize'}; 316 $metadataBlocks .= pack "N", $tmpnum; 317 $metadataBlocks .= $_->{'contents'}; 318 } 319 320 # open FLAC file and write new metadata blocks 321 open FLACFILE, "+<$self->{'filename'}" or return 0; 322 binmode FLACFILE; 323 324 # overwrite the existing metadata blocks 325 my $ret = syswrite(FLACFILE, $metadataBlocks, length($metadataBlocks), 0); 326 327 close FLACFILE; 328 329 return $ret; 330} 331 332# private methods to this class 333sub _checkHeader { 334 my ($self, $fh) = @_; 335 336 # check that the first four bytes are 'fLaC' 337 read($fh, my $buffer, 4) or return -1; 338 339 if (substr($buffer,0,3) eq $ID3HEADERFLAG) { 340 341 $self->{'ID3V2Tag'} = 1; 342 343 my $id3size = ''; 344 345 # How big is the ID3 header? 346 # Skip the next two bytes - major & minor version number. 347 read($fh, $buffer, 2) or return -1; 348 349 # The size of the ID3 tag is a 'synchsafe' 4-byte uint 350 # Read the next 4 bytes one at a time, unpack each one B7, 351 # and concatenate. When complete, do a bin2dec to determine size 352 for (my $c = 0; $c < 4; $c++) { 353 read($fh, $buffer, 1) or return -1; 354 $id3size .= substr(unpack ("B8", $buffer), 1); 355 } 356 357 seek $fh, _bin2dec($id3size) + 10, 0; 358 read($fh, $buffer, 4) or return -1; 359 } 360 361 if ($buffer ne $FLACHEADERFLAG) { 362 warn "Unable to identify $self->{'filename'} as a FLAC bitstream!\n"; 363 return -2; 364 } 365 366 # at this point, we assume the bitstream is valid 367 return tell($fh); 368} 369 370sub _getMetadataBlocks { 371 my ($self, $fh) = @_; 372 373 my $metadataBlockList = []; 374 my $numBlocks = 0; 375 my $lastBlockFlag = 0; 376 my $buffer; 377 378 # Loop through all of the metadata blocks 379 while ($lastBlockFlag == 0) { 380 381 # Read the next metadata_block_header 382 read($fh, $buffer, 4) or return 0; 383 384 my $metadataBlockHeader = unpack('N', $buffer); 385 386 # Break out the contents of the metadata_block_header 387 my $metadataBlockType = ($BLOCKTYPEFLAG & $metadataBlockHeader)>>24; 388 my $metadataBlockLength = ($BLOCKLENFLAG & $metadataBlockHeader); 389 $lastBlockFlag = ($LASTBLOCKFLAG & $metadataBlockHeader)>>31; 390 391 # If the block size is zero go to the next block 392 next unless $metadataBlockLength; 393 394 # Read the contents of the metadata_block 395 read($fh, my $metadataBlockData, $metadataBlockLength) or return 0; 396 397 # Store the parts in the list 398 $metadataBlockList->[$numBlocks++] = { 399 'lastBlockFlag' => $lastBlockFlag, 400 'blockType' => $metadataBlockType, 401 'blockSize' => $metadataBlockLength, 402 'contents' => $metadataBlockData 403 }; 404 } 405 406 # Store the metadata blocks in the hash 407 $self->{'metadataBlocks'} = $metadataBlockList; 408 $self->{'startAudioData'} = tell $fh; 409 410 return 1; 411} 412 413sub _parseStreamInfo { 414 my ($self, $block) = @_; 415 416 my $info = {}; 417 418 # Convert to binary string, since there's some unfriendly lengths ahead 419 my $metaBinString = unpack('B144', $block->{'contents'}); 420 421 my $x32 = 0 x 32; 422 423 $info->{'MINIMUMBLOCKSIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 0, 16), -32))); 424 $info->{'MAXIMUMBLOCKSIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 16, 16), -32))); 425 $info->{'MINIMUMFRAMESIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 32, 24), -32))); 426 $info->{'MAXIMUMFRAMESIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 56, 24), -32))); 427 428 $info->{'SAMPLERATE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 80, 20), -32))); 429 $info->{'NUMCHANNELS'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 100, 3), -32))) + 1; 430 $info->{'BITSPERSAMPLE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 103, 5), -32))) + 1; 431 432 # Calculate total samples in two parts 433 my $highBits = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 108, 4), -32))); 434 435 $info->{'TOTALSAMPLES'} = $highBits * 2 ** 32 + 436 unpack('N', pack('B32', substr($x32 . substr($metaBinString, 112, 32), -32))); 437 438 # Return the MD5 as a 32-character hexadecimal string 439 #$info->{'MD5CHECKSUM'} = unpack('H32',substr($self->{'metadataBlocks'}[$idx]->{'contents'},18,16)); 440 $info->{'MD5CHECKSUM'} = unpack('H32',substr($block->{'contents'}, 18, 16)); 441 442 # Store in the data hash 443 $self->{'info'} = $info; 444 445 # Calculate the track times 446 my $totalSeconds = $info->{'TOTALSAMPLES'} / $info->{'SAMPLERATE'}; 447 448 if ($totalSeconds == 0) { 449 warn "totalSeconds is 0 - we couldn't find either TOTALSAMPLES or SAMPLERATE!\n" . 450 "setting totalSeconds to 1 to avoid divide by zero error!\n"; 451 452 $totalSeconds = 1; 453 } 454 455 $self->{'trackTotalLengthSeconds'} = $totalSeconds; 456 457 $self->{'trackLengthMinutes'} = int(int($totalSeconds) / 60); 458 $self->{'trackLengthSeconds'} = int($totalSeconds) % 60; 459 $self->{'trackLengthFrames'} = ($totalSeconds - int($totalSeconds)) * 75; 460 $self->{'bitRate'} = 8 * ($self->{'fileSize'} - $self->{'startAudioData'}) / $totalSeconds; 461 462 return 1; 463} 464 465sub _parseVorbisComments { 466 my ($self, $block) = @_; 467 468 my $tags = {}; 469 my $rawTags = []; 470 471 # Parse out the tags from the metadata block 472 my $tmpBlock = $block->{'contents'}; 473 my $offset = 0; 474 475 # First tag in block is the Vendor String 476 my $tagLen = unpack('V', substr($tmpBlock, $offset, 4)); 477 $tags->{'VENDOR'} = substr($tmpBlock, ($offset += 4), $tagLen); 478 479 # Now, how many additional tags are there? 480 my $numTags = unpack('V', substr($tmpBlock, ($offset += $tagLen), 4)); 481 482 $offset += 4; 483 484 for (my $tagi = 0; $tagi < $numTags; $tagi++) { 485 486 # Read the tag string 487 my $tagLen = unpack('V', substr($tmpBlock, $offset, 4)); 488 my $tagStr = substr($tmpBlock, ($offset += 4), $tagLen); 489 490 # Save the raw tag 491 push(@$rawTags, $tagStr); 492 493 # Match the key and value 494 if ($tagStr =~ /^(.*?)=(.*?)[\r\n]*$/s) { 495 496 my $tkey = $1; 497 498 # Stick it in the tag hash - and handle multiple tags 499 # of the same name. 500 if (exists $tags->{$tkey} && ref($tags->{$tkey}) ne 'ARRAY') { 501 502 my $oldValue = $tags->{$tkey}; 503 504 $tags->{$tkey} = [ $oldValue, $2 ]; 505 506 } elsif (ref($tags->{$tkey}) eq 'ARRAY') { 507 508 push @{$tags->{$tkey}}, $2; 509 510 } else { 511 512 $tags->{$tkey} = $2; 513 } 514 } 515 516 $offset += $tagLen; 517 } 518 519 $self->{'tags'} = $tags; 520 $self->{'rawTags'} = $rawTags; 521 522 return 1; 523} 524 525sub _parseCueSheet { 526 my ($self, $block) = @_; 527 528 my $cuesheet = []; 529 530 # Parse out the tags from the metadata block 531 my $tmpBlock = $block->{'contents'}; 532 533 # First field in block is the Media Catalog Number 534 my $catalog = substr($tmpBlock,0,128); 535 $catalog =~ s/\x00+.*$//gs; # trim nulls off of the end 536 537 push (@$cuesheet, "CATALOG $catalog\n") if length($catalog) > 0; 538 $tmpBlock = substr($tmpBlock,128); 539 540 # metaflac uses "dummy.wav" but we're going to use the actual filename 541 # this will help external parsers that have to associate the resulting 542 # cuesheet with this flac file. 543 push (@$cuesheet, "FILE \"" . basename("$self->{'filename'}") ."\" FLAC\n"); 544 545 # Next field is the number of lead-in samples for CD-DA 546 my $highbits = unpack('N', substr($tmpBlock,0,4)); 547 my $leadin = $highbits * 2 ** 32 + unpack('N', (substr($tmpBlock,4,4))); 548 $tmpBlock = substr($tmpBlock,8); 549 550 # Flag to determine if this represents a CD 551 my $bits = unpack('B8', substr($tmpBlock, 0, 1)); 552 my $isCD = substr($bits, 0, 1); 553 554 # Some sanity checking related to the CD flag 555 if ($isCD && length($catalog) != 13 && length($catalog) != 0) { 556 warn "Invalid Catalog entry\n"; 557 return -1; 558 } 559 560 if (!$isCD && $leadin > 0) { 561 warn "Lead-in detected for non-CD cue sheet.\n"; 562 return -1; 563 } 564 565 # The next few bits should be zero. 566 my $reserved = _bin2dec(substr($bits, 1, 7)); 567 $reserved += unpack('B*', substr($tmpBlock, 1, 258)); 568 569 if ($reserved != 0) { 570 warn "Either the cue sheet is corrupt, or it's a newer revision than I can parse\n"; 571 #return -1; # ?? may be harmless to continue ... 572 } 573 574 $tmpBlock = substr($tmpBlock,259); 575 576 # Number of tracks 577 my $numTracks = _bin2dec(unpack('B8',substr($tmpBlock,0,1))); 578 $tmpBlock = substr($tmpBlock,1); 579 580 if ($numTracks < 1 || ($isCD && $numTracks > 100)) { 581 warn "Invalid number of tracks $numTracks\n"; 582 return -1; 583 } 584 585 # Parse individual tracks now 586 my %seenTracknumber = (); 587 my $leadout = 0; 588 my $leadouttracknum = 0; 589 590 for (my $i = 1; $i <= $numTracks; $i++) { 591 592 $highbits = unpack('N', substr($tmpBlock,0,4)); 593 594 my $trackOffset = $highbits * 2 ** 32 + unpack('N', (substr($tmpBlock,4,4))); 595 596 if ($isCD && $trackOffset % 588) { 597 warn "Invalid track offset $trackOffset\n"; 598 return -1; 599 } 600 601 my $tracknum = _bin2dec(unpack('B8',substr($tmpBlock,8,1))) || do { 602 603 warn "Invalid track numbered \"0\" detected\n"; 604 return -1; 605 }; 606 607 if ($isCD && $tracknum > 99 && $tracknum != 170) { 608 warn "Invalid track number for a CD $tracknum\n"; 609 return -1; 610 } 611 612 if (defined $seenTracknumber{$tracknum}) { 613 warn "Invalid duplicate track number $tracknum\n"; 614 return -1; 615 } 616 617 $seenTracknumber{$tracknum} = 1; 618 619 my $isrc = substr($tmpBlock,9,12); 620 $isrc =~ s/\x00+.*$//; 621 622 if ((length($isrc) != 0) && (length($isrc) != 12)) { 623 warn "Invalid ISRC code $isrc\n"; 624 return -1; 625 } 626 627 $bits = unpack('B8', substr($tmpBlock, 21, 1)); 628 my $isAudio = !substr($bits, 0, 1); 629 my $preemphasis = substr($bits, 1, 1); 630 631 # The next few bits should be zero. 632 $reserved = _bin2dec(substr($bits, 2, 6)); 633 $reserved += unpack('B*', substr($tmpBlock, 22, 13)); 634 635 if ($reserved != 0) { 636 warn "Either the cue sheet is corrupt, " . 637 "or it's a newer revision than I can parse\n"; 638 #return -1; # ?? may be harmless to continue ... 639 } 640 641 my $numIndexes = _bin2dec(unpack('B8',substr($tmpBlock,35,1))); 642 643 $tmpBlock = substr($tmpBlock,36); 644 645 # If we're on the lead-out track, stop before pushing TRACK info 646 if ($i == $numTracks) { 647 $leadout = $trackOffset; 648 649 if ($isCD && $tracknum != 170) { 650 warn "Incorrect lead-out track number $tracknum for CD\n"; 651 return -1; 652 } 653 654 $leadouttracknum = $tracknum; 655 next; 656 } 657 658 # Add TRACK info to cuesheet 659 my $trackline = sprintf(" TRACK %02d %s\n", $tracknum, $isAudio ? "AUDIO" : "DATA"); 660 661 push (@$cuesheet, $trackline); 662 push (@$cuesheet, " FLAGS PRE\n") if ($preemphasis); 663 push (@$cuesheet, " ISRC " . $isrc . "\n") if ($isrc); 664 665 if ($numIndexes < 1 || ($isCD && $numIndexes > 100)) { 666 warn "Invalid number of Indexes $numIndexes for track $tracknum\n"; 667 return -1; 668 } 669 670 # Itterate through the indexes for this track 671 for (my $j = 0; $j < $numIndexes; $j++) { 672 673 $highbits = unpack('N', substr($tmpBlock,0,4)); 674 675 my $indexOffset = $highbits * 2 ** 32 + unpack('N', (substr($tmpBlock,4,4))); 676 677 if ($isCD && $indexOffset % 588) { 678 warn "Invalid index offset $indexOffset\n"; 679 return -1; 680 } 681 682 my $indexnum = _bin2dec(unpack('B8',substr($tmpBlock,8,1))); 683 #TODO: enforce sequential indexes 684 685 $reserved = 0; 686 $reserved += unpack('B*', substr($tmpBlock, 9, 3)); 687 688 if ($reserved != 0) { 689 warn "Either the cue sheet is corrupt, " . 690 "or it's a newer revision than I can parse\n"; 691 #return -1; # ?? may be harmless to continue ... 692 } 693 694 my $timeoffset = _samplesToTime(($trackOffset + $indexOffset), $self->{'info'}->{'SAMPLERATE'}); 695 696 return -1 unless defined ($timeoffset); 697 698 my $indexline = sprintf (" INDEX %02d %s\n", $indexnum, $timeoffset); 699 700 push (@$cuesheet, $indexline); 701 702 $tmpBlock = substr($tmpBlock,12); 703 } 704 } 705 706 # Add final comments just like metaflac would 707 push (@$cuesheet, "REM FLAC__lead-in " . $leadin . "\n"); 708 push (@$cuesheet, "REM FLAC__lead-out " . $leadouttracknum . " " . $leadout . "\n"); 709 710 $self->{'cuesheet'} = $cuesheet; 711 712 return 1; 713} 714 715sub _parsePicture { 716 my ($self, $block) = @_; 717 718 # Parse out the tags from the metadata block 719 my $tmpBlock = $block->{'contents'}; 720 my $offset = 0; 721 722 my $pictureType = unpack('N', substr($tmpBlock, $offset, 4)); 723 my $mimeLength = unpack('N', substr($tmpBlock, ($offset += 4), 4)); 724 my $mimeType = substr($tmpBlock, ($offset += 4), $mimeLength); 725 my $descLength = unpack('N', substr($tmpBlock, ($offset += $mimeLength), 4)); 726 my $description = substr($tmpBlock, ($offset += 4), $descLength); 727 my $width = unpack('N', substr($tmpBlock, ($offset += $descLength), 4)); 728 my $height = unpack('N', substr($tmpBlock, ($offset += 4), 4)); 729 my $depth = unpack('N', substr($tmpBlock, ($offset += 4), 4)); 730 my $colorIndex = unpack('N', substr($tmpBlock, ($offset += 4), 4)); 731 my $imageLength = unpack('N', substr($tmpBlock, ($offset += 4), 4)); 732 my $imageData = substr($tmpBlock, ($offset += 4), $imageLength); 733 734 $self->{'picture'}->{$pictureType}->{'mimeType'} = $mimeType; 735 $self->{'picture'}->{$pictureType}->{'description'} = $description; 736 $self->{'picture'}->{$pictureType}->{'width'} = $width; 737 $self->{'picture'}->{$pictureType}->{'height'} = $height; 738 $self->{'picture'}->{$pictureType}->{'depth'} = $depth; 739 $self->{'picture'}->{$pictureType}->{'colorIndex'} = $colorIndex; 740 $self->{'picture'}->{$pictureType}->{'imageData'} = $imageData; 741 $self->{'picture'}->{$pictureType}->{'pictureType'} = $pictureType; 742 743 # Create array of hashes with picture data from all the picture metadata blocks 744 push ( @{$self->{'allpictures'}}, {%{$self->{'picture'}->{$pictureType}}} ); 745 746 return 1; 747} 748 749sub _parseSeekTable { 750 my ($self, $block) = @_; 751 752 my $seektable = []; 753 754 # grab the seekpoint table 755 my $tmpBlock = $block->{'contents'}; 756 my $offset = 0; 757 758 # parse out the seekpoints 759 while (my $seekpoint = substr($tmpBlock, $offset, 18)) { 760 761 # Sample number of first sample in the target frame 762 my $highbits = unpack('N', substr($seekpoint,0,4)); 763 my $sampleNumber = $highbits * 2 ** 32 + unpack('N', (substr($seekpoint,4,4))); 764 765 # Detect placeholder seekpoint 766 # since the table is sorted, a placeholder means were finished 767 last if ($sampleNumber == (0xFFFFFFFF * 2 ** 32 + 0xFFFFFFFF)); 768 769 # Offset (in bytes) from the first byte of the first frame header 770 # to the first byte of the target frame's header. 771 $highbits = unpack('N', substr($seekpoint,8,4)); 772 my $streamOffset = $highbits * 2 ** 32 + unpack('N', (substr($seekpoint,12,4))); 773 774 # Number of samples in the target frame 775 my $frameSamples = unpack('n', (substr($seekpoint,16,2))); 776 777 # add this point to our copy of the table 778 push (@$seektable, { 779 'sampleNumber' => $sampleNumber, 780 'streamOffset' => $streamOffset, 781 'frameSamples' => $frameSamples, 782 }); 783 784 $offset += 18; 785 } 786 787 $self->{'seektable'} = $seektable; 788 789 return 1; 790} 791 792sub _parseAppBlock { 793 my ($self, $block) = @_; 794 795 # Parse out the tags from the metadata block 796 my $appID = unpack('N', substr($block->{'contents'}, 0, 4, '')); 797 798 $self->{'application'}->{$appID} = $block->{'contents'}; 799 800 return 1; 801} 802 803# Take an offset as number of flac samples 804# and return CD-DA style mm:ss:ff 805sub _samplesToTime { 806 my $samples = shift; 807 my $samplerate = shift; 808 809 if ($samplerate == 0) { 810 warn "Couldn't find SAMPLERATE for time calculation!\n"; 811 return; 812 } 813 814 my $totalSeconds = $samples / $samplerate; 815 816 if ($totalSeconds == 0) { 817 # handled specially to avoid division by zero errors 818 return "00:00:00"; 819 } 820 821 my $trackMinutes = int(int($totalSeconds) / 60); 822 my $trackSeconds = int($totalSeconds % 60); 823 my $trackFrames = ($totalSeconds - int($totalSeconds)) * 75; 824 825 # Poor man's rounding. Needed to match the output of metaflac. 826 $trackFrames = int($trackFrames + 0.5); 827 828 my $formattedTime = sprintf("%02d:%02d:%02d", $trackMinutes, $trackSeconds, $trackFrames); 829 830 return $formattedTime; 831} 832 833sub _bin2dec { 834 # Freely swiped from Perl Cookbook p. 48 (May 1999) 835 return unpack ('N', pack ('B32', substr(0 x 32 . $_[0], -32))); 836} 837 838sub _packInt32 { 839 # Packs an integer into a little-endian 32-bit unsigned int 840 return pack('V', $_[0]); 841} 842 843sub _findMetadataIndex { 844 my $self = shift; 845 my $htype = shift; 846 my $idx = shift || 0; 847 848 my $found = 0; 849 850 # Loop through the metadata_blocks until one of $htype is found 851 while ($idx < @{$self->{'metadataBlocks'}}) { 852 853 # Check the type to see if it's a $htype block 854 if ($self->{'metadataBlocks'}[$idx]->{'blockType'} == $htype) { 855 $found++; 856 last; 857 } 858 859 $idx++; 860 } 861 862 # No streaminfo found. Error. 863 return -1 if $found == 0; 864 return $idx; 865} 866 867sub _addStringToComment { 868 my $self = shift; 869 my $addString = shift; 870 871 $$self .= _packInt32(length($addString)); 872 $$self .= $addString; 873} 874 875sub _addNewMetadataBlock { 876 my $self = shift; 877 my $htype = shift; 878 my $contents = shift; 879 880 my $numBlocks = @{$self->{'metadataBlocks'}}; 881 882 # create a new block 883 $self->{'metadataBlocks'}->[$numBlocks]->{'lastBlockFlag'} = 0; 884 $self->{'metadataBlocks'}->[$numBlocks]->{'blockType'} = $htype; 885 $self->{'metadataBlocks'}->[$numBlocks]->{'blockSize'} = length($contents); 886 $self->{'metadataBlocks'}->[$numBlocks]->{'contents'} = $contents; 887} 888 889sub _updateMetadataBlock { 890 my $self = shift; 891 my $blockIdx = shift; 892 my $contents = shift; 893 894 # Update the block 895 $self->{'metadataBlocks'}->[$blockIdx]->{'blockSize'} = length($contents); 896 $self->{'metadataBlocks'}->[$blockIdx]->{'contents'} = $contents; 897} 898 8991; 900 901__END__ 902 903=head1 NAME 904 905Audio::FLAC::Header - interface to FLAC header metadata. 906 907=head1 SYNOPSIS 908 909 use Audio::FLAC::Header; 910 my $flac = Audio::FLAC::Header->new("song.flac"); 911 912 my $info = $flac->info(); 913 914 foreach (keys %$info) { 915 print "$_: $info->{$_}\n"; 916 } 917 918 my $tags = $flac->tags(); 919 920 foreach (keys %$tags) { 921 print "$_: $tags->{$_}\n"; 922 } 923 924=head1 DESCRIPTION 925 926This module returns a hash containing basic information about a FLAC file, 927a representation of the embedded cue sheet if one exists, as well as tag 928information contained in the FLAC file's Vorbis tags. 929There is no complete list of tag keys for Vorbis tags, as they can be 930defined by the user; the basic set of tags used for FLAC files include: 931 932 ALBUM 933 ARTIST 934 TITLE 935 DATE 936 GENRE 937 TRACKNUMBER 938 COMMENT 939 940The information returned by Audio::FLAC::info is keyed by: 941 942 MINIMUMBLOCKSIZE 943 MAXIMUMBLOCKSIZE 944 MINIMUMFRAMESIZE 945 MAXIMUMFRAMESIZE 946 TOTALSAMPLES 947 SAMPLERATE 948 NUMCHANNELS 949 BITSPERSAMPLE 950 MD5CHECKSUM 951 952Information stored in the main hash that relates to the file itself or is 953calculated from some of the information fields is keyed by: 954 955 trackLengthMinutes : minutes field of track length 956 trackLengthSeconds : seconds field of track length 957 trackLengthFrames : frames field of track length (base 75) 958 trackTotalLengthSeconds : total length of track in fractional seconds 959 bitRate : average bits per second of file 960 fileSize : file size, in bytes 961 962=head1 CONSTRUCTORS 963 964=head2 C<new ($filename)> 965 966Opens a FLAC file, ensuring that it exists and is actually an 967FLAC stream, then loads the information and comment fields. 968 969=head1 INSTANCE METHODS 970 971=over 4 972 973=item * info( [$key] ) 974 975Returns a hashref containing information about the FLAC file from 976the file's information header. 977 978The optional parameter, key, allows you to retrieve a single value from 979the info hash. Returns C<undef> if the key is not found. 980 981=item * tags( [$key] ) 982 983Returns a hashref containing tag keys and values of the FLAC file from 984the file's Vorbis Comment header. 985 986The optional parameter, key, allows you to retrieve a single value from 987the tag hash. Returns C<undef> if the key is not found. 988 989=item * cuesheet( ) 990 991Returns an arrayref which contains a textual representation of the 992cuesheet metada block. Each element in the array corresponds to one 993line in a .cue file. If there is no cuesheet block in this FLAC file 994the array will be empty. The resulting cuesheet should match the 995output of metaflac's --export-cuesheet-to option, with the exception 996of the FILE line, which includes the actual file name instead of 997"dummy.wav". 998 999=item * seektable( ) 1000 1001Returns the seektable. Currently disabled for performance. 1002 1003=item * application( $appId ) 1004 1005Returns the application block for the passed id. 1006 1007=item * picture( [$type ] ) 1008 1009Returns a hash containing data from a PICTURE block if found. 1010 1011Defaults to type 3 - "Front Cover" 1012 1013When the passed variable is 'all', an array of hashes containing 1014picture data from all PICTURE blocks is returned. Allows for multiple instances 1015of the same picture type. 1016 1017=item * set_separator( ) 1018 1019For multi-value ID3 tags, set the separator string. Defaults to '/' 1020 1021=item * vendor_string( ) 1022 1023Returns the vendor string. 1024 1025=item * set_vendor_string( $string ) 1026 1027Set the vendor string. Will be written on write() 1028 1029=item * write( ) 1030 1031Writes the current contents of the tag hash to the FLAC file, given that 1032there's enough space in the header to do so. If there's insufficient 1033space available (using pre-existing padding), the file will remain 1034unchanged, and the function will return a zero value. 1035 1036=back 1037 1038=head1 SEE ALSO 1039 1040L<http://flac.sourceforge.net/format.html> 1041 1042=head1 AUTHORS 1043 1044Dan Sully, E<lt>daniel@cpan.orgE<gt> 1045 1046=head1 COPYRIGHT 1047 1048Pure perl code Copyright (c) 2003-2004, Erik Reckase. 1049 1050Pure perl code Copyright (c) 2003-2007, Dan Sully & Slim Devices. 1051Pure perl code Copyright (c) 2008-2009, Dan Sully 1052 1053XS code Copyright (c) 2004-2007, Dan Sully & Slim Devices. 1054XS code Copyright (c) 2008-2009, Dan Sully 1055 1056This library is free software; you can redistribute it and/or modify 1057it under the same terms as Perl itself, either Perl version 5.8.2 or, 1058at your option, any later version of Perl 5 you may have available. 1059 1060=cut 1061