r20580 - in /branches/upstream/libaudio-flac-header-perl/current: Changes Header.pm Header.xs MANIFEST META.yml README inc/Module/Install/External.pm t/basic.t t/id3tagged.t t/md5.t

gregoa at users.alioth.debian.org gregoa at users.alioth.debian.org
Sun Jun 1 14:13:49 UTC 2008


Author: gregoa
Date: Sun Jun  1 14:13:49 2008
New Revision: 20580

URL: http://svn.debian.org/wsvn/?sc=1&rev=20580
Log:
[svn-upgrade] Integrating new upstream version, libaudio-flac-header-perl (2.2)

Added:
    branches/upstream/libaudio-flac-header-perl/current/inc/Module/Install/External.pm
Modified:
    branches/upstream/libaudio-flac-header-perl/current/Changes
    branches/upstream/libaudio-flac-header-perl/current/Header.pm
    branches/upstream/libaudio-flac-header-perl/current/Header.xs
    branches/upstream/libaudio-flac-header-perl/current/MANIFEST
    branches/upstream/libaudio-flac-header-perl/current/META.yml
    branches/upstream/libaudio-flac-header-perl/current/README
    branches/upstream/libaudio-flac-header-perl/current/t/basic.t
    branches/upstream/libaudio-flac-header-perl/current/t/id3tagged.t
    branches/upstream/libaudio-flac-header-perl/current/t/md5.t

Modified: branches/upstream/libaudio-flac-header-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libaudio-flac-header-perl/current/Changes?rev=20580&op=diff
==============================================================================
--- branches/upstream/libaudio-flac-header-perl/current/Changes (original)
+++ branches/upstream/libaudio-flac-header-perl/current/Changes Sun Jun  1 14:13:49 2008
@@ -1,4 +1,9 @@
 Revision history for Perl extension Audio::FLAC.
+
+2.2  Sat May 17 00:42:06 PDT 2008
+	- Patches from Nick Hall to allow allpictures XS partity & multiple ID3 tag fixes
+	- RT #36000 - Don't add vendor string, or change case of tags.
+	- RT #36048 - Segfault if FLAC file doesn't contain VENDOR tag.
 
 2.1  Sat May 17 00:42:06 PDT 2008
 	- Try and abort cpansmoke before it sends me email.

Modified: branches/upstream/libaudio-flac-header-perl/current/Header.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libaudio-flac-header-perl/current/Header.pm?rev=20580&op=diff
==============================================================================
--- branches/upstream/libaudio-flac-header-perl/current/Header.pm (original)
+++ branches/upstream/libaudio-flac-header-perl/current/Header.pm Sun Jun  1 14:13:49 2008
@@ -1,11 +1,11 @@
 package Audio::FLAC::Header;
 
-# $Id: Header.pm 24 2008-05-17 07:42:44Z dsully $
+# $Id: Header.pm 25 2008-05-31 20:00:44Z dsully $
 
 use strict;
 use File::Basename;
 
-our $VERSION = '2.1';
+our $VERSION = '2.2';
 our $HAVE_XS = 0;
 
 # First four bytes of stream are always fLaC
@@ -181,7 +181,13 @@
 sub vendor_string {
 	my $self = shift;
 
-	return $self->{'vendor'} || "Audio::FLAC::Header $VERSION";
+	return $self->{'vendor'} || '';
+}
+
+sub set_separator {
+	my $self = shift;
+
+	$self->{'separator'} = shift;
 }
 
 sub _write_PP {
@@ -204,14 +210,8 @@
 		}
 	}
 
