[Slim-Checkins] r10801 - in /trunk/server: Changelog7.html Slim/Formats/FLAC.pm lib/Audio/FLAC/Header.pm

dsully at svn.slimdevices.com dsully at svn.slimdevices.com
Thu Nov 30 10:36:21 PST 2006


Author: dsully
Date: Thu Nov 30 10:36:21 2006
New Revision: 10801

URL: http://svn.slimdevices.com?rev=10801&view=rev
Log:
Bug: N/A
Description: Refactor Audio::FLAC::Header

* Only read metadata blocks if they exist - a good sized performance improvement.

* Support the PICTURE block type.

* Don't read the seektable, it's not used.

Modified:
    trunk/server/Changelog7.html
    trunk/server/Slim/Formats/FLAC.pm
    trunk/server/lib/Audio/FLAC/Header.pm

Modified: trunk/server/Changelog7.html
URL: http://svn.slimdevices.com/trunk/server/Changelog7.html?rev=10801&r1=10800&r2=10801&view=diff
==============================================================================
--- trunk/server/Changelog7.html (original)
+++ trunk/server/Changelog7.html Thu Nov 30 10:36:21 2006
@@ -50,6 +50,7 @@
 	<li>Tag Reading:
 	<ul>
 		<li>Some fixes to WMA tag reading</li>
+		<li>Support the PICTURE metadata type introduced in FLAC 1.1.3</li>
 	</ul>
 	<br />
 

Modified: trunk/server/Slim/Formats/FLAC.pm
URL: http://svn.slimdevices.com/trunk/server/Slim/Formats/FLAC.pm?rev=10801&r1=10800&r2=10801&view=diff
==============================================================================
--- trunk/server/Slim/Formats/FLAC.pm (original)
+++ trunk/server/Slim/Formats/FLAC.pm Thu Nov 30 10:36:21 2006
@@ -288,7 +288,13 @@
 
 		delete $tags->{'COVERART'};
 
