Update to Archive::Extract 0.20, and re-apply patch #31158

p4raw-id: //depot/perl@31288

20 files changed, 144 insertions, 33 deletions

diff --git a/lib/Archive/Extract.pm b/lib/Archive/Extract.pm
index 5c96c56bc5..b81732b934 100644
--- a/lib/Archive/Extract.pm
+++ b/lib/Archive/Extract.pm
@@ -24,14 +24,15 @@ use constant GZ             => 'gz';
 use constant ZIP            => 'zip';
 use constant BZ2            => 'bz2';
 use constant TBZ            => 'tbz';
+use constant Z              => 'Z';
 
 use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG];
 
-$VERSION        = '0.18';
+$VERSION        = '0.20';
 $PREFER_BIN     = 0;
 $WARN           = 1;
 $DEBUG          = 0;
-my @Types       = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ ); # same as all constants
+my @Types       = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z ); # same as all constants
 
 local $Params::Check::VERBOSE = $Params::Check::VERBOSE = 1;
 
@@ -86,9 +87,9 @@ Archive::Extract - A generic archive extracting mechanism
 Archive::Extract is a generic archive extraction mechanism.
 
 It allows you to extract any archive file of the type .tar, .tar.gz,
-.gz, tar.bz2, .tbz, .bz2 or .zip without having to worry how it does 
-so, or use different interfaces for each type by using either perl 
-modules, or commandline tools on your system.
+.gz, .Z, tar.bz2, .tbz, .bz2 or .zip without having to worry how it 
+does so, or use different interfaces for each type by using either 
+perl modules, or commandline tools on your system.
 
 See the C<HOW IT WORKS> section further down for details.
 
@@ -97,7 +98,7 @@ See the C<HOW IT WORKS> section further down for details.
 
 ### see what /bin/programs are available ###
 $PROGRAMS = {};