-	# Create the contents of the vorbis comment metablock
-	my $vorbisComment = '';
-
-	# First, vendor tag (must be first)
-	_addStringToComment(\$vorbisComment, $self->{'tags'}->{'VENDOR'});
-
-	# Next, number of tags
-	$vorbisComment .= _packInt32($numTags);
+	# Create the contents of the vorbis comment metablock with the number of tags
+	my $vorbisComment .= _packInt32($numTags);
 
 	# Finally, each tag string (with length)
 	foreach (@tagString) {
@@ -452,9 +452,7 @@
 		# Match the key and value
 		if ($tagStr =~ /^(.*?)=(.*?)[\r\n]*$/s) {
 
-			# Make the key uppercase
 			my $tkey = $1;
-			$tkey =~ tr/a-z/A-Z/;
 
 			# Stick it in the tag hash - and handle multiple tags
 			# of the same name.
@@ -977,6 +975,10 @@
 picture data from all PICTURE blocks is returned. Allows for multiple instances
 of the same picture type.
 
+=item * set_separator( ) 
+
+For multi-value ID3 tags, set the separator string. Defaults to '/'
+
 =item * vendor_string( ) 
 
 Returns the vendor string.

Modified: branches/upstream/libaudio-flac-header-perl/current/Header.xs
URL: http://svn.debian.org/wsvn/branches/upstream/libaudio-flac-header-perl/current/Header.xs?rev=20580&op=diff
==============================================================================
--- branches/upstream/libaudio-flac-header-perl/current/Header.xs (original)
+++ branches/upstream/libaudio-flac-header-perl/current/Header.xs Sun Jun  1 14:13:49 2008
@@ -60,6 +60,7 @@
 	int storePicture = 0;
 
 	HV *pictureContainer = newHV();
+	AV *allpicturesContainer = newAV();
 
 	switch (block->type) {
 
@@ -154,8 +155,12 @@
 			char *half;
 			AV   *rawTagArray = newAV();
 			HV   *tags = newHV();
-
-			my_hv_store(tags, "VENDOR", newSVpv((char*)block->data.vorbis_comment.vendor_string.entry, 0));
+			SV   **tag = NULL;
+			SV   **separator = NULL;
+
+			if (block->data.vorbis_comment.vendor_string.entry) {
+				my_hv_store(tags, "VENDOR", newSVpv((char*)block->data.vorbis_comment.vendor_string.entry, 0));
+			}
 
 			for (i = 0; i < block->data.vorbis_comment.num_comments; i++) {
 
@@ -170,7 +175,7 @@
 					block->data.vorbis_comment.comments[i].length
 				));
 
-				/* store the raw tag, before we uppercase it */
+				/* store the raw tags */
 				av_push(rawTagArray, newSVpv(entry, 0));
 
 				half = strchr(entry, '=');
@@ -180,12 +185,25 @@
 					continue;
 				}
 
-				/* make the key be uppercased */
-				for (j = 0; j <= half - entry; j++) {
-					entry[j] = toUPPER(entry[j]);
-				}
-
-				hv_store(tags, entry, half - entry, newSVpv(half + 1, 0), 0);
+				if (hv_exists(tags, entry, half - entry)) {
+					/* fetch the existing entry */
+					tag = hv_fetch(tags, entry, half - entry, 0);
+
+					/* fetch the multi-value separator or default and append to the entry */
+					if (hv_exists(self, "separator", 9)) {
+						separator = hv_fetch(self, "separator", 9, 0);
+						sv_catsv(*tag, *separator);
+					}
+					else {
+						sv_catpv(*tag, "/");
+					}
+
+					/* concatenate with the new entry */
+					sv_catpv(*tag, half + 1);
+				}
+				else {
+					hv_store(tags, entry, half - entry, newSVpv(half + 1, 0), 0);
+				}
 			}
 
 			my_hv_store(self, "tags", newRV_noinc((SV*) tags));
@@ -289,6 +307,7 @@
 			my_hv_store(picture, "depth", newSViv(block->data.picture.depth));
 			my_hv_store(picture, "colorIndex", newSViv(block->data.picture.colors));
 			my_hv_store(picture, "imageData", newSVpv((const char*)block->data.picture.data, block->data.picture.data_length));
+			my_hv_store(picture, "pictureType", newSViv(block->data.picture.type));
 
 			my_hv_store(
 				pictureContainer,
@@ -296,6 +315,9 @@
 				newRV_noinc((SV*) picture)
 			);
 
+			/* update allpictures */
+			av_push(allpicturesContainer, (SV*) newRV((SV*) picture));
+
 			storePicture = 1;
 
 			break;
@@ -307,9 +329,14 @@
 			break;
 	}
 