-	} elsif (my $artwork = $flac->application($ESCIENT_ARTWORK)) {
+	} elsif ($flac->picture) {
+
+		$tags->{'ARTWORK'} = $flac->picture->{'imageData'};
+
+	} elsif ($flac->application($ESCIENT_ARTWORK)) {
+
+		my $artwork = $flac->application($ESCIENT_ARTWORK);
 
 		if (substr($artwork, 0, 4, '') eq 'PIC1') {
 			$tags->{'ARTWORK'} = $artwork;

Modified: trunk/server/lib/Audio/FLAC/Header.pm
URL: http://svn.slimdevices.com/trunk/server/lib/Audio/FLAC/Header.pm?rev=10801&r1=10800&r2=10801&view=diff
==============================================================================
--- trunk/server/lib/Audio/FLAC/Header.pm (original)
+++ trunk/server/lib/Audio/FLAC/Header.pm Thu Nov 30 10:36:21 2006
@@ -3,27 +3,38 @@
 # $Id$
 
 use strict;
-use vars qw($VERSION $HAVE_XS);
 use File::Basename;
 
-$VERSION = '1.4';
+our $VERSION = '1.4';
+our $HAVE_XS = 0;
 
 # First four bytes of stream are always fLaC
-use constant FLACHEADERFLAG => 'fLaC';
-use constant ID3HEADERFLAG  => 'ID3';
+my $FLACHEADERFLAG = 'fLaC';
+my $ID3HEADERFLAG  = 'ID3';
 
 # Masks for METADATA_BLOCK_HEADER
-use constant LASTBLOCKFLAG => 0x80000000;
-use constant BLOCKTYPEFLAG => 0x7F000000;
-use constant BLOCKLENFLAG  => 0x00FFFFFF;
+my $LASTBLOCKFLAG = 0x80000000;
+my $BLOCKTYPEFLAG = 0x7F000000;
+my $BLOCKLENFLAG  = 0x00FFFFFF;
 
 # Enumerated Block Types
-use constant BT_STREAMINFO     => 0;
-use constant BT_PADDING        => 1;
-use constant BT_APPLICATION    => 2;
-use constant BT_SEEKTABLE      => 3;
-use constant BT_VORBIS_COMMENT => 4;
-use constant BT_CUESHEET       => 5;
+my $BT_STREAMINFO     = 0;
+my $BT_PADDING        = 1;
+my $BT_APPLICATION    = 2;
+my $BT_SEEKTABLE      = 3;
+my $BT_VORBIS_COMMENT = 4;
+my $BT_CUESHEET       = 5;
+my $BT_PICTURE        = 6;
+
+my %BLOCK_TYPES = (
+	$BT_STREAMINFO     => '_parseStreamInfo',
+	$BT_APPLICATION    => '_parseAppBlock',
+# The seektable isn't actually useful yet, and is a big performance hit. 
+#	$BT_SEEKTABLE      => '_parseSeekTable',
+	$BT_VORBIS_COMMENT => '_parseVorbisComments',
+	$BT_CUESHEET       => '_parseCueSheet',
+	$BT_PICTURE        => '_parsePicture',
+);
 
 XS_BOOT: {
         # If I inherit DynaLoader then I inherit AutoLoader
@@ -37,7 +48,6 @@
 		do {__PACKAGE__->can('bootstrap') || \&DynaLoader::bootstrap}->(__PACKAGE__, $VERSION);
 
 		return 1;
-
 	};
 
 	# Try to use the faster code first.
@@ -45,97 +55,51 @@
 }
 
 sub new_PP {
-	my $class = shift;
-	my $file  = shift;
-	my $writeHack = shift;
-	my $errflag = 0;
-
-	my $self  = {};
+	my ($class, $file, $writeHack) = @_;
+
+	# open up the file
+	open(my $fh, $file) or die "[$file] does not exist or cannot be read: $!";
+
+	# make sure dos-type systems can handle it...
+	binmode($fh);
+
+	my $self  = {
+		'fileSize' => -s $file,
+		'filename' => $file,
+	};
 
 	bless $self, $class;
 
-	# open up the file
-	open(FILE, $file) or do {
-		warn "[$file] does not exist or cannot be read: $!";
-		return undef;
+	# check the header to make sure this is actually a FLAC file
+	my $byteCount = $self->_checkHeader($fh) || 0;
+
+	if ($byteCount <= 0) {
+
+		close($fh);
+		die "[$file] does not appear to be a FLAC file!";
+	}
+
+	$self->{'startMetadataBlocks'} = $byteCount;
+
+	# Grab the metadata blocks from the FLAC file
+	if (!$self->_getMetadataBlocks($fh)) {
+
+		close($fh);
+		die "[$file] Unable to read metadata from FLAC!";
 	};
 
-	# make sure dos-type systems can handle it...
-	binmode FILE;
-
-	$self->{'fileSize'}   = -s $file;
-	$self->{'filename'}   = $file;
-	$self->{'fileHandle'} = \*FILE;
-
-	# Initialize FLAC analysis
-	$errflag = $self->_init();
-	if ($errflag < 0) {
-		warn "[$file] does not appear to be a FLAC file!";
-		close FILE;
-		undef $self->{'fileHandle'};
-		return undef;
-	};
-
-	# Grab the metadata blocks from the FLAC file
-	$errflag = $self->_getMetadataBlocks();
-	if ($errflag < 0) {
-		warn "[$file] Unable to read metadata from FLAC!";
-		close FILE;
-		undef $self->{'fileHandle'};
-		return undef;
-	};
-
 	# This is because we don't write out tags in XS yet.
-	unless ($writeHack) {
-
-		# Parse streaminfo
-		$errflag = $self->_parseStreaminfo();
-		if ($errflag < 0) {
-			warn "[$file] Can't find streaminfo metadata block!";
-			close FILE;
-			undef $self->{'fileHandle'};
-			return undef;
-		};
-
-		# Parse vorbis tags
-		$errflag = $self->_parseVorbisComments();
-		if ($errflag < 0) {
-			warn "[$file] Can't find/parse vorbis comment metadata block!";
-			close FILE;
-			undef $self->{'fileHandle'};
-			return undef;
-		};
-
-		# Parse cuesheet
-		$errflag = $self->_parseCueSheet();
-		if ($errflag < 0) {
-			warn "[$file] Problem parsing cuesheet metadata block!";
-			close FILE;
-			undef $self->{'fileHandle'};
-			return undef;
-		};
-
-		# Parse seekpoint table
-		$errflag = $self->_parseSeekTable();
-		if ($errflag < 0) {
-			warn "[$file] Problem parsing seekpoint table!";
-			close FILE;
-			undef $self->{'fileHandle'};
-			return undef;
-		};
-
-		# Parse third-party application metadata block
-		$errflag = $self->_parseAppBlock();
-		if ($errflag < 0) {
-			warn "[$file] Problem parsing application metadata block!";
-			close FILE;
-			undef $self->{'fileHandle'};
-			return undef;
-		};
-	}
-
-	close FILE;
-	undef $self->{'fileHandle'};
+	if (!$writeHack) {
+
+		for my $block (@{$self->{'metadataBlocks'}}) {
+
+			my $method = $BLOCK_TYPES{ $block->{'blockType'} } || next;
+
+			$self->$method($block);
+		}
+	}
+
+	close($fh);
 
 	return $self;
 }
@@ -193,6 +157,17 @@
 	return undef;
 }
 
+sub picture {
+	my $self = shift;
+	my $type = shift || 3; # front cover
+
+	# if the picture block exists, return it's content
+	return $self->{'picture'}->{$type} if exists($self->{'picture'}->{$type});
+
+	# otherwise, return nothing
+	return undef;
+}
+
 sub write {
 	my $self = shift;
 
@@ -220,7 +195,7 @@
 
 	my ($idxVorbis,$idxPadding);
 	my $totalAvail = 0;
-	my $metadataBlocks = FLACHEADERFLAG;
+	my $metadataBlocks = $FLACHEADERFLAG;
 	my $tmpnum;
 
 	# Make a list of the tags and lengths for packing into the vorbis metadata block
@@ -248,8 +223,8 @@
 
 	# Is there enough space for this new header?
 	# Determine the length of the old comment block and the length of the padding available
-	$idxVorbis  = $self->_findMetadataIndex(BT_VORBIS_COMMENT);
-	$idxPadding = $self->_findMetadataIndex(BT_PADDING);
+	$idxVorbis  = $self->_findMetadataIndex($BT_VORBIS_COMMENT);
+	$idxPadding = $self->_findMetadataIndex($BT_PADDING);
 
 	if ($idxVorbis >= 0) {
 		# Add the length of the block
@@ -279,7 +254,7 @@
 	# Is there a Vorbis metadata block?
 	if ($idxVorbis < 0) {
 		# no vorbis block, so add one
-		_addNewMetadataBlock($self, BT_VORBIS_COMMENT, $vorbisComment);
+		_addNewMetadataBlock($self, $BT_VORBIS_COMMENT, $vorbisComment);
 	} else {
 		# update the vorbis block
 		_updateMetadataBlock($self, $idxVorbis       , $vorbisComment);
@@ -289,7 +264,7 @@
 	# Change the padding to reflect the new vorbis comment size
 	if ($idxPadding < 0) {
 		# no padding block
-		_addNewMetadataBlock($self, BT_PADDING , "\0" x ($totalAvail - length($vorbisComment)));
+		_addNewMetadataBlock($self, $BT_PADDING , "\0" x ($totalAvail - length($vorbisComment)));
 	} else {
 		# update the padding block
 		_updateMetadataBlock($self, $idxPadding, "\0" x ($totalAvail - length($vorbisComment)));
@@ -317,41 +292,17 @@
 }
 
 # private methods to this class
-sub _init {
-	my $self = shift;
-
-	my $fh	 = $self->{'fileHandle'};
-
-	# check the header to make sure this is actually a FLAC file
-	my $byteCount = $self->_checkHeader() || 0;
-
-	unless ($byteCount > 0) {
-		# if it's not, we can't do anything
-		return -1;
-	}
-
-	$self->{'startMetadataBlocks'} = $byteCount;
-
-	return 0;
-}
-
 sub _checkHeader {
-	my $self = shift;
-
-	my $fh	 = $self->{'fileHandle'};
-	my $id3size = '';
-
-	# stores how far into the file we've read,
-	# so later reads into the file can skip right
-	# past all of the header stuff
-	my $byteCount = 0;
+	my ($self, $fh) = @_;
 
 	# check that the first four bytes are 'fLaC'
 	read($fh, my $buffer, 4) or return -1;
 
-	if (substr($buffer,0,3) eq ID3HEADERFLAG) {
+	if (substr($buffer,0,3) eq $ID3HEADERFLAG) {
 
 		$self->{'ID3V2Tag'} = 1;
+
+		my $id3size = '';
 
 		# How big is the ID3 header?
 		# Skip the next two bytes - major & minor version number.
@@ -361,7 +312,7 @@
 		# Read the next 4 bytes one at a time, unpack each one B7,
 		# and concatenate.  When complete, do a bin2dec to determine size
 		for (my $c = 0; $c < 4; $c++) {
-			read ($fh, $buffer, 1) or return -1;
+			read($fh, $buffer, 1) or return -1;
 			$id3size .= substr(unpack ("B8", $buffer), 1);
 		}
 
@@ -369,21 +320,17 @@
 		read($fh, $buffer, 4) or return -1;
 	}
 
-	if ($buffer ne FLACHEADERFLAG) {
+	if ($buffer ne $FLACHEADERFLAG) {
 		warn "Unable to identify $self->{'filename'} as a FLAC bitstream!\n";
 		return -2;
 	}
 
-	$byteCount = tell($fh);
-
 	# at this point, we assume the bitstream is valid
-	return $byteCount;
+	return tell($fh);
 }
 
 sub _getMetadataBlocks {
-	my $self = shift;
-
-	my $fh   = $self->{'fileHandle'};
+	my ($self, $fh) = @_;
 
 	my $metadataBlockList = [];
 	my $numBlocks         = 0;
@@ -394,20 +341,20 @@
 	while ($lastBlockFlag == 0) {
 
 		# Read the next metadata_block_header
-		read $fh, $buffer, 4 or return -1;
-
-		my $metadataBlockHeader = unpack ('N', $buffer);
+		read($fh, $buffer, 4) or return 0;
+
+		my $metadataBlockHeader = unpack('N', $buffer);
 
 		# Break out the contents of the metadata_block_header
-		my $metadataBlockType   = (BLOCKTYPEFLAG & $metadataBlockHeader)>>24;
-		my $metadataBlockLength = (BLOCKLENFLAG  & $metadataBlockHeader);
-		   $lastBlockFlag       = (LASTBLOCKFLAG & $metadataBlockHeader)>>31;
+		my $metadataBlockType   = ($BLOCKTYPEFLAG & $metadataBlockHeader)>>24;
+		my $metadataBlockLength = ($BLOCKLENFLAG  & $metadataBlockHeader);
+		   $lastBlockFlag       = ($LASTBLOCKFLAG & $metadataBlockHeader)>>31;
 
 		# If the block size is zero go to the next block 
 		next unless $metadataBlockLength;
 
 		# Read the contents of the metadata_block
-		read $fh, my $metadataBlockData, $metadataBlockLength or return -1;
+		read($fh, my $metadataBlockData, $metadataBlockLength) or return 0;
 
 		# Store the parts in the list
 		$metadataBlockList->[$numBlocks++] = {
@@ -422,44 +369,43 @@
 	$self->{'metadataBlocks'} = $metadataBlockList;
 	$self->{'startAudioData'} = tell $fh;
 
-	return 0;
-}
-
-sub _parseStreaminfo {
-	my $self = shift;
+	return 1;
+}
+
+sub _parseStreamInfo {
+	my ($self, $block) = @_;
+
 	my $info = {};
-	my ($totalSeconds,$trackMinutes,$trackSeconds,$trackFrames,$bitRate);
-
-	my $idx = $self->_findMetadataIndex(BT_STREAMINFO);
-
-	if ($idx < 0) {
-		return -1;
-	}
 
 	# Convert to binary string, since there's some unfriendly lengths ahead
-	my $metaBinString = unpack('B144', $self->{'metadataBlocks'}[$idx]->{'contents'});
-
-	$info->{'MINIMUMBLOCKSIZE'} = _bin2dec(substr($metaBinString, 0,16));
-	$info->{'MAXIMUMBLOCKSIZE'} = _bin2dec(substr($metaBinString,16,32));
-	$info->{'MINIMUMFRAMESIZE'} = _bin2dec(substr($metaBinString,32,24));
-	$info->{'MAXIMUMFRAMESIZE'} = _bin2dec(substr($metaBinString,56,24));
-
-	$info->{'SAMPLERATE'}       = _bin2dec(substr($metaBinString,80,20));
-	$info->{'NUMCHANNELS'}      = _bin2dec(substr($metaBinString,100,3)) + 1;
-	$info->{'BITSPERSAMPLE'}    = _bin2dec(substr($metaBinString,103,5)) + 1;
+	my $metaBinString = unpack('B144', $block->{'contents'});
+
+	my $x32 = 0 x 32;
+
+	$info->{'MINIMUMBLOCKSIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 0, 16), -32)));
+	$info->{'MAXIMUMBLOCKSIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 16, 32), -32)));
+	$info->{'MINIMUMFRAMESIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 32, 24), -32)));
+	$info->{'MINIMUMFRAMESIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 56, 24), -32)));
+
+	$info->{'SAMPLERATE'}       = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 80, 20), -32)));
+	$info->{'NUMCHANNELS'}      = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 100, 3), -32))) + 1;
+	$info->{'BITSPERSAMPLE'}    = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 100, 5), -32))) + 1;
 
 	# Calculate total samples in two parts
-	my $highBits = _bin2dec(substr($metaBinString,108,4));
-	$info->{'TOTALSAMPLES'} = $highBits * 2 ** 32 + _bin2dec(substr($metaBinString,112,32));
+	my $highBits = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 108, 4), -32)));
+
+	$info->{'TOTALSAMPLES'} = $highBits * 2 ** 32 + 
+		unpack('N', pack('B32', substr($x32 . substr($metaBinString, 112, 32), -32)));
 
 	# Return the MD5 as a 32-character hexadecimal string
