From: Chris Williams Date: Thu, 10 Sep 2009 12:54:09 +0000 (+0100) Subject: Update Archive::Tar to CPAN version 1.54 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=941cb2bb4ab0167cca44f7735880d770d5d78fe6;p=p5sagit%2Fp5-mst-13.2.git Update Archive::Tar to CPAN version 1.54 * important changes in version 1.54 10/09/2009 - Apply a patch from Niko Tyni (ntyni@debian.org) that resolves RT #48879; As seen in [rt.cpan.org #48879], although the recommended way of retrieving the last error is to use an instance method ($tar->error), the returned value is effectively global: an error in one Archive::Tar instance changes the error string of another instance. This change separates the error strings from each other while keeping the (deprecated) global value of $Archive::Tar::error pointing to the last error regardless of its instance. We also support calling error() as a class method (Archive::Tar->error). In this case it returns the global value, which matches the old behaviour. --- diff --git a/MANIFEST b/MANIFEST index 06c5ef9..cb21681 100644 --- a/MANIFEST +++ b/MANIFEST @@ -90,6 +90,7 @@ ext/Archive-Tar/t/02_methods.t Archive::Tar tests ext/Archive-Tar/t/03_file.t Archive::Tar tests ext/Archive-Tar/t/04_resolved_issues.t Archive::Tar tests ext/Archive-Tar/t/05_iter.t Archive::Tar tests +ext/Archive-Tar/t/06_error.t Archive::Tar tests ext/Archive-Tar/t/90_symlink.t Archive::Tar tests ext/Archive-Tar/t/99_pod.t Archive::Tar tests ext/Archive-Tar/t/src/header/signed.tar Archive::Tar tests diff --git a/ext/Archive-Tar/lib/Archive/Tar.pm b/ext/Archive-Tar/lib/Archive/Tar.pm index 022a172..006edbd 100644 --- a/ext/Archive-Tar/lib/Archive/Tar.pm +++ b/ext/Archive-Tar/lib/Archive/Tar.pm @@ -31,7 +31,7 @@ use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD $DEBUG = 0; $WARN = 1; $FOLLOW_SYMLINK = 0; -$VERSION = "1.52"; +$VERSION = "1.54"; $CHOWN = 1; $CHMOD = 1; $SAME_PERMISSIONS = $> == 0 ? 1 : 0; @@ -117,7 +117,7 @@ sub new { ### copying $tmpl here since a shallow copy makes it use the ### same aref, causing for files to remain in memory always. - my $obj = bless { _data => [ ], _file => 'Unknown' }, $class; + my $obj = bless { _data => [ ], _file => 'Unknown', _error => '' }, $class; if (@_) { unless ( $obj->read( @_ ) ) { @@ -1445,6 +1445,10 @@ method call instead. my $self = shift; my $msg = $error = shift; $longmess = Carp::longmess($error); + if (ref $self) { + $self->{_error} = $error; + $self->{_longmess} = $longmess; + } ### set Archive::Tar::WARN to 0 to disable printing ### of errors @@ -1457,7 +1461,11 @@ method call instead. sub error { my $self = shift; - return shift() ? $longmess : $error; + if (ref $self) { + return shift() ? $self->{_longmess} : $self->{_error}; + } else { + return shift() ? $longmess : $error; + } } } @@ -1561,7 +1569,7 @@ Returns an iterator function that reads the tar file without loading it all in memory. Each time the function is called it will return the next file in the tarball. The files are returned as C objects. The iterator function returns the -empty list once it has exhausted the the files contained. +empty list once it has exhausted the files contained. The second argument can be a hash reference with options, which are identical to the arguments passed to C. @@ -1600,7 +1608,8 @@ sub iter { return unless $handle; # handle exhausted? ### read data, should only return file - @data = @{ $class->_read_tar($handle, { %$opts, limit => 1 }) }; + my $tarfile = $class->_read_tar($handle, { %$opts, limit => 1 }); + @data = @$tarfile if ref $tarfile && ref $tarfile eq 'ARRAY'; ### return one piece of data return shift(@data) if @data; @@ -1817,6 +1826,11 @@ use is very much discouraged. Use the C method instead: warn $tar->error unless $tar->extract; +Note that in older versions of this module, the C method +would return an effectively global value even when called an instance +method as above. This has since been fixed, and multiple instances of +C now have separate error strings. + =head2 $Archive::Tar::INSECURE_EXTRACT_MODE This variable indicates whether C should allow diff --git a/ext/Archive-Tar/t/06_error.t b/ext/Archive-Tar/t/06_error.t new file mode 100644 index 0000000..5c728bc --- /dev/null +++ b/ext/Archive-Tar/t/06_error.t @@ -0,0 +1,39 @@ +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir '../lib/Archive/Tar' if -d '../lib/Archive/Tar'; + } + use lib '../../..'; +} + +BEGIN { chdir 't' if -d 't' } + +use Test::More 'no_plan'; +use strict; +use lib '../lib'; + +use Archive::Tar; +use File::Spec; + +$Archive::Tar::WARN = 0; + +my $t1 = Archive::Tar->new; +my $t2 = Archive::Tar->new; + +is($Archive::Tar::error, "", "global error string is empty"); +is($t1->error, "", "error string of object 1 is empty"); +is($t2->error, "", "error string of object 2 is empty"); + +ok(!$t1->read(), "can't read without a file"); + +isnt($t1->error, "", "error string of object 1 is set"); +is($Archive::Tar::error, $t1->error, "global error string equals that of object 1"); +is($Archive::Tar::error, Archive::Tar->error, "the class error method returns the global error"); +is($t2->error, "", "error string of object 2 is still empty"); + +my $src = File::Spec->catfile( qw[src short b] ); +ok(!$t2->read($src), "error when opening $src"); + +isnt($t2->error, "", "error string of object 1 is set"); +isnt($t2->error, $t1->error, "error strings of objects 1 and 2 differ"); +is($Archive::Tar::error, $t2->error, "global error string equals that of object 2"); +is($Archive::Tar::error, Archive::Tar->error, "the class error method returns the global error");