From: Jos I. Boumans <jos@dwim.org>
Date: Wed, 11 Mar 2009 17:48:11 +0000 (+0000)
Subject: [PATCH] Update Archive::Extract to 0.31_03
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7bb74d351eaaa2da4a13b7b3160774cdbaf460b0;p=p5sagit%2Fp5-mst-13.2.git

[PATCH] Update Archive::Extract to 0.31_03

Message-Id: <AC196808-D03D-4193-9255-913DDBA666F2@dwim.org>
---

diff --git a/lib/Archive/Extract.pm b/lib/Archive/Extract.pm
index c83f581..b4b40f1 100644
--- a/lib/Archive/Extract.pm
+++ b/lib/Archive/Extract.pm
@@ -41,7 +41,7 @@ use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG
             $_ALLOW_BIN $_ALLOW_PURE_PERL
          ];
 
-$VERSION            = '0.31_02';
+$VERSION            = '0.31_03';
 $PREFER_BIN         = 0;
 $WARN               = 1;
 $DEBUG              = 0;
@@ -637,12 +637,19 @@ sub have_old_bunzip2 {
                                  $self->bin_tar, '-tf', '-'] :
                 [$self->bin_tar, @ExtraTarFlags, '-tf', $self->archive];
     
-            ### run the command ###
-            my $buffer = '';
-            unless( scalar run( command => $cmd,
+            ### run the command 
+            ### newer versions of 'tar' (1.21 and up) now print record size
+            ### to STDERR as well if v OR t is given (used to be both). This 
+            ### is a 'feature' according to the changelog, so we must now only
+            ### inspect STDOUT, otherwise, failures like these occur:
+            ### nntp.perl.org/group/perl.cpan.testers/2009/02/msg3230366.html
+            my $buffer  = '';
+            my @out     = run(  command => $cmd,
                                 buffer  => \$buffer,
-                                verbose => $DEBUG )
-            ) {
+                                verbose => $DEBUG );
+
+            ### command was unsuccessful            
+            unless( $out[0] ) { 
                 return $self->_error(loc(
                                 "Error listing contents of archive '%1': %2",
                                 $self->archive, $buffer ));
@@ -665,7 +672,8 @@ sub have_old_bunzip2 {
                                                 \s+ [\d,.]+ \s tape \s blocks
                                             |x ? $1 : $_);
     
-                        } split $/, $buffer;
+                        ### only STDOUT, see above
+                        } map { split $/, $_ } @{$out[3]};     
     
                 ### store the files that are in the archive ###
                 $self->files(\@files);