[Slim-Checkins] r11112 - in /trunk/server/lib/Audio: FLAC/Header.pm
WMA.pm
dsully at svn.slimdevices.com
dsully at svn.slimdevices.com
Thu Jan 4 19:11:48 PST 2007
Author: dsully
Date: Thu Jan 4 19:11:48 2007
New Revision: 11112
URL: http://svn.slimdevices.com?rev=11112&view=rev
Log:
Bug: N/A
Description: Sync up with CPAN versions.
Modified:
trunk/server/lib/Audio/FLAC/Header.pm
trunk/server/lib/Audio/WMA.pm
Modified: trunk/server/lib/Audio/FLAC/Header.pm
URL: http://svn.slimdevices.com/trunk/server/lib/Audio/FLAC/Header.pm?rev=11112&r1=11111&r2=11112&view=diff
==============================================================================
--- trunk/server/lib/Audio/FLAC/Header.pm (original)
+++ trunk/server/lib/Audio/FLAC/Header.pm Thu Jan 4 19:11:48 2007
@@ -1,11 +1,11 @@
package Audio::FLAC::Header;
-# $Id$
+# $Id: Header.pm 12 2007-01-05 03:10:38Z dsully $
use strict;
use File::Basename;
-our $VERSION = '1.4';
+our $VERSION = '1.6';
our $HAVE_XS = 0;
# First four bytes of stream are always fLaC
@@ -51,11 +51,17 @@
};
# Try to use the faster code first.
- *new = $HAVE_XS ? \&new_XS : \&new_PP;
+ if ($HAVE_XS) {
+ *new = \&new_XS;
+ *write = \&write_XS;
+ } else {
+ *new = \&new_PP;
+ *write = \&write_PP;
+ }
}
sub new_PP {
- my ($class, $file, $writeHack) = @_;
+ my ($class, $file) = @_;
# open up the file
open(my $fh, $file) or die "[$file] does not exist or cannot be read: $!";
@@ -88,15 +94,14 @@
die "[$file] Unable to read metadata from FLAC!";
};
- # This is because we don't write out tags in XS yet.
- if (!$writeHack) {
-
- for my $block (@{$self->{'metadataBlocks'}}) {
-
- my $method = $BLOCK_TYPES{ $block->{'blockType'} } || next;
-
- $self->$method($block);
- }
+ # Always set to empty hash in the case of no comments.
+ $self->{'tags'} = {};
+
+ for my $block (@{$self->{'metadataBlocks'}}) {
+
+ my $method = $BLOCK_TYPES{ $block->{'blockType'} } || next;
+
+ $self->$method($block);
}
close($fh);
@@ -168,27 +173,14 @@
return undef;
}
-sub write {
+sub vendor_string {
my $self = shift;
- # XXX - this is a hack until I do metadata writing in XS
- # Very ugly, I know.
- if ($HAVE_XS) {
-
- # Make a copy of these - otherwise we'll refcnt++
- my %tags = %{$self->{'tags'}};
- my %info = %{$self->{'info'}};
-
- my $filename = $self->{'filename'};
- my $class = ref($self);
-
- undef $self;
-
- $self = $class->new_PP($filename, 1);
-
- $self->{'tags'} = \%tags;
- $self->{'info'} = \%info;
- }
+ return $self->{'vendor'} || "Audio::FLAC::Header $VERSION";
+}
+
+sub write_PP {
+ my $self = shift;
my @tagString = ();
my $numTags = 0;
@@ -246,7 +238,7 @@
# re-writing entire file (not within scope)
if ($totalAvail - length($vorbisComment) < 0) {
warn "Unable to write Vorbis tags - not enough header space!";
- return -1;
+ return 0;
}
# Modify the metadata blocks to reflect new header sizes
@@ -280,15 +272,15 @@
}
# open FLAC file and write new metadata blocks
- open FLACFILE, "+<$self->{'filename'}" or return -1;
+ open FLACFILE, "+<$self->{'filename'}" or return 0;
binmode FLACFILE;
# overwrite the existing metadata blocks
- print FLACFILE $metadataBlocks or return -1;
+ print FLACFILE $metadataBlocks or return 0;
close FLACFILE;
- return 0;
+ return 1;
}
# private methods to this class
@@ -978,9 +970,9 @@
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.
+Pure perl code Copyright (c) 2003-2007, Dan Sully & Slim Devices.
+
+XS code Copyright (c) 2004-2007, Dan Sully & Slim Devices.
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,
Modified: trunk/server/lib/Audio/WMA.pm
URL: http://svn.slimdevices.com/trunk/server/lib/Audio/WMA.pm?rev=11112&r1=11111&r2=11112&view=diff
==============================================================================
--- trunk/server/lib/Audio/WMA.pm (original)
+++ trunk/server/lib/Audio/WMA.pm Thu Jan 4 19:11:48 2007
@@ -11,7 +11,7 @@
require Encode;
}
-$VERSION = '0.9';
+$VERSION = '1.0';
my %guidMapping = _knownGUIDs();
my %reversedGUIDs = reverse %guidMapping;
@@ -210,7 +210,6 @@
# some sanity checks
return -1 if ($self->{'size'} && $objectSize > $self->{'size'});
- return -1 if ($objectSize < 30);
read($fh, $self->{'headerData'}, ($objectSize - 30));
@@ -222,43 +221,53 @@
my $nextObjectGUIDName = $reversedGUIDs{$nextObjectGUIDText};
- # some sanity checks
- return -1 if (!defined($nextObjectGUIDName));
- return -1 if (!defined $nextObjectSize || ($self->{'size'} && $nextObjectSize > $self->{'size'}));
+ # FIX: calculate the next offset up-front to allow for
+ # object handlers that don't read the full object.
+ my $nextObjectOffset = $self->{'offset'} + ($nextObjectSize - (16 + 8));
if ($DEBUG) {
print "nextObjectGUID: [" . $nextObjectGUIDText . "]\n";
- print "nextObjectName: [" . $nextObjectGUIDName . "]\n";
+ print "nextObjectName: [" . (defined($nextObjectGUIDName) ? $nextObjectGUIDName : "<unknown>") . "]\n";
print "nextObjectSize: [" . $nextObjectSize . "]\n";
print "\n";
}
-
+
+ # FIX: don't error out on unknown objects (they are properly
+ # skipped below), report a debug message if we get an
+ # inconsistent object size. some sanity checks
+ if ((!defined $nextObjectSize) || ($nextObjectSize > $self->{'size'})) {
+
+ if ($DEBUG) {
+ print "Inconsistent object size: $nextObjectSize\n";
+ }
+
+ return -1;
+ }
+
+ # FIX: fall-through to the bottom which sets the
+ # offset for the next object.
if (defined($nextObjectGUIDName)) {
# start the different header types parsing
if ($nextObjectGUIDName eq 'ASF_File_Properties_Object') {
$self->_parseASFFilePropertiesObject();
- next;
}
- if ($nextObjectGUIDName eq 'ASF_Content_Description_Object') {
+ elsif ($nextObjectGUIDName eq 'ASF_Content_Description_Object') {
$self->_parseASFContentDescriptionObject();
- next;
}
- if ($nextObjectGUIDName eq 'ASF_Content_Encryption_Object' ||
+ elsif ($nextObjectGUIDName eq 'ASF_Content_Encryption_Object' ||
$nextObjectGUIDName eq 'ASF_Extended_Content_Encryption_Object') {
$self->_parseASFContentEncryptionObject();
- next;
}
- if ($nextObjectGUIDName eq 'ASF_Extended_Content_Description_Object') {
+ elsif ($nextObjectGUIDName eq 'ASF_Extended_Content_Description_Object') {
$self->_parseASFExtendedContentDescriptionObject();
- next;
}
if ($nextObjectGUIDName eq 'ASF_Stream_Properties_Object') {
@@ -267,21 +276,20 @@
next;
}
- if ($nextObjectGUIDName eq 'ASF_Stream_Bitrate_Properties_Object') {
+ elsif ($nextObjectGUIDName eq 'ASF_Stream_Bitrate_Properties_Object') {
$self->_parseASFStreamBitratePropertiesObject();
- next;
}
- if ($nextObjectGUIDName eq 'ASF_Header_Extension_Object') {
+ elsif ($nextObjectGUIDName eq 'ASF_Header_Extension_Object') {
$self->_parseASFHeaderExtensionObject();
- next;
}
}
- # set our next object size
- $self->{'offset'} += ($nextObjectSize - $GUID - $QWORD);
+ # FIX: set the next offset based on what we calculated
+ # up-front, rather then relying on our object handlers.
+ $self->{'offset'} = $nextObjectOffset;
}
# Now work on the subtypes.
@@ -1205,11 +1213,11 @@
=head1 AUTHOR
-Dan Sully, E<lt>Dan at cpan.orgE<gt>
+Dan Sully, E<lt>daniel at cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
-Copyright 2003-2006 by Dan Sully & Slim Devices, Inc.
+Copyright 2003-2007 by Dan Sully & Slim Devices, Inc.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
More information about the checkins
mailing list