From: Steve Peters Date: Mon, 28 Jan 2008 20:04:40 +0000 (+0000) Subject: Upgrade to Archive-Extract-0.26 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8d2ac73b584b87e4bad5d63be12427d699364853;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Archive-Extract-0.26 p4raw-id: //depot/perl@33098 --- diff --git a/MANIFEST b/MANIFEST index e251bb4..2c3dd58 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1410,6 +1410,7 @@ lib/Archive/Extract/t/src/double_dir.zip.packed Archive::Extract tests lib/Archive/Extract/t/src/x.bz2.packed Archive::Extract tests lib/Archive/Extract/t/src/x.gz.packed Archive::Extract tests lib/Archive/Extract/t/src/x.jar.packed Archive::Extract tests +lib/Archive/Extract/t/src/x.lzma.packed Archive::Extract tests lib/Archive/Extract/t/src/x.par.packed Archive::Extract tests lib/Archive/Extract/t/src/x.tar.gz.packed Archive::Extract tests lib/Archive/Extract/t/src/x.tar.packed Archive::Extract tests diff --git a/lib/Archive/Extract.pm b/lib/Archive/Extract.pm index 1aafd23..d0cba4e 100644 --- a/lib/Archive/Extract.pm +++ b/lib/Archive/Extract.pm @@ -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 extracting mechanism $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 extracting mechanism $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 down for details. ### 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 success, or false on failure. $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 binary, if found 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->{'tar'} if $PROGRAMS->{'tar'} } 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 extract the archive for you. 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 --git a/lib/Archive/Extract/t/01_Archive-Extract.t b/lib/Archive/Extract/t/01_Archive-Extract.t index 4595a35..90abf20 100644 --- a/lib/Archive/Extract/t/01_Archive-Extract.t +++ b/lib/Archive/Extract/t/01_Archive-Extract.t @@ -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 --git a/lib/Archive/Extract/t/src/x.lzma.packed b/lib/Archive/Extract/t/src/x.lzma.packed new file mode 100644 index 0000000..5558011 --- /dev/null +++ b/lib/Archive/Extract/t/src/x.lzma.packed @@ -0,0 +1,207 @@ +######################################################################### +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 Mon Jan 28 14:00:38 2008 +######################################################################### +__UU__ +M(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C +M(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(PI4:&ES(&ES(&$@8FEN87)Y +M(&9I;&4@=&AA="!W87,@<&%C:V5D('=I=&@@=&AE("=U=7!A8VMT;V]L+G!L +M)R!W:&EC:`II"YL>FUA"@I#/E(]4"E75%LB1C%) +M.3(A50I-/%8E1SDR0$DH)D5&*"(Q3SPG,5,K,UE;*59`1S\S3"HB1D5&*")` +M0"DF75`])RQ-+T=,1SDB/5TH(D1`"DT^4$A`*")@0#A6040Z-RA`*29=4#TG +M+$TO1TQ'.2(]72)"8$`H(F!`*")@0#M7*$`Y)D5%*"(I)C@V14P*33DV,$`] +M)EQ`.%9!1#HW*$`])EQ`*5(Q3SPG,5,K,UE;*58P1S\R/%HI(B1"+E!)72)" +M,4\\)S%3*S-96PI-*5