-for my $pgm (qw[tar unzip gzip bunzip2]) {
+for my $pgm (qw[tar unzip gzip bunzip2 uncompress]) {
     $PROGRAMS->{$pgm} = can_run($pgm);
 }
 
@@ -109,6 +110,7 @@ my $Mapping = {
     is_zip  => '_unzip',
     is_tbz  => '_untar',
     is_bz2  => '_bunzip2',
+    is_Z    => '_uncompress',
 };
 
 {
@@ -158,6 +160,11 @@ Corresponds to a C<.tgz> or C<.tar.gz> suffix.
 Gzip compressed file, as produced by, for example C</bin/gzip>.
 Corresponds to a C<.gz> suffix.
 
+=item Z
+
+Lempel-Ziv compressed file, as produced by, for example C</bin/compress>.
+Corresponds to a C<.Z> suffix.
+
 =item zip
 
 Zip compressed file, as produced by, for example C</bin/zip>.
@@ -198,6 +205,7 @@ Returns a C<Archive::Extract> object on success, or false on failure.
                 $ar =~ /.+?\.(zip|jar|par)$/i       ? ZIP   :
                 $ar =~ /.+?\.(?:tbz|tar\.bz2?)$/i   ? TBZ   :
                 $ar =~ /.+?\.bz2$/i                 ? BZ2   :
+                $ar =~ /.+?\.Z$/                    ? Z     :
                 '';
 
         }
@@ -272,9 +280,9 @@ sub extract {
     ### to.
     my $dir;
     {   ### a foo.gz file
-        if( $self->is_gz or $self->is_bz2 ) {
+        if( $self->is_gz or $self->is_bz2 or $self->is_Z) {
     
-            my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2)$//i;
+            my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2|Z)$//i;
         
             ### to is a dir?
             if ( -d $to ) {
@@ -397,6 +405,11 @@ See the C<new()> method for details.
 Returns true if the file is of type C<.gz>.
 See the C<new()> method for details.
 
+=head2 $ae->is_Z
+
+Returns true if the file is of type C<.Z>.
+See the C<new()> method for details.
+
 =head2 $ae->is_zip
 
 Returns true if the file is of type C<.zip>.
@@ -411,6 +424,7 @@ sub is_gz   { return $_[0]->type eq GZ  }
 sub is_zip  { return $_[0]->type eq ZIP }
 sub is_tbz  { return $_[0]->type eq TBZ }
 sub is_bz2  { return $_[0]->type eq BZ2 }
+sub is_Z    { return $_[0]->type eq Z   }
 
 =pod
 
@@ -429,10 +443,12 @@ Returns the full path to your unzip binary, if found
 =cut
 
 ### paths to commandline tools ###
-sub bin_gzip    { return $PROGRAMS->{'gzip'}    if $PROGRAMS->{'gzip'}  }
-sub bin_unzip   { return $PROGRAMS->{'unzip'}   if $PROGRAMS->{'unzip'} }
-sub bin_tar     { return $PROGRAMS->{'tar'}     if $PROGRAMS->{'tar'}   }
-sub bin_bunzip2 { return $PROGRAMS->{'bunzip2'} if $PROGRAMS->{'bunzip2'} }
+sub bin_gzip        { return $PROGRAMS->{'gzip'}    if $PROGRAMS->{'gzip'}  }
+sub bin_unzip       { return $PROGRAMS->{'unzip'}   if $PROGRAMS->{'unzip'} }
+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'} }
 
 #################################
 #
@@ -745,6 +761,68 @@ sub _gunzip_cz {
 
 #################################
 #
+# Uncompress code
+#
+#################################
+
+
+### untar wrapper... goes to either Archive::Tar or /bin/tar
+### depending on $PREFER_BIN
+sub _uncompress {
+    my $self = shift;
+
+    my   @methods = qw[_gunzip_cz _uncompress_bin];
+         @methods = reverse @methods if $PREFER_BIN;
+
+    for my $method (@methods) {
+        $self->_extractor($method) && return 1 if $self->$method();
+    }
+
+    return $self->_error(loc("Unable to untar file '%1'", $self->archive));
+}
+
+sub _uncompress_bin {
+    my $self = shift;
+
+    ### check for /bin/gzip -- we need it ###
+    return $self->_error(loc("No '%1' program found", '/bin/uncompress'))
+        unless $self->bin_uncompress;
+
+
+    my $fh = FileHandle->new('>'. $self->_gunzip_to) or
+        return $self->_error(loc("Could not open '%1' for writing: %2",
+                            $self->_gunzip_to, $! ));
+
+    my $cmd = [ $self->bin_uncompress, '-c', $self->archive ];
+
+    my $buffer;
+    unless( scalar run( command => $cmd,
+                        verbose => $DEBUG,
+                        buffer  => \$buffer )
+    ) {
+        return $self->_error(loc("Unable to uncompress '%1': %2",
+                                    $self->archive, $buffer));
+    }
+
+    ### no buffers available?
+    if( !IPC::Cmd->can_capture_buffer and !$buffer ) {
+        $self->_error( $self->_no_buffer_content( $self->archive ) );
+    }
+
+    print $fh $buffer if defined $buffer;
+
+    close $fh;
+
+    ### set what files where extract, and where they went ###
+    $self->files( [$self->_gunzip_to] );
+    $self->extract_path( File::Spec->rel2abs(cwd()) );
+
+    return 1;
+}
+
+
+#################################
+#
 # Unzip code
 #
 #################################
@@ -1119,6 +1197,8 @@ Defaults to C<false>.
 Maybe this module should use something like C<File::Type> to determine
 the type, rather than blindly trust the suffix.
 
+=back
+
 =head1 BUG REPORTS
 
 Please report bugs or other issues to E<lt>bug-archive-extract@rt.cpan.org<gt>.
diff --git a/lib/Archive/Extract/t/01_Archive-Extract.t b/lib/Archive/Extract/t/01_Archive-Extract.t
index b3154a2ec3..e0912f4d2e 100644
--- a/lib/Archive/Extract/t/01_Archive-Extract.t
+++ b/lib/Archive/Extract/t/01_Archive-Extract.t
@@ -77,11 +77,16 @@ my $tmpl = {
                     method      => 'is_tar',
                     outfile     => 'a',
                 },
-    'x.gz' => {     programs    => [qw[gzip]],
+    'x.gz'  => {    programs    => [qw[gzip]],
                     modules     => [qw[Compress::Zlib]],
                     method      => 'is_gz',
                     outfile     => 'a',
                 },
+    'x.Z'   => {    programs    => [qw[uncompress]],
+                    modules     => [qw[Compress::Zlib]],
+                    method      => 'is_Z',
+                    outfile     => 'a',
+                },
     'x.zip' => {    programs    => [qw[unzip]],
                     modules     => [qw[Archive::Zip]],
                     method      => 'is_zip',
@@ -272,7 +277,9 @@ for my $switch (0,1) {
         ### where to extract to -- try both dir and file for gz files
         ### XXX test me!
         #my @outs = $ae->is_gz ? ($abs_path, $OutDir) : ($OutDir);
-        my @outs = $ae->is_gz || $ae->is_bz2 ? ($abs_path) : ($OutDir);
+        my @outs = $ae->is_gz || $ae->is_bz2 || $ae->is_Z 
+                        ? ($abs_path) 
+                        : ($OutDir);
 
         skip "No binaries or modules to extract ".$archive, 
             (10 * scalar @outs) if $mod_fail && $pgm_fail;
@@ -302,7 +309,7 @@ for my $switch (0,1) {
 
                 diag("Extracting to: $to")                  if $Debug;
                 diag("Buffers enabled: ".!$turn_off)        if $Debug;
-    
+  
                 my $rv = $ae->extract( to => $to );
     
                 ok( $rv, "extract() for '$archive' reports success");
@@ -352,6 +359,14 @@ for my $switch (0,1) {
                         skip "No extract path captured, can't remove paths", 2
                             unless $ae->extract_path;
         
+                        ### if something went wrong with determining the out
+                        ### path, don't go deleting stuff.. might be Really Bad
+                        my $out_re = quotemeta( $OutDir );
+                        if( $ae->extract_path !~ /^$out_re/ ) {   
+                            ok( 0, "Extractpath WRONG (".$ae->extract_path.")"); 
+                            skip(  "Unsafe operation -- skip cleanup!!!" ), 1;
+                        }                    
+        
                         eval { rmtree( $ae->extract_path ) }; 
                         ok( !$@,        "   rmtree gave no error" );
                         ok( !(-d $ae->extract_path ),
diff --git a/lib/Archive/Extract/t/src/double_dir.zip.packed b/lib/Archive/Extract/t/src/double_dir.zip.packed
index 55fd5a69fa..ff5b91c6c3 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 Wed Apr 11 21:33:15 2007
+Created at Mon May 28 12:45:26 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
new file mode 100644
index 0000000000..0ea47274f4
--- /dev/null
+++ b/lib/Archive/Extract/t/src/x.Z.packed
@@ -0,0 +1,16 @@
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+     uupacktool.pl -u lib/Archive/Extract/t/src/x.Z.packed lib/Archive/Extract/t/src/x.Z
+
+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
+#########################################################################
+__UU__
+''YV0>`(J````
diff --git a/lib/Archive/Extract/t/src/x.bz2.packed b/lib/Archive/Extract/t/src/x.bz2.packed
index 153e2c0b07..cc3afd35b6 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 Wed Apr 11 21:33:15 2007
+Created at Mon May 28 12:45:26 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 036efaca17..0a33b126d4 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 Wed Apr 11 21:33:15 2007
+Created at Mon May 28 12:45:26 2007
 #########################################################################
 __UU__
-6'XL(""66P4`"`V$``P``````````````
+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 caaf047828..6911a2da86 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 Wed Apr 11 21:33:15 2007
+Created at Mon May 28 12:45:26 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 dde325f4e8..4ea88bc32d 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 Wed Apr 11 21:33:15 2007
+Created at Mon May 28 12:45:26 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 48ec32ec50..6f3f0d9e1c 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 Wed Apr 11 21:33:15 2007
+Created at Mon May 28 12:45:27 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 5569144293..94c371bd73 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 Wed Apr 11 21:33:15 2007
+Created at Mon May 28 12:45:26 2007
 #########################################################################
 __UU__
 M80``````````````````````````````````````````````````````````
diff --git a/lib/Archive/Extract/t/src/x.tgz.packed b/lib/Archive/Extract/t/src/x.tgz.packed
index c69cc8a3c6..ccef96a594 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 Wed Apr 11 21:33:15 2007
+Created at Mon May 28 12:45:27 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 b911b34a06..97e318c577 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 Wed Apr 11 21:33:16 2007
+Created at Mon May 28 12:45:27 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 edfc713b6e..16496a0f12 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 Wed Apr 11 21:33:16 2007
+Created at Mon May 28 12:45:27 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 f0626f8495..d05447176c 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 Wed Apr 11 21:33:16 2007
+Created at Mon May 28 12:45:27 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 135f81f14e..710f444666 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 Wed Apr 11 21:33:16 2007
+Created at Mon May 28 12:45:28 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 2d3a89dd69..5619f016f0 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 Wed Apr 11 21:33:16 2007
+Created at Mon May 28 12:45:28 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 c1ba61f583..4241385757 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 Wed Apr 11 21:33:16 2007
+Created at Mon May 28 12:45:27 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 07f5ad097c..7aa40b9050 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 Wed Apr 11 21:33:16 2007
+Created at Mon May 28 12:45:28 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 8ff545b547..8c80922db8 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 Wed Apr 11 21:33:16 2007
+Created at Mon May 28 12:45:28 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 143adb2a89..5a1a2c0b1e 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 Wed Apr 11 21:33:16 2007
+Created at Mon May 28 12:45:28 2007
 #########################################################################
 __UU__
 M4$L#!`H``````,NBB#$````````````````"`!``>2]56`P`M%6W06Y4MT'U