r46313 - in /branches/upstream/libarchive-ar-perl/current: CHANGES MANIFEST META.yml Makefile.PL lib/Archive/Ar.pm t/10objects.t t/20new.t t/30write.t t/40mode.t

carnil-guest at users.alioth.debian.org carnil-guest at users.alioth.debian.org
Sat Oct 24 14:57:14 UTC 2009


Author: carnil-guest
Date: Sat Oct 24 14:57:08 2009
New Revision: 46313

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=46313
Log:
[svn-upgrade] Integrating new upstream version, libarchive-ar-perl (1.14)

Added:
    branches/upstream/libarchive-ar-perl/current/META.yml
    branches/upstream/libarchive-ar-perl/current/t/30write.t
    branches/upstream/libarchive-ar-perl/current/t/40mode.t
Modified:
    branches/upstream/libarchive-ar-perl/current/CHANGES
    branches/upstream/libarchive-ar-perl/current/MANIFEST
    branches/upstream/libarchive-ar-perl/current/Makefile.PL
    branches/upstream/libarchive-ar-perl/current/lib/Archive/Ar.pm
    branches/upstream/libarchive-ar-perl/current/t/10objects.t
    branches/upstream/libarchive-ar-perl/current/t/20new.t

Modified: branches/upstream/libarchive-ar-perl/current/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarchive-ar-perl/current/CHANGES?rev=46313&op=diff
==============================================================================
--- branches/upstream/libarchive-ar-perl/current/CHANGES (original)
+++ branches/upstream/libarchive-ar-perl/current/CHANGES Sat Oct 24 14:57:08 2009
@@ -1,3 +1,18 @@
+Version 1.14 - October 14, 2009 - John Bazik <jbazik at cpan.org>
+
+	* Fix list_files to return a list in list context, to match doc.
+
+	* Fixed improper use of /m modifier in anchored match.
+
+	* Pad odd-size archives to an even number of bytes.
+	  Closes RT #18383 (thanks to David Dick).
+
+	* Fixed broken file perms (decimal mode stored as octal string).
+	  Closes RT #49987 (thanks to Stephen Gran - debian bug #523515).
+
+	* Added tests for padding and permission fixes.  Dropped
+	  unnecessary BEGIN clauses from some tests.
+
 Version 1.13b - May 7th, 2003
 
 Fixes to the Makefile.PL file. Ar.pm wasn't being put into /blib

Modified: branches/upstream/libarchive-ar-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarchive-ar-perl/current/MANIFEST?rev=46313&op=diff
==============================================================================
--- branches/upstream/libarchive-ar-perl/current/MANIFEST (original)
+++ branches/upstream/libarchive-ar-perl/current/MANIFEST Sat Oct 24 14:57:08 2009
@@ -1,6 +1,9 @@
+CHANGES
 lib/Archive/Ar.pm
 Makefile.PL
+MANIFEST			This list of files
 t/10objects.t
 t/20new.t
-MANIFEST
-CHANGES
+t/30write.t
+t/40mode.t
+META.yml                                 Module meta-data (added by MakeMaker)

Added: branches/upstream/libarchive-ar-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarchive-ar-perl/current/META.yml?rev=46313&op=file
==============================================================================
--- branches/upstream/libarchive-ar-perl/current/META.yml (added)
+++ branches/upstream/libarchive-ar-perl/current/META.yml Sat Oct 24 14:57:08 2009
@@ -1,0 +1,18 @@
+--- #YAML:1.0
+name:                Archive-Ar
+version:             1.14
+abstract:            Interface for manipulating ar archives
+license:             ~
+author:              
+    - Jay Bonci <jay at bonci.com>
+generated_by:        ExtUtils::MakeMaker version 6.42
+distribution_type:   module
+requires:     
+    File::Spec:                    0.83
+    File::Temp:                    0
+    Test::MockObject:              0.12
+    Test::More:                    0.45
+    Time::Local:                   1.04
+meta-spec:
+    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
+    version: 1.3

Modified: branches/upstream/libarchive-ar-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarchive-ar-perl/current/Makefile.PL?rev=46313&op=diff
==============================================================================
--- branches/upstream/libarchive-ar-perl/current/Makefile.PL (original)
+++ branches/upstream/libarchive-ar-perl/current/Makefile.PL Sat Oct 24 14:57:08 2009
@@ -9,6 +9,7 @@
 			'File::Spec' => '0.83',
 			'Time::Local' => '1.04',
 			'Test::MockObject' => '0.12',
+			'File::Temp' => '0',
 		},
 
 	'dist'		=> 

