This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Archive-Extract to CPAN version 0.42
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Mon, 28 Jun 2010 18:53:51 +0000 (19:53 +0100)
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Mon, 28 Jun 2010 18:53:51 +0000 (19:53 +0100)
  [DELTA]

  Updates since 0.38 include: a safe print method that Michael Schwern
  contributed, that guards Archive::Extract from changes to $\; a
  fix to the tests when run in core perl from Robin Barker; and
  support for TZ files contributed by Paul Marquess, who also supplied a
  modification for the lzma logic to favour IO::Uncompress::Unlzma

MANIFEST
Porting/Maintainers.pl
cpan/Archive-Extract/lib/Archive/Extract.pm
cpan/Archive-Extract/t/01_Archive-Extract.t
cpan/Archive-Extract/t/src/x.tar.xz [new file with mode: 0644]
cpan/Archive-Extract/t/src/x.txz [new file with mode: 0644]
cpan/Archive-Extract/t/src/x.xz [new file with mode: 0644]
cpan/Archive-Extract/t/src/y.tar.xz [new file with mode: 0644]
cpan/Archive-Extract/t/src/y.txz [new file with mode: 0644]

index d0e8004..7e21702 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -27,7 +27,10 @@ cpan/Archive-Extract/t/src/x.lzma            Archive::Extract tests
 cpan/Archive-Extract/t/src/x.par               Archive::Extract tests
 cpan/Archive-Extract/t/src/x.tar               Archive::Extract tests
 cpan/Archive-Extract/t/src/x.tar.gz            Archive::Extract tests
+cpan/Archive-Extract/t/src/x.tar.xz            Archive::Extract tests
 cpan/Archive-Extract/t/src/x.tgz               Archive::Extract tests
+cpan/Archive-Extract/t/src/x.txz               Archive::Extract tests
+cpan/Archive-Extract/t/src/x.xz                Archive::Extract tests
 cpan/Archive-Extract/t/src/x.Z                 Archive::Extract tests
 cpan/Archive-Extract/t/src/x.zip               Archive::Extract tests
 cpan/Archive-Extract/t/src/y.jar               Archive::Extract tests
@@ -35,8 +38,10 @@ cpan/Archive-Extract/t/src/y.par             Archive::Extract tests
 cpan/Archive-Extract/t/src/y.tar               Archive::Extract tests
 cpan/Archive-Extract/t/src/y.tar.bz2           Archive::Extract tests
 cpan/Archive-Extract/t/src/y.tar.gz            Archive::Extract tests
+cpan/Archive-Extract/t/src/y.tar.xz            Archive::Extract tests
 cpan/Archive-Extract/t/src/y.tbz               Archive::Extract tests
 cpan/Archive-Extract/t/src/y.tgz               Archive::Extract tests
+cpan/Archive-Extract/t/src/y.txz               Archive::Extract tests
 cpan/Archive-Extract/t/src/y.zip               Archive::Extract tests
 cpan/Archive-Tar/bin/ptar                              the ptar utility
 cpan/Archive-Tar/bin/ptardiff                          the ptardiff utility
index f630693..1a90159 100755 (executable)
@@ -183,7 +183,7 @@ use File::Glob qw(:case);
     'Archive::Extract' =>
        {
        'MAINTAINER'    => 'kane',
-       'DISTRIBUTION'  => 'BINGOS/Archive-Extract-0.38.tar.gz',
+       'DISTRIBUTION'  => 'BINGOS/Archive-Extract-0.42.tar.gz',
        'FILES'         => q[cpan/Archive-Extract],
        'UPSTREAM'      => 'cpan',
        'BUGS'          => 'bug-archive-extract@rt.cpan.org',
index 08676fb..538d8c3 100644 (file)
@@ -36,12 +36,14 @@ use constant BZ2            => 'bz2';
 use constant TBZ            => 'tbz';
 use constant Z              => 'Z';
 use constant LZMA           => 'lzma';
+use constant XZ             => 'xz';
+use constant TXZ            => 'txz';
 
 use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG 
             $_ALLOW_BIN $_ALLOW_PURE_PERL $_ALLOW_TAR_ITER
          ];
 
-$VERSION            = '0.38';
+$VERSION            = '0.42';
 $PREFER_BIN         = 0;
 $WARN               = 1;
 $DEBUG              = 0;
@@ -50,7 +52,7 @@ $_ALLOW_BIN         = 1;    # allow binary extractors
 $_ALLOW_TAR_ITER        = 1;    # try to use Archive::Tar->iter if available
 
 # same as all constants
