Archive::Extract 0.24 (was Re: Archive::Extract test failures on Solaris)

From: "Jos I. Boumans" <kane@dwim.org>
Message-Id: <174BF3BE-B640-4CCA-AB47-BE527382B236@dwim.org>

p4raw-id: //depot/perl@31928

20 files changed, 129 insertions, 35 deletions

diff --git a/lib/Archive/Extract.pm b/lib/Archive/Extract.pm
index 9b74e059f9..1aafd237ab 100644
--- a/lib/Archive/Extract.pm
+++ b/lib/Archive/Extract.pm
@@ -31,7 +31,7 @@ use constant Z              => 'Z';
 
 use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG];
 
-$VERSION        = '0.22_01';
+$VERSION        = '0.24';
 $PREFER_BIN     = 0;
 $WARN           = 1;
 $DEBUG          = 0;
@@ -206,7 +206,7 @@ Returns a C<Archive::Extract> object on success, or false on failure.
                 $ar =~ /.+?\.gz$/i                  ? GZ    :
                 $ar =~ /.+?\.tar$/i                 ? TAR   :
                 $ar =~ /.+?\.(zip|jar|par)$/i       ? ZIP   :
-                $ar =~ /.+?\.(?:tbz|tar\.bz2?)$/i   ? TBZ   :
+                $ar =~ /.+?\.(?:tbz2?|tar\.bz2?)$/i ? TBZ   :
                 $ar =~ /.+?\.bz2$/i                 ? BZ2   :
                 $ar =~ /.+?\.Z$/                    ? Z     :
                 '';