Modified: branches/upstream/libarchive-ar-perl/current/lib/Archive/Ar.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarchive-ar-perl/current/lib/Archive/Ar.pm?rev=46313&op=diff
==============================================================================
--- branches/upstream/libarchive-ar-perl/current/lib/Archive/Ar.pm (original)
+++ branches/upstream/libarchive-ar-perl/current/lib/Archive/Ar.pm Sat Oct 24 14:57:08 2009
@@ -14,7 +14,7 @@
 use Time::Local;
 
 use vars qw($VERSION);
-$VERSION = '1.13b';
+$VERSION = '1.14';
 
 use constant ARMAG => "!<arch>\n";
 use constant SARMAG => length(ARMAG);
@@ -135,7 +135,7 @@
 {
 	my($this) = @_;
 
-	return \@{$this->{_files}};
+	return wantarray ? @{$this->{_files}} : $this->{_files};
 
 }
 
@@ -219,7 +219,7 @@
 	$params->{uid} ||= 0;
 	$params->{gid} ||= 0;
 	$params->{date} ||= timelocal(localtime());
-	$params->{mode} ||= "100644";
+	$params->{mode} ||= 0100644;
 	
 	unless($this->_addFile($params))
 	{
@@ -252,10 +252,16 @@
 
 		$content->{uid} ||= "";
 		$content->{gid} ||= "";
-
-		$outstr.= pack("A16A12A6A6A8A10", @$content{qw/name date uid gid mode size/});
+		$outstr.= pack("A16A12A6A6A8A10",
+			@$content{qw/name date uid gid/},
+			sprintf('%o', $content->{mode}),  # octal!
+			$content->{size});
 		$outstr.= ARFMAG;
 		$outstr.= $content->{data};
+		unless (((length($content->{data})) % 2) == 0) {
+			# Padding to make up an even number of bytes
+			$outstr.= "\n";
+		}
 	}
 
 	return $outstr unless $filename;
