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 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. Corresponds to a C<.tbz> or C<.tar.bz2> suffix. +=item lzma + +Lzma compressed file, as produced by C. +Corresponds to a C<.lzma> suffix. + =back Returns a C object on success, or false on failure. @@ -209,6 +218,7 @@ Returns a C 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 method for details. Returns true if the file is of type C<.zip>. See the C method for details. +=head2 $ae->is_lzma + +Returns true if the file is of type C<.lzma>. +See the C 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, from before the C 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 will not be able to C can use either pure perl modules or command line programs under the hood. Some of the pure perl modules (like -C take the entire contents of the archive into memory, +C 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``@```````````````````