@@ -285,7 +285,7 @@ sub extract {
     {   ### a foo.gz file
         if( $self->is_gz or $self->is_bz2 or $self->is_Z) {
     
-            my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2|Z)$//i;
+            my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2?|Z)$//i;
         
             ### to is a dir?
             if ( -d $to ) {
@@ -452,6 +452,46 @@ sub bin_tar         { return $PROGRAMS->{'tar'}     if $PROGRAMS->{'tar'}   }
 sub bin_bunzip2     { return $PROGRAMS->{'bunzip2'} if $PROGRAMS->{'bunzip2'} }
 sub bin_uncompress  { return $PROGRAMS->{'uncompress'} 
                                                  if $PROGRAMS->{'uncompress'} }
+=head2 $bool = $ae->have_old_bunzip2
+
+Older versions of C</bin/bunzip2>, from before the C<bunzip2 1.0> release,
+require all archive names to end in C<.bz2> or it will not extract
+them. This method checks if you have a recent version of C<bunzip2>
+that allows any extension, or an older one that doesn't.
+
+=cut
+
+sub have_old_bunzip2 {
+    my $self = shift;
+
+    ### no bunzip2? no old bunzip2 either :)
+    return unless $self->bin_bunzip2;
+
+    ### if we can't run this, we can't be sure if it's too old or not    
+    ### XXX stupid stupid stupid bunzip2 doesn't understand --version
+    ### is not a request to extract data:
+    ### $ bunzip2 --version
+    ### bzip2, a block-sorting file compressor.  Version 1.0.2, 30-Dec-2001.
+    ### [...]
+    ### bunzip2: I won't read compressed data from a terminal.
+    ### bunzip2: For help, type: `bunzip2 --help'.
+    ### $ echo $?
+    ### 1
+    ### HATEFUL!
+    my $buffer;
+    scalar run( command => [$self->bin_bunzip2, '--version'],
+         verbose => 0,
+         buffer  => \$buffer
+    );
+
+    ### no output
+    return unless $buffer;
+    
+    my ($version) = $buffer =~ /version \s+ (\d+)/ix;
+
+    return 1 if $version < 1;
+    return;
+}
 
 #################################
 #
@@ -506,7 +546,7 @@ sub _untar_bin {
     {    my $cmd = 
             $self->is_tgz ? [$self->bin_gzip, '-cdf', $self->archive, '|',
                              $self->bin_tar, '-tf', '-'] :
-            $self->is_tbz ? [$self->bin_bunzip2, '-c', $self->archive, '|',                             
+            $self->is_tbz ? [$self->bin_bunzip2, '-cd', $self->archive, '|',                             
                              $self->bin_tar, '-tf', '-'] :
             [$self->bin_tar, '-tf', $self->archive];
 
@@ -549,7 +589,7 @@ sub _untar_bin {
     {   my $cmd = 
             $self->is_tgz ? [$self->bin_gzip, '-cdf', $self->archive, '|',
                              $self->bin_tar, '-xf', '-'] :
-            $self->is_tbz ? [$self->bin_bunzip2, '-c', $self->archive, '|',                             
+            $self->is_tbz ? [$self->bin_bunzip2, '-cd', $self->archive, '|',                             
                              $self->bin_tar, '-xf', '-'] :
             [$self->bin_tar, '-xf', $self->archive];
 
@@ -854,13 +894,12 @@ sub _unzip_bin {
 
 
     ### first, get the files.. it must be 2 different commands with 'unzip' :(
-    {   my $cmd;
-	if (ON_VMS) {
-	    $cmd = [ $self->bin_unzip, '"-Z"', '-1', $self->archive ];
-	} else {
-	    $cmd = [ $self->bin_unzip, '-Z', '-1', $self->archive ];
-	}
-
+    {   ### on VMS, capital letter options have to be quoted. This is
+        ### peported by John Malmberg on P5P Tue 21 Aug 2007 05:05:11 
+        ### Subject: [patch@31735]Archive Extract fix on VMS.
+        my $opt = ON_VMS ? '"-Z"' : '-Z';
+        my $cmd = [ $self->bin_unzip, $opt, '-1', $self->archive ];
+	
         my $buffer = '';
         unless( scalar run( command => $cmd,
                             verbose => $DEBUG,
@@ -1009,8 +1048,16 @@ sub _bunzip2_bin {
     my $fh = FileHandle->new('>'. $self->_gunzip_to) or
         return $self->_error(loc("Could not open '%1' for writing: %2",
                             $self->_gunzip_to, $! ));
+    
+    ### guard against broken bunzip2. See ->have_old_bunzip2()
+    ### for details
+    if( $self->have_old_bunzip2 and $self->archive !~ /\.bz2$/i ) {
+        return $self->_error(loc("Your bunzip2 version is too old and ".
+                                 "can only extract files ending in '%1'",
+                                 '.bz2'));
+    }
 
-    my $cmd = [ $self->bin_bunzip2, '-c', $self->archive ];
+    my $cmd = [ $self->bin_bunzip2, '-cd', $self->archive ];
 
     my $buffer;
     unless( scalar run( command => $cmd,
@@ -1157,6 +1204,25 @@ your archives do not have any of the extensions as described in the
 C<new()> method, you will have to specify the type explicitly, or
 C<Archive::Extract> will not be able to extract the archive for you.
 
+=head2 Supporting Very Large Files
+
+C<Archive::Extract> can use either pure perl modules or command line
+programs under the hood. Some of the pure perl modules (like 
+C<Archive::Tar> take the entire contents of the archive into memory,
+which may not be feasible on your system. Consider setting the global
+variable C<$Archive::Extract::PREFER_BIN> to C<1>, which will prefer
+the use of command line programs and won't consume so much memory.
+
+See the C<GLOBAL VARIABLES> section below for details.
+
+=head2 Bunzip2 support of arbitrary extensions.
+
+Older versions of C</bin/bunzip2> do not support arbitrary file 
+extensions and insist on a C<.bz2> suffix. Although we do our best
+to guard against this, if you experience a bunzip2 error, it may
+be related to this. For details, please see the C<have_old_bunzip2>
+method.
+
 =head1 GLOBAL VARIABLES
 
 =head2 $Archive::Extract::DEBUG
diff --git a/lib/Archive/Extract/t/01_Archive-Extract.t b/lib/Archive/Extract/t/01_Archive-Extract.t
index 60a26cf42f..4595a3570e 100644
--- a/lib/Archive/Extract/t/01_Archive-Extract.t
+++ b/lib/Archive/Extract/t/01_Archive-Extract.t
@@ -7,7 +7,9 @@ BEGIN {
 
 BEGIN { chdir 't' if -d 't' };
 BEGIN { mkdir 'out' unless -d 'out' };
-END { rmtree('out') };
+
+### left behind, at least on Win32. See core patch #31904
+END   { rmtree('out') };        
 
 use strict;
 use lib qw[../lib];
@@ -164,6 +166,17 @@ my $tmpl = {
                 },
 };
 
+### XXX special case: on older solaris boxes (8),
+### bunzip2 is version 0.9.x. Older versions (pre 1),
+### only extract files that end in .bz2, and nothing
+### else. So remove that test case if we have an older
+### bunzip2 :(
+{   if( $Class->have_old_bunzip2 ) {
+        delete $tmpl->{'y.tbz'};
+        diag "Old bunzip2 detected, skipping .tbz test";
+    }
+}    
+
 ### show us the tools IPC::Cmd will use to run binary programs
 if( $Debug ) {
     diag( "IPC::Run enabled: $IPC::Cmd::USE_IPC_RUN " );
@@ -285,7 +298,6 @@ for my $switch (0,1) {
         skip "No binaries or modules to extract ".$archive, 
             (10 * scalar @outs) if $mod_fail && $pgm_fail;
 
-
         ### we dont warnings spewed about missing modules, that might
         ### be a problem...
         local $IPC::Cmd::WARN = 0;
@@ -363,8 +375,24 @@ for my $switch (0,1) {
                         ### if something went wrong with determining the out
                         ### path, don't go deleting stuff.. might be Really Bad
                         my $out_re = quotemeta( $OutDir );
-                        $out_re =~ s/\\(>|\])\z// if IS_VMS; # zap trailing bracket
-
+                        
+                        ### VMS directory layout is different. Craig Berry
+                        ### explains:
+                        ### the test is trying to determine if C</disk1/foo/bar>
+                        ### is part of C</disk1/foo/bar/baz>.  Except in VMS
+                        ### syntax, that would mean trying to determine whether
+                        ### C<disk1:[foo.bar]> is part of C<disk1:[foo.bar.baz]>
+                        ### Because we have both a directory delimiter
+                        ### (dot) and a directory spec terminator (right 
+                        ### bracket), we have to trim the right bracket from 
+                        ### the first one to make it successfully match the
+                        ### second one.  Since we're asserting the same truth --
+                        ### that one path spec is the leading part of the other
+                        ### -- it seems to me ok to have this in the test only.
+                        ### 
+                        ### so we strip the ']' of the back of the regex
+                        $out_re =~ s/\\\]// if IS_VMS; 
+                        
                         if( $ae->extract_path !~ /^$out_re/ ) {   
                             ok( 0, "Extractpath WRONG (".$ae->extract_path.")"); 
                             skip(  "Unsafe operation -- skip cleanup!!!" ), 1;
diff --git a/lib/Archive/Extract/t/src/double_dir.zip.packed b/lib/Archive/Extract/t/src/double_dir.zip.packed
index ff5b91c6c3..dc32f2c400 100644
--- a/lib/Archive/Extract/t/src/double_dir.zip.packed
+++ b/lib/Archive/Extract/t/src/double_dir.zip.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/double_dir.zip lib/Archive/Extract/t/src/double_dir.zip.packed
 
-Created at Mon May 28 12:45:26 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 M4$L#!`H``````&QH,S0````````````````%`!4`>"]Y+WI55`D``PR`ST,,
diff --git a/lib/Archive/Extract/t/src/x.Z.packed b/lib/Archive/Extract/t/src/x.Z.packed
index 0ea47274f4..c23bfbad0b 100644
--- a/lib/Archive/Extract/t/src/x.Z.packed
+++ b/lib/Archive/Extract/t/src/x.Z.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.Z lib/Archive/Extract/t/src/x.Z.packed
 
-Created at Mon May 28 12:45:27 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 ''YV0>`(J````
diff --git a/lib/Archive/Extract/t/src/x.bz2.packed b/lib/Archive/Extract/t/src/x.bz2.packed
index cc3afd35b6..ce2b505723 100644
--- a/lib/Archive/Extract/t/src/x.bz2.packed
+++ b/lib/Archive/Extract/t/src/x.bz2.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.bz2 lib/Archive/Extract/t/src/x.bz2.packed
 
-Created at Mon May 28 12:45:26 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 .0EIH.1=R13A0D```````
diff --git a/lib/Archive/Extract/t/src/x.gz.packed b/lib/Archive/Extract/t/src/x.gz.packed
index 0a33b126d4..9ec46e17eb 100644
--- a/lib/Archive/Extract/t/src/x.gz.packed
+++ b/lib/Archive/Extract/t/src/x.gz.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.gz lib/Archive/Extract/t/src/x.gz.packed
 
-Created at Mon May 28 12:45:26 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 6'XL("+F;6D8``W@``P``````````````
diff --git a/lib/Archive/Extract/t/src/x.jar.packed b/lib/Archive/Extract/t/src/x.jar.packed
index 6911a2da86..c04e4d1ade 100644
--- a/lib/Archive/Extract/t/src/x.jar.packed
+++ b/lib/Archive/Extract/t/src/x.jar.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.jar lib/Archive/Extract/t/src/x.jar.packed
 
-Created at Mon May 28 12:45:26 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 M4$L#!`H```````MAQ3`````````````````!`!``8558#`!)`B%!EIO!0/4!
diff --git a/lib/Archive/Extract/t/src/x.par.packed b/lib/Archive/Extract/t/src/x.par.packed
index 4ea88bc32d..daac16f701 100644
--- a/lib/Archive/Extract/t/src/x.par.packed
+++ b/lib/Archive/Extract/t/src/x.par.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.par lib/Archive/Extract/t/src/x.par.packed
 
-Created at Mon May 28 12:45:26 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 M4$L#!`H```````MAQ3`````````````````!`!``8558#`!)`B%!EIO!0/4!
diff --git a/lib/Archive/Extract/t/src/x.tar.gz.packed b/lib/Archive/Extract/t/src/x.tar.gz.packed
index 6f3f0d9e1c..fc3e40fef0 100644
--- a/lib/Archive/Extract/t/src/x.tar.gz.packed
+++ b/lib/Archive/Extract/t/src/x.tar.gz.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.tar.gz lib/Archive/Extract/t/src/x.tar.gz.packed
 
-Created at Mon May 28 12:45:27 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 M'XL(`````````^W.NPW"0!!%T2EE2YC%:[N>#7""1,"G?QM##!&.SDE&(]W@
diff --git a/lib/Archive/Extract/t/src/x.tar.packed b/lib/Archive/Extract/t/src/x.tar.packed
index 94c371bd73..1683ed1994 100644
--- a/lib/Archive/Extract/t/src/x.tar.packed
+++ b/lib/Archive/Extract/t/src/x.tar.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.tar lib/Archive/Extract/t/src/x.tar.packed
 
-Created at Mon May 28 12:45:26 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 M80``````````````````````````````````````````````````````````
diff --git a/lib/Archive/Extract/t/src/x.tgz.packed b/lib/Archive/Extract/t/src/x.tgz.packed
index ccef96a594..949b59b33f 100644
--- a/lib/Archive/Extract/t/src/x.tgz.packed
+++ b/lib/Archive/Extract/t/src/x.tgz.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.tgz lib/Archive/Extract/t/src/x.tgz.packed
 
-Created at Mon May 28 12:45:27 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 M'XL(`````````^W.NPW"0!!%T2EE2YC%:[N>#7""1,"G?QM##!&.SDE&(]W@
diff --git a/lib/Archive/Extract/t/src/x.zip.packed b/lib/Archive/Extract/t/src/x.zip.packed
index 97e318c577..543440af6c 100644
--- a/lib/Archive/Extract/t/src/x.zip.packed
+++ b/lib/Archive/Extract/t/src/x.zip.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/x.zip lib/Archive/Extract/t/src/x.zip.packed
 
-Created at Mon May 28 12:45:27 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 M4$L#!`H```````MAQ3`````````````````!`!``8558#`!)`B%!EIO!0/4!
diff --git a/lib/Archive/Extract/t/src/y.jar.packed b/lib/Archive/Extract/t/src/y.jar.packed
index 16496a0f12..796cd2f947 100644
--- a/lib/Archive/Extract/t/src/y.jar.packed
+++ b/lib/Archive/Extract/t/src/y.jar.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.jar lib/Archive/Extract/t/src/y.jar.packed
 
-Created at Mon May 28 12:45:27 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 M4$L#!`H``````,NBB#$````````````````"`!``>2]56`P`M%6W06Y4MT'U
diff --git a/lib/Archive/Extract/t/src/y.par.packed b/lib/Archive/Extract/t/src/y.par.packed
index d05447176c..ad44f35772 100644
--- a/lib/Archive/Extract/t/src/y.par.packed
+++ b/lib/Archive/Extract/t/src/y.par.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.par lib/Archive/Extract/t/src/y.par.packed
 
-Created at Mon May 28 12:45:27 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 M4$L#!`H``````,NBB#$````````````````"`!``>2]56`P`M%6W06Y4MT'U
diff --git a/lib/Archive/Extract/t/src/y.tar.bz2.packed b/lib/Archive/Extract/t/src/y.tar.bz2.packed
index 710f444666..183c1a3855 100644
--- a/lib/Archive/Extract/t/src/y.tar.bz2.packed
+++ b/lib/Archive/Extract/t/src/y.tar.bz2.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.tar.bz2 lib/Archive/Extract/t/src/y.tar.bz2.packed
 
-Created at Mon May 28 12:45:28 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 M0EIH.3%!6293636W".T``+)[E,B``$!``/>```-B"1XP!```0``((`"2A*4]
diff --git a/lib/Archive/Extract/t/src/y.tar.gz.packed b/lib/Archive/Extract/t/src/y.tar.gz.packed
index 5619f016f0..1b68ddf9f6 100644
--- a/lib/Archive/Extract/t/src/y.tar.gz.packed
+++ b/lib/Archive/Extract/t/src/y.tar.gz.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.tar.gz lib/Archive/Extract/t/src/y.tar.gz.packed
 
-Created at Mon May 28 12:45:28 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 M'XL(`````````^W1,0Z#,`R%81\E-R"F><EY&,I2J4.!`4Y?JH@5J4,JH?[?
diff --git a/lib/Archive/Extract/t/src/y.tar.packed b/lib/Archive/Extract/t/src/y.tar.packed
index 4241385757..d11c6d22e3 100644
--- a/lib/Archive/Extract/t/src/y.tar.packed
+++ b/lib/Archive/Extract/t/src/y.tar.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.tar lib/Archive/Extract/t/src/y.tar.packed
 
-Created at Mon May 28 12:45:27 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 M>2\`````````````````````````````````````````````````````````
diff --git a/lib/Archive/Extract/t/src/y.tbz.packed b/lib/Archive/Extract/t/src/y.tbz.packed
index 7aa40b9050..14ae9a54fa 100644
--- a/lib/Archive/Extract/t/src/y.tbz.packed
+++ b/lib/Archive/Extract/t/src/y.tbz.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.tbz lib/Archive/Extract/t/src/y.tbz.packed
 
-Created at Mon May 28 12:45:28 2007
+Created at Thu Sep 20 15:38:01 2007
 #########################################################################
 __UU__
 M0EIH.3%!6293636W".T``+)[E,B``$!``/>```-B"1XP!```0``((`"2A*4]
diff --git a/lib/Archive/Extract/t/src/y.tgz.packed b/lib/Archive/Extract/t/src/y.tgz.packed
index 8c80922db8..ed3e4053c1 100644
--- a/lib/Archive/Extract/t/src/y.tgz.packed
+++ b/lib/Archive/Extract/t/src/y.tgz.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.tgz lib/Archive/Extract/t/src/y.tgz.packed
 
-Created at Mon May 28 12:45:28 2007
+Created at Thu Sep 20 15:38:02 2007
 #########################################################################
 __UU__
 M'XL(`````````^W1,0Z#,`R%81\E-R"F><EY&,I2J4.!`4Y?JH@5J4,JH?[?
diff --git a/lib/Archive/Extract/t/src/y.zip.packed b/lib/Archive/Extract/t/src/y.zip.packed
index 5a1a2c0b1e..75d7f1e8ad 100644
--- a/lib/Archive/Extract/t/src/y.zip.packed
+++ b/lib/Archive/Extract/t/src/y.zip.packed
@@ -10,7 +10,7 @@ To recreate it use the following command:
 
      uupacktool.pl -p lib/Archive/Extract/t/src/y.zip lib/Archive/Extract/t/src/y.zip.packed
 
-Created at Mon May 28 12:45:28 2007
+Created at Thu Sep 20 15:38:02 2007
 #########################################################################
 __UU__
 M4$L#!`H``````,NBB#$````````````````"`!``>2]56`P`M%6W06Y4MT'U