-	if (storePicture && hv_scalar(pictureContainer)) {
-
-		my_hv_store(self, "picture", newRV_noinc((SV*) pictureContainer));
+	if (storePicture) {
+		/* store the 'allpictures' array */
+		my_hv_store(self, "allpictures", newRV_noinc((SV*) allpicturesContainer));
+
+		/* store the 'picture' hash */
+		if (hv_scalar(pictureContainer)) {
+			my_hv_store(self, "picture", newRV_noinc((SV*) pictureContainer));
+		}
 	}
 }
 
@@ -608,12 +635,7 @@
 		FLAC__ASSERT(FLAC__metadata_iterator_get_block(iterator) == block);
 	}
 
-	/* VENDOR must be first */
 	FLAC__StreamMetadata_VorbisComment_Entry entry;
-
-	entry.entry  = (FLAC__byte *)form("VENDOR=%s", FLAC__VENDOR_STRING);
-	entry.length = strlen((const char *)entry.entry);
-
 	FLAC__metadata_object_vorbiscomment_append_comment(block, entry, /*copy=*/true);
 
 	if (hv_iterinit(tags)) {

Modified: branches/upstream/libaudio-flac-header-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libaudio-flac-header-perl/current/MANIFEST?rev=20580&op=diff
==============================================================================
--- branches/upstream/libaudio-flac-header-perl/current/MANIFEST (original)
+++ branches/upstream/libaudio-flac-header-perl/current/MANIFEST Sun Jun  1 14:13:49 2008
@@ -27,6 +27,7 @@
 inc/Module/Install/Makefile.pm
 inc/Module/Install/AutoInstall.pm
 inc/Module/Install/Include.pm
+inc/Module/Install/External.pm
 inc/Module/Install/WriteAll.pm
 inc/Module/Install/Win32.pm
 inc/Module/Install/Can.pm

Modified: branches/upstream/libaudio-flac-header-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libaudio-flac-header-perl/current/META.yml?rev=20580&op=diff
==============================================================================
--- branches/upstream/libaudio-flac-header-perl/current/META.yml (original)
+++ branches/upstream/libaudio-flac-header-perl/current/META.yml Sun Jun  1 14:13:49 2008
@@ -14,4 +14,4 @@
     - t
 requires: 
   perl: 5.005
-version: 2.1
+version: 2.2

Modified: branches/upstream/libaudio-flac-header-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libaudio-flac-header-perl/current/README?rev=20580&op=diff
==============================================================================
--- branches/upstream/libaudio-flac-header-perl/current/README (original)
+++ branches/upstream/libaudio-flac-header-perl/current/README Sun Jun  1 14:13:49 2008
@@ -1,4 +1,4 @@
-Audio::FLAC version 2.1
+Audio::FLAC version 2.2
 =======================
 
 The README is used to introduce the module and provide instructions on

Added: branches/upstream/libaudio-flac-header-perl/current/inc/Module/Install/External.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libaudio-flac-header-perl/current/inc/Module/Install/External.pm?rev=20580&op=file
==============================================================================
--- branches/upstream/libaudio-flac-header-perl/current/inc/Module/Install/External.pm (added)
+++ branches/upstream/libaudio-flac-header-perl/current/inc/Module/Install/External.pm Sun Jun  1 14:13:49 2008
@@ -1,0 +1,66 @@
+#line 1
+package Module::Install::External;
+
+# Provides dependency declarations for external non-Perl things
+
+use strict;
+use Module::Install::Base;
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+	$VERSION = '0.67';
+	$ISCORE  = 1;
+	@ISA     = qw{Module::Install::Base};
+}
+
+sub requires_external_cc {
+	my $self = shift;
+
+	# We need a C compiler, use the can_cc method for this
+	unless ( $self->can_cc ) {
+		print "Unresolvable missing external dependency.\n";
+		print "This package requires a C compiler.\n";
+		print STDERR "NA: Unable to build distribution on this platform.\n";
+		exit(255);
+	}
+
+	# Unlike some of the other modules, while we need to specify a
+	# C compiler as a dep, it needs to be a build-time dependency.
+
+	1;
+}
+
+sub requires_external_bin {
+	my ($self, $bin, $version) = @_;
+	if ( $version ) {
+		die "requires_external_bin does not support versions yet";
+	}
+
+	# Load the package containing can_run early,
+	# to avoid breaking the message below.
+	$self->load('can_run');
+
+	# Locate the bin
+	print "Locating required external dependency bin:$bin...";
+	my $found_bin = $self->can_run( $bin );
+	if ( $found_bin ) {
+		print " found at $found_bin.\n";
+	} else {
+		print " missing.\n";
+		print "Unresolvable missing external dependency.\n";
+		print "Please install '$bin' seperately and try again.\n";
+		print STDERR "NA: Unable to build distribution on this platform.\n";
+		exit(255);
+	}
+
+	# Once we have some way to specify external deps, do it here.
+	# In the mean time, continue as normal.
+
+	1;
+}
+
+1;
+
+__END__
+
+#line 138

