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 (file)
--- 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 (file)
--- 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<Archive::Tar::File> 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<read()>.
@@ -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<error()> method instead:
 
     warn $tar->error unless $tar->extract;
 
+Note that in older versions of this module, the C<error()> 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<Archive::Tar> now have separate error strings.
+
 =head2 $Archive::Tar::INSECURE_EXTRACT_MODE
 
 This variable indicates whether C<Archive::Tar> should allow

diff --git a/ext/Archive-Tar/t/06_error.t b/ext/Archive-Tar/t/06_error.t
new file mode 100644 (file)
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");