-	$info->{'MD5CHECKSUM'} = unpack('H32',substr($self->{'metadataBlocks'}[$idx]->{'contents'},18,16));
+	#$info->{'MD5CHECKSUM'} = unpack('H32',substr($self->{'metadataBlocks'}[$idx]->{'contents'},18,16));
+	$info->{'MD5CHECKSUM'} = unpack('H32',substr($block->{'contents'}, 18, 16));
 
 	# Store in the data hash
 	$self->{'info'} = $info;
 
 	# Calculate the track times
-	$totalSeconds = $info->{'TOTALSAMPLES'} / $info->{'SAMPLERATE'};
+	my $totalSeconds = $info->{'TOTALSAMPLES'} / $info->{'SAMPLERATE'};
 
 	if ($totalSeconds == 0) {
 		warn "totalSeconds is 0 - we couldn't find either TOTALSAMPLES or SAMPLERATE!\n" .
@@ -475,41 +421,40 @@
 	$self->{'trackLengthFrames'}  = ($totalSeconds - int($totalSeconds)) * 75;
 	$self->{'bitRate'}            = 8 * ($self->{'fileSize'} - $self->{'startAudioData'}) / $totalSeconds;
 
-	return 0;
+	return 1;
 }
 
 sub _parseVorbisComments {
-	my $self = shift;
-	my $tags = {};
+	my ($self, $block) = @_;
+
+	my $tags    = {};
 	my $rawTags = [];
-	my $idx  = $self->_findMetadataIndex(BT_VORBIS_COMMENT);
-
-	# continue parsing, even if we can't find the comment.
-	return 0 if $idx < 0;
 
 	# Parse out the tags from the metadata block
-	my $tmpBlock         = $self->{'metadataBlocks'}[$idx]->{'contents'};
+	my $tmpBlock = $block->{'contents'};
+	my $offset   = 0;
 
 	# First tag in block is the Vendor String
-	my $tagLen        = _grabInt32(\$tmpBlock);
-	$tags->{'VENDOR'} = substr($tmpBlock,0,$tagLen);
-	$tmpBlock         = substr($tmpBlock,$tagLen);
+	my $tagLen = unpack('V', substr($tmpBlock, $offset, 4));
+	$tags->{'VENDOR'} = substr($tmpBlock, ($offset += 4), $tagLen);
 
 	# Now, how many additional tags are there?
-	my $numTags       = _grabInt32(\$tmpBlock);
+	my $numTags = unpack('V', substr($tmpBlock, ($offset += $tagLen), 4));
+
+	$offset += 4;
 
 	for (my $tagi = 0; $tagi < $numTags; $tagi++) {
 
 		# Read the tag string
-		$tagLen    = _grabInt32(\$tmpBlock);
-		my $tagStr = substr($tmpBlock,0,$tagLen);
-		$tmpBlock  = substr($tmpBlock,$tagLen);
+		my $tagLen = unpack('V', substr($tmpBlock, $offset, 4));
+		my $tagStr = substr($tmpBlock, ($offset += 4), $tagLen);
 
 		# Save the raw tag
 		push(@$rawTags, $tagStr);
 
 		# Match the key and value
 		if ($tagStr =~ /^(.*?)=(.*?)[\r\n]*$/s) {
+
 			# Make the key uppercase
 			my $tkey = $1;
 			$tkey =~ tr/a-z/A-Z/;
@@ -531,27 +476,23 @@
 				$tags->{$tkey} = $2;
 			}
 		}
+
+		$offset += $tagLen;
 	}
 
 	$self->{'tags'} = $tags;
 	$self->{'rawTags'} = $rawTags;
 