@@ -319,20 +325,21 @@
 	while($scratchdata =~ /\S/)
 	{
 
-		if($scratchdata =~ s/^(.{58})`\n//m)		
-		{
-			my @fields = unpack("A16A12A6A6A8A10", $1);
-
-			for(0.. at fields)
-			{
-				$fields[$_] ||= "";
-				$fields[$_] =~ s/\s*$//g;
+		if($scratchdata =~ s/^(.{58})`\n//s)
+		{
+			my $headers = {};
+			@$headers{qw/name date uid gid mode size/} =
+				unpack("A16A12A6A6A8A10", $1);
+
+			for (values %$headers) {
+				$_ ||= "";
+				$_ =~ s/\s*$//;
 			}
-
-			my $headers = {};
-			@$headers{qw/name date uid gid mode size/} = @fields;
+			$headers->{mode} = oct($headers->{mode});
 
 			$headers->{data} = substr($scratchdata, 0, $headers->{size}, "");
+			# delete padding, if any
+			substr($scratchdata, 0, $headers->{size} % 2, "");
 
 			$this->_addFile($headers);
 		}else{
@@ -531,6 +538,7 @@
 =item * C<list_files()>
 
 This lists the files contained inside of the archive by filename, as an array.
+If called in a scalar context, returns a reference to an array.
 
 =back
 
@@ -565,7 +573,7 @@
         "uid" => $uid, #defaults to zero
         "gid" => $gid, #defaults to zero
         "date" => $date,  #date in epoch seconds. Defaults to now.
-        "mode" => $mode, #defaults to "100644";
+        "mode" => $mode, #defaults to 0100644;
 	}
 
 You cannot add_data over another file however.  This returns the file length in 
@@ -635,6 +643,16 @@
 
 =over 4
 
+=item * B<Version 1.14> - October 14, 2009
+
+Fix list_files to return a list in list context, to match doc.
+
+Pad odd-size archives to an even number of bytes.
+Closes RT #18383 (thanks to David Dick).
+
+Fixed broken file perms (decimal mode stored as octal string).
+Closes RT #49987 (thanks to Stephen Gran - debian bug #523515).
+
 =item * B<Version 1.13b> - May 7th, 2003
 
 Fixes to the Makefile.PL file. Ar.pm wasn't being put into /blib

Modified: branches/upstream/libarchive-ar-perl/current/t/10objects.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarchive-ar-perl/current/t/10objects.t?rev=46313&op=diff
==============================================================================
--- branches/upstream/libarchive-ar-perl/current/t/10objects.t (original)
+++ branches/upstream/libarchive-ar-perl/current/t/10objects.t Sat Oct 24 14:57:08 2009
@@ -1,11 +1,6 @@
 #!/usr/bin/perl -w
 
 use Test::More tests => 13;
-
-BEGIN {
-        chdir 't' if -d 't';
-        use lib '../blib/lib', 'lib/', '..';
-}
 
 my $mod = "Archive::Ar";
 

Modified: branches/upstream/libarchive-ar-perl/current/t/20new.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarchive-ar-perl/current/t/20new.t?rev=46313&op=diff
==============================================================================
--- branches/upstream/libarchive-ar-perl/current/t/20new.t (original)
+++ branches/upstream/libarchive-ar-perl/current/t/20new.t Sat Oct 24 14:57:08 2009
@@ -2,11 +2,6 @@
 
 use Test::More tests => 9;
 use Test::MockObject;
-
-BEGIN {
-        chdir 't' if -d 't';
-        use lib '../blib/lib', 'lib/', '..';
-}
 
 my $mod = "Archive::Ar";
 my $mock = new Test::MockObject;

Added: branches/upstream/libarchive-ar-perl/current/t/30write.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarchive-ar-perl/current/t/30write.t?rev=46313&op=file
==============================================================================
--- branches/upstream/libarchive-ar-perl/current/t/30write.t (added)
+++ branches/upstream/libarchive-ar-perl/current/t/30write.t Sat Oct 24 14:57:08 2009
@@ -1,0 +1,15 @@
+#!/usr/bin/perl -w
+
+use Test::More (tests => 2);
+use strict;
+
+use Archive::Ar();
+
+my ($padding_archive) = new Archive::Ar();
+$padding_archive->add_data("test.txt", "here\n");
+my ($archive_results) = $padding_archive->write();
+ok(length($archive_results) == 74, "Archive::Ar pads un-even number of bytes successfully\n");
+$padding_archive = new Archive::Ar();
+$padding_archive->add_data("test.txt", "here1\n");
+$archive_results = $padding_archive->write();
+ok(length($archive_results) == 74, "Archive::Ar pads even number of bytes successfully\n");

Added: branches/upstream/libarchive-ar-perl/current/t/40mode.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libarchive-ar-perl/current/t/40mode.t?rev=46313&op=file
==============================================================================
--- branches/upstream/libarchive-ar-perl/current/t/40mode.t (added)
+++ branches/upstream/libarchive-ar-perl/current/t/40mode.t Sat Oct 24 14:57:08 2009
@@ -1,0 +1,58 @@
+#!/usr/bin/perl -w
+
+use Test::More tests => 19;
+
+use File::Temp qw(tempfile);
+use Archive::Ar;
+
+my ($fh, $file) = tempfile(UNLINK => 1);
+my $data;
+while (<DATA>) {
+    next if /^#/;
+    chomp;
+    $data .= unpack('u', $_);
+}
+print $fh $data;
+close $fh;
+
+my $ar = Archive::Ar->new($file);
+isa_ok($ar, 'Archive::Ar', 'object');
+is_deeply([$ar->list_files], [qw(odd even)], 'list_files');
+
+my $filedata = $ar->get_content('odd');
+is($filedata->{name}, 'odd',		'file1, filedata/name');
+is($filedata->{uid}, 2202,		'file1, filedata/uid');
+is($filedata->{gid}, 2988,		'file1, filedata/gid');
+is($filedata->{mode}, 0100644,		'file1, filedata/mode');
+is($filedata->{date}, 1255532835,	'file1, filedata/date');
+is($filedata->{size}, 11,		'file1, filedata/size');
+is($filedata->{data}, "oddcontent\n",	'file1, filedata/data');
+
+$filedata = $ar->get_content('even');
+is($filedata->{name}, 'even',		'file2, filedata/name');
+is($filedata->{uid}, 2202,		'file2, filedata/uid');
+is($filedata->{gid}, 2988,		'file2, filedata/gid');
+is($filedata->{mode}, 0100644,		'file2, filedata/mode');
+is($filedata->{date}, 1255532831,	'file2, filedata/date');
+is($filedata->{size}, 12,		'file2, filedata/size');
+is($filedata->{data}, "evencontent\n",	'file2, filedata/data');
+
+my ($nfh, $nfile) = tempfile(UNLINK => 1);
+
+print $nfh $ar->write;
+close $nfh;
+
+my $nar = Archive::Ar->new($nfile);
+
+is_deeply([$ar->list_files], [$nar->list_files], 'write/read, list_files');
+is_deeply($ar->get_content('odd'), $nar->get_content('odd'), 'write/read, file1 compare');
+is_deeply($ar->get_content('even'), $nar->get_content('even'), 'write/read, file2 compare');
+
+__END__
+#
+# Uuencoded ar archive produced by ar(1).
+#
+M(3QA<F-H/@IO9&0@("`@("`@("`@("`@,3(U-34S,C at S-2`@,C(P,B`@,CDX
+M."`@,3`P-C0T("`Q,2`@("`@("`@8`IO9&1C;VYT96YT"@IE=F5N("`@("`@
+M("`@("`@,3(U-34S,C at S,2`@,C(P,B`@,CDX."`@,3`P-C0T("`Q,B`@("`@
+1("`@8`IE=F5N8V]N=&5N=`H`




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