Update Archive::Extract to 0.26 Update Module::Load::Conditional to 0.24

Conditionalize reporting of multilib patch
This commit is contained in:
Tom Callaway 2008-03-08 20:38:57 +00:00
parent 74f22796c3
commit 6a5cde9e1c
3 changed files with 397 additions and 12 deletions

View File

@ -0,0 +1,298 @@
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.

View File

@ -0,0 +1,72 @@
diff -up perl-5.10.0/lib/Module/Load/Conditional.pm.BAD perl-5.10.0/lib/Module/Load/Conditional.pm
--- perl-5.10.0/lib/Module/Load/Conditional.pm.BAD 2007-12-18 05:47:07.000000000 -0500
+++ perl-5.10.0/lib/Module/Load/Conditional.pm 2008-03-08 15:26:18.000000000 -0500
@@ -9,7 +9,7 @@ use Locale::Maketext::Simple Style => '
use Carp ();
use File::Spec ();
use FileHandle ();
-use version qw[qv];
+use version;
use constant ON_VMS => $^O eq 'VMS';
@@ -18,7 +18,7 @@ BEGIN {
$FIND_VERSION $ERROR $CHECK_INC_HASH];
use Exporter;
@ISA = qw[Exporter];
- $VERSION = '0.22';
+ $VERSION = '0.24';
$VERBOSE = 0;
$FIND_VERSION = 1;
$CHECK_INC_HASH = 0;
@@ -280,8 +280,14 @@ sub check_install {
### use qv(), as it will deal with developer release number
### ie ones containing _ as well. This addresses bug report
### #29348: Version compare logic doesn't handle alphas?
+ ###
+ ### Update from JPeacock: apparently qv() and version->new
+ ### are different things, and we *must* use version->new
+ ### here, or things like #30056 might start happening
$href->{uptodate} =
- qv( $args->{version} ) <= qv( $href->{version} ) ? 1 : 0;
+ version->new( $args->{version} ) <= version->new( $href->{version} )
+ ? 1
+ : 0;
}
return $href;
@@ -301,7 +307,8 @@ sub _parse_version {
### regex breaks under -T, we must modifiy it so
### it captures the entire expression, and eval /that/
### rather than $_, which is insecure.
-
+ my $taint_safe_str = do { $str =~ /(^.*$)/sm; $1 };
+
if( $str =~ /(?<!\\)([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) {
print "Evaluating: $str\n" if $verbose;
@@ -321,7 +328,7 @@ sub _parse_version {
local $1$2;
\$$2=undef; do {
- $str
+ $taint_safe_str
}; \$$2
};
@@ -426,9 +433,14 @@ sub can_load {
### use qv(), as it will deal with developer release number
### ie ones containing _ as well. This addresses bug report
### #29348: Version compare logic doesn't handle alphas?
+ ###
+ ### Update from JPeacock: apparently qv() and version->new
+ ### are different things, and we *must* use version->new
+ ### here, or things like #30056 might start happening
if ( !$args->{nocache}
&& defined $CACHE->{$mod}->{usable}
- && (qv($CACHE->{$mod}->{version}||0) >= qv($href->{$mod}))
+ && (version->new( $CACHE->{$mod}->{version}||0 )
+ >= version->new( $href->{$mod} ) )
) {
$error = loc( q[Already tried to use '%1', which was unsuccessful], $mod);
last BLOCK;

View File

@ -16,7 +16,7 @@
Name: perl
Version: %{perl_version}
Release: 11%{?dist}
Release: 12%{?dist}
Epoch: %{perl_epoch}
Summary: The Perl programming language
Group: Development/Languages
@ -45,25 +45,31 @@ Patch4: perl-5.8.8-rpath-make.patch
Patch5: perl-5.8.0-libdir64.patch
# Fedora/RHEL specific (use libresolv instead of libbind)
Patch6: perl-5.8.6-libresolv.patch
Patch6: perl-5.8.6-libresolv.patch
# FIXME: May need the "Fedora" references removed before upstreaming
Patch7: perl-5.10.0-USE_MM_LD_RUN_PATH.patch
Patch7: perl-5.10.0-USE_MM_LD_RUN_PATH.patch
# Skip hostname tests, since hostname lookup isn't available in Fedora
# buildroots by design.
Patch8: perl-5.10.0-disable_test_hosts.patch
Patch8: perl-5.10.0-disable_test_hosts.patch
# Bump Sys::Syslog to 0.24 to fix test failure case
Patch9: perl-5.10.0-SysSyslog-0.24.patch
Patch9: perl-5.10.0-SysSyslog-0.24.patch
# The Fedora builders started randomly failing this futime test
# only on x86_64, so we just don't run it. Works fine on normal
# systems.
Patch10: perl-5.10.0-x86_64-io-test-failure.patch
Patch10: perl-5.10.0-x86_64-io-test-failure.patch
# http://public.activestate.com/cgi-bin/perlbrowse/p/32891
Patch11: 32891.patch
Patch11: 32891.patch
# Bump Archive::Extract to 0.26 for clean upgrade
Patch12: perl-5.10.0-Archive-Extract-0.26.patch
# Update Module::Load::Conditional to 0.24 for clean upgrade
Patch13: perl-5.10.0-Module-Load-Conditional-0.24.patch
BuildRoot: %{_tmppath}/%{name}-%{perl_version}-%{release}-root-%(%{__id_u} -n)
BuildRequires: tcsh, dos2unix, man, groff
@ -281,8 +287,7 @@ Summary: API & CLI access to the CPAN mirrors
Group: Development/Libraries
License: GPL+ or Artistic
Epoch: 0
# It's really 0.83_09, but we drop the _09.
Version: 0.83
Version: 0.84
Requires: perl(IPC::Run) >= 0.79
Requires: perl(Module::Pluggable) >= 2.4
Requires: perl(Module::CoreList)
@ -376,8 +381,7 @@ Summary: Generic file fetching mechanism
Group: Development/Libraries
License: GPL+ or Artistic
Epoch: 0
# Really 0.13_04, but we drop the _04.
Version: 0.13
Version: 0.14
Requires: perl(IPC::Cmd) >= 0.36
Requires: perl(Module::Load::Conditional) >= 0.04
Requires: perl(Params::Check) >= 0.07
@ -524,7 +528,7 @@ Summary: Perl core modules indexed by perl versions
Group: Development/Languages
License: GPL+ or Artistic
Epoch: 0
Version: 2.12
Version: 2.13
Requires: perl = %{perl_epoch}:%{perl_version}-%{release}
Requires: perl(version)
@ -782,6 +786,8 @@ upstream tarball from perl.org.
%patch9 -p1
%patch10 -p1
%patch11 -p1
%patch12 -p1
%patch13 -p1
#
# Candidates for doc recoding (need case by case review):
@ -975,13 +981,17 @@ perl -x patchlevel.h 'Fedora Patch1: Permit suidperl to install as nonroot'
perl -x patchlevel.h 'Fedora Patch2: Removes date check, Fedora/RHEL specific'
perl -x patchlevel.h 'Fedora Patch3: Fedora/RHEL use links instead of lynx'
perl -x patchlevel.h 'Fedora Patch4: Work around annoying rpath issue'
%ifarch %{multilib_64_archs}
perl -x patchlevel.h 'Fedora Patch5: support for libdir64'
%endif
perl -x patchlevel.h 'Fedora Patch6: use libresolv instead of libbind'
perl -x patchlevel.h 'Fedora Patch7: USE_MM_LD_RUN_PATH'
perl -x patchlevel.h 'Fedora Patch8: Skip hostname tests, due to builders not being network capable'
perl -x patchlevel.h 'Fedora Patch9: Update Sys::Syslog to 0.24'
perl -x patchlevel.h 'Fedora Patch10: Dont run one io test due to random builder failures'
perl -x patchlevel.h '32891 fix big slowdown in 5.10 @_ parameter passing'
perl -x patchlevel.h 'Fedora Patch12: Update Archive::Extract to 0.26'
perl -x patchlevel.h 'Fedora Patch13: Update Module::Load::Conditional to 0.24'
%clean
rm -rf $RPM_BUILD_ROOT
@ -1581,6 +1591,11 @@ make test
# Old changelog entries are preserved in CVS.
%changelog
* Fri Mar 7 2008 Tom "spot" Callaway <tcallawa@redhat.com> 4:5.10.0-12
- conditionalize multilib patch report in patchlevel.h
- Update Archive::Extract to 0.26
- Update Module::Load::Conditional to 0.24
* Fri Mar 7 2008 Tom "spot" Callaway <tcallawa@redhat.com> 4:5.10.0-11
- only do it once, and do it for all our patches