-	return 0;
+	return 1;
 }
 
 sub _parseCueSheet {
-	my $self = shift;
-
-	my $idx  = $self->_findMetadataIndex(BT_CUESHEET);
-
-        # No cuesheet block found. 
-        # Not really an error, but no need to continue.
-	return 0 if $idx < 0;
+	my ($self, $block) = @_;
 
 	my $cuesheet = [];
 
 	# Parse out the tags from the metadata block
-	my $tmpBlock  = $self->{'metadataBlocks'}[$idx]->{'contents'};
+	my $tmpBlock = $block->{'contents'};
 
 	# First field in block is the Media Catalog Number
 	my $catalog   = substr($tmpBlock,0,128);
@@ -732,27 +673,53 @@
 
 	$self->{'cuesheet'} = $cuesheet;
 
-	return 0;
+	return 1;
+}
+
+sub _parsePicture {
+	my ($self, $block) = @_;
+
+	# Parse out the tags from the metadata block
+	my $tmpBlock  = $block->{'contents'};
+	my $offset    = 0;
+
+	my $pictureType   = unpack('N', substr($tmpBlock, $offset, 4));
+	my $mimeLength    = unpack('N', substr($tmpBlock, ($offset += 4), 4));
+	my $mimeType      = substr($tmpBlock, ($offset += 4), $mimeLength);
+	my $descLength    = unpack('N', substr($tmpBlock, ($offset += $mimeLength), 4));
+	my $description   = substr($tmpBlock, ($offset += 4), $descLength);
+	my $width         = unpack('N', substr($tmpBlock, ($offset += $descLength), 4));
+	my $height        = unpack('N', substr($tmpBlock, ($offset += 4), 4));
+	my $depth         = unpack('N', substr($tmpBlock, ($offset += 4), 4));
+	my $colorIndex    = unpack('N', substr($tmpBlock, ($offset += 4), 4));
+	my $imageLength   = unpack('N', substr($tmpBlock, ($offset += 4), 4));
+	my $imageData     = substr($tmpBlock, ($offset += 4), $imageLength);
+
+	$self->{'picture'}->{$pictureType}->{'mimeType'}    = $mimeType;
+	$self->{'picture'}->{$pictureType}->{'description'} = $description;
+	$self->{'picture'}->{$pictureType}->{'width'}       = $width;
+	$self->{'picture'}->{$pictureType}->{'height'}      = $height;
+	$self->{'picture'}->{$pictureType}->{'depth'}       = $depth;
+	$self->{'picture'}->{$pictureType}->{'colorIndex'}  = $colorIndex;
+	$self->{'picture'}->{$pictureType}->{'imageData'}   = $imageData;
+
+	return 1;
 }
 
 sub _parseSeekTable {
-	my $self = shift;
+	my ($self, $block) = @_;
+
 	my $seektable = [];
 
-	my $idx  = $self->_findMetadataIndex(BT_SEEKTABLE);
-
-	# seekpoint tables are optional, so return 0 if we don't have one
-	if ($idx < 0) {
-		return 0;
-	}
-
-	#grab the seekpoint table
-	my $tmpBlock = $self->{'metadataBlocks'}[$idx]->{'contents'};
-
-	#parse out the seekpoints
-	while (my $seekpoint = substr($tmpBlock, 0, 18)) {
+	# grab the seekpoint table
+	my $tmpBlock = $block->{'contents'};
+	my $offset   = 0;
+
+	# parse out the seekpoints
+	while (my $seekpoint = substr($tmpBlock, $offset, 18)) {
+
 		# Sample number of first sample in the target frame
-		my $highbits = unpack('N', substr($seekpoint,0,4));
+		my $highbits     = unpack('N', substr($seekpoint,0,4));
 		my $sampleNumber = $highbits * 2 ** 32 + unpack('N', (substr($seekpoint,4,4)));
 
 		# Detect placeholder seekpoint
@@ -767,40 +734,30 @@
 		# Number of samples in the target frame
 		my $frameSamples = unpack('n', (substr($seekpoint,16,2)));
 
-		# remove this point from the tmpBlock
-		$tmpBlock = substr($tmpBlock, 18);
-
 		# add this point to our copy of the table
-		push (@$seektable, { "sampleNumber" => $sampleNumber, 
-				     "streamOffset" => $streamOffset,
-				     "frameSamples" => $frameSamples });
-	}
-
-	# make it official
+		push (@$seektable, {
+			'sampleNumber' => $sampleNumber, 
+			'streamOffset' => $streamOffset,
+			'frameSamples' => $frameSamples,
+		});
+
+		$offset += 18;
+	}
+
 	$self->{'seektable'} = $seektable;
 
-	return 0;
+	return 1;
 }
 
 sub _parseAppBlock {
-	my $self = shift;
-
-	# there may be multiple application blocks with different ids
-	# so we need to loop through them all.
-	my $idx = $self->_findMetadataIndex(BT_APPLICATION);
-	while ($idx >= 0) {
-		my $appContent = [];
-
-		# Parse out the tags from the metadata block
-		my $tmpBlock  = $self->{'metadataBlocks'}[$idx]->{'contents'};
-
-		# Find the application id
-		my $appID   = unpack('N', substr($tmpBlock,0,4));
-	
-		$self->{'application'}->{$appID} = substr($tmpBlock,4);
-		$idx  = $self->_findMetadataIndex(BT_APPLICATION, ++$idx);
-	}
-	return 0;
+	my ($self, $block) = @_;
+
+	# Parse out the tags from the metadata block
+	my $appID = unpack('N', substr($block->{'contents'}, 0, 4, ''));
+
+	$self->{'application'}->{$appID} = $block->{'contents'};
+
+	return 1;
 }
 
 # Take an offset as number of flac samples