-my @Types           = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z, LZMA ); 
+my @Types           = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z, LZMA, XZ, TXZ ); 
 
 local $Params::Check::VERBOSE = $Params::Check::VERBOSE = 1;
 
@@ -91,6 +93,8 @@ Archive::Extract - A generic archive extracting mechanism
     $ae->is_bz2;    # is it a .bz2 file?
     $ae->is_tbz;    # is it a .tar.bz2 or .tbz file?
     $ae->is_lzma;   # is it a .lzma file?
+    $ae->is_xz;     # is it a .xz file?
+    $ae->is_txz;    # is it a .tar.xz or .txz file?
 
     ### absolute path to the archive you provided ###
     $ae->archive;
@@ -101,13 +105,15 @@ Archive::Extract - A generic archive extracting mechanism
     $ae->bin_unzip   # path to /bin/unzip, if found
     $ae->bin_bunzip2 # path to /bin/bunzip2 if found
     $ae->bin_unlzma  # path to /bin/unlzma if found
+    $ae->bin_unxz    # path to /bin/unxz if found
 
 =head1 DESCRIPTION
 
 Archive::Extract is a generic archive extraction mechanism.
 
 It allows you to extract any archive file of the type .tar, .tar.gz,
-.gz, .Z, tar.bz2, .tbz, .bz2, .zip or .lzma without having to worry how it 
+.gz, .Z, tar.bz2, .tbz, .bz2, .zip, .xz,, .txz, .tar.xz or .lzma 
+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.
 
