rpms
/
perl
7
0
Fork 0
Code Issues Pull Requests Releases Activity

- rebuild with new gdbm 

- clean spec a little more
This commit is contained in:
Marcela Mašláňová 2010-03-11 08:56:39 +00:00
parent 75aad87998
commit 26547351fb
24 changed files with 15 additions and 71876 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

978
perl-update-Archive-Extract.patch
View File

@ -1,978 +0,0 @@
Archive-Extract-0.30
diff -urN perl-5.10.0.orig/lib/Archive/Extract/t/01_Archive-Extract.t perl-5.10.0/lib/Archive/Extract/t/01_Archive-Extract.t
--- perl-5.10.0.orig/lib/Archive/Extract/t/01_Archive-Extract.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Archive/Extract/t/01_Archive-Extract.t 2009-03-10 12:31:09.000000000 +0100
@@ -58,6 +58,7 @@
$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 @@
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
@@ -201,8 +207,53 @@
ok( $obj, " Object created based on '$type'" );
ok( !$obj->error, " No error logged" );
}
+
+ ### test unknown type
+ { ### must turn on warnings to catch error here
+ local $Archive::Extract::WARN = 1;
+
+ my $warnings;
+ local $SIG{__WARN__} = sub { $warnings .= "@_" };
+
+ my $ae = $Class->new( archive => $Me );
+ ok( !$ae, " No archive created based on '$Me'" );
+ ok( !$Class->error, " Error not captured in class method" );
+ ok( $warnings, " Error captured as warning" );
+ like( $warnings, qr/Cannot determine file type for/,
+ " Error is: unknown file type" );
+ }
}
+### test multiple errors
+### XXX whitebox test
+{ ### grab a random file from the template, so we can make an object
+ my $ae = Archive::Extract->new(
+ archive => File::Spec->catfile($SrcDir,[keys %$tmpl]->[0])
+ );
+ ok( $ae, "Archive created" );
+ ok( not($ae->error), " No errors yet" );
+
+ ### log a few errors
+ { local $Archive::Extract::WARN = 0;
+ $ae->_error( $_ ) for 1..5;
+ }
+
+ my $err = $ae->error;
+ ok( $err, " Errors retrieved" );
+
+ my $expect = join $/, 1..5;
+ is( $err, $expect, " As expected" );
+
+ ### this resets the errors
+ ### override the 'check' routine to return false, so we bail out of
+ ### extract() early and just run the error reset code;
+ { no warnings qw[once redefine];
+ local *Archive::Extract::check = sub { return };
+ $ae->extract;
+ }
+ ok( not($ae->error), " Errors erased after ->extract() call" );
+}
+
### XXX whitebox test
### test __get_extract_dir
SKIP: { my $meth = '__get_extract_dir';
@@ -237,15 +288,18 @@
}
}
-for my $switch (0,1) {
+### configuration to run in: allow perl or allow binaries
+for my $switch ( [0,1], [1,0] ) {
+ my $cfg = "PP: $switch->[0] Bin: $switch->[1]";
- local $Archive::Extract::PREFER_BIN = $switch;
- diag("Running extract with PREFER_BIN = $Archive::Extract::PREFER_BIN")
- if $Debug;
+ local $Archive::Extract::_ALLOW_PURE_PERL = $switch->[0];
+ local $Archive::Extract::_ALLOW_BIN = $switch->[1];
+
+ diag("Running extract with configuration: $cfg") if $Debug;
for my $archive (keys %$tmpl) {
- diag("Extracting $archive") if $Debug;
+ diag("Extracting $archive in config $cfg") if $Debug;
### check first if we can do the proper
@@ -291,12 +345,14 @@
### 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);
skip "No binaries or modules to extract ".$archive,
- (10 * scalar @outs) if $mod_fail && $pgm_fail;
+ (10 * scalar @outs) if
+ ($mod_fail && ($pgm_fail || !$Archive::Extract::_ALLOW_BIN)) ||
+ ($pgm_fail && ($mod_fail || !$Archive::Extract::_ALLOW_PURE_PERL));
### we dont warnings spewed about missing modules, that might
### be a problem...
@@ -307,7 +363,7 @@
### test buffers ###
my $turn_off = !$use_buffer && !$pgm_fail &&
- $Archive::Extract::PREFER_BIN;
+ $Archive::Extract::_ALLOW_BIN;
### whitebox test ###
### stupid warnings ###
@@ -325,20 +381,24 @@
my $rv = $ae->extract( to => $to );
- ok( $rv, "extract() for '$archive' reports success");
-
- diag("Extractor was: " . $ae->_extractor) if $Debug;
-
SKIP: {
my $re = qr/^No buffer captured/;
my $err = $ae->error || '';
### skip buffer tests if we dont have buffers or
### explicitly turned them off
- skip "No buffers available", 7,
+ skip "No buffers available", 8
if ( $turn_off || !IPC::Cmd->can_capture_buffer)
&& $err =~ $re;
+ ### skip tests if we dont have an extractor
+ skip "No extractor available", 8
+ if $err =~ /Extract failed; no extractors available/;
+
+ ok( $rv, "extract() for '$archive' reports success ($cfg)");
+
+ diag("Extractor was: " . $ae->_extractor) if $Debug;
+
### if we /should/ have buffers, there should be
### no errors complaining we dont have them...
unlike( $err, $re,
@@ -346,10 +406,16 @@
### might be 1 or 2, depending wether we extracted
### a dir too
+ my $files = $ae->files || [];
my $file_cnt = grep { defined } $file, $dir;
- is( scalar @{ $ae->files || []}, $file_cnt,
+ is( scalar @$files, $file_cnt,
"Found correct number of output files" );
- is( $ae->files->[-1], $nix_path,
+
+ ### due to prototypes on is(), if there's no -1 index on
+ ### the array ref, it'll give a fatal exception:
+ ### "Modification of non-creatable array value attempted,
+ ### subscript -1 at -e line 1." So wrap it in do { }
+ is( do { $files->[-1] }, $nix_path,
"Found correct output file '$nix_path'" );
ok( -e $abs_path,
diff -urN perl-5.10.0.orig/lib/Archive/Extract/t/src/x.lzma.packed perl-5.10.0/lib/Archive/Extract/t/src/x.lzma.packed
--- perl-5.10.0.orig/lib/Archive/Extract/t/src/x.lzma.packed 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/Archive/Extract/t/src/x.lzma.packed 2009-03-10 12:34:10.000000000 +0100
@@ -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 Tue Mar 10 12:34:10 2009
+#########################################################################
+__UU__
+270``@```````````````````
diff -urN perl-5.10.0.orig/lib/Archive/Extract.pm perl-5.10.0/lib/Archive/Extract.pm
--- perl-5.10.0.orig/lib/Archive/Extract.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Archive/Extract.pm 2009-03-10 12:30:20.000000000 +0100
@@ -20,6 +20,10 @@
### VMS may require quoting upper case command options
use constant ON_VMS => $^O eq 'VMS' ? 1 : 0;
+### we can't use this extraction method, because of missing
+### modules/binaries:
+use constant METHOD_NA => [];
+
### If these are changed, update @TYPES and the new() POD
use constant TGZ => 'tgz';
use constant TAR => 'tar';
@@ -28,14 +32,21 @@
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];
+use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG
+ $_ALLOW_BIN $_ALLOW_PURE_PERL
+ ];
+
+$VERSION = '0.30';
+$PREFER_BIN = 0;
+$WARN = 1;
+$DEBUG = 0;
+$_ALLOW_PURE_PERL = 1; # allow pure perl extractors
+$_ALLOW_BIN = 1; # allow binary extractors
-$VERSION = '0.24';
-$PREFER_BIN = 0;
-$WARN = 1;
-$DEBUG = 0;
-my @Types = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z ); # same as all constants
+# same as all constants
+my @Types = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z, LZMA );
local $Params::Check::VERBOSE = $Params::Check::VERBOSE = 1;
@@ -75,6 +86,7 @@
$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 +96,14 @@
$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,31 +114,35 @@
### 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);
}
### mapping from types to extractor methods ###
-my $Mapping = {
- is_tgz => '_untar',
- is_tar => '_untar',
- is_gz => '_gunzip',
- is_zip => '_unzip',
- is_tbz => '_untar',
- is_bz2 => '_bunzip2',
- is_Z => '_uncompress',
+my $Mapping = { # binary program # pure perl module
+ is_tgz => { bin => '_untar_bin', pp => '_untar_at' },
+ is_tar => { bin => '_untar_bin', pp => '_untar_at' },
+ is_gz => { bin => '_gunzip_bin', pp => '_gunzip_cz' },
+ is_zip => { bin => '_unzip_bin', pp => '_unzip_az' },
+ is_tbz => { bin => '_untar_bin', pp => '_untar_at' },
+ is_bz2 => { bin => '_bunzip2_bin', pp => '_bunzip2_bz2'},
+ is_Z => { bin => '_uncompress_bin', pp => '_gunzip_cz' },
+ is_lzma => { bin => '_unlzma_bin', pp => '_unlzma_cz' },
};
-{
+{ ### use subs so we re-generate array refs etc for the no-overide flags
+ ### if we don't, then we reuse the same arrayref, meaning objects store
+ ### previous errors
my $tmpl = {
- archive => { required => 1, allow => FILE_EXISTS },
- type => { default => '', allow => [ @Types ] },
+ archive => sub { { required => 1, allow => FILE_EXISTS } },
+ type => sub { { default => '', allow => [ @Types ] } },
+ _error_msg => sub { { no_override => 1, default => [] } },
+ _error_msg_long => sub { { no_override => 1, default => [] } },
};
### build accesssors ###
for my $method( keys %$tmpl,
qw[_extractor _gunzip_to files extract_path],
- qw[_error_msg _error_msg_long]
) {
no strict 'refs';
*$method = sub {
@@ -183,6 +200,11 @@
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.
@@ -193,8 +215,12 @@
sub new {
my $class = shift;
my %hash = @_;
+
+ ### see above why we use subs here and generate the template;
+ ### it's basically to not re-use arrayrefs
+ my %utmpl = map { $_ => $tmpl->{$_}->() } keys %$tmpl;
- my $parsed = check( $tmpl, \%hash ) or return;
+ my $parsed = check( \%utmpl, \%hash ) or return;
### make sure we have an absolute path ###
my $ar = $parsed->{archive} = File::Spec->rel2abs( $parsed->{archive} );
@@ -209,15 +235,18 @@
$ar =~ /.+?\.(?:tbz2?|tar\.bz2?)$/i ? TBZ :
$ar =~ /.+?\.bz2$/i ? BZ2 :
$ar =~ /.+?\.Z$/ ? Z :
+ $ar =~ /.+?\.lzma$/ ? LZMA :
'';
}
- ### don't know what type of file it is ###
- return __PACKAGE__->_error(loc("Cannot determine file type for '%1'",
- $parsed->{archive} )) unless $parsed->{type};
+ bless $parsed, $class;
- return bless $parsed, $class;
+ ### don't know what type of file it is
+ ### XXX this *has* to be an object call, not a package call
+ return $parsed->_error(loc("Cannot determine file type for '%1'",
+ $parsed->{archive} )) unless $parsed->{type};
+ return $parsed;
}
}
@@ -229,11 +258,11 @@
Since C<.gz> files never hold a directory, but only a single file; if
the C<to> argument is an existing directory, the file is extracted
-there, with it's C<.gz> suffix stripped.
+there, with its C<.gz> suffix stripped.
If the C<to> argument is not an existing directory, the C<to> argument
is understood to be a filename, if the archive type is C<gz>.
In the case that you did not specify a C<to> argument, the output
-file will be the name of the archive file, stripped from it's C<.gz>
+file will be the name of the archive file, stripped from its C<.gz>
suffix, in the current working directory.
C<extract> will try a pure perl solution first, and then fall back to
@@ -269,6 +298,10 @@
my $self = shift;
my %hash = @_;
+ ### reset error messages
+ $self->_error_msg( [] );
+ $self->_error_msg_long( [] );
+
my $to;
my $tmpl = {
to => { default => '.', store => \$to }
@@ -283,9 +316,9 @@
### 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 ) {
@@ -330,19 +363,50 @@
### ../lib/Archive/Extract.pm line 742. (rt #19815)
$self->files( [] );
- ### find what extractor method to use ###
- while( my($type,$method) = each %$Mapping ) {
+ ### find out the dispatch methods needed for this type of
+ ### archive. Do a $self->is_XXX to figure out the type, then
+ ### get the hashref with bin + pure perl dispatchers.
+ my ($map) = map { $Mapping->{$_} } grep { $self->$_ } keys %$Mapping;
+
+ ### add pure perl extractor if allowed & add bin extractor if allowed
+ my @methods;
+ push @methods, $map->{'pp'} if $_ALLOW_PURE_PERL;
+ push @methods, $map->{'bin'} if $_ALLOW_BIN;
+
+ ### reverse it if we prefer bin extractors
+ @methods = reverse @methods if $PREFER_BIN;
- ### call the corresponding method if the type is OK ###
- if( $self->$type) {
- $ok = $self->$method();
- }
+ my($na, $fail);
+ for my $method (@methods) {
+ print "# Extracting with ->$method\n" if $DEBUG;
+
+ my $rv = $self->$method;
+
+ ### a positive extraction
+ if( $rv and $rv ne METHOD_NA ) {
+ print "# Extraction succeeded\n" if $DEBUG;
+ $self->_extractor($method);
+ last;
+
+ ### method is not available
+ } elsif ( $rv and $rv eq METHOD_NA ) {
+ print "# Extraction method not available\n" if $DEBUG;
+ $na++;
+ } else {
+ print "# Extraction method failed\n" if $DEBUG;
+ $fail++;
+ }
}
- ### warn something went wrong if we didn't get an OK ###
- $self->_error(loc("Extract failed, no extractor found"))
- unless $ok;
-
+ ### warn something went wrong if we didn't get an extractor
+ unless( $self->_extractor ) {
+ my $diag = $fail ? loc("Extract failed due to errors") :
+ $na ? loc("Extract failed; no extractors available") :
+ '';
+
+ $self->_error($diag);
+ $ok = 0;
+ }
}
### and chdir back ###
@@ -418,6 +482,11 @@
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 +497,7 @@
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 +513,10 @@
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 +526,8 @@
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 +554,16 @@
### $ 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 its 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
);
@@ -500,43 +584,31 @@
#################################
-### untar wrapper... goes to either Archive::Tar or /bin/tar
-### depending on $PREFER_BIN
-sub _untar {
- my $self = shift;
-
- ### bzip2 support in A::T via IO::Uncompress::Bzip2
- my @methods = qw[_untar_at _untar_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 untar file '%1'", $self->archive));
-}
-
### use /bin/tar to extract ###
sub _untar_bin {
my $self = shift;
### check for /bin/tar ###
- return $self->_error(loc("No '%1' program found", '/bin/tar'))
- unless $self->bin_tar;
-
### check for /bin/gzip if we need it ###
- return $self->_error(loc("No '%1' program found", '/bin/gzip'))
- if $self->is_tgz && !$self->bin_gzip;
-
- return $self->_error(loc("No '%1' program found", '/bin/bunzip2'))
- if $self->is_tbz && !$self->bin_bunzip2;
+ ### if any of the binaries are not available, return NA
+ { my $diag = not $self->bin_tar ?
+ loc("No '%1' program found", '/bin/tar') :
+ $self->is_tgz && !$self->bin_gzip ?
+ loc("No '%1' program found", '/bin/gzip') :
+ $self->is_tbz && !$self->bin_bunzip2 ?
+ loc("No '%1' program found", '/bin/bunzip2') :
+ '';
+
+ if( $diag ) {
+ $self->_error( $diag );
+ return METHOD_NA;
+ }
+ }
### XXX figure out how to make IPC::Run do this in one call --
### currently i don't know how to get output of a command after a pipe
### trapped in a scalar. Mailed barries about this 5th of june 2004.
-
-
### see what command we should run, based on whether
### it's a .tgz or .tar
@@ -620,14 +692,25 @@
sub _untar_at {
my $self = shift;
- ### we definitely need A::T, so load that first
+ ### Loading Archive::Tar is going to set it to 1, so make it local
+ ### within this block, starting with its initial value. Whatever
+ ### Achive::Tar does will be undone when we return.
+ ###
+ ### Also, later, set $Archive::Tar::WARN to $Archive::Extract::WARN
+ ### so users don't have to even think about this variable. If they
+ ### do, they still get their set value outside of this call.
+ local $Archive::Tar::WARN = $Archive::Tar::WARN;
+
+ ### we definitely need Archive::Tar, so load that first
{ my $use_list = { 'Archive::Tar' => '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.",
- 'Archive::Tar'));
+ $self->_error(loc("You do not have '%1' installed - " .
+ "Please install it as soon as possible.",
+ 'Archive::Tar'));
+
+ return METHOD_NA;
}
}
@@ -644,18 +727,24 @@
unless( can_load( modules => $use_list ) ) {
my $which = join '/', sort keys %$use_list;
- return $self->_error(loc(
- "You do not have '%1' installed - Please ".
- "install it as soon as possible.", $which));
-
+ $self->_error(loc(
+ "You do not have '%1' installed - Please ".
+ "install it as soon as possible.", $which)
+ );
+
+ return METHOD_NA;
}
+
} elsif ( $self->is_tbz ) {
my $use_list = { 'IO::Uncompress::Bunzip2' => '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.",
- 'IO::Uncompress::Bunzip2'));
+ $self->_error(loc(
+ "You do not have '%1' installed - Please " .
+ "install it as soon as possible.",
+ 'IO::Uncompress::Bunzip2')
+ );
+
+ return METHOD_NA;
}
my $bz = IO::Uncompress::Bunzip2->new( $self->archive ) or
@@ -666,6 +755,10 @@
$fh_to_read = $bz;
}
+ ### $Archive::Tar::WARN is 1 by default in Archive::Tar, but we've
+ ### localized $Archive::Tar::WARN already.
+ $Archive::Tar::WARN = $Archive::Extract::WARN;
+
my $tar = Archive::Tar->new();
### only tell it it's compressed if it's a .tgz, as we give it a file
@@ -684,8 +777,8 @@
*Archive::Tar::chown = sub {};
}
- ### for version of archive::tar > 1.04
- local $Archive::Tar::Constant::CHOWN = 0;
+ ### for version of Archive::Tar > 1.04
+ local $Archive::Tar::CHOWN = 0;
{ local $^W; # quell 'splice() offset past end of array' warnings
# on older versions of A::T
@@ -720,28 +813,14 @@
#
#################################
-### gunzip wrapper... goes to either Compress::Zlib or /bin/gzip
-### depending on $PREFER_BIN
-sub _gunzip {
- my $self = shift;
-
- my @methods = qw[_gunzip_cz _gunzip_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 gunzip file '%1'", $self->archive));
-}
-
sub _gunzip_bin {
my $self = shift;
### check for /bin/gzip -- we need it ###
- return $self->_error(loc("No '%1' program found", '/bin/gzip'))
- unless $self->bin_gzip;
-
+ unless( $self->bin_gzip ) {
+ $self->_error(loc("No '%1' program found", '/bin/gzip'));
+ return METHOD_NA;
+ }
my $fh = FileHandle->new('>'. $self->_gunzip_to) or
return $self->_error(loc("Could not open '%1' for writing: %2",
@@ -779,8 +858,9 @@
my $use_list = { 'Compress::Zlib' => '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::Zlib'));
+ $self->_error(loc("You do not have '%1' installed - Please " .
+ "install it as soon as possible.", 'Compress::Zlib'));
+ return METHOD_NA;
}
my $gz = Compress::Zlib::gzopen( $self->archive, "rb" ) or
@@ -808,29 +888,14 @@
#
#################################
-
-### untar wrapper... goes to either Archive::Tar or /bin/tar
-### depending on $PREFER_BIN
-sub _uncompress {
- my $self = shift;
-
- my @methods = qw[_gunzip_cz _uncompress_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 untar file '%1'", $self->archive));
-}
-
sub _uncompress_bin {
my $self = shift;
### check for /bin/gzip -- we need it ###
- return $self->_error(loc("No '%1' program found", '/bin/uncompress'))
- unless $self->bin_uncompress;
-
+ unless( $self->bin_uncompress ) {
+ $self->_error(loc("No '%1' program found", '/bin/uncompress'));
+ return METHOD_NA;
+ }
my $fh = FileHandle->new('>'. $self->_gunzip_to) or
return $self->_error(loc("Could not open '%1' for writing: %2",
@@ -870,28 +935,15 @@
#
#################################
-### unzip wrapper... goes to either Archive::Zip or /bin/unzip
-### depending on $PREFER_BIN
-sub _unzip {
- my $self = shift;
-
- my @methods = qw[_unzip_az _unzip_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 gunzip file '%1'", $self->archive));
-}
sub _unzip_bin {
my $self = shift;
### check for /bin/gzip if we need it ###
- return $self->_error(loc("No '%1' program found", '/bin/unzip'))
- unless $self->bin_unzip;
-
+ unless( $self->bin_unzip ) {
+ $self->_error(loc("No '%1' program found", '/bin/unzip'));
+ return METHOD_NA;
+ }
### first, get the files.. it must be 2 different commands with 'unzip' :(
{ ### on VMS, capital letter options have to be quoted. This is
@@ -946,8 +998,9 @@
my $use_list = { 'Archive::Zip' => '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.", 'Archive::Zip'));
+ $self->_error(loc("You do not have '%1' installed - Please " .
+ "install it as soon as possible.", 'Archive::Zip'));
+ return METHOD_NA;
}
my $zip = Archive::Zip->new();
@@ -1023,27 +1076,14 @@
#
#################################
-### bunzip2 wrapper...
-sub _bunzip2 {
- my $self = shift;
-
- my @methods = qw[_bunzip2_cz2 _bunzip2_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 bunzip2 file '%1'", $self->archive));
-}
-
sub _bunzip2_bin {
my $self = shift;
### check for /bin/gzip -- we need it ###
- return $self->_error(loc("No '%1' program found", '/bin/bunzip2'))
- unless $self->bin_bunzip2;
-
+ unless( $self->bin_bunzip2 ) {
+ $self->_error(loc("No '%1' program found", '/bin/bunzip2'));
+ return METHOD_NA;
+ }
my $fh = FileHandle->new('>'. $self->_gunzip_to) or
return $self->_error(loc("Could not open '%1' for writing: %2",
@@ -1116,14 +1156,15 @@
# return 1;
# }
-sub _bunzip2_cz2 {
+sub _bunzip2_bz2 {
my $self = shift;
my $use_list = { 'IO::Uncompress::Bunzip2' => '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.",
- 'IO::Uncompress::Bunzip2'));
+ $self->_error(loc("You do not have '%1' installed - Please " .
+ "install it as soon as possible.",
+ 'IO::Uncompress::Bunzip2'));
+ return METHOD_NA;
}
IO::Uncompress::Bunzip2::bunzip2($self->archive => $self->_gunzip_to)
@@ -1141,6 +1182,84 @@
#################################
#
+# unlzma code
+#
+#################################
+
+sub _unlzma_bin {
+ my $self = shift;
+
+ ### check for /bin/unlzma -- we need it ###
+ unless( $self->bin_unlzma ) {
+ $self->_error(loc("No '%1' program found", '/bin/unlzma'));
+ return METHOD_NA;
+ }
+
+ 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 ) ) {
+ $self->_error(loc("You do not have '%1' installed - Please " .
+ "install it as soon as possible.", 'Compress::unLZMA'));
+ return METHOD_NA;
+ }
+
+ 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
#
#################################
@@ -1148,14 +1267,15 @@
sub _error {
my $self = shift;
my $error = shift;
-
- $self->_error_msg( $error );
- $self->_error_msg_long( Carp::longmess($error) );
+ my $lerror = Carp::longmess($error);
+
+ push @{$self->_error_msg}, $error;
+ push @{$self->_error_msg_long}, $lerror;
### set $Archive::Extract::WARN to 0 to disable printing
### of errors
if( $WARN ) {
- carp $DEBUG ? $self->_error_msg_long : $self->_error_msg;
+ carp $DEBUG ? $lerror : $error;
}
return;
@@ -1163,7 +1283,15 @@
sub error {
my $self = shift;
- return shift() ? $self->_error_msg_long : $self->_error_msg;
+
+ ### make sure we have a fallback aref
+ my $aref = do {
+ shift()
+ ? $self->_error_msg_long
+ : $self->_error_msg
+ } || [];
+
+ return join $/, @$aref;
}
sub _no_buffer_files {
@@ -1208,7 +1336,7 @@
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.
--- perl-5.10.0.orig/MANIFEST 2009-02-20 18:22:32.000000000 +0100
+++ perl-5.10.0/MANIFEST 2009-03-10 15:16:45.000000000 +0100
@@ -1390,6 +1390,7 @@
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

3202
perl-update-Archive-Tar.patch
View File

File diff suppressed because it is too large Load Diff

2058
perl-update-CGI.patch
View File

File diff suppressed because it is too large Load Diff

1536
perl-update-Compress-Raw-Zlib.patch
View File

File diff suppressed because it is too large Load Diff

248
perl-update-Digest-SHA.patch
View File

@ -1,248 +0,0 @@
Digest-SHA-5.47
- minus the move of SHA.pm from topdir to lib/Digest
(and the induced changes to *.t files and Makefile.PL
diff -urN perl-5.10.0.orig/ext/Digest/SHA/Changes perl-5.10.0/ext/Digest/SHA/Changes
--- perl-5.10.0.orig/ext/Digest/SHA/Changes 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Digest/SHA/Changes 2009-03-23 16:33:05.000000000 +0100
@@ -1,5 +1,21 @@
Revision history for Perl extension Digest::SHA.
+5.47 Wed Apr 30 04:00:54 MST 2008
+ - modified Makefile.PL to install in core for Perls >= 5.10
+ -- thanks to Jerry Hedden for patch
+ - changed from #include <> to #include "" in SHA.xs
+ -- some platforms not able to find SHA source files
+ -- thanks to Alexandr Ciornii for testing
+ - moved .pm file to appropriate lib directory
+ - minor addition to META.yml
+
+5.46 Wed Apr 9 05:04:00 MST 2008
+ - modified Addfile to recognize leading and trailing
+ whitespace in filenames (ref. rt.cpan.org #34690)
+ - minor C source code modification (ref. hmac.c)
+ - use const in sha.c for clean builds with -Wwrite-strings
+ -- thanks to Robin Barker for patch
+
5.45 Tue Jun 26 02:36:00 MST 2007
- extended portability to earlier Perls
-- works on Perl 5.003 and later
diff -urN perl-5.10.0.orig/ext/Digest/SHA/README perl-5.10.0/ext/Digest/SHA/README
--- perl-5.10.0.orig/ext/Digest/SHA/README 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Digest/SHA/README 2009-03-23 16:33:05.000000000 +0100
@@ -1,4 +1,4 @@
-Digest::SHA version 5.45
+Digest::SHA version 5.47
========================
Digest::SHA is a complete implementation of the NIST Secure Hash
@@ -34,7 +34,7 @@
COPYRIGHT AND LICENSE
-Copyright (C) 2003-2007 Mark Shelor
+Copyright (C) 2003-2008 Mark Shelor
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
diff -urN perl-5.10.0.orig/ext/Digest/SHA/SHA.pm perl-5.10.0/ext/Digest/SHA/SHA.pm
--- perl-5.10.0.orig/ext/Digest/SHA/SHA.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Digest/SHA/SHA.pm 2009-03-23 16:33:05.000000000 +0100
@@ -6,7 +6,7 @@
use integer;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = '5.45';
+$VERSION = '5.47';
require Exporter;
require DynaLoader;
@@ -114,7 +114,10 @@
my $text = -T $file;
local *FH;
- open(FH, "<$file") or _bail("Open failed");
+ # protect any leading or trailing whitespace in $file;
+ # otherwise, 2-arg "open" will ignore them
+ $file =~ s#^(\s)#./$1#;
+ open(FH, "< $file\0") or _bail("Open failed");
binmode(FH) if $binary || $portable;
unless ($portable && $text) {
@@ -496,9 +499,9 @@
The "p" mode is handy since it ensures that the digest value of
I<$filename> will be the same when computed on different operating
-systems. It accomplishes this by internally translating all newlines
-in text files to UNIX format before calculating the digest; on the other
-hand, binary files are read in raw mode with no translation whatsoever.
+systems. It accomplishes this by internally translating all newlines in
+text files to UNIX format before calculating the digest. Binary files
+are read in raw mode with no translation whatsoever.
For a fuller discussion of newline formats, refer to CPAN module
L<File::LocalizeNewlines>. Its "universal line separator" regex forms
@@ -637,6 +640,7 @@
Gisle Aas
Chris Carey
+ Alexandr Ciornii
Jim Doble
Julius Duque
Jeffrey Friedl
@@ -655,7 +659,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright (C) 2003-2007 Mark Shelor
+Copyright (C) 2003-2008 Mark Shelor
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
diff -urN perl-5.10.0.orig/ext/Digest/SHA/SHA.xs perl-5.10.0/ext/Digest/SHA/SHA.xs
--- perl-5.10.0.orig/ext/Digest/SHA/SHA.xs 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Digest/SHA/SHA.xs 2009-03-23 16:33:05.000000000 +0100
@@ -2,8 +2,8 @@
#include "perl.h"
#include "XSUB.h"
-#include <src/sha.c>
-#include <src/hmac.c>
+#include "src/sha.c"
+#include "src/hmac.c"
static int ix2alg[] =
{1,1,1,224,224,224,256,256,256,384,384,384,512,512,512};
@@ -12,8 +12,8 @@
PROTOTYPES: ENABLE
-#include <src/sha.h>
-#include <src/hmac.h>
+#include "src/sha.h"
+#include "src/hmac.h"
#ifndef INT2PTR
#define INT2PTR(p, i) (p) (i)
diff -urN perl-5.10.0.orig/ext/Digest/SHA/bin/shasum perl-5.10.0/ext/Digest/SHA/bin/shasum
--- perl-5.10.0.orig/ext/Digest/SHA/bin/shasum 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Digest/SHA/bin/shasum 2009-03-23 16:33:05.000000000 +0100
@@ -2,10 +2,10 @@
# shasum: filter for computing SHA digests (analogous to sha1sum)
#
- # Copyright (C) 2003-2007 Mark Shelor, All Rights Reserved
+ # Copyright (C) 2003-2008 Mark Shelor, All Rights Reserved
#
- # Version: 5.45
- # Tue Jun 26 02:36:00 MST 2007
+ # Version: 5.47
+ # Wed Apr 30 04:00:54 MST 2008
=head1 NAME
@@ -61,7 +61,7 @@
=head1 AUTHOR
-Copyright (c) 2003-2007 Mark Shelor <mshelor@cpan.org>.
+Copyright (c) 2003-2008 Mark Shelor <mshelor@cpan.org>.
=head1 SEE ALSO
@@ -74,7 +74,7 @@
use FileHandle;
use Getopt::Long;
-my $VERSION = "5.45";
+my $VERSION = "5.47";
# Try to use Digest::SHA, since it's faster. If not installed,
diff -urN perl-5.10.0.orig/ext/Digest/SHA/src/hmac.c perl-5.10.0/ext/Digest/SHA/src/hmac.c
--- perl-5.10.0.orig/ext/Digest/SHA/src/hmac.c 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Digest/SHA/src/hmac.c 2009-03-23 16:33:05.000000000 +0100
@@ -3,10 +3,10 @@
*
* Ref: FIPS PUB 198 The Keyed-Hash Message Authentication Code
*
- * Copyright (C) 2003-2007 Mark Shelor, All Rights Reserved
+ * Copyright (C) 2003-2008 Mark Shelor, All Rights Reserved
*
- * Version: 5.45
- * Tue Jun 26 02:36:00 MST 2007
+ * Version: 5.47
+ * Wed Apr 30 04:00:54 MST 2008
*
*/
@@ -94,8 +94,8 @@
/* hmacclose: de-allocates digest object */
int hmacclose(HMAC *h)
{
- shaclose(h->osha);
if (h != NULL) {
+ shaclose(h->osha);
memset(h, 0, sizeof(HMAC));
SHA_free(h);
}
diff -urN perl-5.10.0.orig/ext/Digest/SHA/src/hmac.h perl-5.10.0/ext/Digest/SHA/src/hmac.h
--- perl-5.10.0.orig/ext/Digest/SHA/src/hmac.h 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Digest/SHA/src/hmac.h 2009-03-23 16:33:05.000000000 +0100
@@ -3,10 +3,10 @@
*
* Ref: FIPS PUB 198 The Keyed-Hash Message Authentication Code
*
- * Copyright (C) 2003-2007 Mark Shelor, All Rights Reserved
+ * Copyright (C) 2003-2008 Mark Shelor, All Rights Reserved
*
- * Version: 5.45
- * Tue Jun 26 02:36:00 MST 2007
+ * Version: 5.47
+ * Wed Apr 30 04:00:54 MST 2008
*
*/
diff -urN perl-5.10.0.orig/ext/Digest/SHA/src/sha.c perl-5.10.0/ext/Digest/SHA/src/sha.c
--- perl-5.10.0.orig/ext/Digest/SHA/src/sha.c 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Digest/SHA/src/sha.c 2009-03-23 16:33:05.000000000 +0100
@@ -3,10 +3,10 @@
*
* Ref: NIST FIPS PUB 180-2 Secure Hash Standard
*
- * Copyright (C) 2003-2007 Mark Shelor, All Rights Reserved
+ * Copyright (C) 2003-2008 Mark Shelor, All Rights Reserved
*
- * Version: 5.45
- * Tue Jun 26 02:36:00 MST 2007
+ * Version: 5.47
+ * Wed Apr 30 04:00:54 MST 2008
*
*/
@@ -560,7 +560,7 @@
/* ldvals: checks next line in dump file against tag, and loads values */
static int ldvals(
SHA_FILE *f,
- char *tag,
+ const char *tag,
int type,
void *pval,
int reps,
diff -urN perl-5.10.0.orig/ext/Digest/SHA/src/sha.h perl-5.10.0/ext/Digest/SHA/src/sha.h
--- perl-5.10.0.orig/ext/Digest/SHA/src/sha.h 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Digest/SHA/src/sha.h 2009-03-23 16:33:05.000000000 +0100
@@ -3,10 +3,10 @@
*
* Ref: NIST FIPS PUB 180-2 Secure Hash Standard
*
- * Copyright (C) 2003-2007 Mark Shelor, All Rights Reserved
+ * Copyright (C) 2003-2008 Mark Shelor, All Rights Reserved
*
- * Version: 5.45
- * Tue Jun 26 02:36:00 MST 2007
+ * Version: 5.47
+ * Wed Apr 30 04:00:54 MST 2008
*
*/

371
perl-update-File-Fetch.patch
View File

@ -1,371 +0,0 @@
File-Fetch-0.18
diff -urN perl-5.10.0.orig/lib/File/Fetch/t/01_File-Fetch.t perl-5.10.0/lib/File/Fetch/t/01_File-Fetch.t
--- perl-5.10.0.orig/lib/File/Fetch/t/01_File-Fetch.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/File/Fetch/t/01_File-Fetch.t 2009-03-10 14:28:48.000000000 +0100
@@ -22,7 +22,7 @@
Some of these tests assume you are connected to the
internet. If you are not, or if certain protocols or hosts
-are blocked and/or firewalled, these tests will fail due
+are blocked and/or firewalled, these tests could fail due
to no fault of the module itself.
###########################################################
@@ -115,6 +115,13 @@
) if &File::Fetch::ON_WIN;
+### sanity tests
+{ like( $File::Fetch::USER_AGENT, qr/$File::Fetch::VERSION/,
+ "User agent contains version" );
+ like( $File::Fetch::FROM_EMAIL, qr/@/,
+ q[Email contains '@'] );
+}
+
### parse uri tests ###
for my $entry (@map ) {
my $uri = $entry->{'uri'};
@@ -148,14 +155,14 @@
my $prefix = &File::Fetch::ON_UNIX ? 'file://' : 'file:///';
my $uri = $prefix . cwd() .'/'. basename($0);
- for (qw[lwp file]) {
+ for (qw[lwp lftp file]) {
_fetch_uri( file => $uri, $_ );
}
}
### ftp:// tests ###
{ my $uri = 'ftp://ftp.funet.fi/pub/CPAN/index.html';
- for (qw[lwp netftp wget curl ncftp]) {
+ for (qw[lwp netftp wget curl lftp ncftp]) {
### STUPID STUPID warnings ###
next if $_ eq 'ncftp' and $File::Fetch::FTP_PASSIVE
@@ -167,9 +174,10 @@
### http:// tests ###
{ for my $uri ( 'http://www.cpan.org/index.html',
- 'http://www.cpan.org/index.html?q=1&y=2'
+ 'http://www.cpan.org/index.html?q=1',
+ 'http://www.cpan.org/index.html?q=1&y=2',
) {
- for (qw[lwp wget curl lynx]) {
+ for (qw[lwp wget curl lftp lynx]) {
_fetch_uri( http => $uri, $_ );
}
}
@@ -206,6 +214,11 @@
skip "You do not have '$method' installed/available", 3
if $File::Fetch::METHOD_FAIL->{$method} &&
$File::Fetch::METHOD_FAIL->{$method};
+
+ ### if the file wasn't fetched, it may be a network/firewall issue
+ skip "Fetch failed; no network connectivity for '$type'?", 3
+ unless $file;
+
ok( $file, " File ($file) fetched with $method ($uri)" );
ok( $file && -s $file,
" File has size" );
diff -urN perl-5.10.0.orig/lib/File/Fetch.pm perl-5.10.0/lib/File/Fetch.pm
--- perl-5.10.0.orig/lib/File/Fetch.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/File/Fetch.pm 2009-03-10 14:29:10.000000000 +0100
@@ -2,6 +2,7 @@
use strict;
use FileHandle;
+use File::Temp;
use File::Copy;
use File::Spec;
use File::Spec::Unix;
@@ -9,7 +10,7 @@
use Cwd qw[cwd];
use Carp qw[carp];
-use IPC::Cmd qw[can_run run];
+use IPC::Cmd qw[can_run run QUOTE];
use File::Path qw[mkpath];
use Params::Check qw[check];
use Module::Load::Conditional qw[can_load];
@@ -20,14 +21,11 @@
$FTP_PASSIVE $TIMEOUT $DEBUG $WARN
];
-use constant QUOTE => do { $^O eq 'MSWin32' ? q["] : q['] };
-
-
-$VERSION = '0.14';
+$VERSION = '0.18';
$VERSION = eval $VERSION; # avoid warnings with development releases
$PREFER_BIN = 0; # XXX TODO implement
$FROM_EMAIL = 'File-Fetch@example.com';
-$USER_AGENT = 'File::Fetch/$VERSION';
+$USER_AGENT = "File::Fetch/$VERSION";
$BLACKLIST = [qw|ftp|];
$METHOD_FAIL = { };
$FTP_PASSIVE = 1;
@@ -37,9 +35,9 @@
### methods available to fetch the file depending on the scheme
$METHODS = {
- http => [ qw|lwp wget curl lynx| ],
- ftp => [ qw|lwp netftp wget curl ncftp ftp| ],
- file => [ qw|lwp file| ],
+ http => [ qw|lwp wget curl lftp lynx| ],
+ ftp => [ qw|lwp netftp wget curl lftp ncftp ftp| ],
+ file => [ qw|lwp lftp file| ],
rsync => [ qw|rsync| ]
};
@@ -50,11 +48,13 @@
local $Module::Load::Conditional::VERBOSE = 0;
### see what OS we are on, important for file:// uris ###
-use constant ON_WIN => ($^O eq 'MSWin32');
-use constant ON_VMS => ($^O eq 'VMS');
-use constant ON_UNIX => (!ON_WIN);
-use constant HAS_VOL => (ON_WIN);
-use constant HAS_SHARE => (ON_WIN);
+use constant ON_WIN => ($^O eq 'MSWin32');
+use constant ON_VMS => ($^O eq 'VMS');
+use constant ON_UNIX => (!ON_WIN);
+use constant HAS_VOL => (ON_WIN);
+use constant HAS_SHARE => (ON_WIN);
+
+
=pod
=head1 NAME
@@ -146,7 +146,7 @@
##########################
{
- ### template for new() and autogenerated accessors ###
+ ### template for autogenerated accessors ###
my $Tmpl = {
scheme => { default => 'http' },
host => { default => 'localhost' },
@@ -626,11 +626,14 @@
push @$cmd, '--passive-ftp' if $FTP_PASSIVE;
### set the output document, add the uri ###
- push @$cmd, '--output-document',
- ### DO NOT quote things for IPC::Run, it breaks stuff.
- $IPC::Cmd::USE_IPC_RUN
- ? ($to, $self->uri)
- : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
+ push @$cmd, '--output-document', $to, $self->uri;
+
+ ### with IPC::Cmd > 0.41, this is fixed in teh library,
+ ### and there's no need for special casing any more.
+ ### DO NOT quote things for IPC::Run, it breaks stuff.
+ # $IPC::Cmd::USE_IPC_RUN
+ # ? ($to, $self->uri)
+ # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
### shell out ###
my $captured;
@@ -653,6 +656,81 @@
}
}
+### /bin/lftp fetch ###
+sub _lftp_fetch {
+ my $self = shift;
+ my %hash = @_;
+
+ my ($to);
+ my $tmpl = {
+ to => { required => 1, store => \$to }
+ };
+ check( $tmpl, \%hash ) or return;
+
+ ### see if we have a wget binary ###
+ if( my $lftp = can_run('lftp') ) {
+
+ ### no verboseness, thanks ###
+ my $cmd = [ $lftp, '-f' ];
+
+ my $fh = File::Temp->new;
+
+ my $str;
+
+ ### if a timeout is set, add it ###
+ $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT;
+
+ ### run passive if specified ###
+ $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE;
+
+ ### set the output document, add the uri ###
+ ### quote the URI, because lftp supports certain shell
+ ### expansions, most notably & for backgrounding.
+ ### ' quote does nto work, must be "
+ $str .= q[get ']. $self->uri .q[' -o ]. $to . $/;
+
+ if( $DEBUG ) {
+ my $pp_str = join ' ', split $/, $str;
+ print "# lftp command: $pp_str\n";
+ }
+
+ ### write straight to the file.
+ $fh->autoflush(1);
+ print $fh $str;
+
+ ### the command needs to be 1 string to be executed
+ push @$cmd, $fh->filename;
+
+ ### with IPC::Cmd > 0.41, this is fixed in teh library,
+ ### and there's no need for special casing any more.
+ ### DO NOT quote things for IPC::Run, it breaks stuff.
+ # $IPC::Cmd::USE_IPC_RUN
+ # ? ($to, $self->uri)
+ # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
+
+
+ ### shell out ###
+ my $captured;
+ unless(run( command => $cmd,
+ buffer => \$captured,
+ verbose => $DEBUG
+ )) {
+ ### wget creates the output document always, even if the fetch
+ ### fails.. so unlink it in that case
+ 1 while unlink $to;
+
+ return $self->_error(loc( "Command failed: %1", $captured || '' ));
+ }
+
+ return $to;
+
+ } else {
+ $METHOD_FAIL->{'lftp'} = 1;
+ return;
+ }
+}
+
+
### /bin/ftp fetch ###
sub _ftp_fetch {
@@ -717,6 +795,33 @@
'lynx' ));
}
+ ### check if the HTTP resource exists ###
+ if ($self->uri =~ /^https?:\/\//i) {
+ my $cmd = [
+ $lynx,
+ '-head',
+ '-source',
+ "-auth=anonymous:$FROM_EMAIL",
+ ];
+
+ push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT;
+
+ push @$cmd, $self->uri;
+
+ ### shell out ###
+ my $head;
+ unless(run( command => $cmd,
+ buffer => \$head,
+ verbose => $DEBUG )
+ ) {
+ return $self->_error(loc("Command failed: %1", $head || ''));
+ }
+
+ unless($head =~ /^HTTP\/\d+\.\d+ 200\b/) {
+ return $self->_error(loc("Command failed: %1", $head || ''));
+ }
+ }
+
### write to the output file ourselves, since lynx ass_u_mes to much
my $local = FileHandle->new(">$to")
or return $self->_error(loc(
@@ -732,9 +837,14 @@
push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT;
### DO NOT quote things for IPC::Run, it breaks stuff.
- push @$cmd, $IPC::Cmd::USE_IPC_RUN
- ? $self->uri
- : QUOTE. $self->uri .QUOTE;
+ push @$cmd, $self->uri;
+
+ ### with IPC::Cmd > 0.41, this is fixed in teh library,
+ ### and there's no need for special casing any more.
+ ### DO NOT quote things for IPC::Run, it breaks stuff.
+ # $IPC::Cmd::USE_IPC_RUN
+ # ? $self->uri
+ # : QUOTE. $self->uri .QUOTE;
### shell out ###
@@ -829,7 +939,7 @@
if (my $curl = can_run('curl')) {
### these long opts are self explanatory - I like that -jmb
- my $cmd = [ $curl ];
+ my $cmd = [ $curl, '-q' ];
push(@$cmd, '--connect-timeout', $TIMEOUT) if $TIMEOUT;
@@ -842,11 +952,15 @@
### curl doesn't follow 302 (temporarily moved) etc automatically
### so we add --location to enable that.
- push @$cmd, '--fail', '--location', '--output',
- ### DO NOT quote things for IPC::Run, it breaks stuff.
- $IPC::Cmd::USE_IPC_RUN
- ? ($to, $self->uri)
- : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
+ push @$cmd, '--fail', '--location', '--output', $to, $self->uri;
+
+ ### with IPC::Cmd > 0.41, this is fixed in teh library,
+ ### and there's no need for special casing any more.
+ ### DO NOT quote things for IPC::Run, it breaks stuff.
+ # $IPC::Cmd::USE_IPC_RUN
+ # ? ($to, $self->uri)
+ # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
+
my $captured;
unless(run( command => $cmd,
@@ -960,9 +1074,14 @@
push(@$cmd, '--quiet') unless $DEBUG;
### DO NOT quote things for IPC::Run, it breaks stuff.
- push @$cmd, $IPC::Cmd::USE_IPC_RUN
- ? ($self->uri, $to)
- : (QUOTE. $self->uri .QUOTE, QUOTE. $to .QUOTE);
+ push @$cmd, $self->uri, $to;
+
+ ### with IPC::Cmd > 0.41, this is fixed in teh library,
+ ### and there's no need for special casing any more.
+ ### DO NOT quote things for IPC::Run, it breaks stuff.
+ # $IPC::Cmd::USE_IPC_RUN
+ # ? ($to, $self->uri)
+ # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
my $captured;
unless(run( command => $cmd,
@@ -1030,9 +1149,9 @@
Below is a mapping of what utilities will be used in what order
for what schemes, if available:
- file => LWP, file
- http => LWP, wget, curl, lynx
- ftp => LWP, Net::FTP, wget, curl, ncftp, ftp
+ file => LWP, lftp, file
+ http => LWP, wget, curl, lftp, lynx
+ ftp => LWP, Net::FTP, wget, curl, lftp, ncftp, ftp
rsync => rsync
If you'd like to disable the use of one or more of these utilities
@@ -1148,6 +1267,7 @@
ftp => ftp
curl => curl
rsync => rsync
+ lftp => lftp
=head1 FREQUENTLY ASKED QUESTIONS

1398
perl-update-File-Temp.patch
View File

File diff suppressed because it is too large Load Diff

1758
perl-update-FileSpec.patch
View File

File diff suppressed because it is too large Load Diff

1475
perl-update-IO-Compress-Base.patch
View File

File diff suppressed because it is too large Load Diff

5232
perl-update-IO-Compress-Zlib.patch
View File

File diff suppressed because it is too large Load Diff

1268
perl-update-IPC-Cmd.patch
View File

File diff suppressed because it is too large Load Diff

788
perl-update-Module-CoreList.patch
View File

@ -1,788 +0,0 @@
Module-CoreList-2.17
diff -urN perl-5.10.0.orig/lib/Module/CoreList/bin/corelist perl-5.10.0/lib/Module/CoreList/bin/corelist
--- perl-5.10.0.orig/lib/Module/CoreList/bin/corelist 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Module/CoreList/bin/corelist 2009-02-10 11:51:46.000000000 +0100
@@ -11,14 +11,14 @@
=head1 SYNOPSIS
corelist -v
- corelist [-a] <ModuleName> | /<ModuleRegex>/ [<ModuleVersion>] ...
+ corelist [-a|-d] <ModuleName> | /<ModuleRegex>/ [<ModuleVersion>] ...
corelist [-v <PerlVersion>] [ <ModuleName> | /<ModuleRegex>/ ] ...
=head1 OPTIONS
=over
-=item -a modulename
+=item -a
lists all versions of the given module (or the matching modules, in case you
used a module regexp) in the perls Module::CoreList knows about.
@@ -44,6 +44,11 @@
5.009002 1.04
5.009003 1.06
+=item -d
+
+finds the first perl version where a module has been released by
+date, and not by version number (as is the default).
+
=item -? or -help
help! help! help! to see more help, try --man.
@@ -79,7 +84,7 @@
my %Opts;
-GetOptions(\%Opts, qw[ help|?! man! v|version:f a! ] );
+GetOptions(\%Opts, qw[ help|?! man! v|version:f a! d ] );
pod2usage(1) if $Opts{help};
pod2usage(-verbose=>2) if $Opts{man};
@@ -93,15 +98,16 @@
}
$Opts{v} = numify_version( $Opts{v} );
- if( !exists $Module::CoreList::version{$Opts{v}} ) {
+ my $version_hash = Module::CoreList->find_version($Opts{v});
+ if( !$version_hash ) {
print "\nModule::CoreList has no info on perl v$Opts{v}\n\n";
exit 1;
}
if ( !@ARGV ) {
print "\nThe following modules were in perl v$Opts{v} CORE\n";
- print "$_ ", $Module::CoreList::version{$Opts{v}}{$_} || " ","\n"
- for sort keys %{$Module::CoreList::version{$Opts{v}}};
+ print "$_ ", $version_hash->{$_} || " ","\n"
+ for sort keys %$version_hash;
print "\n";
exit 0;
}
@@ -149,12 +155,17 @@
my($mod,$ver) = @_;
if ( $Opts{v} ) {
- return printf " %-24s %-10s\n",
- $mod,
- $Module::CoreList::version{$Opts{v}}{$mod} || 'undef';
+ my $version_hash = Module::CoreList->find_version($Opts{v});
+ if ($version_hash) {
+ print $mod, " ", $version_hash->{$mod} || 'undef', "\n";
+ return;
+ }
+ else { die "Shouldn't happen" }
}
- my $ret = Module::CoreList->first_release(@_);
+ my $ret = $Opts{d}
+ ? Module::CoreList->first_release_by_date(@_)
+ : Module::CoreList->first_release(@_);
my $msg = $mod;
$msg .= " $ver" if $ver;
@@ -184,13 +195,12 @@
sub numify_version {
my $ver = shift;
- if ( index( $ver, q{.}, index( $ver, q{.} ) ) >= 0 ) {
- eval { require version };
- if ($@) {
- die "You need to install version.pm to use dotted version numbers\n";
- }
+ if ($ver =~ /\..+\./) {
+ eval { require version ; 1 }
+ or die "You need to install version.pm to use dotted version numbers\n";
$ver = version->new($ver)->numify;
}
+ $ver += 0;
return $ver;
}
diff -urN perl-5.10.0.orig/lib/Module/CoreList.pm perl-5.10.0/lib/Module/CoreList.pm
--- perl-5.10.0.orig/lib/Module/CoreList.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Module/CoreList.pm 2009-02-10 11:51:14.000000000 +0100
@@ -1,7 +1,7 @@
package Module::CoreList;
use strict;
use vars qw/$VERSION %released %patchlevel %version %families/;
-$VERSION = '2.13';
+$VERSION = '2.17';
=head1 NAME
@@ -59,7 +59,7 @@
Module::CoreList currently covers the 5.000, 5.001, 5.002, 5.003_07, 5.004,
5.004_05, 5.005, 5.005_03, 5.005_04, 5.6.0, 5.6.1, 5.6.2, 5.7.3, 5.8.0, 5.8.1,
-5.8.2, 5.8.3, 5.8.4, 5.8.5, 5.8.6, 5.8.7, 5.8.8, 5.9.0, 5.9.1, 5.9.2, 5.9.3,
+5.8.2, 5.8.3, 5.8.4, 5.8.5, 5.8.6, 5.8.7, 5.8.8, 5.8.9, 5.9.0, 5.9.1, 5.9.2, 5.9.3,
5.9.4, 5.9.5 and 5.10.0 releases of perl.
=head1 HISTORY
@@ -74,7 +74,7 @@
=head1 COPYRIGHT
-Copyright (C) 2002-2007 Richard Clamp. All Rights Reserved.
+Copyright (C) 2002-2009 Richard Clamp. All Rights Reserved.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -138,12 +138,17 @@
return sort keys %mods
}
+sub find_version {
+ my ($class, $v) = @_;
+ return $version{$v} if defined $version{$v};
+ return undef;
+}
# when things escaped
%released = (
5.000 => '1994-10-17',
5.001 => '1995-03-14',
- 5.002 => '1996-02-96',
+ 5.002 => '1996-02-29',
5.00307 => '1996-10-10',
5.004 => '1997-05-15',
5.005 => '1998-07-22',
@@ -170,13 +175,14 @@
5.009004 => '2006-08-15',
5.009005 => '2007-07-07',
5.010000 => '2007-12-18',
+ 5.008009 => '2008-12-14',
);
# perforce branches and patch levels
%patchlevel = (
5.005 => [perl => 1647],
5.00503 => ['maint-5.005' => 3198],
- 5.00405 => ['maint-5.004' => 999],
+ 5.00405 => ['maint-5.004' => 3296],
5.006 => [perl => 5899],
5.006001 => ['maint-5.6' => 9654],
5.006002 => ['maint-5.6' => 21727],
@@ -198,6 +204,7 @@
5.009004 => [perl => 28727],
5.009005 => [perl => 31562],
5.010000 => [perl => 32642],
+ 5.008009 => ['maint-5.8' => 35095],
);
for my $version ( sort { $a <=> $b } keys %released ) {
@@ -1377,6 +1384,7 @@
'ExtUtils::MM_Win32' => undef, #./lib/ExtUtils/MM_Win32.pm
'ExtUtils::MakeMaker' => '5.45', #./lib/ExtUtils/MakeMaker.pm
'ExtUtils::Manifest' => '1.33 ', #./lib/ExtUtils/Manifest.pm
+ 'ExtUtils::Miniperl' => undef,
'ExtUtils::Mkbootstrap' => '1.14 ', #./lib/ExtUtils/Mkbootstrap.pm
'ExtUtils::Mksymlists' => '1.17 ', #./lib/ExtUtils/Mksymlists.pm
'ExtUtils::Packlist' => '0.03', #./lib/ExtUtils/Packlist.pm
@@ -1601,6 +1609,7 @@
'ExtUtils::Liblist' => 1.26 ,
'ExtUtils::MakeMaker' => 5.45,
'ExtUtils::Manifest' => 1.33 ,
+ 'ExtUtils::Miniperl' => undef,
'ExtUtils::Mkbootstrap' => 1.14 ,
'ExtUtils::Mksymlists' => 1.17 ,
'ExtUtils::MM_Cygwin' => undef,
@@ -2002,7 +2011,7 @@
'warnings' => undef, #lib/warnings.pm
'warnings::register' => undef, #lib/warnings/register.pm
'XSLoader' => '0.01', #lib/XSLoader.pm
- },
+ },
5.007003 => {
'AnyDBM_File' => '1.00',
@@ -2103,6 +2112,7 @@
'ExtUtils::Liblist' => '1.2701',
'ExtUtils::MakeMaker' => '5.48_03',
'ExtUtils::Manifest' => '1.35',
+ 'ExtUtils::Miniperl' => undef,
'ExtUtils::Mkbootstrap' => '1.1401',
'ExtUtils::Mksymlists' => '1.18',
'ExtUtils::MM_BeOS' => '1.00',
@@ -2424,6 +2434,7 @@
'ExtUtils::Liblist::Kid'=> '1.29', #./lib/ExtUtils/Liblist/Kid.pm
'ExtUtils::MakeMaker' => '6.03', #./lib/ExtUtils/MakeMaker.pm
'ExtUtils::Manifest' => '1.38', #./lib/ExtUtils/Manifest.pm
+ 'ExtUtils::Miniperl' => undef,
'ExtUtils::Mkbootstrap' => '1.15', #./lib/ExtUtils/Mkbootstrap.pm
'ExtUtils::Mksymlists' => '1.19', #./lib/ExtUtils/Mksymlists.pm
'ExtUtils::MM' => '0.04', #./lib/ExtUtils/MM.pm
@@ -4457,6 +4468,7 @@
'XSLoader' => '0.03', #lib/XSLoader.pm
'XS::Typemap' => '0.01', #lib/XS/Typemap.pm
},
+
5.008004 => {
'AnyDBM_File' => '1.00', #lib/AnyDBM_File.pm
'attributes' => '0.06', #lib/attributes.pm
@@ -5550,6 +5562,7 @@
'XSLoader' => '0.02', #lib/XSLoader.pm
'XS::Typemap' => '0.01', #lib/XS/Typemap.pm
},
+
5.009002 => {
'AnyDBM_File' => '1.00',
'Attribute::Handlers' => '0.78_01',
@@ -5590,6 +5603,7 @@
'Carp::Heavy' => '1.04',
'Class::ISA' => '0.33',
'Class::Struct' => '0.63',
+ 'Config' => undef,
'Config::Extensions' => '0.01',
'Cwd' => '3.05',
'DB' => '1.0',
@@ -5668,6 +5682,7 @@
'ExtUtils::MakeMaker::bytes'=> '0.01',
'ExtUtils::MakeMaker::vmsish'=> '0.01',
'ExtUtils::Manifest' => '1.44',
+ 'ExtUtils::Miniperl' => undef,
'ExtUtils::Mkbootstrap' => '1.15',
'ExtUtils::Mksymlists' => '1.19',
'ExtUtils::Packlist' => '0.04',
@@ -5914,6 +5929,7 @@
'warnings' => '1.04',
'warnings::register' => '1.00',
},
+
5.008007 => {
'AnyDBM_File' => '1.00',
'Attribute::Handlers' => '0.78_01',
@@ -5954,6 +5970,7 @@
'Carp::Heavy' => '1.04',
'Class::ISA' => '0.33',
'Class::Struct' => '0.63',
+ 'Config' => undef,
'Cwd' => '3.05',
'DB' => '1.0',
'DBM_Filter' => '0.01',
@@ -6031,6 +6048,7 @@
'ExtUtils::MakeMaker::bytes'=> '0.01',
'ExtUtils::MakeMaker::vmsish'=> '0.01',
'ExtUtils::Manifest' => '1.42',
+ 'ExtUtils::Miniperl' => undef,
'ExtUtils::Mkbootstrap' => '1.15',
'ExtUtils::Mksymlists' => '1.19',
'ExtUtils::Packlist' => '0.04',
@@ -6273,6 +6291,7 @@
'warnings' => '1.03',
'warnings::register' => '1.00',
},
+
5.009003 => {
'AnyDBM_File' => '1.00',
'Archive::Tar' => '1.26_01',
@@ -6343,6 +6362,7 @@
'Compress::Zlib::ParseParameters'=> '2.000_07',
'Compress::Zlib::UncompressPlugin::Identity'=> '2.000_05',
'Compress::Zlib::UncompressPlugin::Inflate'=> '2.000_05',
+ 'Config' => undef,
'Config::Extensions' => '0.01',
'Cwd' => '3.15',
'DB' => '1.01',
@@ -6438,6 +6458,7 @@
'ExtUtils::MakeMaker::bytes'=> '0.01',
'ExtUtils::MakeMaker::vmsish'=> '0.01',
'ExtUtils::Manifest' => '1.46',
+ 'ExtUtils::Miniperl' => undef,
'ExtUtils::Mkbootstrap' => '1.15',
'ExtUtils::Mksymlists' => '1.19',
'ExtUtils::Packlist' => '0.04',
@@ -6722,6 +6743,7 @@
'warnings' => '1.05',
'warnings::register' => '1.01',
},
+
5.008008 => {
'AnyDBM_File' => '1.00',
'Attribute::Handlers' => '0.78_02',
@@ -6762,6 +6784,7 @@
'Carp::Heavy' => '1.04',
'Class::ISA' => '0.33',
'Class::Struct' => '0.63',
+ 'Config' => undef,
'Cwd' => '3.12',
'DB' => '1.01',
'DBM_Filter' => '0.01',
@@ -6844,6 +6867,7 @@
'ExtUtils::MakeMaker::bytes'=> '0.01',
'ExtUtils::MakeMaker::vmsish'=> '0.01',
'ExtUtils::Manifest' => '1.46',
+ 'ExtUtils::Miniperl' => undef,
'ExtUtils::Mkbootstrap' => '1.15',
'ExtUtils::Mksymlists' => '1.19',
'ExtUtils::Packlist' => '0.04',
@@ -7089,6 +7113,7 @@
'warnings' => '1.05',
'warnings::register' => '1.01',
},
+
5.009004 => {
'AnyDBM_File' => '1.00',
'Archive::Tar' => '1.30_01',
@@ -7138,6 +7163,7 @@
'Class::Struct' => '0.63',
'Compress::Raw::Zlib' => '2.000_13',
'Compress::Zlib' => '2.000_13',
+ 'Config' => undef,
'Config::Extensions' => '0.01',
'Cwd' => '3.19',
'DB' => '1.01',
@@ -7233,6 +7259,7 @@
'ExtUtils::MakeMaker::bytes'=> '0.01',
'ExtUtils::MakeMaker::vmsish'=> '0.01',
'ExtUtils::Manifest' => '1.46_01',
+ 'ExtUtils::Miniperl' => undef,
'ExtUtils::Mkbootstrap' => '1.15_01',
'ExtUtils::Mksymlists' => '1.19_01',
'ExtUtils::Packlist' => '1.41',
@@ -7571,6 +7598,7 @@
'warnings' => '1.05',
'warnings::register' => '1.01',
},
+
5.009005 => {
'AnyDBM_File' => '1.00',
'Archive::Extract' => '0.22_01',
@@ -8105,6 +8133,7 @@
'warnings' => '1.06',
'warnings::register' => '1.01',
},
+
5.010000 => {
'AnyDBM_File' => '1.00',
'Archive::Extract' => '0.24',
@@ -8285,6 +8314,7 @@
'ExtUtils::MakeMaker::bytes'=> '6.42',
'ExtUtils::MakeMaker::vmsish'=> '6.42',
'ExtUtils::Manifest' => '1.51_01',
+ 'ExtUtils::Miniperl' => undef,
'ExtUtils::Mkbootstrap' => '6.42',
'ExtUtils::Mksymlists' => '6.42',
'ExtUtils::Packlist' => '1.43',
@@ -8644,7 +8674,418 @@
'warnings' => '1.06',
'warnings::register' => '1.01',
},
+
+ 5.008009 => {
+ 'AnyDBM_File' => '1.00',
+ 'Attribute::Handlers' => '0.78_03',
+ 'AutoLoader' => '5.67',
+ 'AutoSplit' => '1.06',
+ 'B' => '1.19',
+ 'B::Asmdata' => '1.02',
+ 'B::Assembler' => '0.08',
+ 'B::Bblock' => '1.02_01',
+ 'B::Bytecode' => '1.01_01',
+ 'B::C' => '1.05',
+ 'B::CC' => '1.00_01',
+ 'B::Concise' => '0.76',
+ 'B::Debug' => '1.05',
+ 'B::Deparse' => '0.87',
+ 'B::Disassembler' => '1.05',
+ 'B::Lint' => '1.11',
+ 'B::Lint::Debug' => undef,
+ 'B::Showlex' => '1.02',
+ 'B::Stackobj' => '1.00',
+ 'B::Stash' => '1.00',
+ 'B::Terse' => '1.05',
+ 'B::Xref' => '1.01',
+ 'Benchmark' => '1.1',
+ 'ByteLoader' => '0.06',
+ 'CGI' => '3.42',
+ 'CGI::Apache' => '1.00',
+ 'CGI::Carp' => '1.30_01',
+ 'CGI::Cookie' => '1.29',
+ 'CGI::Fast' => '1.07',
+ 'CGI::Pretty' => '1.08',
+ 'CGI::Push' => '1.04',
+ 'CGI::Switch' => '1.00',
+ 'CGI::Util' => '1.5_01',
+ 'CPAN' => '1.9301',
+ 'CPAN::Debug' => '5.5',
+ 'CPAN::DeferedCode' => '5.50',
+ 'CPAN::Distroprefs' => '6',
+ 'CPAN::FirstTime' => '5.5_01',
+ 'CPAN::HandleConfig' => '5.5',
+ 'CPAN::Kwalify' => '5.50',
+ 'CPAN::Nox' => '5.50',
+ 'CPAN::Queue' => '5.5',
+ 'CPAN::Tarzip' => '5.5',
+ 'CPAN::Version' => '5.5',
+ 'Carp' => '1.10',
+ 'Carp::Heavy' => '1.10',
+ 'Class::ISA' => '0.33',
+ 'Class::Struct' => '0.63',
+ 'Config' => undef,
+ 'Cwd' => '3.29',
+ 'DB' => '1.01',
+ 'DBM_Filter' => '0.02',
+ 'DBM_Filter::compress' => '0.02',
+ 'DBM_Filter::encode' => '0.02',
+ 'DBM_Filter::int32' => '0.02',
+ 'DBM_Filter::null' => '0.02',
+ 'DBM_Filter::utf8' => '0.02',
+ 'DB_File' => '1.817',
+ 'DCLsym' => '1.03',
+ 'Data::Dumper' => '2.121_17',
+ 'Devel::DProf' => '20080331.00',
+ 'Devel::InnerPackage' => '0.3',
+ 'Devel::PPPort' => '3.14',
+ 'Devel::Peek' => '1.04',
+ 'Devel::SelfStubber' => '1.03',
+ 'Digest' => '1.15',
+ 'Digest::MD5' => '2.37',
+ 'Digest::base' => '1.00',
+ 'Digest::file' => '1.00',
+ 'DirHandle' => '1.02',
+ 'Dumpvalue' => '1.12',
+ 'DynaLoader' => '1.09',
+ 'Encode' => '2.26',
+ 'Encode::Alias' => '2.10',
+ 'Encode::Byte' => '2.03',
+ 'Encode::CJKConstants' => '2.02',
+ 'Encode::CN' => '2.02',
+ 'Encode::CN::HZ' => '2.05',
+ 'Encode::Config' => '2.05',
+ 'Encode::EBCDIC' => '2.02',
+ 'Encode::Encoder' => '2.01',
+ 'Encode::Encoding' => '2.05',
+ 'Encode::GSM0338' => '2.01',
+ 'Encode::Guess' => '2.02',
+ 'Encode::JP' => '2.03',
+ 'Encode::JP::H2Z' => '2.02',
+ 'Encode::JP::JIS7' => '2.04',
+ 'Encode::KR' => '2.02',
+ 'Encode::KR::2022_KR' => '2.02',
+ 'Encode::MIME::Header' => '2.05',
+ 'Encode::MIME::Header::ISO_2022_JP'=> '1.03',
+ 'Encode::MIME::Name' => '1.01',
+ 'Encode::Symbol' => '2.02',
+ 'Encode::TW' => '2.02',
+ 'Encode::Unicode' => '2.05',
+ 'Encode::Unicode::UTF7' => '2.04',
+ 'English' => '1.03',
+ 'Env' => '1.00',
+ 'Errno' => '1.10',
+ 'Exporter' => '5.63',
+ 'Exporter::Heavy' => '5.63',
+ 'ExtUtils::Command' => '1.15',
+ 'ExtUtils::Command::MM' => '6.48',
+ 'ExtUtils::Constant' => '0.21',
+ 'ExtUtils::Constant::Base'=> '0.04',
+ 'ExtUtils::Constant::ProxySubs'=> '0.06',
+ 'ExtUtils::Constant::Utils'=> '0.02',
+ 'ExtUtils::Constant::XS'=> '0.02',
+ 'ExtUtils::Embed' => '1.28',
+ 'ExtUtils::Install' => '1.50_01',
+ 'ExtUtils::Installed' => '1.43',
+ 'ExtUtils::Liblist' => '6.48',
+ 'ExtUtils::Liblist::Kid'=> '6.48',
+ 'ExtUtils::MM' => '6.48',
+ 'ExtUtils::MM_AIX' => '6.48',
+ 'ExtUtils::MM_Any' => '6.48',
+ 'ExtUtils::MM_BeOS' => '6.48',
+ 'ExtUtils::MM_Cygwin' => '6.48',
+ 'ExtUtils::MM_DOS' => '6.48',
+ 'ExtUtils::MM_Darwin' => '6.48',
+ 'ExtUtils::MM_MacOS' => '6.48',
+ 'ExtUtils::MM_NW5' => '6.48',
+ 'ExtUtils::MM_OS2' => '6.48',
+ 'ExtUtils::MM_QNX' => '6.48',
+ 'ExtUtils::MM_UWIN' => '6.48',
+ 'ExtUtils::MM_Unix' => '6.48',
+ 'ExtUtils::MM_VMS' => '6.48',
+ 'ExtUtils::MM_VOS' => '6.48',
+ 'ExtUtils::MM_Win32' => '6.48',
+ 'ExtUtils::MM_Win95' => '6.48',
+ 'ExtUtils::MY' => '6.48',
+ 'ExtUtils::MakeMaker' => '6.48',
+ 'ExtUtils::MakeMaker::Config'=> '6.48',
+ 'ExtUtils::MakeMaker::bytes'=> '6.48',
+ 'ExtUtils::MakeMaker::vmsish'=> '6.48',
+ 'ExtUtils::Manifest' => '1.55',
+ 'ExtUtils::Miniperl' => undef,
+ 'ExtUtils::Mkbootstrap' => '6.48',
+ 'ExtUtils::Mksymlists' => '6.48',
+ 'ExtUtils::Packlist' => '1.43',
+ 'ExtUtils::ParseXS' => '2.19',
+ 'ExtUtils::testlib' => '6.48',
+ 'Fatal' => '1.06',
+ 'Fcntl' => '1.06',
+ 'File::Basename' => '2.77',
+ 'File::CheckTree' => '4.4',
+ 'File::Compare' => '1.1005',
+ 'File::Copy' => '2.13',
+ 'File::DosGlob' => '1.01',
+ 'File::Find' => '1.13',
+ 'File::Glob' => '1.06',
+ 'File::Path' => '2.07_02',
+ 'File::Spec' => '3.29',
+ 'File::Spec::Cygwin' => '3.29',
+ 'File::Spec::Epoc' => '3.29',
+ 'File::Spec::Functions' => '3.29',
+ 'File::Spec::Mac' => '3.29',
+ 'File::Spec::OS2' => '3.29',
+ 'File::Spec::Unix' => '3.29',
+ 'File::Spec::VMS' => '3.29',
+ 'File::Spec::Win32' => '3.29',
+ 'File::Temp' => '0.20',
+ 'File::stat' => '1.01',
+ 'FileCache' => '1.07',
+ 'FileHandle' => '2.01',
+ 'Filespec' => '1.11',
+ 'Filter::Simple' => '0.83',
+ 'Filter::Util::Call' => '1.07',
+ 'FindBin' => '1.49',
+ 'GDBM_File' => '1.09',
+ 'Getopt::Long' => '2.37',
+ 'Getopt::Std' => '1.06',
+ 'Hash::Util' => '0.06',
+ 'I18N::Collate' => '1.00',
+ 'I18N::LangTags' => '0.35',
+ 'I18N::LangTags::Detect'=> '1.03',
+ 'I18N::LangTags::List' => '0.35',
+ 'I18N::Langinfo' => '0.02',
+ 'IO' => '1.23',
+ 'IO::Dir' => '1.06',
+ 'IO::File' => '1.14',
+ 'IO::Handle' => '1.27',
+ 'IO::Pipe' => '1.13',
+ 'IO::Poll' => '0.07',
+ 'IO::Seekable' => '1.10',
+ 'IO::Select' => '1.17',
+ 'IO::Socket' => '1.30',
+ 'IO::Socket::INET' => '1.31',
+ 'IO::Socket::UNIX' => '1.23',
+ 'IPC::Msg' => '2.00',
+ 'IPC::Open2' => '1.03',
+ 'IPC::Open3' => '1.03',
+ 'IPC::Semaphore' => '2.00',
+ 'IPC::SharedMem' => '2.00',
+ 'IPC::SysV' => '2.00',
+ 'IPC::lib::IPC::Msg' => '2.00',
+ 'IPC::lib::IPC::Semaphore'=> '2.00',
+ 'IPC::lib::IPC::SharedMem'=> '2.00',
+ 'List::Util' => '1.19',
+ 'Locale::Constants' => '2.07',
+ 'Locale::Country' => '2.07',
+ 'Locale::Currency' => '2.07',
+ 'Locale::Language' => '2.07',
+ 'Locale::Maketext' => '1.13',
+ 'Locale::Maketext::Guts'=> '1.13',
+ 'Locale::Maketext::GutsLoader'=> '1.13',
+ 'Locale::Script' => '2.07',
+ 'MIME::Base64' => '3.07',
+ 'MIME::QuotedPrint' => '3.07',
+ 'Math::BigFloat' => '1.60',
+ 'Math::BigFloat::Trace' => '0.01',
+ 'Math::BigInt' => '1.89',
+ 'Math::BigInt::Calc' => '0.52',
+ 'Math::BigInt::CalcEmu' => '0.05',
+ 'Math::BigInt::Trace' => '0.01',
+ 'Math::BigRat' => '0.22',
+ 'Math::Complex' => '1.54',
+ 'Math::Trig' => '1.18',
+ 'Memoize' => '1.01',
+ 'Memoize::AnyDBM_File' => '0.65',
+ 'Memoize::Expire' => '1.00',
+ 'Memoize::ExpireFile' => '1.01',
+ 'Memoize::ExpireTest' => '0.65',
+ 'Memoize::NDBM_File' => '0.65',
+ 'Memoize::SDBM_File' => '0.65',
+ 'Memoize::Storable' => '0.65',
+ 'Module::CoreList' => '2.17',
+ 'Module::Pluggable' => '3.8',
+ 'Module::Pluggable::Object'=> '3.6',
+ 'Module::Pluggable::lib::Devel::InnerPackage'=> '0.3',
+ 'NDBM_File' => '1.07',
+ 'NEXT' => '0.61',
+ 'Net::Cmd' => '2.29',
+ 'Net::Config' => '1.11',
+ 'Net::Domain' => '2.20',
+ 'Net::FTP' => '2.77',
+ 'Net::FTP::A' => '1.18',
+ 'Net::FTP::E' => '0.01',
+ 'Net::FTP::I' => '1.12',
+ 'Net::FTP::L' => '0.01',
+ 'Net::FTP::dataconn' => '0.11',
+ 'Net::NNTP' => '2.24',
+ 'Net::Netrc' => '2.12',
+ 'Net::POP3' => '2.29',
+ 'Net::Ping' => '2.35',
+ 'Net::SMTP' => '2.31',
+ 'Net::Time' => '2.10',
+ 'Net::hostent' => '1.01',
+ 'Net::netent' => '1.00',
+ 'Net::protoent' => '1.00',
+ 'Net::servent' => '1.01',
+ 'O' => '1.01',
+ 'ODBM_File' => '1.07',
+ 'Opcode' => '1.0601',
+ 'POSIX' => '1.15',
+ 'PerlIO' => '1.05',
+ 'PerlIO::encoding' => '0.11',
+ 'PerlIO::scalar' => '0.06',
+ 'PerlIO::via' => '0.05',
+ 'PerlIO::via::QuotedPrint'=> '0.06',
+ 'Pod::Checker' => '1.43',
+ 'Pod::Find' => '1.34',
+ 'Pod::Functions' => '1.03',
+ 'Pod::Html' => '1.09',
+ 'Pod::InputObjects' => '1.3',
+ 'Pod::LaTeX' => '0.58',
+ 'Pod::Man' => '1.37',
+ 'Pod::ParseLink' => '1.06',
+ 'Pod::ParseUtils' => '1.35',
+ 'Pod::Parser' => '1.35',
+ 'Pod::Perldoc' => '3.14',
+ 'Pod::Perldoc::BaseTo' => undef,
+ 'Pod::Perldoc::GetOptsOO'=> undef,
+ 'Pod::Perldoc::ToChecker'=> undef,
+ 'Pod::Perldoc::ToMan' => undef,
+ 'Pod::Perldoc::ToNroff' => undef,
+ 'Pod::Perldoc::ToPod' => undef,
+ 'Pod::Perldoc::ToRtf' => undef,
+ 'Pod::Perldoc::ToText' => undef,
+ 'Pod::Perldoc::ToTk' => undef,
+ 'Pod::Perldoc::ToXml' => undef,
+ 'Pod::PlainText' => '2.02',
+ 'Pod::Plainer' => '0.01',
+ 'Pod::Select' => '1.35',
+ 'Pod::Text' => '2.21',
+ 'Pod::Text::Color' => '1.04',
+ 'Pod::Text::Overstrike' => '1.1',
+ 'Pod::Text::Termcap' => '1.11',
+ 'Pod::Usage' => '1.35',
+ 'SDBM_File' => '1.06',
+ 'Safe' => '2.16',
+ 'Scalar::Util' => '1.19',
+ 'Search::Dict' => '1.02',
+ 'SelectSaver' => '1.01',
+ 'SelfLoader' => '1.17',
+ 'Shell' => '0.72',
+ 'Socket' => '1.81',
+ 'Stdio' => '2.4',
+ 'Storable' => '2.19',
+ 'Switch' => '2.13',
+ 'Symbol' => '1.06',
+ 'Sys::Hostname' => '1.11',
+ 'Sys::Syslog' => '0.27',
+ 'Sys::Syslog::win32::Win32'=> undef,
+ 'Term::ANSIColor' => '1.12',
+ 'Term::Cap' => '1.12',
+ 'Term::Complete' => '1.402',
+ 'Term::ReadLine' => '1.03',
+ 'Test' => '1.25',
+ 'Test::Builder' => '0.80',
+ 'Test::Builder::Module' => '0.80',
+ 'Test::Builder::Tester' => '1.13',
+ 'Test::Builder::Tester::Color'=> undef,
+ 'Test::Harness' => '2.64',
+ 'Test::Harness::Assert' => '0.02',
+ 'Test::Harness::Iterator'=> '0.02',
+ 'Test::Harness::Point' => '0.01',
+ 'Test::Harness::Results'=> '0.01_01',
+ 'Test::Harness::Straps' => '0.26_01',
+ 'Test::Harness::Util' => '0.01',
+ 'Test::More' => '0.80',
+ 'Test::Simple' => '0.80',
+ 'Text::Abbrev' => '1.01',
+ 'Text::Balanced' => '1.98',
+ 'Text::ParseWords' => '3.27',
+ 'Text::Soundex' => '3.03',
+ 'Text::Tabs' => '2007.1117',
+ 'Text::Wrap' => '2006.1117',
+ 'Thread' => '2.01',
+ 'Thread::Queue' => '2.11',
+ 'Thread::Semaphore' => '2.09',
+ 'Thread::Signal' => '1.00',
+ 'Thread::Specific' => '1.00',
+ 'Tie::Array' => '1.03',
+ 'Tie::File' => '0.97',
+ 'Tie::Handle' => '4.2',
+ 'Tie::Hash' => '1.03',
+ 'Tie::Memoize' => '1.1',
+ 'Tie::RefHash' => '1.38',
+ 'Tie::Scalar' => '1.01',
+ 'Tie::StdHandle' => '4.2',
+ 'Tie::SubstrHash' => '1.00',
+ 'Time::HiRes' => '1.9715',
+ 'Time::Local' => '1.1901',
+ 'Time::gmtime' => '1.03',
+ 'Time::localtime' => '1.02',
+ 'Time::tm' => '1.00',
+ 'UNIVERSAL' => '1.01',
+ 'Unicode' => '5.1.0',
+ 'Unicode::Collate' => '0.52',
+ 'Unicode::Normalize' => '1.02',
+ 'Unicode::UCD' => '0.25',
+ 'User::grent' => '1.01',
+ 'User::pwent' => '1.00',
+ 'Win32' => '0.38',
+ 'Win32API::File' => '0.1001_01',
+ 'Win32API::File::ExtUtils::Myconst2perl'=> '1',
+ 'Win32CORE' => '0.02',
+ 'XS::APItest' => '0.15',
+ 'XS::Typemap' => '0.03',
+ 'XSLoader' => '0.10',
+ 'XSSymSet' => '1.1',
+ 'attributes' => '0.09',
+ 'attrs' => '1.02',
+ 'autouse' => '1.06',
+ 'base' => '2.13',
+ 'bigint' => '0.23',
+ 'bignum' => '0.23',
+ 'bigrat' => '0.23',
+ 'blib' => '1.04',
+ 'bytes' => '1.02',
+ 'charnames' => '1.06',
+ 'constant' => '1.17',
+ 'diagnostics' => '1.16',
+ 'encoding' => '2.6_01',
+ 'fields' => '2.12',
+ 'filetest' => '1.02',
+ 'if' => '0.05',
+ 'integer' => '1.00',
+ 'less' => '0.01',
+ 'lib' => '0.61',
+ 'locale' => '1.00',
+ 'open' => '1.06',
+ 'ops' => '1.02',
+ 'overload' => '1.06',
+ 're' => '0.0601',
+ 'sigtrap' => '1.04',
+ 'sort' => '1.02',
+ 'strict' => '1.03',
+ 'subs' => '1.00',
+ 'threads' => '1.71',
+ 'threads::shared' => '1.27',
+ 'utf8' => '1.07',
+ 'vars' => '1.01',
+ 'vmsish' => '1.02',
+ 'warnings' => '1.05_01',
+ 'warnings::register' => '1.01',
+ },
);
+# Create aliases with trailing zeros for $] use
+
+$released{'5.000'} = $released{5};
+$released{'5.010000'} = $released{5.01};
+
+$patchlevel{'5.000'} = $patchlevel{5};
+$patchlevel{'5.010000'} = $patchlevel{5.01};
+
+$version{'5.000'} = $version{5};
+$version{'5.010000'} = $version{5.01};
+
1;
__END__

178
perl-update-Module-Load-Conditional.patch
View File

@ -1,178 +0,0 @@
Module-Load-Conditional-0.30
diff -ur perl-5.10.0.orig/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t perl-5.10.0/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t
--- perl-5.10.0.orig/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t 2009-02-10 11:41:18.000000000 +0100
@@ -20,8 +20,8 @@
use constant ON_VMS => $^O eq 'VMS';
-use lib "$FindBin::Bin/../lib";
-use lib "$FindBin::Bin/to_load";
+use lib File::Spec->catdir($FindBin::Bin, qw[.. lib] );
+use lib File::Spec->catdir($FindBin::Bin, q[to_load] );
use_ok( 'Module::Load::Conditional' );
@@ -46,6 +46,23 @@
ok( $rv->{uptodate}, q[Verify self] );
is( $rv->{version}, $Module::Load::Conditional::VERSION,
q[ Found proper version] );
+ ok( $rv->{dir}, q[ Found directory information] );
+
+ { my $dir = File::Spec->canonpath( $rv->{dir} );
+
+ ### special rules apply on VMS, as always...
+ if (ON_VMS) {
+ ### Need path syntax for VMS compares.
+ $dir = VMS::Filespec::pathify($dir);
+ ### Remove the trailing VMS specific directory delimiter
+ $dir =~ s/\]//;
+ }
+
+ ### quote for Win32 paths, use | to avoid slash confusion
+ my $dir_re = qr|^\Q$dir\E|i;
+ like( File::Spec->canonpath( $rv->{file} ), $dir_re,
+ q[ Dir subset of file path] );
+ }
### break up the specification
my @rv_path = do {
@@ -64,11 +81,17 @@
### and return it
@path;
};
-
- is( $INC{'Module/Load/Conditional.pm'},
+ my $inc_path = $INC{'Module/Load/Conditional.pm'};
+ if ( $^O eq 'MSWin32' ) {
+ $inc_path = File::Spec->canonpath( $inc_path );
+ $inc_path =~ s{\\}{/}g; # to meet with unix path
+ }
+ is( $inc_path,
File::Spec::Unix->catfile(@rv_path),
q[ Found proper file]
);
+
+
}
diff -ur perl-5.10.0.orig/lib/Module/Load/Conditional.pm perl-5.10.0/lib/Module/Load/Conditional.pm
--- perl-5.10.0.orig/lib/Module/Load/Conditional.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Module/Load/Conditional.pm 2009-02-10 11:40:22.000000000 +0100
@@ -9,7 +9,7 @@
use Carp ();
use File::Spec ();
use FileHandle ();
-use version qw[qv];
+use version;
use constant ON_VMS => $^O eq 'VMS';
@@ -18,7 +18,7 @@
$FIND_VERSION $ERROR $CHECK_INC_HASH];
use Exporter;
@ISA = qw[Exporter];
- $VERSION = '0.22';
+ $VERSION = '0.30';
$VERBOSE = 0;
$FIND_VERSION = 1;
$CHECK_INC_HASH = 0;
@@ -116,6 +116,11 @@
Full path to the file that contains the module
+=item dir
+
+Directory, or more exact the C<@INC> entry, where the module was
+loaded from.
+
=item version
The version number of the installed module - this will be C<undef> if
@@ -226,6 +231,9 @@
}
}
+ ### store the directory we found the file in
+ $href->{dir} = $dir;
+
### files need to be in unix format under vms,
### or they might be loaded twice
$href->{file} = ON_VMS
@@ -236,18 +244,20 @@
if( $FIND_VERSION ) {
my $in_pod = 0;
- while (local $_ = <$fh> ) {
+ while ( my $line = <$fh> ) {
### stolen from EU::MM_Unix->parse_version to address
### #24062: "Problem with CPANPLUS 0.076 misidentifying
### versions after installing Text::NSP 1.03" where a
### VERSION mentioned in the POD was found before
### the real $VERSION declaration.
- $in_pod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $in_pod;
+ $in_pod = $line =~ /^=(?!cut)/ ? 1 :
+ $line =~ /^=cut/ ? 0 :
+ $in_pod;
next if $in_pod;
### try to find a version declaration in this string.
- my $ver = __PACKAGE__->_parse_version( $_ );
+ my $ver = __PACKAGE__->_parse_version( $line );
if( defined $ver ) {
$href->{version} = $ver;
@@ -280,8 +290,14 @@
### 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 +317,8 @@
### 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 +338,7 @@
local $1$2;
\$$2=undef; do {
- $str
+ $taint_safe_str
}; \$$2
};
@@ -426,9 +443,14 @@
### 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;

964
perl-update-Module-Pluggable.patch
View File

@ -1,964 +0,0 @@
This patch is derived from the perl-5.10.1 tarball as released on the CPAN.
diff -urN perl-5.10.0.orig/lib/Devel/InnerPackage.pm perl-5.10.0/lib/Devel/InnerPackage.pm
--- perl-5.10.0.orig/lib/Devel/InnerPackage.pm 2007-12-18 02:47:07.000000000 -0800
+++ perl-5.10.0/lib/Devel/InnerPackage.pm 2009-08-31 19:47:24.444773931 -0700
@@ -17,7 +17,7 @@
=head1 SYNOPSIS
use Foo::Bar;
- use Devel::innerPackage qw(list_packages);
+ use Devel::InnerPackage qw(list_packages);
my @inner_packages = list_packages('Foo::Bar');
@@ -75,7 +75,7 @@
!__PACKAGE__->_loaded($pack.$cand); # or @children;
push @packs, @children;
}
- return grep {$_ !~ /::::ISA::CACHE/} @packs;
+ return grep {$_ !~ /::(::ISA::CACHE|SUPER)/} @packs;
}
### XXX this is an inlining of the Class-Inspector->loaded()
diff -urN perl-5.10.0.orig/lib/Module/Pluggable/Object.pm perl-5.10.0/lib/Module/Pluggable/Object.pm
--- perl-5.10.0.orig/lib/Module/Pluggable/Object.pm 2007-12-18 02:47:07.000000000 -0800
+++ perl-5.10.0/lib/Module/Pluggable/Object.pm 2009-08-31 19:47:24.446771196 -0700
@@ -6,10 +6,9 @@
use File::Spec::Functions qw(splitdir catdir curdir catfile abs2rel);
use Carp qw(croak carp);
use Devel::InnerPackage;
-use Data::Dumper;
use vars qw($VERSION);
-$VERSION = '3.6';
+$VERSION = '3.9';
sub new {
@@ -20,6 +19,10 @@
}
+### Eugggh, this code smells
+### This is what happens when you keep adding patches
+### *sigh*
+
sub plugins {
my $self = shift;
@@ -30,14 +33,14 @@
my $filename = $self->{'filename'};
my $pkg = $self->{'package'};
+ # Get the exception params instantiated
+ $self->_setup_exceptions;
+
# automatically turn a scalar search path or namespace into a arrayref
for (qw(search_path search_dirs)) {
$self->{$_} = [ $self->{$_} ] if exists $self->{$_} && !ref($self->{$_});
}
-
-
-
# default search path is '<Module>::<Name>::Plugin'
$self->{'search_path'} = ["${pkg}::Plugin"] unless $self->{'search_path'};
@@ -46,13 +49,14 @@
# check to see if we're running under test
- my @SEARCHDIR = exists $INC{"blib.pm"} && $filename =~ m!(^|/)blib/! ? grep {/blib/} @INC : @INC;
+ my @SEARCHDIR = exists $INC{"blib.pm"} && defined $filename && $filename =~ m!(^|/)blib/! ? grep {/blib/} @INC : @INC;
# add any search_dir params
unshift @SEARCHDIR, @{$self->{'search_dirs'}} if defined $self->{'search_dirs'};
my @plugins = $self->search_directories(@SEARCHDIR);
+ push(@plugins, $self->handle_innerpackages($_)) for @{$self->{'search_path'}};
# push @plugins, map { print STDERR "$_\n"; $_->require } list_packages($_) for (@{$self->{'search_path'}});
@@ -60,43 +64,12 @@
return () unless @plugins;
- # exceptions
- my %only;
- my %except;
- my $only;
- my $except;
-
- if (defined $self->{'only'}) {
- if (ref($self->{'only'}) eq 'ARRAY') {
- %only = map { $_ => 1 } @{$self->{'only'}};
- } elsif (ref($self->{'only'}) eq 'Regexp') {
- $only = $self->{'only'}
- } elsif (ref($self->{'only'}) eq '') {
- $only{$self->{'only'}} = 1;
- }
- }
-
-
- if (defined $self->{'except'}) {
- if (ref($self->{'except'}) eq 'ARRAY') {
- %except = map { $_ => 1 } @{$self->{'except'}};
- } elsif (ref($self->{'except'}) eq 'Regexp') {
- $except = $self->{'except'}
- } elsif (ref($self->{'except'}) eq '') {
- $except{$self->{'except'}} = 1;
- }
- }
-
# remove duplicates
# probably not necessary but hey ho
my %plugins;
for(@plugins) {
- next if (keys %only && !$only{$_} );
- next unless (!defined $only || m!$only! );
-
- next if (keys %except && $except{$_} );
- next if (defined $except && m!$except! );
+ next unless $self->_is_legit($_);
$plugins{$_} = 1;
}
@@ -112,6 +85,58 @@
}
+sub _setup_exceptions {
+ my $self = shift;
+
+ my %only;
+ my %except;
+ my $only;
+ my $except;
+
+ if (defined $self->{'only'}) {
+ if (ref($self->{'only'}) eq 'ARRAY') {
+ %only = map { $_ => 1 } @{$self->{'only'}};
+ } elsif (ref($self->{'only'}) eq 'Regexp') {
+ $only = $self->{'only'}
+ } elsif (ref($self->{'only'}) eq '') {
+ $only{$self->{'only'}} = 1;
+ }
+ }
+
+
+ if (defined $self->{'except'}) {
+ if (ref($self->{'except'}) eq 'ARRAY') {
+ %except = map { $_ => 1 } @{$self->{'except'}};
+ } elsif (ref($self->{'except'}) eq 'Regexp') {
+ $except = $self->{'except'}
+ } elsif (ref($self->{'except'}) eq '') {
+ $except{$self->{'except'}} = 1;
+ }
+ }
+ $self->{_exceptions}->{only_hash} = \%only;
+ $self->{_exceptions}->{only} = $only;
+ $self->{_exceptions}->{except_hash} = \%except;
+ $self->{_exceptions}->{except} = $except;
+
+}
+
+sub _is_legit {
+ my $self = shift;
+ my $plugin = shift;
+ my %only = %{$self->{_exceptions}->{only_hash}||{}};
+ my %except = %{$self->{_exceptions}->{except_hash}||{}};
+ my $only = $self->{_exceptions}->{only};
+ my $except = $self->{_exceptions}->{except};
+
+ return 0 if (keys %only && !$only{$plugin} );
+ return 0 unless (!defined $only || $plugin =~ m!$only! );
+
+ return 0 if (keys %except && $except{$plugin} );
+ return 0 if (defined $except && $plugin =~ m!$except! );
+
+ return 1;
+}
+
sub search_directories {
my $self = shift;
my @SEARCHDIR = @_;
@@ -121,7 +146,6 @@
foreach my $dir (@SEARCHDIR) {
push @plugins, $self->search_paths($dir);
}
-
return @plugins;
}
@@ -151,6 +175,8 @@
# parse the file to get the name
my ($name, $directory, $suffix) = fileparse($file, $file_regex);
+ next if (!$self->{include_editor_junk} && $self->_is_editor_junk($name));
+
$directory = abs2rel($directory, $sp);
# If we have a mixed-case package name, assume case has been preserved
@@ -203,17 +229,34 @@
# now add stuff that may have been in package
# NOTE we should probably use all the stuff we've been given already
# but then we can't unload it :(
- push @plugins, $self->handle_innerpackages($searchpath) unless (exists $self->{inner} && !$self->{inner});
+ push @plugins, $self->handle_innerpackages($searchpath);
} # foreach $searchpath
return @plugins;
}
+sub _is_editor_junk {
+ my $self = shift;
+ my $name = shift;
+
+ # Emacs (and other Unix-y editors) leave temp files ending in a
+ # tilde as a backup.
+ return 1 if $name =~ /~$/;
+ # Emacs makes these files while a buffer is edited but not yet
+ # saved.
+ return 1 if $name =~ /^\.#/;
+ # Vim can leave these files behind if it crashes.
+ return 1 if $name =~ /\.sw[po]$/;
+
+ return 0;
+}
+
sub handle_finding_plugin {
my $self = shift;
my $plugin = shift;
return unless (defined $self->{'instantiate'} || $self->{'require'});
+ return unless $self->_is_legit($plugin);
$self->_require($plugin);
}
@@ -245,10 +288,11 @@
sub handle_innerpackages {
my $self = shift;
+ return () if (exists $self->{inner} && !$self->{inner});
+
my $path = shift;
my @plugins;
-
foreach my $plugin (Devel::InnerPackage::list_packages($path)) {
my $err = $self->handle_finding_plugin($plugin);
#next if $err;
@@ -299,6 +343,14 @@
Optionally it instantiates those classes for you.
+This object is wrapped by C<Module::Pluggable>. If you want to do something
+odd or add non-general special features you're probably best to wrap this
+and produce your own subclass.
+
+=head1 OPTIONS
+
+See the C<Module::Pluggable> docs.
+
=head1 AUTHOR
Simon Wistow <simon@thegestalt.org>
diff -urN perl-5.10.0.orig/lib/Module/Pluggable.pm perl-5.10.0/lib/Module/Pluggable.pm
--- perl-5.10.0.orig/lib/Module/Pluggable.pm 2007-12-18 02:47:07.000000000 -0800
+++ perl-5.10.0/lib/Module/Pluggable.pm 2009-08-31 19:47:24.448771465 -0700
@@ -9,7 +9,7 @@
# Peter Gibbons: I wouldn't say I've been missing it, Bob!
-$VERSION = '3.6';
+$VERSION = '3.9';
sub import {
my $class = shift;
@@ -60,8 +60,9 @@
no strict 'refs';
- no warnings 'redefine';
- *{"$package\::$sub"} = $subroutine;
+ no warnings qw(redefine prototype);
+
+ *{"$package\::$sub"} = $subroutine;
*{"$package\::search_path"} = $searchsub;
*{"$package\::only"} = $onlysub;
*{"$package\::except"} = $exceptsub;
@@ -297,6 +298,14 @@
file_regex => qr/\.plugin$/
+=head2 include_editor_junk
+
+By default C<Module::Pluggable> ignores files that look like they were
+left behind by editors. Currently this means files ending in F<~> (~),
+the extensions F<.swp> or F<.swo>, or files beginning with F<.#>.
+
+Setting C<include_editor_junk> changes C<Module::Pluggable> so it does
+not ignore any files it finds.
=head1 METHODs
diff -urN perl-5.10.0.orig/MANIFEST perl-5.10.0/MANIFEST
--- perl-5.10.0.orig/MANIFEST 2007-12-18 02:47:07.000000000 -0800
+++ perl-5.10.0/MANIFEST 2009-08-31 19:47:24.452770885 -0700
@@ -3612,11 +3612,14 @@
t/Module_Pluggable/09require.t Module::Pluggable tests
t/Module_Pluggable/10innerpack_inner.t Module::Pluggable tests
t/Module_Pluggable/10innerpack_noinner.t Module::Pluggable tests
+t/Module_Pluggable/10innerpack_onefile.t Module::Pluggable tests
t/Module_Pluggable/10innerpack_override.t Module::Pluggable tests
+t/Module_Pluggable/10innerpack_super.t Module::Pluggable tests
t/Module_Pluggable/10innerpack.t Module::Pluggable tests
t/Module_Pluggable/11usetwice.t Module::Pluggable tests
t/Module_Pluggable/12onlyarray.t Module::Pluggable tests
t/Module_Pluggable/12onlyregex.t Module::Pluggable tests
+t/Module_Pluggable/12onlyrequire.t Module::Pluggable tests
t/Module_Pluggable/12only.t Module::Pluggable tests
t/Module_Pluggable/13exceptarray.t Module::Pluggable tests
t/Module_Pluggable/13exceptregex.t Module::Pluggable tests
@@ -3628,8 +3631,15 @@
t/Module_Pluggable/18skipped_package.t Module::Pluggable tests
t/Module_Pluggable/19can_ok_clobber.t Module::Pluggable tests
t/Module_Pluggable/20dodgy_files.t Module::Pluggable tests
+t/Module_Pluggable/21editor_junk.t Module::Pluggable tests
t/Module_Pluggable/acme/Acme/MyTest/Plugin/Foo.pm Module::Pluggable tests
t/Module_Pluggable/lib/Acme/MyTest/Plugin/Foo.pm Module::Pluggable tests
+t/Module_Pluggable/lib/Acme/Foo-Bar.pm Module::Pluggable tests
+t/Module_Pluggable/lib/EditorJunk/Plugin/Foo.pm Module::Pluggable tests
+t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm.swo Module::Pluggable tests
+t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm.swp Module::Pluggable tests
+t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm~ Module::Pluggable tests
+t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm Module::Pluggable tests
t/Module_Pluggable/lib/ExtTest/Plugin/Bar.plugin Module::Pluggable tests
t/Module_Pluggable/lib/ExtTest/Plugin/Foo.plugin Module::Pluggable tests
t/Module_Pluggable/lib/ExtTest/Plugin/Quux/Foo.plugin Module::Pluggable tests
@@ -3646,6 +3656,7 @@
t/Module_Pluggable/lib/OddTest/Plugin/-Dodgy.pm Module::Pluggable tests
t/Module_Pluggable/lib/OddTest/Plugin/Foo.pm Module::Pluggable tests
t/Module_Pluggable/lib/TA/C/A/I.pm Module::Pluggable tests
+t/Module_Pluggable/lib/Zot/.Zork.pm Module::Pluggable tests
t/mro/basic_01_c3.t mro tests
t/mro/basic_01_dfs.t mro tests
t/mro/basic_02_c3.t mro tests
diff -urN perl-5.10.0.orig/t/Module_Pluggable/02alsoworks.t perl-5.10.0/t/Module_Pluggable/02alsoworks.t
--- perl-5.10.0.orig/t/Module_Pluggable/02alsoworks.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/02alsoworks.t 2009-08-31 19:47:24.454770805 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 5;
my $foo;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/02works.t perl-5.10.0/t/Module_Pluggable/02works.t
--- perl-5.10.0.orig/t/Module_Pluggable/02works.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/02works.t 2009-08-31 19:47:24.455771358 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 5;
my $foo;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/03diffname.t perl-5.10.0/t/Module_Pluggable/03diffname.t
--- perl-5.10.0.orig/t/Module_Pluggable/03diffname.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/03diffname.t 2009-08-31 19:47:24.456771493 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 3;
my $foo;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/04acmedir_single.t perl-5.10.0/t/Module_Pluggable/04acmedir_single.t
--- perl-5.10.0.orig/t/Module_Pluggable/04acmedir_single.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/04acmedir_single.t 2009-08-31 19:47:24.456771493 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 3;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/04acmedir.t perl-5.10.0/t/Module_Pluggable/04acmedir.t
--- perl-5.10.0.orig/t/Module_Pluggable/04acmedir.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/04acmedir.t 2009-08-31 19:47:24.457771627 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 3;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/04acmepath_single.t perl-5.10.0/t/Module_Pluggable/04acmepath_single.t
--- perl-5.10.0.orig/t/Module_Pluggable/04acmepath_single.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/04acmepath_single.t 2009-08-31 19:47:24.458773508 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 3;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/04acmepath.t perl-5.10.0/t/Module_Pluggable/04acmepath.t
--- perl-5.10.0.orig/t/Module_Pluggable/04acmepath.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/04acmepath.t 2009-08-31 19:47:24.459772105 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 3;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/05postpath.t perl-5.10.0/t/Module_Pluggable/05postpath.t
--- perl-5.10.0.orig/t/Module_Pluggable/05postpath.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/05postpath.t 2009-08-31 19:47:24.460771332 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 3;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/06multipath.t perl-5.10.0/t/Module_Pluggable/06multipath.t
--- perl-5.10.0.orig/t/Module_Pluggable/06multipath.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/06multipath.t 2009-08-31 19:47:24.461771676 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 3;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/07instantiate.t perl-5.10.0/t/Module_Pluggable/07instantiate.t
--- perl-5.10.0.orig/t/Module_Pluggable/07instantiate.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/07instantiate.t 2009-08-31 19:47:24.462772090 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 6;
my $foo;
@@ -26,7 +26,7 @@
use File::Spec::Functions qw(catdir);
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Module::Pluggable (search_path => ["MyTest::Extend::Plugin"], sub_name => 'booga', instantiate => 'new');
use Module::Pluggable (search_path => ["MyTest::Extend::Plugin"], sub_name => 'wooga', instantiate => 'nosomuchmethod');
diff -urN perl-5.10.0.orig/t/Module_Pluggable/08nothing.t perl-5.10.0/t/Module_Pluggable/08nothing.t
--- perl-5.10.0.orig/t/Module_Pluggable/08nothing.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/08nothing.t 2009-08-31 19:47:24.463771316 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 2;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/09require.t perl-5.10.0/t/Module_Pluggable/09require.t
--- perl-5.10.0.orig/t/Module_Pluggable/09require.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/09require.t 2009-08-31 19:47:24.464771800 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 2;
my $t = MyTest->new();
diff -urN perl-5.10.0.orig/t/Module_Pluggable/10innerpack_inner.t perl-5.10.0/t/Module_Pluggable/10innerpack_inner.t
--- perl-5.10.0.orig/t/Module_Pluggable/10innerpack_inner.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/10innerpack_inner.t 2009-08-31 19:47:24.465771515 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 3;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/10innerpack_noinner.t perl-5.10.0/t/Module_Pluggable/10innerpack_noinner.t
--- perl-5.10.0.orig/t/Module_Pluggable/10innerpack_noinner.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/10innerpack_noinner.t 2009-08-31 19:47:24.479772629 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 3;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/10innerpack_onefile.t perl-5.10.0/t/Module_Pluggable/10innerpack_onefile.t
--- perl-5.10.0.orig/t/Module_Pluggable/10innerpack_onefile.t 1969-12-31 16:00:00.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/10innerpack_onefile.t 2009-08-31 19:47:24.480772134 -0700
@@ -0,0 +1,27 @@
+#!perl -wT
+
+use strict;
+use Test::More tests => 2;
+use Data::Dumper;
+
+my $mc = MyClass->new();
+my $mc2 = MyClass2->new();
+
+
+is_deeply([$mc->plugins], [qw(MyClass::Plugin::MyPlugin)], "Got inner plugin");
+is_deeply([$mc2->plugins], [], "Didn't get plugin");
+
+package MyClass::Plugin::MyPlugin;
+sub pretty { print "I am pretty" };
+
+package MyClass;
+use Module::Pluggable inner => 1;
+
+sub new { return bless {}, $_[0] }
+
+package MyClass2;
+use Module::Pluggable search_path => "MyClass::Plugin", inner => 0;
+
+sub new { return bless {}, $_[0] }
+1;
+
diff -urN perl-5.10.0.orig/t/Module_Pluggable/10innerpack_override.t perl-5.10.0/t/Module_Pluggable/10innerpack_override.t
--- perl-5.10.0.orig/t/Module_Pluggable/10innerpack_override.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/10innerpack_override.t 2009-08-31 19:47:24.481771501 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 3;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/10innerpack_super.t perl-5.10.0/t/Module_Pluggable/10innerpack_super.t
--- perl-5.10.0.orig/t/Module_Pluggable/10innerpack_super.t 1969-12-31 16:00:00.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/10innerpack_super.t 2009-08-31 19:47:24.482771565 -0700
@@ -0,0 +1,29 @@
+#!perl -wT
+
+use Test::More tests => 3;
+use strict;
+use_ok('Devel::InnerPackage');
+Bar->whee;
+is_deeply([Devel::InnerPackage::list_packages("Bar")],[], "Don't pick up ::SUPER pseudo stash");
+is_deeply([Devel::InnerPackage::list_packages("Foo")],['Foo::Bar'], "Still pick up other inner package");
+
+package Foo;
+
+sub whee {
+ 1;
+}
+
+package Foo::Bar;
+
+sub whee {}
+
+package Bar;
+use base 'Foo';
+
+sub whee {
+ shift->SUPER::whee;
+ 2;
+}
+
+
+1;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/10innerpack.t perl-5.10.0/t/Module_Pluggable/10innerpack.t
--- perl-5.10.0.orig/t/Module_Pluggable/10innerpack.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/10innerpack.t 2009-08-31 19:47:24.483771909 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 4;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/11usetwice.t perl-5.10.0/t/Module_Pluggable/11usetwice.t
--- perl-5.10.0.orig/t/Module_Pluggable/11usetwice.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/11usetwice.t 2009-08-31 19:47:24.484771624 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 3;
my $foo;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/12onlyarray.t perl-5.10.0/t/Module_Pluggable/12onlyarray.t
--- perl-5.10.0.orig/t/Module_Pluggable/12onlyarray.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/12onlyarray.t 2009-08-31 19:47:24.485772038 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 10;
{
diff -urN perl-5.10.0.orig/t/Module_Pluggable/12onlyregex.t perl-5.10.0/t/Module_Pluggable/12onlyregex.t
--- perl-5.10.0.orig/t/Module_Pluggable/12onlyregex.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/12onlyregex.t 2009-08-31 19:47:24.485772038 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 10;
{
diff -urN perl-5.10.0.orig/t/Module_Pluggable/12onlyrequire.t perl-5.10.0/t/Module_Pluggable/12onlyrequire.t
--- perl-5.10.0.orig/t/Module_Pluggable/12onlyrequire.t 1969-12-31 16:00:00.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/12onlyrequire.t 2009-08-31 19:47:24.505021273 -0700
@@ -0,0 +1,21 @@
+#!perl -w
+use strict;
+use FindBin;
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
+use Test::More tests => 2;
+
+my @packages = eval { Zot->_dist_types };
+is($@, '', "No warnings");
+is(scalar(@packages), 0, "Correctly only got 1 package");
+
+
+package Zot;
+use strict;
+use Module::Pluggable (
+ sub_name => '_dist_types',
+ search_path => __PACKAGE__,
+ only => qr/Zot::\w+$/,
+ require => 1,
+ );
+
+1;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/12only.t perl-5.10.0/t/Module_Pluggable/12only.t
--- perl-5.10.0.orig/t/Module_Pluggable/12only.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/12only.t 2009-08-31 19:47:24.506022385 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 10;
{
diff -urN perl-5.10.0.orig/t/Module_Pluggable/13exceptarray.t perl-5.10.0/t/Module_Pluggable/13exceptarray.t
--- perl-5.10.0.orig/t/Module_Pluggable/13exceptarray.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/13exceptarray.t 2009-08-31 19:47:24.507021263 -0700
@@ -1,8 +1,8 @@
-#!perl -w
+#!perl -wT
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 10;
{
diff -urN perl-5.10.0.orig/t/Module_Pluggable/13exceptregex.t perl-5.10.0/t/Module_Pluggable/13exceptregex.t
--- perl-5.10.0.orig/t/Module_Pluggable/13exceptregex.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/13exceptregex.t 2009-08-31 19:47:24.510021945 -0700
@@ -1,8 +1,8 @@
-#!perl -w
+#!perl -wT
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 10;
{
diff -urN perl-5.10.0.orig/t/Module_Pluggable/13except.t perl-5.10.0/t/Module_Pluggable/13except.t
--- perl-5.10.0.orig/t/Module_Pluggable/13except.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/13except.t 2009-08-31 19:47:24.511021381 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 10;
{
diff -urN perl-5.10.0.orig/t/Module_Pluggable/14package.t perl-5.10.0/t/Module_Pluggable/14package.t
--- perl-5.10.0.orig/t/Module_Pluggable/14package.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/14package.t 2009-08-31 19:47:24.842414378 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 5;
my $foo;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/15topicsafe.t perl-5.10.0/t/Module_Pluggable/15topicsafe.t
--- perl-5.10.0.orig/t/Module_Pluggable/15topicsafe.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/15topicsafe.t 2009-08-31 19:47:24.842774343 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More 'no_plan';
use Module::Pluggable search_path => 'Acme::MyTest';
diff -urN perl-5.10.0.orig/t/Module_Pluggable/16different_extension.t perl-5.10.0/t/Module_Pluggable/16different_extension.t
--- perl-5.10.0.orig/t/Module_Pluggable/16different_extension.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/16different_extension.t 2009-08-31 19:47:24.843800947 -0700
@@ -2,7 +2,7 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests => 5;
my $foo;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/17devel_inner_package.t perl-5.10.0/t/Module_Pluggable/17devel_inner_package.t
--- perl-5.10.0.orig/t/Module_Pluggable/17devel_inner_package.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/17devel_inner_package.t 2009-08-31 19:47:24.843800947 -0700
@@ -3,7 +3,7 @@
use Devel::InnerPackage qw(list_packages);
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
my @packages;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/18skipped_package.t perl-5.10.0/t/Module_Pluggable/18skipped_package.t
--- perl-5.10.0.orig/t/Module_Pluggable/18skipped_package.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/18skipped_package.t 2009-08-31 19:47:24.844780129 -0700
@@ -2,7 +2,7 @@
use Test::More tests => 1;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Devel::InnerPackage qw(list_packages);
use No::Middle;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/19can_ok_clobber.t perl-5.10.0/t/Module_Pluggable/19can_ok_clobber.t
--- perl-5.10.0.orig/t/Module_Pluggable/19can_ok_clobber.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/19can_ok_clobber.t 2009-08-31 19:47:24.844780129 -0700
@@ -3,7 +3,7 @@
use warnings;
use Data::Dumper;
use FindBin;
-use lib "$FindBin::Bin/lib";
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
use Test::More tests=>5;
diff -urN perl-5.10.0.orig/t/Module_Pluggable/20dodgy_files.t perl-5.10.0/t/Module_Pluggable/20dodgy_files.t
--- perl-5.10.0.orig/t/Module_Pluggable/20dodgy_files.t 2007-12-18 02:47:08.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/20dodgy_files.t 2009-08-31 19:47:24.845769158 -0700
@@ -1,7 +1,7 @@
#!perl -w
BEGIN {
- if ($^O eq 'VMS') {
+ if ($^O eq 'VMS' || $^O eq 'VOS') {
print "1..0 # Skip: can't handle misspelled plugin names\n";
exit;
}
@@ -9,8 +9,18 @@
use strict;
use FindBin;
-use lib "$FindBin::Bin/lib";
-use Test::More tests => 5;
+use Test::More;
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
+use File::Spec::Functions qw(catfile);
+
+
+my ($dodgy_file) = (catfile($FindBin::Bin, "lib", "OddTest", "Plugin", "-Dodgy.pm")=~/^(.*)$/);
+unless (-f $dodgy_file) {
+ plan skip_all => "Can't handle misspelled plugin names\n";
+} else {
+ plan tests => 5;
+}
+
my $foo;
ok($foo = OddTest->new());
diff -urN perl-5.10.0.orig/t/Module_Pluggable/21editor_junk.t perl-5.10.0/t/Module_Pluggable/21editor_junk.t
--- perl-5.10.0.orig/t/Module_Pluggable/21editor_junk.t 1969-12-31 16:00:00.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/21editor_junk.t 2009-08-31 19:47:24.845769158 -0700
@@ -0,0 +1,53 @@
+#!perl -w
+
+use Test::More;
+use FindBin;
+use lib (($FindBin::Bin."/lib")=~/^(.*)$/);
+use Module::Pluggable::Object;
+use File::Spec::Functions qw(catfile);
+
+my ($dodgy_file) = (catfile($FindBin::Bin,"lib", "EditorJunk", "Plugin", "#Bar.pm#")=~/^(.*)$/);
+unless (-f $dodgy_file) {
+ plan skip_all => "Can't handle plugin names with octothorpes\n";
+} else {
+ plan tests => 4;
+}
+
+
+
+my $foo;
+ok($foo = EditorJunk->new());
+
+my @plugins;
+my @expected = qw(EditorJunk::Plugin::Bar EditorJunk::Plugin::Foo);
+ok(@plugins = sort $foo->plugins);
+
+is_deeply(\@plugins, \@expected, "is deeply");
+
+
+my $mpo = Module::Pluggable::Object->new(
+ package => 'EditorJunk',
+ filename => __FILE__,
+ include_editor_junk => 1,
+);
+
+@expected = ('EditorJunk::Plugin::.#Bar', 'EditorJunk::Plugin::Bar', 'EditorJunk::Plugin::Foo');
+@plugins = sort $mpo->plugins();
+is_deeply(\@plugins, \@expected, "is deeply");
+
+
+
+package EditorJunk;
+
+use strict;
+use Module::Pluggable;
+
+
+sub new {
+ my $class = shift;
+ return bless {}, $class;
+
+}
+1;
+
+
diff -urN perl-5.10.0.orig/t/Module_Pluggable/lib/Acme/Foo-Bar.pm perl-5.10.0/t/Module_Pluggable/lib/Acme/Foo-Bar.pm
--- perl-5.10.0.orig/t/Module_Pluggable/lib/Acme/Foo-Bar.pm 1969-12-31 16:00:00.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/lib/Acme/Foo-Bar.pm 2009-08-31 19:47:24.845769158 -0700
@@ -0,0 +1,6 @@
+package Acme::FooBar;
+
+our $quux = "hello";
+
+1;
+
diff -urN perl-5.10.0.orig/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm perl-5.10.0/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm
--- perl-5.10.0.orig/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm 1969-12-31 16:00:00.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm 2009-08-31 19:47:24.846769084 -0700
@@ -0,0 +1,9 @@
+package EditorJunk::Bar;
+
+
+use strict;
+
+
+1;
+
+
diff -urN perl-5.10.0.orig/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm~ perl-5.10.0/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm~
--- perl-5.10.0.orig/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm~ 1969-12-31 16:00:00.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm~ 2009-08-31 19:47:24.851770803 -0700
@@ -0,0 +1,9 @@
+package EditorJunk::Bar;
+
+
+use strict;
+
+
+1;
+
+
diff -urN perl-5.10.0.orig/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm.swo perl-5.10.0/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm.swo
--- perl-5.10.0.orig/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm.swo 1969-12-31 16:00:00.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm.swo 2009-08-31 19:47:24.852771985 -0700
@@ -0,0 +1,9 @@
+package EditorJunk::Bar;
+
+
+use strict;
+
+
+1;
+
+
diff -urN perl-5.10.0.orig/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm.swp perl-5.10.0/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm.swp
--- perl-5.10.0.orig/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm.swp 1969-12-31 16:00:00.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/lib/EditorJunk/Plugin/Bar.pm.swp 2009-08-31 19:47:24.853771770 -0700
@@ -0,0 +1,9 @@
+package EditorJunk::Bar;
+
+
+use strict;
+
+
+1;
+
+
diff -urN perl-5.10.0.orig/t/Module_Pluggable/lib/EditorJunk/Plugin/Foo.pm perl-5.10.0/t/Module_Pluggable/lib/EditorJunk/Plugin/Foo.pm
--- perl-5.10.0.orig/t/Module_Pluggable/lib/EditorJunk/Plugin/Foo.pm 1969-12-31 16:00:00.000000000 -0800
+++ perl-5.10.0/t/Module_Pluggable/lib/EditorJunk/Plugin/Foo.pm 2009-08-31 19:47:24.854771835 -0700
@@ -0,0 +1,9 @@
+package EditorJunk::Foo;
+
+
+use strict;
+
+
+1;
+
+

1278
perl-update-Pod-Simple.patch
View File

File diff suppressed because it is too large Load Diff

1520
perl-update-Scalar-List-Utils.patch
View File

File diff suppressed because it is too large Load Diff

389
perl-update-Storable.patch
View File

@ -1,389 +0,0 @@
Storable-2.21
diff -urpN perl-5.10.0.orig/MANIFEST perl-5.10.0/MANIFEST
--- perl-5.10.0.orig/MANIFEST 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/MANIFEST 2009-10-01 13:18:44.000000000 +0200
@@ -1028,6 +1028,7 @@ ext/Socket/t/Socket.t See if Socket wor
ext/Storable/ChangeLog Storable extension
ext/Storable/hints/gnukfreebsd.pl Hint for Storable for named architecture
ext/Storable/hints/gnuknetbsd.pl Hint for Storable for named architecture
+ext/Storable/hints/hpux.pl Hint for Storable for named architecture
ext/Storable/hints/linux.pl Hint for Storable for named architecture
ext/Storable/Makefile.PL Storable extension
ext/Storable/MANIFEST Storable extension
diff -urpN perl-5.10.0.orig/ext/Storable/ChangeLog perl-5.10.0/ext/Storable/ChangeLog
--- perl-5.10.0.orig/ext/Storable/ChangeLog 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Storable/ChangeLog 2009-10-01 13:17:50.000000000 +0200
@@ -1,3 +1,18 @@
+Thu Aug 6 10:55:50 IST 2009 Abhijit Menon-Sen <ams@toroid.org>
+
+ Version 2.21
+
+ Includes hints/hpux.pl that was inadvertently left out of 2.20.
+
+Mon May 18 09:38:20 IST 2009 Abhijit Menon-Sen <ams@toroid.org>
+
+ Version 2.20
+
+ Fix bug handling blessed references to overloaded objects, plus
+ other miscellaneous fixes.
+
+ (Version 2.19 was released with 5.8.9.)
+
Thu Nov 22 13:24:18 IST 2007 Abhijit Menon-Sen <ams@toroid.org>
Version 2.18
diff -urpN perl-5.10.0.orig/ext/Storable/MANIFEST perl-5.10.0/ext/Storable/MANIFEST
--- perl-5.10.0.orig/ext/Storable/MANIFEST 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Storable/MANIFEST 2009-10-01 13:17:50.000000000 +0200
@@ -4,6 +4,7 @@ Makefile.PL Generic Makefile templa
Storable.pm The perl side of Storable
Storable.xs The C side of Storable
ChangeLog Changes since baseline
+hints/hpux.pl Hint file to drop to -O1 on HPUX
hints/linux.pl Hint file to drop gcc to -O2
hints/gnukfreebsd.pl Hint file to drop gcc to -O2
hints/gnuknetbsd.pl Hint file to drop gcc to -O2
diff -urpN perl-5.10.0.orig/ext/Storable/Makefile.PL perl-5.10.0/ext/Storable/Makefile.PL
--- perl-5.10.0.orig/ext/Storable/Makefile.PL 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Storable/Makefile.PL 2009-10-01 13:17:58.000000000 +0200
@@ -11,7 +11,6 @@ use Config;
WriteMakefile(
NAME => 'Storable',
DISTNAME => "Storable",
- MAN3PODS => {},
# We now ship this in t/
# PREREQ_PM => { 'Test::More' => '0.41' },
INSTALLDIRS => $] >= 5.007 ? 'perl' : 'site',
diff -urpN perl-5.10.0.orig/ext/Storable/Storable.pm perl-5.10.0/ext/Storable/Storable.pm
--- perl-5.10.0.orig/ext/Storable/Storable.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Storable/Storable.pm 2009-10-01 13:17:58.000000000 +0200
@@ -23,7 +23,7 @@ use AutoLoader;
use FileHandle;
use vars qw($canonical $forgive_me $VERSION);
-$VERSION = '2.18';
+$VERSION = '2.21';
*AUTOLOAD = \&AutoLoader::AUTOLOAD; # Grrr...
#
@@ -1177,7 +1177,7 @@ Storable was written by Raphael Manfredi
Maintenance is now done by the perl5-porters F<E<lt>perl5-porters@perl.orgE<gt>>
Please e-mail us with problems, bug fixes, comments and complaints,
-although if you have complements you should send them to Raphael.
+although if you have compliments you should send them to Raphael.
Please don't e-mail Raphael with problems, as he no longer works on
Storable, and your message will be delayed while he forwards it to us.
diff -urpN perl-5.10.0.orig/ext/Storable/Storable.xs perl-5.10.0/ext/Storable/Storable.xs
--- perl-5.10.0.orig/ext/Storable/Storable.xs 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Storable/Storable.xs 2009-10-01 13:17:58.000000000 +0200
@@ -151,7 +151,7 @@ typedef double NV; /* Older perls lack
#define TRACEME(x) \
STMT_START { \
- if (SvTRUE(perl_get_sv("Storable::DEBUGME", TRUE))) \
+ if (SvTRUE(perl_get_sv("Storable::DEBUGME", GV_ADD))) \
{ PerlIO_stdoutf x; PerlIO_stdoutf("\n"); } \
} STMT_END
#else
@@ -401,7 +401,7 @@ typedef struct stcxt {
#if (PATCHLEVEL <= 4) && (SUBVERSION < 68)
#define dSTCXT_SV \
- SV *perinterp_sv = perl_get_sv(MY_VERSION, FALSE)
+ SV *perinterp_sv = perl_get_sv(MY_VERSION, 0)
#else /* >= perl5.004_68 */
#define dSTCXT_SV \
SV *perinterp_sv = *hv_fetch(PL_modglobal, \
@@ -1682,7 +1682,7 @@ static SV *pkg_fetchmeth(
pTHX_
HV *cache,
HV *pkg,
- char *method)
+ const char *method)
{
GV *gv;
SV *sv;
@@ -1722,7 +1722,7 @@ static void pkg_hide(
pTHX_
HV *cache,
HV *pkg,
- char *method)
+ const char *method)
{
const char *hvname = HvNAME_get(pkg);
(void) hv_store(cache,
@@ -1738,7 +1738,7 @@ static void pkg_uncache(
pTHX_
HV *cache,
HV *pkg,
- char *method)
+ const char *method)
{
const char *hvname = HvNAME_get(pkg);
(void) hv_delete(cache, hvname, strlen(hvname), G_DISCARD);
@@ -1756,7 +1756,7 @@ static SV *pkg_can(
pTHX_
HV *cache,
HV *pkg,
- char *method)
+ const char *method)
{
SV **svh;
SV *sv;
@@ -2332,7 +2332,7 @@ static int store_hash(pTHX_ stcxt_t *cxt
if (
!(cxt->optype & ST_CLONE) && (cxt->canonical == 1 ||
(cxt->canonical < 0 && (cxt->canonical =
- (SvTRUE(perl_get_sv("Storable::canonical", TRUE)) ? 1 : 0))))
+ (SvTRUE(perl_get_sv("Storable::canonical", GV_ADD)) ? 1 : 0))))
) {
/*
* Storing in order, sorted by key.
@@ -2619,7 +2619,7 @@ static int store_code(pTHX_ stcxt_t *cxt
if (
cxt->deparse == 0 ||
(cxt->deparse < 0 && !(cxt->deparse =
- SvTRUE(perl_get_sv("Storable::Deparse", TRUE)) ? 1 : 0))
+ SvTRUE(perl_get_sv("Storable::Deparse", GV_ADD)) ? 1 : 0))
) {
return store_other(aTHX_ cxt, (SV*)cv);
}
@@ -3397,7 +3397,7 @@ static int store_other(pTHX_ stcxt_t *cx
if (
cxt->forgive_me == 0 ||
(cxt->forgive_me < 0 && !(cxt->forgive_me =
- SvTRUE(perl_get_sv("Storable::forgive_me", TRUE)) ? 1 : 0))
+ SvTRUE(perl_get_sv("Storable::forgive_me", GV_ADD)) ? 1 : 0))
)
CROAK(("Can't store %s items", sv_reftype(sv, FALSE)));
@@ -3434,7 +3434,9 @@ static int sv_type(pTHX_ SV *sv)
{
switch (SvTYPE(sv)) {
case SVt_NULL:
+#if PERL_VERSION <= 10
case SVt_IV:
+#endif
case SVt_NV:
/*
* No need to check for ROK, that can't be set here since there
@@ -3442,7 +3444,11 @@ static int sv_type(pTHX_ SV *sv)
*/
return svis_SCALAR;
case SVt_PV:
+#if PERL_VERSION <= 10
case SVt_RV:
+#else
+ case SVt_IV:
+#endif
case SVt_PVIV:
case SVt_PVNV:
/*
@@ -3683,7 +3689,7 @@ static int magic_write(pTHX_ stcxt_t *cx
length = sizeof (network_file_header);
} else {
#ifdef USE_56_INTERWORK_KLUDGE
- if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", TRUE))) {
+ if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", GV_ADD))) {
header = file_header_56;
length = sizeof (file_header_56);
} else
@@ -4444,7 +4450,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *
* into the existing design. -- RAM, 17/02/2001
*/
- sv_magic(sv, rv, mtype, Nullch, 0);
+ sv_magic(sv, rv, mtype, (char *)NULL, 0);
SvREFCNT_dec(rv); /* Undo refcnt inc from sv_magic() */
return sv;
@@ -4497,7 +4503,7 @@ static SV *retrieve_ref(pTHX_ stcxt_t *c
if (cname) {
/* No need to do anything, as rv will already be PVMG. */
- assert (SvTYPE(rv) >= SVt_RV);
+ assert (SvTYPE(rv) == SVt_RV || SvTYPE(rv) >= SVt_PV);
} else {
sv_upgrade(rv, SVt_RV);
}
@@ -4561,7 +4567,7 @@ static SV *retrieve_overloaded(pTHX_ stc
* WARNING: breaks RV encapsulation.
*/
- sv_upgrade(rv, SVt_RV);
+ SvUPGRADE(rv, SVt_RV);
SvRV_set(rv, sv); /* $rv = \$sv */
SvROK_on(rv);
@@ -4641,7 +4647,7 @@ static SV *retrieve_tied_array(pTHX_ stc
sv_upgrade(tv, SVt_PVAV);
AvREAL_off((AV *)tv);
- sv_magic(tv, sv, 'P', Nullch, 0);
+ sv_magic(tv, sv, 'P', (char *)NULL, 0);
SvREFCNT_dec(sv); /* Undo refcnt inc from sv_magic() */
TRACEME(("ok (retrieve_tied_array at 0x%"UVxf")", PTR2UV(tv)));
@@ -4669,7 +4675,7 @@ static SV *retrieve_tied_hash(pTHX_ stcx
return (SV *) 0; /* Failed */
sv_upgrade(tv, SVt_PVHV);
- sv_magic(tv, sv, 'P', Nullch, 0);
+ sv_magic(tv, sv, 'P', (char *)NULL, 0);
SvREFCNT_dec(sv); /* Undo refcnt inc from sv_magic() */
TRACEME(("ok (retrieve_tied_hash at 0x%"UVxf")", PTR2UV(tv)));
@@ -4701,7 +4707,7 @@ static SV *retrieve_tied_scalar(pTHX_ st
}
sv_upgrade(tv, SVt_PVMG);
- sv_magic(tv, obj, 'q', Nullch, 0);
+ sv_magic(tv, obj, 'q', (char *)NULL, 0);
if (obj) {
/* Undo refcnt inc from sv_magic() */
@@ -4768,7 +4774,7 @@ static SV *retrieve_tied_idx(pTHX_ stcxt
RLEN(idx); /* Retrieve <idx> */
sv_upgrade(tv, SVt_PVMG);
- sv_magic(tv, sv, 'p', Nullch, idx);
+ sv_magic(tv, sv, 'p', (char *)NULL, idx);
SvREFCNT_dec(sv); /* Undo refcnt inc from sv_magic() */
return tv;
@@ -4907,7 +4913,7 @@ static SV *retrieve_utf8str(pTHX_ stcxt_
#else
if (cxt->use_bytes < 0)
cxt->use_bytes
- = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE))
+ = (SvTRUE(perl_get_sv("Storable::drop_utf8", GV_ADD))
? 1 : 0);
if (cxt->use_bytes == 0)
UTF8_CROAK();
@@ -4936,7 +4942,7 @@ static SV *retrieve_lutf8str(pTHX_ stcxt
#else
if (cxt->use_bytes < 0)
cxt->use_bytes
- = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE))
+ = (SvTRUE(perl_get_sv("Storable::drop_utf8", GV_ADD))
? 1 : 0);
if (cxt->use_bytes == 0)
UTF8_CROAK();
@@ -5267,7 +5273,7 @@ static SV *retrieve_flag_hash(pTHX_ stcx
if (hash_flags & SHV_RESTRICTED) {
if (cxt->derestrict < 0)
cxt->derestrict
- = (SvTRUE(perl_get_sv("Storable::downgrade_restricted", TRUE))
+ = (SvTRUE(perl_get_sv("Storable::downgrade_restricted", GV_ADD))
? 1 : 0);
if (cxt->derestrict == 0)
RESTRICTED_HASH_CROAK();
@@ -5336,7 +5342,7 @@ static SV *retrieve_flag_hash(pTHX_ stcx
#else
if (cxt->use_bytes < 0)
cxt->use_bytes
- = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE))
+ = (SvTRUE(perl_get_sv("Storable::drop_utf8", GV_ADD))
? 1 : 0);
if (cxt->use_bytes == 0)
UTF8_CROAK();
@@ -5437,14 +5443,14 @@ static SV *retrieve_code(pTHX_ stcxt_t *
*/
if (cxt->eval == NULL) {
- cxt->eval = perl_get_sv("Storable::Eval", TRUE);
+ cxt->eval = perl_get_sv("Storable::Eval", GV_ADD);
SvREFCNT_inc(cxt->eval);
}
if (!SvTRUE(cxt->eval)) {
if (
cxt->forgive_me == 0 ||
(cxt->forgive_me < 0 && !(cxt->forgive_me =
- SvTRUE(perl_get_sv("Storable::forgive_me", TRUE)) ? 1 : 0))
+ SvTRUE(perl_get_sv("Storable::forgive_me", GV_ADD)) ? 1 : 0))
) {
CROAK(("Can't eval, please set $Storable::Eval to a true value"));
} else {
@@ -5459,7 +5465,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *
SAVETMPS;
if (SvROK(cxt->eval) && SvTYPE(SvRV(cxt->eval)) == SVt_PVCV) {
- SV* errsv = get_sv("@", TRUE);
+ SV* errsv = get_sv("@", GV_ADD);
sv_setpvn(errsv, "", 0); /* clear $@ */
PUSHMARK(sp);
XPUSHs(sv_2mortal(newSVsv(sub)));
@@ -5771,7 +5777,7 @@ static SV *magic_check(pTHX_ stcxt_t *cx
if (cxt->accept_future_minor < 0)
cxt->accept_future_minor
= (SvTRUE(perl_get_sv("Storable::accept_future_minor",
- TRUE))
+ GV_ADD))
? 1 : 0);
if (cxt->accept_future_minor == 1)
croak_now = 0; /* Don't croak yet. */
@@ -5808,7 +5814,7 @@ static SV *magic_check(pTHX_ stcxt_t *cx
#ifdef USE_56_INTERWORK_KLUDGE
/* No point in caching this in the context as we only need it once per
retrieve, and we need to recheck it each read. */
- if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", TRUE))) {
+ if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", GV_ADD))) {
if ((c != (sizeof (byteorderstr_56) - 1))
|| memNE(buf, byteorderstr_56, c))
CROAK(("Byte order is not compatible"));
@@ -5942,7 +5948,7 @@ static SV *retrieve(pTHX_ stcxt_t *cxt,
if (cxt->accept_future_minor < 0)
cxt->accept_future_minor
= (SvTRUE(perl_get_sv("Storable::accept_future_minor",
- TRUE))
+ GV_ADD))
? 1 : 0);
if (cxt->accept_future_minor == 1) {
CROAK(("Storable binary image v%d.%d contains data of type %d. "
diff -urpN perl-5.10.0.orig/ext/Storable/hints/hpux.pl perl-5.10.0/ext/Storable/hints/hpux.pl
--- perl-5.10.0.orig/ext/Storable/hints/hpux.pl 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/ext/Storable/hints/hpux.pl 2009-10-01 13:17:58.000000000 +0200
@@ -0,0 +1,10 @@
+# HP C-ANSI-C has problems in the optimizer for 5.8.x (not for 5.11.x)
+# So drop to -O1 for Storable
+
+use Config;
+
+unless ($Config{gccversion}) {
+ my $optimize = $Config{optimize};
+ $optimize =~ s/(^| )[-+]O[2-9]( |$)/$1+O1$2/ and
+ $self->{OPTIMIZE} = $optimize;
+ }
diff -urpN perl-5.10.0.orig/ext/Storable/t/overload.t perl-5.10.0/ext/Storable/t/overload.t
--- perl-5.10.0.orig/ext/Storable/t/overload.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Storable/t/overload.t 2009-10-01 13:17:58.000000000 +0200
@@ -25,7 +25,7 @@ sub ok;
use Storable qw(freeze thaw);
-print "1..16\n";
+print "1..19\n";
package OVERLOADED;
@@ -103,4 +103,17 @@ ok 13, $@ eq "";
ok 14, ref ($t) eq 'REF';
ok 15, ref ($$t) eq 'HAS_OVERLOAD';
ok 16, $$$t eq 'snow';
+
+
+#---
+# blessed reference to overloded object.
+{
+ my $a = bless [88], 'OVERLOADED';
+ my $c = thaw freeze bless \$a, 'main';
+ ok 17, ref $c eq 'main';
+ ok 18, ref $$c eq 'OVERLOADED';
+ ok 19, "$$c" eq "88";
+
+}
+
1;

965
perl-update-Sys-Syslog.patch
View File

@ -1,965 +0,0 @@
Sys-Syslog-0.27
diff -urN perl-5.10.0.orig/MANIFEST perl-5.10.0/MANIFEST
--- perl-5.10.0.orig/MANIFEST 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/MANIFEST 2009-02-10 11:14:14.000000000 +0100
@@ -1081,6 +1081,7 @@
ext/Sys/Syslog/Changes Changlog for Sys::Syslog
ext/Sys/Syslog/fallback/const-c.inc Sys::Syslog constants fallback file
ext/Sys/Syslog/fallback/const-xs.inc Sys::Syslog constants fallback file
+ext/Sys/Syslog/fallback/syslog.h Sys::Syslog fallback file
ext/Sys/Syslog/Makefile.PL Sys::Syslog extension makefile writer
ext/Sys/Syslog/README README for Sys::Syslog
ext/Sys/Syslog/README.win32 README for Sys::Syslog on Windows
@@ -1088,6 +1089,7 @@
ext/Sys/Syslog/Syslog.xs Sys::Syslog extension external subroutines
ext/Sys/Syslog/t/00-load.t test for Sys::Syslog
ext/Sys/Syslog/t/constants.t test for Sys::Syslog
+ext/Sys/Syslog/t/data-validation.t test for Sys::Syslog
ext/Sys/Syslog/t/syslog.t See if Sys::Syslog works
ext/Sys/Syslog/win32/compile.pl Sys::Syslog extension Win32 related file
ext/Sys/Syslog/win32/PerlLog_dll.uu Sys::Syslog extension Win32 related file
diff -urN perl-5.10.0.orig/ext/Sys/Syslog/Changes perl-5.10.0/ext/Sys/Syslog/Changes
--- perl-5.10.0.orig/ext/Sys/Syslog/Changes 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Sys/Syslog/Changes 2009-02-10 11:10:19.000000000 +0100
@@ -1,5 +1,41 @@
Revision history for Sys-Syslog
+0.27 -- 2008.09.21 -- Sebastien Aperghis-Tramoni (SAPER)
+ [BUGFIX] Fixed compilation on Win32, thanks to Serguei Trouchelle.
+ Also added stubs so calling the XS functions will never fail.
+ [TESTS] t/pod.t now also uses Pod::Checker.
+
+0.26 -- 2008.06.16 -- Sebastien Aperghis-Tramoni (SAPER)
+ [BUGFIX] Make Sys::Syslog works with Perl 5.10.0 (because of
+ ExtUtils::Constant::ProxySubs).
+ [CODE] setlogsock() is now a little more strict about its arguments.
+
+0.25 -- 2008.05.17 -- Sebastien Aperghis-Tramoni (SAPER)
+ [BUGFIX] CPAN-RT#34691: Fixed an incorrect call to sysopen() which
+ prevented Sys::Syslog from working on some Solaris systems.
+ Thanks to Paul Townsend.
+ [BUGFIX] CPAN-RT#34753: Fixed a slowness introduced in v0.19 (which
+ was to work around OSX syslog own slowness). Thanks to Alex Efros.
+ [BUGFIX] CPAN-RT#35952: Fixed a bug with the "nofatal" option.
+ [BUGFIX] CPAN-RT#35189: Fixed a bug in xlate().
+ [BUGFIX] Fixed build on Win32, thanks to Adam Kennedy.
+ [FEATURE] setlogsock() now interprets the second argument as the
+ hostname for network mechanisms.
+ [DIST] Add AUTHOR to WriteMakefile() in order to fix the META.yml
+ generated by ExtUtils::MakeMaker.
+ [TESTS] Improved t/pod.t with Pod::Checker.
+
+0.24 -- 2007.12.31 -- Sebastien Aperghis-Tramoni (SAPER)
+ [BUGFIX] CPANT-RT#32001: Skip the setlogsock('stream') tests when
+ /dev/log is unavailable (Brendan O'Dea).
+
+0.23 -- 2007.11.12 -- Sebastien Aperghis-Tramoni (SAPER)
+ [BUGFIX] Fixed a too liberal test in the "pipe" mechanism, thanks
+ to Jan Dubois.
+ [DIST] fallback/syslog.h was missing from MANIFEST (thanks to CPAN
+ Tester Matthew Musgrove).
+ [TESTS] Better handling of Perl 5.005, thanks to CPAN Tester Slaven Rezic.
+
0.22 -- 2007.11.08 -- Sebastien Aperghis-Tramoni (SAPER)
[BUGFIX] CPAN-RT#29875: Added workaround SpamAssassin overzealous
logging features.
@@ -33,6 +69,8 @@
via syslog().
[BUGFIX] Rewrote the constants generation code in order to provide
fallback value for non-standard macros.
+ [BUGFIX] Mark Blackman and Edmund von der Burg identified and fixed the
+ random failures appearing on OSX, caused by a UDP timeout.
[FEATURE] Added Win32 event log support thanks to Yves Orton.
[FEATURE] Added new macros from modern BSD and IRIX.
[FEATURE] Each non-standard macro now fall backs to a standard macro.
diff -urN perl-5.10.0.orig/ext/Sys/Syslog/Makefile.PL perl-5.10.0/ext/Sys/Syslog/Makefile.PL
--- perl-5.10.0.orig/ext/Sys/Syslog/Makefile.PL 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Sys/Syslog/Makefile.PL 2009-02-10 11:10:19.000000000 +0100
@@ -29,11 +29,14 @@
print " * Win32::EventLog detected.\n";
my $name = "PerlLog";
- push @extra_prereqs, "Win32::TieRegistry" => 0, "Win32::EventLog" => 0;
+ push @extra_prereqs,
+ Win32 => 0, "Win32::TieRegistry" => 0, "Win32::EventLog" => 0;
$virtual_path{'win32/Win32.pm' } = '$(INST_LIBDIR)/Syslog/Win32.pm';
$virtual_path{'win32/PerlLog.dll'} = '$(INST_ARCHAUTODIR)/PerlLog.dll';
+ push @extra_params, CCFLAGS => "-Ifallback";
+
# recreate the DLL from its uuencoded form if it's not here
if (! -f File::Spec->catfile("win32", "$name.dll")) {
# read the uuencoded data
@@ -70,22 +73,37 @@
DEFINE => '-DUSE_PPPORT_H';
}
+# on pre-5.6 Perls, add warnings::compat to the prereq modules
+push @extra_prereqs, "warnings::compat" => "0.06" if $] < 5.006;
+
WriteMakefile(
NAME => 'Sys::Syslog',
LICENSE => 'perl',
+ AUTHOR => 'Sebastien Aperghis-Tramoni <sebastien@aperghis.net>',
VERSION_FROM => 'Syslog.pm',
ABSTRACT_FROM => 'Syslog.pm',
INSTALLDIRS => 'perl',
XSPROTOARG => '-noprototypes',
PM => \%virtual_path,
PREREQ_PM => {
- 'Test::More' => 0,
- 'XSLoader' => 0,
+ # run prereqs
+ 'Carp' => 0,
+ 'Fcntl' => 0,
+ 'File::Basename' => 0,
+ 'File::Spec' => 0,
+ 'POSIX' => 0,
+ 'Socket' => 0,
+ 'XSLoader' => 0,
@extra_prereqs,
+
+ # build/test prereqs
+ 'Test::More' => 0,
},
+ PL_FILES => {},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'Sys-Syslog-*' },
- realclean => { FILES => 'lib const-c.inc const-xs.inc macros.all PerlLog.h *.bak *.bin *.rc' },
+ realclean => { FILES => 'lib const-c.inc const-xs.inc macros.all '
+ .'PerlLog.h typemap *.bak *.bin *.rc win32/PerlLog_dll' },
@extra_params
);
@@ -160,9 +178,9 @@
);
ExtUtils::Constant::WriteConstants(
- ($] > 5.009002 ? (PROXYSUBS => 1) : ()),
NAME => 'Sys::Syslog',
NAMES => [ @levels, @facilities, @options, @others_macros ],
+ ($] > 5.009002 ? (PROXYSUBS => 1) : ()),
);
my @names = map { ref $_ ? $_->{name} : $_ } @levels, @facilities, @options;
diff -urN perl-5.10.0.orig/ext/Sys/Syslog/README perl-5.10.0/ext/Sys/Syslog/README
--- perl-5.10.0.orig/ext/Sys/Syslog/README 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Sys/Syslog/README 2009-02-10 11:10:19.000000000 +0100
@@ -63,5 +63,7 @@
COPYRIGHT AND LICENCE
+ Copyright (C) 1990-2008 by Larry Wall and others.
+
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
diff -urN perl-5.10.0.orig/ext/Sys/Syslog/Syslog.pm perl-5.10.0/ext/Sys/Syslog/Syslog.pm
--- perl-5.10.0.orig/ext/Sys/Syslog/Syslog.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Sys/Syslog/Syslog.pm 2009-02-10 11:10:19.000000000 +0100
@@ -1,16 +1,17 @@
package Sys::Syslog;
use strict;
+use warnings;
use warnings::register;
use Carp;
+use Exporter ();
use Fcntl qw(O_WRONLY);
use File::Basename;
use POSIX qw(strftime setlocale LC_TIME);
use Socket ':all';
require 5.005;
-require Exporter;
{ no strict 'vars';
- $VERSION = '0.22';
+ $VERSION = '0.27';
@ISA = qw(Exporter);
%EXPORT_TAGS = (
@@ -76,6 +77,11 @@
#
use vars qw($host); # host to send syslog messages to (see notes at end)
+#
+# Prototypes
+#
+sub silent_eval (&);
+
#
# Global variables
#
@@ -85,6 +91,7 @@
my $syslog_path = undef; # syslog path for "stream" and "unix" mechanisms
my $syslog_xobj = undef; # if defined, holds the external object used to send messages
my $transmit_ok = 0; # flag to indicate if the last message was transmited
+my $sock_timeout = 0; # socket timeout, see below
my $current_proto = undef; # current mechanism used to transmit messages
my $ident = ''; # identifiant prepended to each message
$facility = ''; # current facility
@@ -105,15 +112,12 @@
@connectMethods = grep { $_ ne 'udp' } @connectMethods;
}
+# And on Win32 systems, we try to use the native mechanism for this
+# platform, the events logger, available through Win32::EventLog.
EVENTLOG: {
- # use EventLog on Win32
my $is_Win32 = $^O =~ /Win32/i;
- # some applications are trying to be too smart
- # yes I'm speaking of YOU, SpamAssassin, grr..
- local($SIG{__DIE__}, $SIG{__WARN__}, $@);
-
- if (eval "use Sys::Syslog::Win32; 1") {
+ if (can_load("Sys::Syslog::Win32")) {
unshift @connectMethods, 'eventlog';
}
elsif ($is_Win32) {
@@ -124,6 +128,18 @@
my @defaultMethods = @connectMethods;
my @fallbackMethods = ();
+# The timeout in connection_ok() was pushed up to 0.25 sec in
+# Sys::Syslog v0.19 in order to address a heisenbug on MacOSX:
+# http://london.pm.org/pipermail/london.pm/Week-of-Mon-20061211/005961.html
+#
+# However, this also had the effect of slowing this test for
+# all other operating systems, which apparently impacted some
+# users (cf. CPAN-RT #34753). So, in order to make everybody
+# happy, the timeout is now zero by default on all systems
+# except on OSX where it is set to 250 msec, and can be set
+# with the infamous setlogsock() function.
+$sock_timeout = 0.25 if $^O =~ /darwin/;
+
# coderef for a nicer handling of errors
my $err_sub = $options{nofatal} ? \&warnings::warnif : \&croak;
@@ -155,7 +171,7 @@
$options{$opt} = 1 if exists $options{$opt}
}
- $err_sub = $options{nofatal} ? \&warnings::warnif : \&croak;
+ $err_sub = delete $options{nofatal} ? \&warnings::warnif : \&croak;
return 1 unless $options{ndelay};
connect_log();
}
@@ -172,8 +188,18 @@
}
sub setlogsock {
- my $setsock = shift;
- $syslog_path = shift;
+ my ($setsock, $setpath, $settime) = @_;
+
+ # check arguments
+ my $diag_invalid_arg
+ = "Invalid argument passed to setlogsock; must be 'stream', 'pipe', "
+ . "'unix', 'native', 'eventlog', 'tcp', 'udp' or 'inet'";
+ croak $diag_invalid_arg unless defined $setsock;
+ croak "Invalid number of arguments" unless @_ >= 1 and @_ <= 3;
+
+ $syslog_path = $setpath if defined $setpath;
+ $sock_timeout = $settime if defined $settime;
+
disconnect_log() if $connected;
$transmit_ok = 0;
@fallbackMethods = ();
@@ -221,7 +247,7 @@
} elsif (lc $setsock eq 'pipe') {
for my $path ($syslog_path, &_PATH_LOG, "/dev/log") {
- next unless defined $path and length $path and -w $path;
+ next unless defined $path and length $path and -p $path and -w _;
$syslog_path = $path;
last
}
@@ -237,7 +263,7 @@
@connectMethods = qw(native);
} elsif (lc $setsock eq 'eventlog') {
- if (eval "use Win32::EventLog; 1") {
+ if (can_load("Win32::EventLog")) {
@connectMethods = qw(eventlog);
} else {
warnings::warnif "eventlog passed to setlogsock, but no Win32 API available";
@@ -248,6 +274,7 @@
} elsif (lc $setsock eq 'tcp') {
if (getservbyname('syslog', 'tcp') || getservbyname('syslogng', 'tcp')) {
@connectMethods = qw(tcp);
+ $host = $syslog_path;
} else {
warnings::warnif "tcp passed to setlogsock, but tcp service unavailable";
return undef;
@@ -256,6 +283,7 @@
} elsif (lc $setsock eq 'udp') {
if (getservbyname('syslog', 'udp')) {
@connectMethods = qw(udp);
+ $host = $syslog_path;
} else {
warnings::warnif "udp passed to setlogsock, but udp service unavailable";
return undef;
@@ -268,8 +296,7 @@
@connectMethods = qw(console);
} else {
- croak "Invalid argument passed to setlogsock; must be 'stream', 'pipe', ",
- "'unix', 'native', 'eventlog', 'tcp', 'udp' or 'inet'"
+ croak $diag_invalid_arg
}
return 1;
@@ -293,25 +320,29 @@
croak "syslog: expecting argument \$priority" unless defined $priority;
croak "syslog: expecting argument \$format" unless defined $mask;
+ croak "syslog: invalid level/facility: $priority" if $priority =~ /^-\d+$/;
@words = split(/\W+/, $priority, 2); # Allow "level" or "level|facility".
undef $numpri;
undef $numfac;
- foreach (@words) {
- $num = xlate($_); # Translate word to number.
- if ($num < 0) {
- croak "syslog: invalid level/facility: $_"
- }
- elsif ($num <= &LOG_PRIMASK) {
- croak "syslog: too many levels given: $_" if defined $numpri;
- $numpri = $num;
- return 0 unless LOG_MASK($numpri) & $maskpri;
- }
- else {
- croak "syslog: too many facilities given: $_" if defined $numfac;
- $facility = $_;
- $numfac = $num;
- }
+ for my $word (@words) {
+ next if length $word == 0;
+
+ $num = xlate($word); # Translate word to number.
+
+ if ($num < 0) {
+ croak "syslog: invalid level/facility: $word"
+ }
+ elsif ($num <= &LOG_PRIMASK) {
+ croak "syslog: too many levels given: $word" if defined $numpri;
+ $numpri = $num;
+ return 0 unless LOG_MASK($numpri) & $maskpri;
+ }
+ else {
+ croak "syslog: too many facilities given: $word" if defined $numfac;
+ $facility = $word;
+ $numfac = $num;
+ }
}
croak "syslog: level must be given" unless defined $numpri;
@@ -464,14 +495,28 @@
# private function to translate names to numeric values
#
sub xlate {
- my($name) = @_;
+ my ($name) = @_;
+
return $name+0 if $name =~ /^\s*\d+\s*$/;
$name = uc $name;
$name = "LOG_$name" unless $name =~ /^LOG_/;
- $name = "Sys::Syslog::$name";
- # Can't have just eval { &$name } || -1 because some LOG_XXX may be zero.
- my $value = eval { no strict 'refs'; &$name };
- $@ = "";
+
+ # ExtUtils::Constant 0.20 introduced a new way to implement
+ # constants, called ProxySubs. When it was used to generate
+ # the C code, the constant() function no longer returns the
+ # correct value. Therefore, we first try a direct call to
+ # constant(), and if the value is an error we try to call the
+ # constant by its full name.
+ my $value = constant($name);
+
+ if (index($value, "not a valid") >= 0) {
+ $name = "Sys::Syslog::$name";
+ $value = eval { no strict "refs"; &$name };
+ $value = $@ unless defined $value;
+ }
+
+ $value = -1 if index($value, "not a valid") >= 0;
+
return defined $value ? $value : -1;
}
@@ -546,11 +591,10 @@
}
setsockopt(SYSLOG, SOL_SOCKET, SO_KEEPALIVE, 1);
- if (eval { IPPROTO_TCP() }) {
+ if (silent_eval { IPPROTO_TCP() }) {
# These constants don't exist in 5.005. They were added in 1999
setsockopt(SYSLOG, IPPROTO_TCP(), TCP_NODELAY(), 1);
}
- $@ = "";
if (!connect(SYSLOG, $addr)) {
push @$errs, "tcp connect: $!";
return 0;
@@ -619,7 +663,7 @@
push @$errs, "stream $syslog_path is not writable";
return 0;
}
- if (!sysopen(SYSLOG, $syslog_path, 0400, O_WRONLY)) {
+ if (!sysopen(SYSLOG, $syslog_path, O_WRONLY, 0400)) {
push @$errs, "stream can't open $syslog_path: $!";
return 0;
}
@@ -697,12 +741,7 @@
$logopt += xlate($opt) if $options{$opt}
}
- eval { openlog_xs($ident, $logopt, xlate($facility)) };
- if ($@) {
- push @$errs, $@;
- return 0;
- }
-
+ openlog_xs($ident, $logopt, xlate($facility));
$syslog_send = \&_syslog_send_native;
return 1;
@@ -741,7 +780,7 @@
my $rin = '';
vec($rin, fileno(SYSLOG), 1) = 1;
- my $ret = select $rin, undef, $rin, 0.25;
+ my $ret = select $rin, undef, $rin, $sock_timeout;
return ($ret ? 0 : 1);
}
@@ -761,7 +800,26 @@
return close SYSLOG;
}
-1;
+
+#
+# Wrappers around eval() that makes sure that nobody, and I say NOBODY,
+# ever knows that I wanted to test if something was here or not.
+# It is needed because some applications are trying to be too smart,
+# do it wrong, and it ends up in EPIC FAIL.
+# Yes I'm speaking of YOU, SpamAssassin.
+#
+sub silent_eval (&) {
+ local($SIG{__DIE__}, $SIG{__WARN__}, $@);
+ return eval { $_[0]->() }
+}
+
+sub can_load {
+ local($SIG{__DIE__}, $SIG{__WARN__}, $@);
+ return eval "use $_[0]; 1"
+}
+
+
+"Eighth Rule: read the documentation."
__END__
@@ -771,7 +829,7 @@
=head1 VERSION
-Version 0.22
+Version 0.27
=head1 SYNOPSIS
@@ -965,6 +1023,8 @@
=item B<setlogsock($sock_type, $stream_location)> (added in Perl 5.004_02)
+=item B<setlogsock($sock_type, $stream_location, $sock_timeout)> (added in 0.25)
+
Sets the socket type to be used for the next call to
C<openlog()> or C<syslog()> and returns true on success,
C<undef> on failure. The available mechanisms are:
@@ -984,15 +1044,18 @@
=item *
C<"tcp"> - connect to a TCP socket, on the C<syslog/tcp> or C<syslogng/tcp>
-service.
+service. If defined, the second parameter is used as a hostname to connect to.
=item *
C<"udp"> - connect to a UDP socket, on the C<syslog/udp> service.
+If defined, the second parameter is used as a hostname to connect to,
+and the third parameter as the timeout used to check for UDP response.
=item *
-C<"inet"> - connect to an INET socket, either TCP or UDP, tried in that order.
+C<"inet"> - connect to an INET socket, either TCP or UDP, tried in that
+order. If defined, the second parameter is used as a hostname to connect to.
=item *
@@ -1026,7 +1089,8 @@
When this calling method is used, the array should contain a list of
mechanisms which are attempted in order.
-The default is to try C<native>, C<tcp>, C<udp>, C<unix>, C<stream>, C<console>.
+The default is to try C<native>, C<tcp>, C<udp>, C<unix>, C<pipe>, C<stream>,
+C<console>.
Under systems with the Win32 API, C<eventlog> will be added as the first
mechanism to try if C<Win32::EventLog> is available.
@@ -1113,8 +1177,7 @@
Log to UDP port on C<$remotehost> instead of logging locally:
- setlogsock('udp');
- $Sys::Syslog::host = $remotehost;
+ setlogsock("udp", $remotehost);
openlog($program, 'ndelay', 'user');
syslog('info', 'something happened over here');
@@ -1342,16 +1405,19 @@
L<http://www.gnu.org/software/libc/manual/html_node/Syslog.html>
Solaris 10 documentation on syslog,
-L<http://docs.sun.com/app/docs/doc/816-5168/6mbb3hruo?a=view>
+L<http://docs.sun.com/app/docs/doc/816-5168/syslog-3c?a=view>
-IRIX 6.4 documentation on syslog,
-L<http://techpubs.sgi.com/library/tpl/cgi-bin/getdoc.cgi?coll=0640&db=man&fname=3c+syslog>
+Mac OS X documentation on syslog,
+L<http://developer.apple.com/documentation/Darwin/Reference/ManPages/man3/syslog.3.html>
+
+IRIX 6.5 documentation on syslog,
+L<http://techpubs.sgi.com/library/tpl/cgi-bin/getdoc.cgi?coll=0650&db=man&fname=3c+syslog>
AIX 5L 5.3 documentation on syslog,
L<http://publib.boulder.ibm.com/infocenter/pseries/v5r3/index.jsp?topic=/com.ibm.aix.basetechref/doc/basetrf2/syslog.htm>
HP-UX 11i documentation on syslog,
-L<http://docs.hp.com/en/B9106-90010/syslog.3C.html>
+L<http://docs.hp.com/en/B2355-60130/syslog.3C.html>
Tru64 5.1 documentation on syslog,
L<http://h30097.www3.hp.com/docs/base_doc/DOCUMENTATION/V51_HTML/MAN/MAN3/0193____.HTM>
@@ -1455,7 +1521,7 @@
=head1 COPYRIGHT
-Copyright (C) 1990-2007 by Larry Wall and others.
+Copyright (C) 1990-2008 by Larry Wall and others.
=head1 LICENSE
@@ -1518,6 +1584,9 @@
Links
-----
+Linux Fast-STREAMS
+- L<http://www.openss7.org/streams.html>
+
II12021: SYSLOGD HOWTO TCPIPINFO (z/OS, OS/390, MVS)
- L<http://www-1.ibm.com/support/docview.wss?uid=isg1II12021>
diff -urN perl-5.10.0.orig/ext/Sys/Syslog/Syslog.xs perl-5.10.0/ext/Sys/Syslog/Syslog.xs
--- perl-5.10.0.orig/ext/Sys/Syslog/Syslog.xs 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Sys/Syslog/Syslog.xs 2009-02-10 11:10:19.000000000 +0100
@@ -1,3 +1,7 @@
+#if defined(_WIN32)
+# include <windows.h>
+#endif
+
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
@@ -9,13 +13,13 @@
#define HAVE_SYSLOG 1
#endif
-#if defined(I_SYSLOG) || PATCHLEVEL < 6
-#include <syslog.h>
-#endif
-
#if defined(_WIN32) && !defined(__CYGWIN__)
-#undef HAVE_SYSLOG
-#include "fallback/syslog.h"
+# undef HAVE_SYSLOG
+# include "fallback/syslog.h"
+#else
+# if defined(I_SYSLOG) || PATCHLEVEL < 6
+# include <syslog.h>
+# endif
#endif
static SV *ident_svptr;
@@ -126,7 +130,9 @@
INPUT:
int mask
CODE:
- setlogmask(mask);
+ RETVAL = setlogmask(mask);
+ OUTPUT:
+ RETVAL
void
closelog_xs()
@@ -135,4 +141,31 @@
if (SvREFCNT(ident_svptr))
SvREFCNT_dec(ident_svptr);
+#else /* HAVE_SYSLOG */
+
+void
+openlog_xs(ident, option, facility)
+ INPUT:
+ SV* ident
+ int option
+ int facility
+ CODE:
+
+void
+syslog_xs(priority, message)
+ INPUT:
+ int priority
+ const char * message
+ CODE:
+
+int
+setlogmask_xs(mask)
+ INPUT:
+ int mask
+ CODE:
+
+void
+closelog_xs()
+ CODE:
+
#endif /* HAVE_SYSLOG */
diff -urN perl-5.10.0.orig/ext/Sys/Syslog/fallback/syslog.h perl-5.10.0/ext/Sys/Syslog/fallback/syslog.h
--- perl-5.10.0.orig/ext/Sys/Syslog/fallback/syslog.h 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/ext/Sys/Syslog/fallback/syslog.h 2009-02-10 11:10:19.000000000 +0100
@@ -0,0 +1,111 @@
+/*
+ * Copyright (c) 1982, 1986, 1988, 1993
+ * The Regents of the University of California. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 4. Neither the name of the University nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ *
+ * @(#)syslog.h 8.1 (Berkeley) 6/2/93
+ */
+
+#ifndef _SYS_SYSLOG_H
+#define _SYS_SYSLOG_H 1
+
+#define _PATH_LOG ""
+
+/*
+ * priorities/facilities are encoded into a single 32-bit quantity, where the
+ * bottom 3 bits are the priority (0-7) and the top 28 bits are the facility
+ * (0-big number). Both the priorities and the facilities map roughly
+ * one-to-one to strings in the syslogd(8) source code. This mapping is
+ * included in this file.
+ *
+ * priorities (these are ordered)
+ */
+#define LOG_EMERG 0 /* system is unusable */
+#define LOG_ALERT 1 /* action must be taken immediately */
+#define LOG_CRIT 2 /* critical conditions */
+#define LOG_ERR 3 /* error conditions */
+#define LOG_WARNING 4 /* warning conditions */
+#define LOG_NOTICE 5 /* normal but significant condition */
+#define LOG_INFO 6 /* informational */
+#define LOG_DEBUG 7 /* debug-level messages */
+
+#define LOG_PRIMASK 0x07 /* mask to extract priority part (internal) */
+ /* extract priority */
+#define LOG_PRI(p) ((p) & LOG_PRIMASK)
+#define LOG_MAKEPRI(fac, pri) (((fac) << 3) | (pri))
+
+/* facility codes */
+#define LOG_KERN (0<<3) /* kernel messages */
+#define LOG_USER (1<<3) /* random user-level messages */
+#define LOG_MAIL (2<<3) /* mail system */
+#define LOG_DAEMON (3<<3) /* system daemons */
+#define LOG_AUTH (4<<3) /* security/authorization messages */
+#define LOG_SYSLOG (5<<3) /* messages generated internally by syslogd */
+#define LOG_LPR (6<<3) /* line printer subsystem */
+#define LOG_NEWS (7<<3) /* network news subsystem */
+#define LOG_UUCP (8<<3) /* UUCP subsystem */
+#define LOG_CRON (9<<3) /* clock daemon */
+#define LOG_AUTHPRIV (10<<3) /* security/authorization messages (private) */
+#define LOG_FTP (11<<3) /* ftp daemon */
+#define LOG_NETINFO (12<<3) /* NetInfo */
+#define LOG_REMOTEAUTH (13<<3) /* remote authentication/authorization */
+#define LOG_INSTALL (14<<3) /* installer subsystem */
+#define LOG_RAS (15<<3) /* Remote Access Service (VPN / PPP) */
+#define LOG_LOCAL0 (16<<3) /* reserved for local use */
+#define LOG_LOCAL1 (17<<3) /* reserved for local use */
+#define LOG_LOCAL2 (18<<3) /* reserved for local use */
+#define LOG_LOCAL3 (19<<3) /* reserved for local use */
+#define LOG_LOCAL4 (20<<3) /* reserved for local use */
+#define LOG_LOCAL5 (21<<3) /* reserved for local use */
+#define LOG_LOCAL6 (22<<3) /* reserved for local use */
+#define LOG_LOCAL7 (23<<3) /* reserved for local use */
+#define LOG_LAUNCHD (24<<3) /* launchd - general bootstrap daemon */
+
+#define LOG_NFACILITIES 25 /* current number of facilities */
+#define LOG_FACMASK 0x03f8 /* mask to extract facility part */
+ /* facility of pri */
+#define LOG_FAC(p) (((p) & LOG_FACMASK) >> 3)
+
+/*
+ * arguments to setlogmask.
+ */
+#define LOG_MASK(pri) (1 << (pri)) /* mask for one priority */
+#define LOG_UPTO(pri) ((1 << ((pri)+1)) - 1) /* all priorities through pri */
+
+/*
+ * Option flags for openlog.
+ *
+ * LOG_ODELAY no longer does anything.
+ * LOG_NDELAY is the inverse of what it used to be.
+ */
+#define LOG_PID 0x01 /* log the pid with each message */
+#define LOG_CONS 0x02 /* log on the console if errors in sending */
+#define LOG_ODELAY 0x04 /* delay open until first syslog() (default) */
+#define LOG_NDELAY 0x08 /* don't delay open */
+#define LOG_NOWAIT 0x10 /* don't wait for console forks: DEPRECATED */
+#define LOG_PERROR 0x20 /* log to stderr as well */
+
+#endif /* sys/syslog.h */
diff -urN perl-5.10.0.orig/ext/Sys/Syslog/t/00-load.t perl-5.10.0/ext/Sys/Syslog/t/00-load.t
--- perl-5.10.0.orig/ext/Sys/Syslog/t/00-load.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Sys/Syslog/t/00-load.t 2009-02-10 11:10:19.000000000 +0100
@@ -2,9 +2,7 @@
use strict;
use Test::More tests => 1;
-BEGIN {
- use_ok( 'Sys::Syslog' );
-}
+use_ok( 'Sys::Syslog' );
diag( "Testing Sys::Syslog $Sys::Syslog::VERSION, Perl $], $^X" )
unless $ENV{PERL_CORE};
diff -urN perl-5.10.0.orig/ext/Sys/Syslog/t/data-validation.t perl-5.10.0/ext/Sys/Syslog/t/data-validation.t
--- perl-5.10.0.orig/ext/Sys/Syslog/t/data-validation.t 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/ext/Sys/Syslog/t/data-validation.t 2009-02-10 11:10:19.000000000 +0100
@@ -0,0 +1,114 @@
+#!perl -w
+# --------------------------------------------------------------------
+# The aim of this test is to start a syslog server (TCP or UDP) using
+# the one available in POE, make Sys::Syslog connect to it by manually
+# select the corresponding mechanism, send some messages and, inside
+# the POE syslog server, check that these message are correctly crafted.
+# --------------------------------------------------------------------
+use strict;
+
+my $port;
+BEGIN {
+ # override getservbyname()
+ *CORE::GLOBAL::getservbyname = sub ($$) {
+ my @v = CORE::getservbyname($_[0], $_[1]);
+
+ if (@v) {
+ $v[2] = $port;
+ } else {
+ @v = ($_[0], "", $port, $_[1]);
+ }
+
+ return wantarray ? @v : $port
+ }
+}
+
+use File::Spec;
+use Test::More;
+use Socket;
+use Sys::Syslog qw(:standard :extended :macros);
+
+
+# check than POE is available
+plan skip_all => "POE is not available" unless eval "use POE; 1";
+
+# check than POE::Component::Server::Syslog is available
+plan skip_all => "POE::Component::Server::Syslog is not available"
+ unless eval "use POE::Component::Server::Syslog; 1";
+
+plan tests => 1;
+
+ $port = 5140;
+my $proto = "tcp";
+
+my $ident = "pocosyslog";
+my $text = "Close the world, txEn eht nepO.";
+
+
+$SIG{ALRM} = sub {
+ ok( 0, "test took too much time to execute" );
+ exit
+};
+alarm 30;
+
+my $pid = fork();
+
+if ($pid) {
+ # parent: setup a syslog server
+ POE::Component::Server::Syslog->spawn(
+ Alias => 'syslog',
+ Type => $proto,
+ BindAddress => '127.0.0.1',
+ BindPort => $port,
+ InputState => \&client_input,
+ ErrorState => \&client_error,
+ );
+
+ $SIG{CHLD} = sub { wait() };
+
+ POE::Kernel->run;
+}
+else {
+ # child: send a message to the syslog server setup in the parent
+ sleep 2;
+ openlog($ident, "ndelay,pid", "local0");
+ setlogsock($proto);
+ syslog(info => $text);
+ closelog();
+ exit
+}
+
+sub client_input {
+ my $message = $_[&ARG0];
+ delete $message->{'time'}; # too hazardous to test
+ my $nl = $^O =~ /darwin/ ? "" : "\n";
+
+ is_deeply(
+ $message,
+ {
+ host => scalar gethostbyaddr(inet_aton('127.0.0.1'), AF_INET),
+ pri => &LOG_LOCAL0 + &LOG_INFO,
+ facility => &LOG_LOCAL0 >> 3,
+ severity => &LOG_INFO,
+ msg => "$ident\[$pid]: $text$nl\0",
+ },
+ "checking syslog message"
+ );
+
+ POE::Kernel->post(syslog => "shutdown");
+ POE::Kernel->stop;
+}
+
+sub client_error {
+ my $message = $_[&ARG0];
+
+ require Data::Dumper;
+ $Data::Dumper::Indent = 0; $Data::Dumper::Indent = 0;
+ $Data::Dumper::Sortkeys = 1; $Data::Dumper::Sortkeys = 1;
+ fail "checking syslog message";
+ diag "[client_error] message = ", Data::Dumper::Dumper($message);
+
+ POE::Kernel->post(syslog => "shutdown");
+ POE::Kernel->stop;
+}
+
diff -urN perl-5.10.0.orig/ext/Sys/Syslog/t/syslog.t perl-5.10.0/ext/Sys/Syslog/t/syslog.t
--- perl-5.10.0.orig/ext/Sys/Syslog/t/syslog.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Sys/Syslog/t/syslog.t 2009-02-10 11:10:19.000000000 +0100
@@ -19,6 +19,10 @@
pack portable recursion redefine regexp severe signal substr
syntax taint uninitialized unpack untie utf8 void);
+# if someone is using warnings::compat, the previous trick won't work, so we
+# must manually disable warnings
+$^W = 0 if $] < 5.006;
+
my $is_Win32 = $^O =~ /win32/i;
my $is_Cygwin = $^O =~ /cygwin/i;
@@ -111,35 +115,35 @@
}
-BEGIN { $tests += 20 * 8 }
+BEGIN { $tests += 22 * 8 }
# try to open a syslog using all the available connection methods
my @passed = ();
for my $sock_type (qw(native eventlog unix pipe stream inet tcp udp)) {
SKIP: {
- skip "the 'stream' mechanism because a previous mechanism with similar interface succeeded", 20
+ skip "the 'stream' mechanism because a previous mechanism with similar interface succeeded", 22
if $sock_type eq 'stream' and grep {/pipe|unix/} @passed;
# setlogsock() called with an arrayref
$r = eval { setlogsock([$sock_type]) } || 0;
- skip "can't use '$sock_type' socket", 20 unless $r;
+ skip "can't use '$sock_type' socket", 22 unless $r;
is( $@, '', "[$sock_type] setlogsock() called with ['$sock_type']" );
ok( $r, "[$sock_type] setlogsock() should return true: '$r'" );
# setlogsock() called with a single argument
$r = eval { setlogsock($sock_type) } || 0;
- skip "can't use '$sock_type' socket", 18 unless $r;
+ skip "can't use '$sock_type' socket", 20 unless $r;
is( $@, '', "[$sock_type] setlogsock() called with '$sock_type'" );
ok( $r, "[$sock_type] setlogsock() should return true: '$r'" );
# openlog() without option NDELAY
$r = eval { openlog('perl', '', 'local0') } || 0;
- skip "can't connect to syslog", 16 if $@ =~ /^no connection to syslog available/;
+ skip "can't connect to syslog", 18 if $@ =~ /^no connection to syslog available/;
is( $@, '', "[$sock_type] openlog() called with facility 'local0' and without option 'ndelay'" );
ok( $r, "[$sock_type] openlog() should return true: '$r'" );
# openlog() with the option NDELAY
$r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
- skip "can't connect to syslog", 14 if $@ =~ /^no connection to syslog available/;
+ skip "can't connect to syslog", 16 if $@ =~ /^no connection to syslog available/;
is( $@, '', "[$sock_type] openlog() called with facility 'local0' with option 'ndelay'" );
ok( $r, "[$sock_type] openlog() should return true: '$r'" );
@@ -148,6 +152,11 @@
like( $@, '/^syslog: invalid level\/facility: /', "[$sock_type] syslog() called with level -1" );
ok( !$r, "[$sock_type] syslog() should return false: '$r'" );
+ # syslog() with invalid level, should fail
+ $r = eval { syslog("plonk", "$test_string by connecting to a $sock_type socket") } || 0;
+ like( $@, '/^syslog: invalid level\/facility: /', "[$sock_type] syslog() called with level plonk" );
+ ok( !$r, "[$sock_type] syslog() should return false: '$r'" );
+
# syslog() with levels "info" and "notice" (as a strings), should fail
$r = eval { syslog('info,notice', "$test_string by connecting to a $sock_type socket") } || 0;
like( $@, '/^syslog: too many levels given: notice/', "[$sock_type] syslog() called with level 'info,notice'" );
@@ -189,6 +198,9 @@
skip "the 'unix' mechanism works, so the tests will likely fail with the 'stream' mechanism", 10
if grep {/unix/} @passed;
+ skip "not testing setlogsock('stream'): _PATH_LOG unavailable", 10
+ unless -e Sys::Syslog::_PATH_LOG();
+
# setlogsock() with "stream" and an undef path
$r = eval { setlogsock("stream", undef ) } || '';
is( $@, '', "setlogsock() called, with 'stream' and an undef path" );

33016
perl-update-Test-Harness.patch
View File

File diff suppressed because it is too large Load Diff

8177
perl-update-Test-Simple.patch
View File

File diff suppressed because it is too large Load Diff

686
perl-update-Time-HiRes.patch
View File

@ -1,686 +0,0 @@
Time-HiRes-1.9719
diff -urN perl-5.10.0.orig/ext/Time/HiRes/Changes perl-5.10.0/ext/Time/HiRes/Changes
--- perl-5.10.0.orig/ext/Time/HiRes/Changes 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Time/HiRes/Changes 2009-03-10 17:48:02.000000000 +0100
@@ -1,5 +1,66 @@
Revision history for the Perl extension Time::HiRes.
+1.9719 [2009-01-04]
+ - As with QNX, Haiku has the API of interval timers but not
+ the implementation (bleadperl change #34630), hence skip
+ the tests, via David Mitchell.
+
+1.9718 [2008-12-31]
+ - .xs code cleanup from Albert Dvornik
+ - in the #39 and #40 do not do us I did, mixing alarm() and
+ sleep(). Now instead spin until enough time has passed.
+
+1.9717 [2008-12-30]
+ - Skip the tests added in 1.9716 (#39, #40) if there's no subsecond
+ alarm capability, like with the older subsecond alarm tests
+
+1.9716 [2008-12-26]
+ - Change documentation to agree with reality: there are
+ no interval timers in Win32.
+ - Address [rt.cpan.org #35899] (problem in subsecond sleeps),
+ add two tests to guard against this problem
+ - Address [rt.cpan.org #36600] 'Division by zero' failure in test suite
+ - Address [rt.cpan.org #37340] [PATCH] Address timer process in test
+ - Address [rt.cpan.org#40311 ] bad implementation of hrt_usleep
+ with TIME_HIRES_NANOSLEEP
+
+1.9715 [2008-04-08]
+ - Silly me: Makefile.PL does need to accept arguments other than mine.
+ Some testing frameworks obviously do this.
+ - Add retrying for tests 34..37, which are the most commonly
+ failing tests. If this helps, consider extending the retry
+ framework to all the tests. [Inspired by Slaven Rezic,
+ [rt.cpan.org #34711] Occasional failures of test 35 or 36 (FreeBSD)]
+
+1.9714 [2008-04-07]
+ - Under Perl 5.6.* NVgf needs to be "g", reported by Zefram,
+ it seems that ppport.h 3.13 gets this wrong.
+ - remove the check in Makefile.PL for 5.7.2, shouldn't be
+ (a) necessary (b) relevant
+ - add logic to Makefile.PL to skip configure/write Makefile
+ step if the "xdefine" file already exists, indicating that
+ the configure step has already been done, one can still
+ force (re)configure by "perl Makefile.PL configure",
+ or of course by "make clean && perl Makefile.PL".
+
+1.9713 [2008-04-04]
+ - for alarm() and ualarm() [Perl] prefer setitimer() [C]
+ instead of ualarm() [C] since ualarm() [C] cannot portably
+ (and standards-compliantly) be used for more than 999_999
+ microseconds (rt.cpan.org #34655)
+ - it seems that HP-UX has started (at least in 11.31 ia64)
+ #defining the CLOCK_REALTIME et alia (instead of having
+ them just as enums)
+ - document all the diagnostics
+
+1.9712 [2008-02-09]
+ - move the sub tick in the test file back to where it used to be
+ - in the "consider upgrading" message recommend at least Perl 5.8.8
+ and make the message to appear only for 5.8.0 since 5.8.1 and
+ later have the problem fixed
+ - VOS tweak for Makefile (core perl change #33259)
+ - since the test #17 seems to fail often, relax its limits a bit
+
1.9711 [2007-11-29]
- lost VMS test skippage from Craig Berry
- reformat the test code a little
diff -urN perl-5.10.0.orig/ext/Time/HiRes/HiRes.pm perl-5.10.0/ext/Time/HiRes/HiRes.pm
--- perl-5.10.0.orig/ext/Time/HiRes/HiRes.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Time/HiRes/HiRes.pm 2009-03-10 17:48:02.000000000 +0100
@@ -22,8 +22,8 @@
d_clock d_clock_nanosleep
stat
);
-
-$VERSION = '1.9711';
+
+$VERSION = '1.9719';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -209,6 +209,9 @@
Issues a C<ualarm> call; the C<$interval_useconds> is optional and
will be zero if unspecified, resulting in C<alarm>-like behaviour.
+Returns the remaining time in the alarm in microseconds, or C<undef>
+if an error occurred.
+
ualarm(0) will cancel an outstanding ualarm().
Note that the interaction between alarms and sleeps is unspecified.
@@ -260,10 +263,14 @@
=item alarm ( $floating_seconds [, $interval_floating_seconds ] )
The C<SIGALRM> signal is sent after the specified number of seconds.
-Implemented using C<ualarm()>. The C<$interval_floating_seconds> argument
-is optional and will be zero if unspecified, resulting in C<alarm()>-like
-behaviour. This function can be imported, resulting in a nice drop-in
-replacement for the C<alarm> provided with perl, see the L</EXAMPLES> below.
+Implemented using C<setitimer()> if available, C<ualarm()> if not.
+The C<$interval_floating_seconds> argument is optional and will be
+zero if unspecified, resulting in C<alarm()>-like behaviour. This
+function can be imported, resulting in a nice drop-in replacement for
+the C<alarm> provided with perl, see the L</EXAMPLES> below.
+
+Returns the remaining time in the alarm in seconds, or C<undef>
+if an error occurred.
B<NOTE 1>: With some combinations of operating systems and Perl
releases C<SIGALRM> restarts C<select()>, instead of interrupting it.
@@ -292,9 +299,9 @@
There are usually three or four interval timers (signals) available: the
C<$which> can be C<ITIMER_REAL>, C<ITIMER_VIRTUAL>, C<ITIMER_PROF>, or
C<ITIMER_REALPROF>. Note that which ones are available depends: true
-UNIX platforms usually have the first three, but (for example) Win32
-and Cygwin have only C<ITIMER_REAL>, and only Solaris seems to have
-C<ITIMER_REALPROF> (which is used to profile multithreaded programs).
+UNIX platforms usually have the first three, but only Solaris seems to
+have C<ITIMER_REALPROF> (which is used to profile multithreaded programs).
+Win32 unfortunately does not haveinterval timers.
C<ITIMER_REAL> results in C<alarm()>-like behaviour. Time is counted in
I<real time>; that is, wallclock time. C<SIGALRM> is delivered when
@@ -337,8 +344,8 @@
CLOCK_REALTIME is zero, it might be one, or something else.
Another potentially useful (but not available everywhere) value is
C<CLOCK_MONOTONIC>, which guarantees a monotonically increasing time
-value (unlike time(), which can be adjusted). See your system
-documentation for other possibly supported values.
+value (unlike time() or gettimeofday(), which can be adjusted).
+See your system documentation for other possibly supported values.
=item clock_getres ( $which )
@@ -528,6 +535,15 @@
Something went horribly wrong-- the number of microseconds that cannot
become negative just became negative. Maybe your compiler is broken?
+=head2 useconds or uinterval equal to or more than 1000000
+
+In some platforms it is not possible to get an alarm with subsecond
+resolution and later than one second.
+
+=head2 unimplemented in this platform
+
+Some calls simply aren't available, real or emulated, on every platform.
+
=head1 CAVEATS
Notice that the core C<time()> maybe rounding rather than truncating.
@@ -544,6 +560,9 @@
Note that since Time::HiRes 1.77 the clock_gettime(CLOCK_MONOTONIC)
might help in this (in case your system supports CLOCK_MONOTONIC).
+Some systems have APIs but not implementations: for example QNX and Haiku
+have the interval timer APIs but not the functionality.
+
=head1 SEE ALSO
Perl modules L<BSD::Resource>, L<Time::TAI64>.
@@ -563,7 +582,8 @@
Copyright (c) 1996-2002 Douglas E. Wegscheid. All rights reserved.
-Copyright (c) 2002, 2003, 2004, 2005, 2006, 2007 Jarkko Hietaniemi. All rights reserved.
+Copyright (c) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Jarkko Hietaniemi.
+All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
diff -urN perl-5.10.0.orig/ext/Time/HiRes/HiRes.xs perl-5.10.0/ext/Time/HiRes/HiRes.xs
--- perl-5.10.0.orig/ext/Time/HiRes/HiRes.xs 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Time/HiRes/HiRes.xs 2009-03-10 17:48:02.000000000 +0100
@@ -2,7 +2,8 @@
*
* Copyright (c) 1996-2002 Douglas E. Wegscheid. All rights reserved.
*
- * Copyright (c) 2002,2003,2004,2005,2006,2007 Jarkko Hietaniemi. All rights reserved.
+ * Copyright (c) 2002,2003,2004,2005,2006,2007,2008 Jarkko Hietaniemi.
+ * All rights reserved.
*
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
@@ -37,6 +38,13 @@
}
#endif
+/* At least ppport.h 3.13 gets this wrong: one really cannot
+ * have NVgf as anything else than "g" under Perl 5.6.x. */
+#if PERL_REVISION == 5 && PERL_VERSION == 6
+# undef NVgf
+# define NVgf "g"
+#endif
+
#define IV_1E6 1000000
#define IV_1E7 10000000
#define IV_1E9 1000000000
@@ -71,9 +79,13 @@
/* HP-UX has CLOCK_XXX values but as enums, not as defines.
* The only way to detect these would be to test compile for each. */
# ifdef __hpux
-# define CLOCK_REALTIME CLOCK_REALTIME
-# define CLOCK_VIRTUAL CLOCK_VIRTUAL
-# define CLOCK_PROFILE CLOCK_PROFILE
+/* However, it seems that at least in HP-UX 11.31 ia64 there *are*
+ * defines for these, so let's try detecting them. */
+# ifndef CLOCK_REALTIME
+# define CLOCK_REALTIME CLOCK_REALTIME
+# define CLOCK_VIRTUAL CLOCK_VIRTUAL
+# define CLOCK_PROFILE CLOCK_PROFILE
+# endif
# endif /* # ifdef __hpux */
#endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC) */
@@ -390,10 +402,10 @@
* The TIME_HIRES_NANOSLEEP is set by Makefile.PL. */
#if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP)
#define HAS_USLEEP
-#define usleep hrt_nanosleep /* could conflict with ncurses for static build */
+#define usleep hrt_usleep /* could conflict with ncurses for static build */
void
-hrt_nanosleep(unsigned long usec) /* This is used to emulate usleep. */
+hrt_usleep(unsigned long usec) /* This is used to emulate usleep. */
{
struct timespec res;
res.tv_sec = usec / IV_1E6;
@@ -433,21 +445,6 @@
}
#endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */
-#if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP)
-#define HAS_USLEEP
-#define usleep hrt_usleep /* could conflict with ncurses for static build */
-
-void
-hrt_usleep(unsigned long usec)
-{
- struct timespec ts1;
- ts1.tv_sec = usec * 1000; /* Ignoring wraparound. */
- ts1.tv_nsec = 0;
- nanosleep(&ts1, NULL);
-}
-
-#endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */
-
#if !defined(HAS_USLEEP) && defined(HAS_POLL)
#define HAS_USLEEP
#define usleep hrt_usleep /* could conflict with ncurses for static build */
@@ -462,16 +459,24 @@
#endif /* #if !defined(HAS_USLEEP) && defined(HAS_POLL) */
#if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
+
+static int
+hrt_ualarm_itimero(struct itimerval* itv, int usec, int uinterval)
+{
+ itv->it_value.tv_sec = usec / IV_1E6;
+ itv->it_value.tv_usec = usec % IV_1E6;
+ itv->it_interval.tv_sec = uinterval / IV_1E6;
+ itv->it_interval.tv_usec = uinterval % IV_1E6;
+ return setitimer(ITIMER_REAL, itv, 0);
+}
+
int
-hrt_ualarm_itimer(int usec, int interval)
+hrt_ualarm_itimer(int usec, int uinterval)
{
- struct itimerval itv;
- itv.it_value.tv_sec = usec / IV_1E6;
- itv.it_value.tv_usec = usec % IV_1E6;
- itv.it_interval.tv_sec = interval / IV_1E6;
- itv.it_interval.tv_usec = interval % IV_1E6;
- return setitimer(ITIMER_REAL, &itv, 0);
+ struct itimerval itv;
+ return hrt_ualarm_itimero(&itv, usec, uinterval);
}
+
#ifdef HAS_UALARM
int
hrt_ualarm(int usec, int interval) /* for binary compat before 1.91 */
@@ -898,21 +903,27 @@
#ifdef HAS_UALARM
-int
-ualarm(useconds,interval=0)
+IV
+ualarm(useconds,uinterval=0)
int useconds
- int interval
+ int uinterval
CODE:
- if (useconds < 0 || interval < 0)
- croak("Time::HiRes::ualarm(%d, %d): negative time not invented yet", useconds, interval);
- if (useconds >= IV_1E6 || interval >= IV_1E6)
+ if (useconds < 0 || uinterval < 0)
+ croak("Time::HiRes::ualarm(%d, %d): negative time not invented yet", useconds, uinterval);
#if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
- RETVAL = hrt_ualarm_itimer(useconds, interval);
+ {
+ struct itimerval itv;
+ if (hrt_ualarm_itimero(&itv, useconds, uinterval)) {
+ RETVAL = itv.it_value.tv_sec + IV_1E6 * itv.it_value.tv_usec;
+ } else {
+ RETVAL = 0;
+ }
+ }
#else
- croak("Time::HiRes::ualarm(%d, %d): useconds or interval equal or more than %"IVdf, useconds, interval, IV_1E6);
+ if (useconds >= IV_1E6 || uinterval >= IV_1E6)
+ croak("Time::HiRes::ualarm(%d, %d): useconds or uinterval equal to or more than %"IVdf, useconds, uinterval, IV_1E6);
+ RETVAL = ualarm(useconds, uinterval);
#endif
- else
- RETVAL = ualarm(useconds, interval);
OUTPUT:
RETVAL
@@ -924,8 +935,24 @@
CODE:
if (seconds < 0.0 || interval < 0.0)
croak("Time::HiRes::alarm(%"NVgf", %"NVgf"): negative time not invented yet", seconds, interval);
- RETVAL = (NV)ualarm((IV)(seconds * IV_1E6),
- (IV)(interval * IV_1E6)) / NV_1E6;
+ {
+ IV useconds = IV_1E6 * seconds;
+ IV uinterval = IV_1E6 * interval;
+#if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
+ {
+ struct itimerval itv;
+ if (hrt_ualarm_itimero(&itv, useconds, uinterval)) {
+ RETVAL = (NV)itv.it_value.tv_sec + (NV)itv.it_value.tv_usec / NV_1E6;
+ } else {
+ RETVAL = 0;
+ }
+ }
+#else
+ if (useconds >= IV_1E6 || uinterval >= IV_1E6)
+ croak("Time::HiRes::alarm(%d, %d): seconds or interval equal to or more than 1.0 ", useconds, uinterval, IV_1E6);
+ RETVAL = (NV)ualarm( useconds, uinterval ) / NV_1E6;
+#endif
+ }
OUTPUT:
RETVAL
diff -urN perl-5.10.0.orig/ext/Time/HiRes/Makefile.PL perl-5.10.0/ext/Time/HiRes/Makefile.PL
--- perl-5.10.0.orig/ext/Time/HiRes/Makefile.PL 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Time/HiRes/Makefile.PL 2009-03-10 17:48:02.000000000 +0100
@@ -19,8 +19,11 @@
use vars qw($self); # Used in 'sourcing' the hints.
+# TBD: Can we just use $Config(exe_ext) here instead of this complex
+# expression?
my $ld_exeext = ($^O eq 'cygwin' ||
- $^O eq 'os2' && $Config{ldflags} =~ /-Zexe\b/) ? '.exe' : '';
+ $^O eq 'os2' && $Config{ldflags} =~ /-Zexe\b/) ? '.exe' :
+ (($^O eq 'vos') ? $Config{exe_ext} : '');
unless($ENV{PERL_CORE}) {
$ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV;
@@ -829,38 +832,43 @@
}
sub main {
- print "Configuring Time::HiRes...\n";
- if ($] == 5.007002) {
- die "Cannot Configure Time::HiRes for Perl $], aborting.\n";
- }
-
- if ($^O =~ /Win32/i) {
- DEFINE('SELECT_IS_BROKEN');
- $LIBS = [];
- print "System is $^O, skipping full configure...\n";
- } else {
- init();
+ if (-f "xdefine" && !(@ARGV && $ARGV[0] eq '--configure')) {
+ print qq[$0: The "xdefine" exists, skipping the configure step.\n];
+ print qq[("$^X $0 --configure" to force the configure step)\n];
+ } else {
+ print "Configuring Time::HiRes...\n";
+ 1 while unlink("define");
+ if ($^O =~ /Win32/i) {
+ DEFINE('SELECT_IS_BROKEN');
+ $LIBS = [];
+ print "System is $^O, skipping full configure...\n";
+ open(XDEFINE, ">xdefine") or die "$0: Cannot create xdefine: $!\n";
+ close(XDEFINE);
+ } else {
+ init();
+ }
+ doMakefile;
+ doConstants;
}
- doMakefile;
- doConstants;
my $make = $Config{'make'} || "make";
unless (exists $ENV{PERL_CORE} && $ENV{PERL_CORE}) {
print <<EOM;
Now you may issue '$make'. Do not forget also '$make test'.
EOM
- if ((exists $ENV{LC_ALL} && $ENV{LC_ALL} =~ /utf-?8/i) ||
- (exists $ENV{LC_CTYPE} && $ENV{LC_CTYPE} =~ /utf-?8/i) ||
- (exists $ENV{LANG} && $ENV{LANG} =~ /utf-?8/i)) {
+ if ($] == 5.008 &&
+ ((exists $ENV{LC_ALL} && $ENV{LC_ALL} =~ /utf-?8/i) ||
+ (exists $ENV{LC_CTYPE} && $ENV{LC_CTYPE} =~ /utf-?8/i) ||
+ (exists $ENV{LANG} && $ENV{LANG} =~ /utf-?8/i))) {
print <<EOM;
NOTE: if you get an error like this (the Makefile line number may vary):
Makefile:91: *** missing separator
then set the environment variable LC_ALL to "C" and retry
from scratch (re-run perl "Makefile.PL").
-(And consider upgrading your Perl.)
+(And consider upgrading your Perl to, say, at least Perl 5.8.8.)
(You got this message because you seem to have
an UTF-8 locale active in your shell environment, this used
- to cause broken Makefiles to be created from Makefile.PLs.)
+ to cause broken Makefiles to be created from Makefile.PLs)
EOM
}
}
diff -urN perl-5.10.0.orig/ext/Time/HiRes/t/HiRes.t perl-5.10.0/ext/Time/HiRes/t/HiRes.t
--- perl-5.10.0.orig/ext/Time/HiRes/t/HiRes.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/ext/Time/HiRes/t/HiRes.t 2009-03-10 17:48:02.000000000 +0100
@@ -12,7 +12,7 @@
}
}
-BEGIN { $| = 1; print "1..38\n"; }
+BEGIN { $| = 1; print "1..40\n"; }
END { print "not ok 1\n" unless $loaded }
@@ -68,7 +68,7 @@
my $have_alarm = $Config{d_alarm};
my $have_fork = $Config{d_fork};
-my $waitfor = 180; # 30-45 seconds is normal (load affects this).
+my $waitfor = 360; # 30-45 seconds is normal (load affects this).
my $timer_pid;
my $TheEnd;
@@ -79,11 +79,14 @@
if ($timer_pid == 0) { # We are the kid, set up the timer.
my $ppid = getppid();
print "# I am the timer process $$, sleeping for $waitfor seconds...\n";
- sleep($waitfor);
- warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded!\n";
- print "# Terminating main process $ppid...\n";
- kill('TERM', $ppid);
- print "# This is the timer process $$, over and out.\n";
+ sleep($waitfor - 2); # Workaround for perlbug #49073
+ sleep(2); # Wait for parent to exit
+ if (kill(0, $ppid)) { # Check if parent still exists
+ warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded!\n";
+ print "# Terminating main process $ppid...\n";
+ kill('KILL', $ppid);
+ print "# This is the timer process $$, over and out.\n";
+ }
exit(0);
} else {
print "# The timer process $timer_pid launched, continuing testing...\n";
@@ -238,10 +241,13 @@
$has_ualarm ||= $xdefine =~ /-DHAS_UALARM/;
-unless ( defined &Time::HiRes::gettimeofday
- && defined &Time::HiRes::ualarm
- && defined &Time::HiRes::usleep
- && $has_ualarm) {
+my $can_subsecond_alarm =
+ defined &Time::HiRes::gettimeofday &&
+ defined &Time::HiRes::ualarm &&
+ defined &Time::HiRes::usleep &&
+ $has_ualarm;
+
+unless ($can_subsecond_alarm) {
for (15..17) {
print "ok $_ # Skip: no gettimeofday or no ualarm or no usleep\n";
}
@@ -271,19 +277,6 @@
# Perl's deferred signals may be too wimpy to break through
# a restartable select(), so use POSIX::sigaction if available.
- sub tick {
- $i--;
- my $ival = Time::HiRes::tv_interval ($r);
- print "# Tick! $i $ival\n";
- my $exp = 0.3 * (5 - $i);
- # This test is more sensitive, so impose a softer limit.
- if (abs($ival/$exp - 1) > 4*$limit) {
- my $ratio = abs($ival/$exp);
- $not = "tick: $exp sleep took $ival ratio $ratio";
- $i = 0;
- }
- }
-
POSIX::sigaction(&POSIX::SIGALRM,
POSIX::SigAction->new("tick"),
$oldaction)
@@ -314,8 +307,12 @@
last;
}
my $exp = 0.3 * (5 - $i);
+ if ($exp == 0) {
+ $not = "while: divisor became zero";
+ last;
+ }
# This test is more sensitive, so impose a softer limit.
- if (abs($ival/$exp - 1) > 3*$limit) {
+ if (abs($ival/$exp - 1) > 4*$limit) {
my $ratio = abs($ival/$exp);
$not = "while: $exp sleep took $ival ratio $ratio";
last;
@@ -324,6 +321,23 @@
}
}
+ sub tick {
+ $i--;
+ my $ival = Time::HiRes::tv_interval ($r);
+ print "# Tick! $i $ival\n";
+ my $exp = 0.3 * (5 - $i);
+ if ($exp == 0) {
+ $not = "tick: divisor became zero";
+ last;
+ }
+ # This test is more sensitive, so impose a softer limit.
+ if (abs($ival/$exp - 1) > 4*$limit) {
+ my $ratio = abs($ival/$exp);
+ $not = "tick: $exp sleep took $ival ratio $ratio";
+ $i = 0;
+ }
+ }
+
if ($use_sigaction) {
POSIX::sigaction(&POSIX::SIGALRM, $oldaction);
} else {
@@ -333,11 +347,13 @@
print $not ? "not ok 17 # $not\n" : "ok 17 # $ok\n";
}
-unless ( defined &Time::HiRes::setitimer
+unless (defined &Time::HiRes::setitimer
&& defined &Time::HiRes::getitimer
&& has_symbol('ITIMER_VIRTUAL')
&& $Config{sig_name} =~ m/\bVTALRM\b/
- && $^O !~ /^(nto)$/) { # nto: QNX 6 has the API but no implementation
+ && $^O ne 'nto' # nto: QNX 6 has the API but no implementation
+ && $^O ne 'haiku' # haiku: has the API but no implementation
+ ) {
for (18..19) {
print "ok $_ # Skip: no virtual interval timers\n";
}
@@ -502,13 +518,14 @@
};
# Next setup a periodic timer (the two-argument alarm() of
- # Time::HiRes, behind the curtains the libc ualarm()) which has
- # a signal handler that takes so much time (on the first initial
- # invocation) that the first periodic invocation (second invocation)
- # will happen before the first invocation has finished. In Perl 5.8.0
- # the "safe signals" concept was implemented, with unfortunately at least
- # one bug that caused a core dump on reentering the handler. This bug
- # was fixed by the time of Perl 5.8.1.
+ # Time::HiRes, behind the curtains the libc getitimer() or
+ # ualarm()) which has a signal handler that takes so much time (on
+ # the first initial invocation) that the first periodic invocation
+ # (second invocation) will happen before the first invocation has
+ # finished. In Perl 5.8.0 the "safe signals" concept was
+ # implemented, with unfortunately at least one bug that caused a
+ # core dump on reentering the handler. This bug was fixed by the
+ # time of Perl 5.8.1.
# Do not try mixing sleep() and alarm() for testing this.
@@ -620,6 +637,16 @@
skip 33;
}
+sub bellish { # Cheap emulation of a bell curve.
+ my ($min, $max) = @_;
+ my $rand = ($max - $min) / 5;
+ my $sum = 0;
+ for my $i (0..4) {
+ $sum += rand($rand);
+ }
+ return $min + $sum;
+}
+
if ($have_ualarm) {
# 1_100_000 sligthly over 1_000_000,
# 2_200_000 slightly over 2**31/1000,
@@ -629,21 +656,29 @@
[36, 2_200_000],
[37, 4_300_000]) {
my ($i, $n) = @$t;
- my $alarmed = 0;
- local $SIG{ ALRM } = sub { $alarmed++ };
- my $t0 = Time::HiRes::time();
- print "# t0 = $t0\n";
- print "# ualarm($n)\n";
- ualarm($n); 1 while $alarmed == 0;
- my $t1 = Time::HiRes::time();
- print "# t1 = $t1\n";
- my $dt = $t1 - $t0;
- print "# dt = $dt\n";
- my $r = $dt / ($n/1e6);
- print "# r = $r\n";
- ok $i,
- ($n < 1_000_000 || # Too much noise.
- $r >= 0.8 && $r <= 1.6), "ualarm($n) close enough";
+ my $ok;
+ for my $retry (1..10) {
+ my $alarmed = 0;
+ local $SIG{ ALRM } = sub { $alarmed++ };
+ my $t0 = Time::HiRes::time();
+ print "# t0 = $t0\n";
+ print "# ualarm($n)\n";
+ ualarm($n); 1 while $alarmed == 0;
+ my $t1 = Time::HiRes::time();
+ print "# t1 = $t1\n";
+ my $dt = $t1 - $t0;
+ print "# dt = $dt\n";
+ my $r = $dt / ($n/1e6);
+ print "# r = $r\n";
+ $ok =
+ ($n < 1_000_000 || # Too much noise.
+ ($r >= 0.8 && $r <= 1.6));
+ last if $ok;
+ my $nap = bellish(3, 15);
+ printf "# Retrying in %.1f seconds...\n", $nap;
+ Time::HiRes::sleep($nap);
+ }
+ ok $i, $ok, "ualarm($n) close enough";
}
} else {
print "# No ualarm\n";
@@ -710,12 +745,37 @@
skip 38;
}
+unless ($can_subsecond_alarm) {
+ skip 39..40;
+} else {
+ {
+ my $alrm;
+ $SIG{ALRM} = sub { $alrm++ };
+ Time::HiRes::alarm(0.1);
+ my $t0 = time();
+ 1 while time() - $t0 <= 1;
+ print $alrm ? "ok 39\n" : "not ok 39\n";
+ }
+ {
+ my $alrm;
+ $SIG{ALRM} = sub { $alrm++ };
+ Time::HiRes::alarm(1.1);
+ my $t0 = time();
+ 1 while time() - $t0 <= 2;
+ print $alrm ? "ok 40\n" : "not ok 40\n";
+ }
+}
+
END {
if ($timer_pid) { # Only in the main process.
my $left = $TheEnd - time();
printf "# I am the main process $$, terminating the timer process $timer_pid\n# before it terminates me in %d seconds (testing took %d seconds).\n", $left, $waitfor - $left;
- my $kill = kill('TERM', $timer_pid); # We are done, the timer can go.
- printf "# kill TERM $timer_pid = %d\n", $kill;
+ if (kill(0, $timer_pid)) {
+ local $? = 0;
+ my $kill = kill('KILL', $timer_pid); # We are done, the timer can go.
+ wait();
+ printf "# kill KILL $timer_pid = %d\n", $kill;
+ }
unlink("ktrace.out"); # Used in BSD system call tracing.
print "# All done.\n";
}

4211
perl-update-autodie.patch
View File

File diff suppressed because it is too large Load Diff

115
perl-update-constant.patch
View File

@ -1,115 +0,0 @@
constant-1.17
diff -urN perl-5.10.0.orig/lib/constant.pm perl-5.10.0/lib/constant.pm
--- perl-5.10.0.orig/lib/constant.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/constant.pm 2008-10-29 22:38:47.000000000 +0100
@@ -4,7 +4,7 @@
use warnings::register;
use vars qw($VERSION %declared);
-$VERSION = '1.13';
+$VERSION = '1.17';
#=======================================================================
@@ -168,7 +168,7 @@
far less likely to send a space probe to the wrong planet because
nobody noticed the one equation in which you wrote C<3.14195>.
-When a constant is used in an expression, perl replaces it with its
+When a constant is used in an expression, Perl replaces it with its
value at compile time, and may then optimize the expression further.
In particular, any code in an C<if (CONSTANT)> block will be optimized
away if the constant is false.
@@ -331,6 +331,20 @@
(or simply use a comma in place of the big arrow) instead of
C<< CONSTANT => 'value' >>.
+=head1 SEE ALSO
+
+L<Readonly> - Facility for creating read-only scalars, arrays, hashes.
+
+L<Const> - Facility for creating read-only variables. Similar to C<Readonly>,
+but uses C<SvREADONLY> instead of C<tie>.
+
+L<Attribute::Constant> - Make read-only variables via attribute
+
+L<Scalar::Readonly> - Perl extension to the C<SvREADONLY> scalar flag
+
+L<Hash::Util> - A selection of general-utility hash subroutines (mostly
+to lock/unlock keys and values)
+
=head1 BUGS
Please report any bugs or feature requests via the perlbug(1) utility.
@@ -350,7 +364,7 @@
The CPAN distribution is maintained by SE<eacute>bastien Aperghis-Tramoni
E<lt>F<sebastien@aperghis.net>E<gt>.
-=head1 COPYRIGHT
+=head1 COPYRIGHT & LICENSE
Copyright (C) 1997, 1999 Tom Phoenix
diff -urN perl-5.10.0.orig/lib/constant.t perl-5.10.0/lib/constant.t
--- perl-5.10.0.orig/lib/constant.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/constant.t 2008-10-29 22:38:47.000000000 +0100
@@ -12,11 +12,11 @@
BEGIN { # ...and save 'em for later
$SIG{'__WARN__'} = sub { push @warnings, @_ }
}
-END { print STDERR @warnings }
+END { @warnings && print STDERR join "\n- ", "accumulated warnings:", @warnings }
use strict;
-use Test::More tests => 97;
+use Test::More tests => 95;
my $TB = Test::More->builder;
BEGIN { use_ok('constant'); }
@@ -80,13 +80,6 @@
is MESS, q('"'\\"'"\\);
is length(MESS), 8;
-use constant TRAILING => '12 cats';
-{
- local $^W;
- cmp_ok TRAILING, '==', 12;
-}
-is TRAILING, '12 cats';
-
use constant LEADING => " \t1234";
cmp_ok LEADING, '==', 1234;
is LEADING, " \t1234";
@@ -112,7 +105,7 @@
# text may vary, so we can't test much better than this.
cmp_ok length(E2BIG), '>', 6;
-is @warnings, 0 or diag join "\n", "unexpected warning", @warnings;
+is @warnings, 0 or diag join "\n- ", "unexpected warning:", @warnings;
@warnings = (); # just in case
undef &PI;
ok @warnings && ($warnings[0] =~ /Constant sub.* undefined/) or
@@ -122,9 +115,9 @@
is @warnings, 0, "unexpected warning";
my $curr_test = $TB->current_test;
-use constant CSCALAR => \"ok 37\n";
-use constant CHASH => { foo => "ok 38\n" };
-use constant CARRAY => [ undef, "ok 39\n" ];
+use constant CSCALAR => \"ok 35\n";
+use constant CHASH => { foo => "ok 36\n" };
+use constant CARRAY => [ undef, "ok 37\n" ];
use constant CCODE => sub { "ok $_[0]\n" };
my $output = $TB->output ;
@@ -305,7 +298,7 @@
eval 'use constant zit => 4; 1' or die $@;
# empty prototypes are reported differently in different versions
- my $no_proto = $] < 5.008 ? "" : ": none";
+ my $no_proto = $] < 5.008004 ? "" : ": none";
is(scalar @warnings, 1, "1 warning");
like ($warnings[0], qr/^Prototype mismatch: sub main::zit$no_proto vs \(\)/,

80
perl.spec
View File

@ -7,7 +7,7 @@
Name: perl
Version: %{perl_version}
Release: 112%{?dist}
Release: 113%{?dist}
Epoch: %{perl_epoch}
Summary: Practical Extraction and Report Language
Group: Development/Languages
@ -20,9 +20,9 @@ Group: Development/Languages
License: (GPL+ or Artistic) and (GPLv2+ or Artistic) and Copyright Only and MIT and Public Domain and UCD
Url: http://www.perl.org/
Source0: http://www.cpan.org/src/5.0/perl-%{perl_version}.tar.bz2
Source11: filter-requires.sh
Source12: perl-5.8.0-libnet.cfg
Source13: macros.perl
Source1: filter-requires.sh
Source2: perl-5.8.0-libnet.cfg
Source3: macros.perl
# Specific to Fedora/RHEL
Patch1: perl-suid-noroot.patch
@ -101,64 +101,11 @@ Patch203: perl-update-Module-Build.patch
Patch204: perl-update-Parse-CPAN-Meta.patch
%define Parse_CPAN_Meta_version 1.40
#---
# FIXME; is 2.18->2.21, should be 2.20->2.21
#--- MODULES ---
# Storable_version FIXME; is 2.18->2.21, should be 2.20->2.21
# - was 2.21 previously; but it is not a subpackage, can wait
Patch99: perl-update-Storable.patch
%define Storable_version 2.20
# This patches are now unused:
#could be 1.19
Patch100: perl-update-constant.patch
%define constant_version 1.17
# could be 0.36
Patch101: perl-update-Archive-Extract.patch
# could be 1.54
Patch102: perl-update-Archive-Tar.patch
# could be 3.43->3.48
Patch103: perl-update-CGI.patch
# could be 0.22
Patch105: perl-update-File-Fetch.patch
Patch107: perl-update-File-Temp.patch
# could be 0.54
Patch108: perl-update-IPC-Cmd.patch
# could be 2.23
Patch110: perl-update-Module-CoreList.patch
# could be 0.34
Patch111: perl-update-Module-Load-Conditional.patch
# could be 3.10
Patch112: perl-update-Pod-Simple.patch
Patch113: perl-update-Sys-Syslog.patch
%define Sys_Syslog_version 0.27
Patch114: perl-update-Test-Harness.patch
# could be 0.94
Patch115: perl-update-Test-Simple.patch
Patch116: perl-update-Time-HiRes.patch
%define Time_HiRes_version 1.9719
Patch117: perl-update-Digest-SHA.patch
# includes Fatal.pm
Patch118: perl-update-autodie.patch
%define autodie_version 1.999
# cpan has it under PathTools-3.30
# could be 3.31
Patch119: perl-update-FileSpec.patch
%define File_Spec_version 3.30
# FIXME should be 2.023, to preserve upgrade path
# Compress_Raw_Zlib_version FIXME should be 2.023, to preserve upgrade path
# -- for now, we just cheat with the version number
Patch120: perl-update-Compress-Raw-Zlib.patch
%define Compress_Raw_Zlib_version 2.023
# could be 1.22
Patch121: perl-update-Scalar-List-Utils.patch
%define Scalar_List_Utils 1.21
Patch122: perl-update-Module-Pluggable.patch
# could be 2.023
Patch124: perl-update-IO-Compress-Base.patch
%define IO_Compress_Base_version 2.020
# could be 2.023
Patch125: perl-update-IO-Compress-Zlib.patch
%define IO_Compress_Zlib_version 2.020
#... also update version number of Compress::Zlib
# FIXME: Compress-Raw-Zlib also contains Compress-Raw-Bzip2
# and IO-Compress-Zlib contains IO-Compress-Bzip2
@ -168,7 +115,6 @@ Patch125: perl-update-IO-Compress-Zlib.patch
# and also ExtUtils-ParseXS 2.2002 -> 2.21
BuildRoot: %(mktemp -ud %{_tmppath}/%{name}-%{version}-%{release}-XXXXXX)
BuildRequires: tcsh, dos2unix, man, groff
BuildRequires: gdbm-devel, db4-devel, zlib-devel
@ -255,13 +201,13 @@ Requires(post): perl-libs
# The original script might be /usr/lib/rpm/perl.req or
# /usr/lib/rpm/redhat/perl.req, better use the original value of the macro:
%{expand:%%define prev__perl_requires %{__perl_requires}}
%define __perl_requires %{SOURCE11} %{prev__perl_requires}
%define __perl_requires %{SOURCE1} %{prev__perl_requires}
# When _use_internal_dependency_generator is 0, the perl.req script is
# called from /usr/lib/rpm{,/redhat}/find-requires.sh
# Likewise:
%{expand:%%define prev__find_requires %{__find_requires}}
%define __find_requires %{SOURCE11} %{prev__find_requires}
%define __find_requires %{SOURCE1} %{prev__find_requires}
%description
@ -1101,13 +1047,13 @@ done
#
# libnet configuration file
#
install -p -m 644 %{SOURCE12} %{build_privlib}/Net/libnet.cfg
install -p -m 644 %{SOURCE2} %{build_privlib}/Net/libnet.cfg
#
# perl RPM macros
#
mkdir -p ${RPM_BUILD_ROOT}%{_sysconfdir}/rpm
install -p -m 644 %{SOURCE13} ${RPM_BUILD_ROOT}%{_sysconfdir}/rpm/
install -p -m 644 %{SOURCE3} ${RPM_BUILD_ROOT}%{_sysconfdir}/rpm/
#
# Core modules removal
@ -1825,6 +1771,10 @@ make test
# Old changelog entries are preserved in CVS.
%changelog
* Thu Mar 11 2010 Marcela Mašláňová <mmaslano@redhat.com> - 4:5.10.1-113
- rebuild with new gdbm
- clean spec a little more
* Fri Mar 5 2010 Marcela Mašláňová <mmaslano@redhat.com> - 4:5.10.1-112
- fix license according to advice from legal
- clean unused patches