@@ -838,17 +795,9 @@
 	return unpack ('N', pack ('B32', substr(0 x 32 . shift, -32)));
 }
 
-sub _grabInt32 {
-	# Pulls a little-endian unsigned int from a string and returns the remainder
-	my $data  = shift;
-	my $value = unpack('V',substr($$data,0,4));
-	$$data    = substr($$data,4);
-	return $value;
-}
-
 sub _packInt32 {
 	# Packs an integer into a little-endian 32-bit unsigned int
-	return pack('V',shift)
+	return pack('V', shift)
 }
 
 sub _findMetadataIndex {
@@ -860,6 +809,7 @@
 
 	# Loop through the metadata_blocks until one of $htype is found
 	while ($idx < @{$self->{'metadataBlocks'}}) {
+
 		# Check the type to see if it's a $htype block
 		if ($self->{'metadataBlocks'}[$idx]->{'blockType'} == $htype) {
 			$found++;
@@ -1026,9 +976,11 @@
 
 =head1 COPYRIGHT
 
-Pure perl code Copyright (c) 2003-2005, Erik Reckase.
-
-XS code Copyright (c) 2004-2005, Dan Sully.
+Pure perl code Copyright (c) 2003-2004, Erik Reckase.
+
+Pure perl code Copyright (c) 2003-2006, Dan Sully.
+
+XS code Copyright (c) 2004-2006, Dan Sully.
 
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself, either Perl version 5.8.2 or,



More information about the checkins mailing list