rpms/perl
7
0
Fork 0
Code Issues Pull Requests Releases Activity
85f75da710
perl/perl-5.10.0-Archive-Extract-0.26.patch
Tom Callaway 30d1b9a580 add missing lzma test file
2008-03-09 00:24:39 +00:00

319 lines
11 KiB
Diff
Raw Blame History

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``@```````````````````
Reference in New Issue View Git Blame Copy Permalink