Modified: branches/upstream/libaudio-flac-header-perl/current/t/basic.t
URL: http://svn.debian.org/wsvn/branches/upstream/libaudio-flac-header-perl/current/t/basic.t?rev=20580&op=diff
==============================================================================
--- branches/upstream/libaudio-flac-header-perl/current/t/basic.t (original)
+++ branches/upstream/libaudio-flac-header-perl/current/t/basic.t Sun Jun  1 14:13:49 2008
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More tests => 33;
+use Test::More tests => 31;
 use File::Spec::Functions qw(:ALL);
 
 BEGIN { use_ok('Audio::FLAC::Header') };
@@ -16,16 +16,6 @@
 		my $flac = Audio::FLAC::Header->$constructor(catdir('data', 'test.flac'));
 
 		ok($flac, "constructor: $constructor");
-
-		my $checkVendor = '';
-
-		if ($constructor =~ /PP/) {
-			$checkVendor = 'Audio::FLAC::Header';
-		} else {
-			$checkVendor = 'libFLAC';
-		}
-
-		like($flac->vendor_string, qr/$checkVendor/, "vendor string");
 
 		my $info = $flac->info();
 

Modified: branches/upstream/libaudio-flac-header-perl/current/t/id3tagged.t
URL: http://svn.debian.org/wsvn/branches/upstream/libaudio-flac-header-perl/current/t/id3tagged.t?rev=20580&op=diff
==============================================================================
--- branches/upstream/libaudio-flac-header-perl/current/t/id3tagged.t (original)
+++ branches/upstream/libaudio-flac-header-perl/current/t/id3tagged.t Sun Jun  1 14:13:49 2008
@@ -25,7 +25,7 @@
 
 		ok($tags, "tags read");
 
-		ok($tags->{'TITLE'} =~ /Allegro Maestoso/, "found title");
+		ok($tags->{'title'} =~ /Allegro Maestoso/, "found title");
 	}
 }
 

Modified: branches/upstream/libaudio-flac-header-perl/current/t/md5.t
URL: http://svn.debian.org/wsvn/branches/upstream/libaudio-flac-header-perl/current/t/md5.t?rev=20580&op=diff
==============================================================================
--- branches/upstream/libaudio-flac-header-perl/current/t/md5.t (original)
+++ branches/upstream/libaudio-flac-header-perl/current/t/md5.t Sun Jun  1 14:13:49 2008
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More tests => 7;
+use Test::More tests => 3;
 use File::Spec::Functions qw(:ALL);
 
 BEGIN { use_ok('Audio::FLAC::Header') };
@@ -15,20 +15,7 @@
 
 		my $flac = Audio::FLAC::Header->$constructor(catdir('data', 'md5.flac'));
 
-		ok($flac, "constructor: $constructor");
-
-		my $checkVendor = '';
-
-		if ($constructor =~ /PP/) {
-			$checkVendor = 'Audio::FLAC::Header';
-		} else {
-			$checkVendor = 'libFLAC';
-		}
-
 		my $info = $flac->info();
-
-		ok($info, "info block");
-
 		ok($flac->info('MD5CHECKSUM') eq '00428198e1ae27ad16754f75ff068752', "md5");
        }
 




More information about the Pkg-perl-cvs-commits mailing list