@@ -118,7 +124,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 uncompress unlzma]) {
+for my $pgm (qw[tar unzip gzip bunzip2 uncompress unlzma unxz]) {
     $PROGRAMS->{$pgm} = can_run($pgm);
 }
 
@@ -132,6 +138,8 @@ my $Mapping = {  # binary program           # pure perl module
     is_bz2  => { bin => '_bunzip2_bin',     pp => '_bunzip2_bz2'},
     is_Z    => { bin => '_uncompress_bin',  pp => '_gunzip_cz'  },
     is_lzma => { bin => '_unlzma_bin',      pp => '_unlzma_cz'  },
+    is_xz   => { bin => '_unxz_bin',        pp => '_unxz_cz'    },
+    is_txz  => { bin => '_untar_bin',       pp => '_untar_at'   },
 };
 
 {   ### use subs so we re-generate array refs etc for the no-overide flags
@@ -209,6 +217,16 @@ Corresponds to a C<.tbz> or C<.tar.bz2> suffix.
 Lzma compressed file, as produced by C</bin/lzma>.
 Corresponds to a C<.lzma> suffix.
 
+=item xz
+
+Xz compressed file, as produced by C</bin/xz>.
+Corresponds to a C<.xz> suffix.
+
+=item txz
+
+Xz compressed tar file, as produced by, for exmample C</bin/tar -J>.
+Corresponds to a C<.txz> or C<.tar.xz> suffix.
+
 =back
 
 Returns a C<Archive::Extract> object on success, or false on failure.
@@ -240,6 +258,8 @@ Returns a C<Archive::Extract> object on success, or false on failure.
                 $ar =~ /.+?\.bz2$/i                 ? BZ2   :
                 $ar =~ /.+?\.Z$/                    ? Z     :
                 $ar =~ /.+?\.lzma$/                 ? LZMA  :
+                $ar =~ /.+?\.(?:txz|tar\.xz)$/i     ? TXZ   :
+                $ar =~ /.+?\.xz$/                   ? XZ    :
                 '';
 
         }
@@ -320,9 +340,9 @@ sub extract {
     ### to.
     my $dir;
     {   ### a foo.gz file
-        if( $self->is_gz or $self->is_bz2 or $self->is_Z or $self->is_lzma ) {
+        if( $self->is_gz or $self->is_bz2 or $self->is_Z or $self->is_lzma or $self->is_xz ) {
     
-            my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2?|Z|lzma)$//i;
+            my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2?|Z|lzma|xz)$//i;
         
             ### to is a dir?
             if ( -d $to ) {
@@ -491,6 +511,11 @@ See the C<new()> method for details.
 Returns true if the file is of type C<.lzma>.
 See the C<new()> method for details.
 
+=head2 $ae->is_xz
+
+Returns true if the file is of type C<.xz>.
+See the C<new()> method for details.
+
 =cut
 
 ### quick check methods ###
@@ -502,6 +527,8 @@ sub is_tbz  { return $_[0]->type eq TBZ }
 sub is_bz2  { return $_[0]->type eq BZ2 }
 sub is_Z    { return $_[0]->type eq Z   }
 sub is_lzma { return $_[0]->type eq LZMA }
+sub is_xz   { return $_[0]->type eq XZ   }
+sub is_txz  { return $_[0]->type eq TXZ }
 
 =pod
 
@@ -521,6 +548,10 @@ Returns the full path to your unzip binary, if found
 
 Returns the full path to your unlzma binary, if found
 
+=head2 $ae->bin_unxz
+
+Returns the full path to your unxz binary, if found
+
 =cut
 
 ### paths to commandline tools ###
@@ -531,6 +562,7 @@ sub bin_bunzip2     { return $PROGRAMS->{'bunzip2'} if $PROGRAMS->{'bunzip2'} }
 sub bin_uncompress  { return $PROGRAMS->{'uncompress'} 
                                                  if $PROGRAMS->{'uncompress'} }
 sub bin_unlzma      { return $PROGRAMS->{'unlzma'}  if $PROGRAMS->{'unlzma'} }
+sub bin_unxz        { return $PROGRAMS->{'unxz'}    if $PROGRAMS->{'unxz'} }
 
 =head2 $bool = $ae->have_old_bunzip2
 
@@ -613,6 +645,8 @@ sub have_old_bunzip2 {
                             loc("No '%1' program found", '/bin/gzip') :
                         $self->is_tbz && !$self->bin_bunzip2 ?
                             loc("No '%1' program found", '/bin/bunzip2') :
+                        $self->is_txz && !$self->bin_unxz ?
+                            loc("No '%1' program found", '/bin/unxz') :
                         '';
                         
             if( $diag ) {
@@ -636,6 +670,8 @@ sub have_old_bunzip2 {
                                  $self->bin_tar, '-tf', '-'] :
                 $self->is_tbz ? [$self->bin_bunzip2, '-cd', $self->archive, '|',                             
                                  $self->bin_tar, '-tf', '-'] :
+                $self->is_txz ? [$self->bin_unxz, '-cd', $self->archive, '|',                             
+                                 $self->bin_tar, '-tf', '-'] :
                 [$self->bin_tar, @ExtraTarFlags, '-tf', $self->archive];
     
             ### run the command 
@@ -689,6 +725,8 @@ sub have_old_bunzip2 {
                                  $self->bin_tar, '-xf', '-'] :
                 $self->is_tbz ? [$self->bin_bunzip2, '-cd', $self->archive, '|',                             
                                  $self->bin_tar, '-xf', '-'] :
+                $self->is_txz ? [$self->bin_unxz, '-cd', $self->archive, '|',                             
+                                 $self->bin_tar, '-xf', '-'] :
                 [$self->bin_tar, @ExtraTarFlags, '-xf', $self->archive];
     
             my $buffer = '';
@@ -781,6 +819,24 @@ sub _untar_at {
                             $IO::Uncompress::Bunzip2::Bunzip2Error));
 
         $fh_to_read = $bz;
+    } elsif ( $self->is_txz ) {
+        my $use_list = { 'IO::Uncompress::UnXz' => '0.0' };
+        unless( can_load( modules => $use_list ) ) {
+            $self->_error(loc(
+                "You do not have '%1' installed - Please " .
+                "install it as soon as possible.", 
+                'IO::Uncompress::UnXz')
+            );
+            
+            return METHOD_NA;
+        }
+
+        my $xz = IO::Uncompress::UnXz->new( $self->archive ) or
+            return $self->_error(loc("Unable to open '%1': %2",
+                            $self->archive,
+                            $IO::Uncompress::UnXz::UnXzError));
+
+        $fh_to_read = $xz;
     }
 
     my @files;
@@ -1256,6 +1312,75 @@ sub _bunzip2_bz2 {
     return 1;
 }
 
+#################################
+#
+# UnXz code
+#
+#################################
+
+sub _unxz_bin {
+    my $self = shift;
+
+    ### check for /bin/unxz -- we need it ###
+    unless( $self->bin_unxz ) {
+        $self->_error(loc("No '%1' program found", '/bin/unxz'));
+        return METHOD_NA;
+    }
+
+    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_unxz, '-cdf', $self->archive ];
+
+    my $buffer;
+    unless( scalar run( command => $cmd,
+                        verbose => $DEBUG,
+                        buffer  => \$buffer )
+    ) {
+        return $self->_error(loc("Unable to unxz '%1': %2",
+                                    $self->archive, $buffer));
+    }
+
+    ### no buffers available?
+    if( !IPC::Cmd->can_capture_buffer and !$buffer ) {
+        $self->_error( $self->_no_buffer_content( $self->archive ) );
+    }
+
+    $self->_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;
+}
+
+sub _unxz_cz {
+    my $self = shift;
+
+    my $use_list = { 'IO::Uncompress::UnXz' => '0.0' };
+    unless( can_load( modules => $use_list ) ) {
+        $self->_error(loc("You do not have '%1' installed - Please " .
+                          "install it as soon as possible.",
+                          'IO::Uncompress::UnXz'));
+        return METHOD_NA;                          
+    }
+
+    IO::Uncompress::UnXz::unxz($self->archive => $self->_gunzip_to)
+        or return $self->_error(loc("Unable to uncompress '%1': %2",
+                            $self->archive,
+                            $IO::Uncompress::UnXz::UnXzError));
+
+    ### set what files where extract, and where they went ###
+    $self->files( [$self->_gunzip_to] );
+    $self->extract_path( File::Spec->rel2abs(cwd()) );
+
+    return 1;
+}
+
 
 #################################
 #
@@ -1306,27 +1431,37 @@ sub _unlzma_bin {
 sub _unlzma_cz {
     my $self = shift;
 
-    my $use_list = { 'Compress::unLZMA' => '0.0' };
-    unless( can_load( modules => $use_list ) ) {
-        $self->_error(loc("You do not have '%1' installed - Please " .
-                    "install it as soon as possible.", 'Compress::unLZMA'));
-        return METHOD_NA;                    
+    my $use_list1 = { 'IO::Uncompress::UnLzma' => '0.0' };
+    my $use_list2 = { 'Compress::unLZMA' => '0.0' };
+
+    if (can_load( modules => $use_list1 ) ) {
+        IO::Uncompress::UnLzma::unlzma($self->archive => $self->_gunzip_to)
+            or return $self->_error(loc("Unable to uncompress '%1': %2",
+                                $self->archive,
+                                $IO::Uncompress::UnLzma::UnLzmaError));
     }
+    elsif (can_load( modules => $use_list2 ) ) {
 
-    my $fh = FileHandle->new('>'. $self->_gunzip_to) or
-        return $self->_error(loc("Could not open '%1' for writing: %2",
-                            $self->_gunzip_to, $! ));
+        my $fh = FileHandle->new('>'. $self->_gunzip_to) or
+            return $self->_error(loc("Could not open '%1' for writing: %2",
+                                $self->_gunzip_to, $! ));
 
-    my $buffer;
-    $buffer = Compress::unLZMA::uncompressfile( $self->archive );
-    unless ( defined $buffer ) {
-        return $self->_error(loc("Could not unlzma '%1': %2",
-                                    $self->archive, $@));
-    }
+        my $buffer;
+        $buffer = Compress::unLZMA::uncompressfile( $self->archive );
+        unless ( defined $buffer ) {
+            return $self->_error(loc("Could not unlzma '%1': %2",
+                                        $self->archive, $@));
+        }
 
-    $self->_print($fh, $buffer) if defined $buffer;
+        $self->_print($fh, $buffer) if defined $buffer;
 
-    close $fh;
+        close $fh;
+    }
+    else {
+        $self->_error(loc("You do not have '%1' or '%2' installed - Please " .
+                    "install it as soon as possible.", 'Compress::unLZMA', 'IO::Uncompress::UnLzma'));
+        return METHOD_NA;                    
+    }
 
     ### set what files where extract, and where they went ###
     $self->files( [$self->_gunzip_to] );
index 93c9026..941ac83 100644 (file)
@@ -1,10 +1,3 @@
-BEGIN { 
-    if( $ENV{PERL_CORE} ) {
-        chdir '../lib/Archive/Extract' if -d '../lib/Archive/Extract';
-        unshift @INC, '../../..', '../../../..';
-    }
-}    
-
 BEGIN { chdir 't' if -d 't' };
 BEGIN { mkdir 'out' unless -d 'out' };
 
@@ -122,6 +115,23 @@ my $tmpl = {
                     method      => 'is_lzma',
                     outfile     => 'a',
                 },
+    'x.xz'   => {   programs    => [qw[unxz]],
+                    modules     => [qw[IO::Uncompress::UnXz]],
+                    method      => 'is_xz',
+                    outfile     => 'a',
+                },
+    'x.txz'  => {   programs    => [qw[unxz tar]],
+                    modules     => [qw[Archive::Tar
+                                           IO::Uncompress::UnXz]],
+                    method      => 'is_txz',
+                    outfile     => 'a',
+                },
+    'x.tar.xz'=> {  programs    => [qw[unxz tar]],
+                    modules     => [qw[Archive::Tar
+                                           IO::Uncompress::UnXz]],
+                    method      => 'is_txz',
+                    outfile     => 'a',
+                },
     ### with a directory
     'y.tbz'     => {    programs    => [qw[bunzip2 tar]],
                         modules     => [qw[Archive::Tar 
@@ -137,6 +147,20 @@ my $tmpl = {
                         outfile     => 'z',
                         outdir      => 'y'
                     },    
+    'y.txz'     => {    programs    => [qw[unxz tar]],
+                        modules     => [qw[Archive::Tar 
+                                           IO::Uncompress::UnXz]],
+                        method      => 'is_txz',
+                        outfile     => 'z',
+                        outdir      => 'y',
+                    },
+    'y.tar.xz'  => {    programs    => [qw[unxz tar]],
+                        modules     => [qw[Archive::Tar 
+                                           IO::Uncompress::UnXz]],
+                        method      => 'is_txz',
+                        outfile     => 'z',
+                        outdir      => 'y'
+                    },    
     'y.tgz'     => {    programs    => [qw[gzip tar]],
                         modules     => [qw[Archive::Tar IO::Zlib]],
                         method      => 'is_tgz',
@@ -309,6 +333,7 @@ for my $switch ( [0,1], [1,0] ) {
     diag("Running extract with configuration: $cfg") if $Debug;
 
     for my $archive (keys %$tmpl) {
+        diag("Archive : $archive") if $Debug;
 
         ### check first if we can do the proper
 
@@ -318,11 +343,11 @@ for my $switch ( [0,1], [1,0] ) {
         ### Do an extra run with _ALLOW_TAR_ITER = 0 if it's a tar file of some
         ### sort
         my @with_tar_iter = ( 1 );
-        push @with_tar_iter, 0 if grep { $ae->$_ } qw[is_tbz is_tgz is_tar];
+        push @with_tar_iter, 0 if grep { $ae->$_ } qw[is_tbz is_tgz is_txz is_tar];
 
         for my $tar_iter (@with_tar_iter) { SKIP: {
 
-            ### Doesn't matter unless .tar, .tbz, .tgz
+            ### Doesn't matter unless .tar, .tbz, .tgz, .txz
             local $Archive::Extract::_ALLOW_TAR_ITER = $tar_iter; 
         
             diag("Archive::Tar->iter: $tar_iter") if $Debug;
@@ -330,8 +355,7 @@ for my $switch ( [0,1], [1,0] ) {
             isa_ok( $ae, $Class );
 
             my $method = $tmpl->{$archive}->{method};
-            ok( $ae->$method(),         "Archive type recognized properly" );
-
+            ok( $ae->$method(),         "Archive type $method recognized properly" );
         
             my $file        = $tmpl->{$archive}->{outfile};
             my $dir         = $tmpl->{$archive}->{outdir};  # can be undef
@@ -365,7 +389,7 @@ for my $switch ( [0,1], [1,0] ) {
             ### 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 || $ae->is_Z || $ae->is_lzma
+            my @outs = $ae->is_gz || $ae->is_bz2 || $ae->is_Z || $ae->is_lzma || $ae->is_xz
                             ? ($abs_path) 
                             : ($OutDir);
 
diff --git a/cpan/Archive-Extract/t/src/x.tar.xz b/cpan/Archive-Extract/t/src/x.tar.xz
new file mode 100644 (file)
index 0000000..531eee8
Binary files /dev/null and b/cpan/Archive-Extract/t/src/x.tar.xz differ
diff --git a/cpan/Archive-Extract/t/src/x.txz b/cpan/Archive-Extract/t/src/x.txz
new file mode 100644 (file)
index 0000000..531eee8
Binary files /dev/null and b/cpan/Archive-Extract/t/src/x.txz differ
diff --git a/cpan/Archive-Extract/t/src/x.xz b/cpan/Archive-Extract/t/src/x.xz
new file mode 100644 (file)
index 0000000..ea28d9e
Binary files /dev/null and b/cpan/Archive-Extract/t/src/x.xz differ
diff --git a/cpan/Archive-Extract/t/src/y.tar.xz b/cpan/Archive-Extract/t/src/y.tar.xz
new file mode 100644 (file)
index 0000000..dfca273
Binary files /dev/null and b/cpan/Archive-Extract/t/src/y.tar.xz differ
diff --git a/cpan/Archive-Extract/t/src/y.txz b/cpan/Archive-Extract/t/src/y.txz
new file mode 100644 (file)
index 0000000..dfca273
Binary files /dev/null and b/cpan/Archive-Extract/t/src/y.txz differ