perl/perl-5.10.0-Archive-Extract-0.26.patch

diff -up perl-5.10.0/lib/Archive/Extract/t/01_Archive-Extract.t.BAD perl-5.10.0/lib/Archive/Extract/t/01_Archive-Extract.t
--- perl-5.10.0/lib/Archive/Extract/t/01_Archive-Extract.t.BAD	2007-12-18 05:47:07.000000000 -0500
+++ perl-5.10.0/lib/Archive/Extract/t/01_Archive-Extract.t	2008-03-08 14:55:53.000000000 -0500
@@ -58,6 +58,7 @@ use_ok($Class);
 $Archive::Extract::VERBOSE  = $Archive::Extract::VERBOSE = $Debug;
 $Archive::Extract::WARN     = $Archive::Extract::WARN    = $Debug ? 1 : 0;
 
+
 my $tmpl = {
     ### plain files
     'x.bz2' => {    programs    => [qw[bunzip2]],
@@ -105,6 +106,11 @@ my $tmpl = {
                     method      => 'is_zip',
                     outfile     => 'a',
                 },                
+    'x.lzma' => {   programs    => [qw[unlzma]],
+                    modules     => [qw[Compress::unLZMA]],
+                    method      => 'is_lzma',
+                    outfile     => 'a',
+                },
     ### with a directory
     'y.tbz'     => {    programs    => [qw[bunzip2 tar]],
                         modules     => [qw[Archive::Tar 
@@ -291,7 +297,7 @@ 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 || $ae->is_Z 
+        my @outs = $ae->is_gz || $ae->is_bz2 || $ae->is_Z || $ae->is_lzma
                         ? ($abs_path) 
                         : ($OutDir);
 
diff -up perl-5.10.0/lib/Archive/Extract.pm.BAD perl-5.10.0/lib/Archive/Extract.pm
--- perl-5.10.0/lib/Archive/Extract.pm.BAD	2007-12-18 05:47:07.000000000 -0500
+++ perl-5.10.0/lib/Archive/Extract.pm	2008-03-08 14:55:15.000000000 -0500
@@ -28,14 +28,15 @@ use constant ZIP            => 'zip';
 use constant BZ2            => 'bz2';
 use constant TBZ            => 'tbz';
 use constant Z              => 'Z';
+use constant LZMA           => 'lzma';
 
 use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG];
 
-$VERSION        = '0.24';
+$VERSION        = '0.26';
 $PREFER_BIN     = 0;
 $WARN           = 1;
 $DEBUG          = 0;
-my @Types       = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z ); # same as all constants
+my @Types       = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z, LZMA ); # same as all constants
 
 local $Params::Check::VERBOSE = $Params::Check::VERBOSE = 1;
 
@@ -75,6 +76,7 @@ Archive::Extract - A generic archive ext
     $ae->is_zip;    # is it a .zip file?
     $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?
 
     ### absolute path to the archive you provided ###
     $ae->archive;
@@ -84,13 +86,14 @@ Archive::Extract - A generic archive ext
     $ae->bin_gzip    # path to /bin/gzip, if found
     $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
 
 =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 or .zip without having to worry how it 
+.gz, .Z, tar.bz2, .tbz, .bz2, .zip 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.
 
@@ -101,7 +104,7 @@ See the C<HOW IT WORKS> section further 
 
 ### see what /bin/programs are available ###
 $PROGRAMS = {};
-for my $pgm (qw[tar unzip gzip bunzip2 uncompress]) {
+for my $pgm (qw[tar unzip gzip bunzip2 uncompress unlzma]) {
     $PROGRAMS->{$pgm} = can_run($pgm);
 }
 
@@ -114,6 +117,7 @@ my $Mapping = {
     is_tbz  => '_untar',
     is_bz2  => '_bunzip2',
     is_Z    => '_uncompress',
+    is_lzma => '_unlzma',
 };
 
 {
@@ -183,6 +187,11 @@ Corresponds to a C<.bz2> suffix.
 Bzip2 compressed tar file, as produced by, for exmample C</bin/tar -j>.
 Corresponds to a C<.tbz> or C<.tar.bz2> suffix.
 
+=item lzma
+
+Lzma compressed file, as produced by C</bin/lzma>.
+Corresponds to a C<.lzma> suffix.
+
 =back
 
 Returns a C<Archive::Extract> object on success, or false on failure.
@@ -209,6 +218,7 @@ Returns a C<Archive::Extract> object on 
                 $ar =~ /.+?\.(?:tbz2?|tar\.bz2?)$/i ? TBZ   :
                 $ar =~ /.+?\.bz2$/i                 ? BZ2   :
                 $ar =~ /.+?\.Z$/                    ? Z     :
+                $ar =~ /.+?\.lzma$/                 ? LZMA  :
                 '';
 
         }
@@ -283,9 +293,9 @@ sub extract {
     ### to.
     my $dir;
     {   ### a foo.gz file
-        if( $self->is_gz or $self->is_bz2 or $self->is_Z) {
+        if( $self->is_gz or $self->is_bz2 or $self->is_Z or $self->is_lzma ) {
     
-            my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2?|Z)$//i;
+            my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2?|Z|lzma)$//i;
         
             ### to is a dir?
             if ( -d $to ) {
@@ -418,6 +428,11 @@ See the C<new()> method for details.
 Returns true if the file is of type C<.zip>.
 See the C<new()> method for details.
 
+=head2 $ae->is_lzma
+
+Returns true if the file is of type C<.lzma>.
+See the C<new()> method for details.
+
 =cut
 
 ### quick check methods ###
@@ -428,6 +443,7 @@ 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   }
+sub is_lzma { return $_[0]->type eq LZMA }
 
 =pod
 
@@ -443,6 +459,10 @@ Returns the full path to your gzip binar
 
 Returns the full path to your unzip binary, if found
 
+=head2 $ae->bin_unlzma
+
+Returns the full path to your unlzma binary, if found
+
 =cut
 
 ### paths to commandline tools ###
@@ -452,6 +472,8 @@ sub bin_tar         { return $PROGRAMS->
 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'} }
+
 =head2 $bool = $ae->have_old_bunzip2
 
 Older versions of C</bin/bunzip2>, from before the C<bunzip2 1.0> release,
@@ -478,8 +500,16 @@ sub have_old_bunzip2 {
     ### $ echo $?
     ### 1
     ### HATEFUL!
+    
+    ### double hateful: bunzip2 --version also hangs if input is a pipe
+    ### See #32370: Archive::Extract will hang if stdin is a pipe [+PATCH]
+    ### So, we have to provide *another* argument which is a fake filename,
+    ### just so it wont try to read from stdin to print it's version..
+    ### *sigh*
+    ### Even if the file exists, it won't clobber or change it.
     my $buffer;
-    scalar run( command => [$self->bin_bunzip2, '--version'],
+    scalar run( 
+         command => [$self->bin_bunzip2, '--version', 'NoSuchFile'],
          verbose => 0,
          buffer  => \$buffer
     );
@@ -499,7 +529,6 @@ sub have_old_bunzip2 {
 #
 #################################
 
-
 ### untar wrapper... goes to either Archive::Tar or /bin/tar
 ### depending on $PREFER_BIN
 sub _untar {
@@ -1141,6 +1170,96 @@ sub _bunzip2_cz2 {
 
 #################################
 #
+# unlzma code
+#
+#################################
+
+### unlzma wrapper... goes to either Compress::unLZMA or /bin/unlzma
+### depending on $PREFER_BIN
+sub _unlzma {
+    my $self = shift;
+
+    my @methods = qw[_unlzma_cz _unlzma_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 unlzma file '%1'", $self->archive));
+}
+
+sub _unlzma_bin {
+    my $self = shift;
+
+    ### check for /bin/unlzma -- we need it ###
+    return $self->_error(loc("No '%1' program found", '/bin/unlzma'))
+        unless $self->bin_unlzma;
+
+    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_unlzma, '-c', $self->archive ];
+
+    my $buffer;
+    unless( scalar run( command => $cmd,
+                        verbose => $DEBUG,
+                        buffer  => \$buffer )
+    ) {
+        return $self->_error(loc("Unable to unlzma '%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;
+}
+
+sub _unlzma_cz {
+    my $self = shift;
+
+    my $use_list = { 'Compress::unLZMA' => '0.0' };
+    unless( can_load( modules => $use_list ) ) {
+        return $self->_error(loc("You do not have '%1' installed - Please " .
+                       "install it as soon as possible.", 'Compress::unLZMA'));
+    }
+
+    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, $@));
+    }
+
+    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;
+}
+
+#################################
+#
 # Error code
 #
 #################################
@@ -1208,7 +1327,7 @@ C<Archive::Extract> will not be able to 
 
 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,
+C<Archive::Tar> and Compress::unLZMA) 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.
diff -up perl-5.10.0/lib/Archive/Extract/t/src/x.lzma.packed.BAD perl-5.10.0/lib/Archive/Extract/t/src/x.lzma.packed
--- perl-5.10.0/lib/Archive/Extract/t/src/x.lzma.packed.BAD	2008-03-08 19:20:41.000000000 -0500
+++ perl-5.10.0/lib/Archive/Extract/t/src/x.lzma.packed	2008-03-08 19:20:33.000000000 -0500
@@ -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.lzma.packed lib/Archive/Extract/t/src/x.lzma
+
+To recreate it use the following command:
+
+     uupacktool.pl -p lib/Archive/Extract/t/src/x.lzma lib/Archive/Extract/t/src/x.lzma.packed
+
+Created at Sat Mar  8 19:20:33 2008
+#########################################################################
+__UU__
+270``@```````````````````