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

- remove compatibility obsolete sitelib directories

Browse Source 
- use a better BuildRoot
- drop a redundant mkdir in %%install
- call patchlevel.h only once; rm patchlevel.bak
- update modules Sys::Syslog, Module::Load::Conditional, Module::CoreList,
    Test::Harness, Test::Simple, CGI.pm (dropping the upstreamed patch),
    File::Path (that includes our perl-5.10.0-CVE-2008-2827.patch),
    constant, Pod::Simple, Archive::Tar, Archive::Extract, File::Fetch,
    File::Temp, IPC::Cmd, Time::HiRes, Module::Build, ExtUtils::CBuilder
- standardize the patches for updating embedded modules
- work around a bug in Module::Build tests bu setting TMPDIR to a directory
    inside the source tree
This commit is contained in:
Štěpán Kasal 2009-03-11 21:12:37 +00:00
parent 2c34225ecf
commit 26b7a08961
32 changed files with 46455 additions and 36703 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.cvsignore
View File

@ -1,3 +1 @@
perl-5.10.0.tar.gz
Tar-Archive.tar.gz
x.tgz

58
perl-5.10.0-ArchiveTar1.38.patch
View File

@ -1,58 +0,0 @@
diff -urN perl-5.10.0/lib/Archive/Tar.old/t/04_resolved_issues.t perl-5.10.0/lib/Archive/Tar/t/04_resolved_issues.t
--- perl-5.10.0/lib/Archive/Tar.old/t/04_resolved_issues.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/t/04_resolved_issues.t 2007-11-15 12:47:43.000000000 +0100
@@ -121,7 +121,6 @@
" Renamed to '$out_file'" );
### first, test with strict extract permissions on
-TODO:
{ local $Archive::Tar::INSECURE_EXTRACT_MODE = 0;
### we quell the error on STDERR
@@ -135,20 +134,14 @@
ok( ! -e $out_file, " File '$out_file' does not exist" );
ok( $tar->error, " Error message stored" );
-
- local $TODO = 'Exposed unrelated filespec handling bugs on VMS' if $^O eq 'VMS';
-
like( $tar->error, qr/attempting to leave/,
" Proper violation detected" );
}
### now disable those
-TODO:
{ local $Archive::Tar::INSECURE_EXTRACT_MODE = 1;
ok( 1, " Extracting in insecure mode" );
- local $TODO = 'Exposed unrelated filespec handling bugs on VMS' if $^O eq 'VMS';
-
ok( $tar->extract_file( $out_file ),
" File extracted" );
ok( -e $out_file, " File '$out_file' exists" );
diff -urN perl-5.10.0/lib/Archive/Tar.old/t/99_pod.t perl-5.10.0/lib/Archive/Tar/t/99_pod.t
--- perl-5.10.0/lib/Archive/Tar.old/t/99_pod.t 1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/t/99_pod.t 2007-03-06 15:30:04.000000000 +0100
@@ -0,0 +1,22 @@
+use Test::More;
+use File::Spec;
+use File::Find;
+use strict;
+
+BEGIN { chdir 't' if -d 't' };
+
+eval 'use Test::Pod';
+plan skip_all => "Test::Pod v0.95 required for testing POD"
+ if $@ || $Test::Pod::VERSION < 0.95;
+
+my @files;
+find( sub { push @files, File::Spec->catfile(
+ File::Spec->splitdir( $File::Find::dir ), $_
+ ) if /\.p(?:l|m|od)$/ }, File::Spec->catdir(qw(.. blib lib) ));
+
+plan tests => scalar @files;
+for my $file ( @files ) {
+ pod_file_ok( $file );
+}
+
+

1756
perl-5.10.0-ArchiveTar1.40.patch
View File

File diff suppressed because it is too large Load Diff

12
perl-5.10.0-CGI.patch
View File

@ -1,12 +0,0 @@
diff -up perl-5.10.0/lib/CGI.pm.tied perl-5.10.0/lib/CGI.pm
--- perl-5.10.0/lib/CGI.pm.tied 2008-07-30 08:37:48.000000000 +0200
+++ perl-5.10.0/lib/CGI.pm 2008-07-30 08:41:38.000000000 +0200
@@ -1176,7 +1176,7 @@ END_OF_FUNC
'EXISTS' => <<'END_OF_FUNC',
sub EXISTS {
- exists $_[0]->{$_[1]};
+ exists $_[0]->{param}{$_[1]};
}
END_OF_FUNC

16
perl-5.10.0-CVE-2008-2827.patch
View File

@ -1,16 +0,0 @@
diff -up perl-5.10.0/lib/File/Path.pm.cve perl-5.10.0/lib/File/Path.pm
--- perl-5.10.0/lib/File/Path.pm.cve 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/File/Path.pm 2008-06-24 13:25:53.000000000 +0200
@@ -351,10 +351,8 @@ sub _rmtree {
}
my $nperm = $perm & 07777 | 0600;
- if ($nperm != $perm and not chmod $nperm, $root) {
- if ($Force_Writeable) {
- _error($arg, "cannot make file writeable", $canon);
- }
+ if ($Force_Writeable && $nperm != $perm and not chmod $nperm, $root) {
+ _error($arg, "cannot make file writeable", $canon);
}
print "unlink $canon\n" if $arg->{verbose};
# delete all versions under VMS

128
perl-5.10.0-Change33640.patch
View File

@ -1,3 +1,6 @@
http://www.nntp.perl.org/group/perl.perl5.changes/2008/04/msg21478.html
- minus the change in Module::CoreList that we are upgrading
--- perl/Porting/Maintainers.pm#2~33194~ 2008-02-02 09:05:25.000000000 -0800
+++ perl/Porting/Maintainers.pm 2008-04-03 09:03:24.000000000 -0700
@@ -14,11 +14,12 @@
@ -201,131 +204,6 @@
require Cwd;
--- perl/lib/Module/CoreList.pm#3~33615~ 2008-03-31 11:01:17.000000000 -0700
+++ perl/lib/Module/CoreList.pm 2008-04-03 09:03:24.000000000 -0700
@@ -1,7 +1,7 @@
package Module::CoreList;
use strict;
use vars qw/$VERSION %released %patchlevel %version %families/;
-$VERSION = '2.14';
+$VERSION = '2.15';
=head1 NAME
@@ -2007,7 +2007,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',
@@ -4462,6 +4462,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
@@ -5555,6 +5556,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',
@@ -5595,6 +5597,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',
@@ -5919,6 +5922,7 @@
'warnings' => '1.04',
'warnings::register' => '1.00',
},
+
5.008007 => {
'AnyDBM_File' => '1.00',
'Attribute::Handlers' => '0.78_01',
@@ -5959,6 +5963,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',
@@ -6278,6 +6283,7 @@
'warnings' => '1.03',
'warnings::register' => '1.00',
},
+
5.009003 => {
'AnyDBM_File' => '1.00',
'Archive::Tar' => '1.26_01',
@@ -6348,6 +6354,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',
@@ -6727,6 +6734,7 @@
'warnings' => '1.05',
'warnings::register' => '1.01',
},
+
5.008008 => {
'AnyDBM_File' => '1.00',
'Attribute::Handlers' => '0.78_02',
@@ -6767,6 +6775,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',
@@ -7094,6 +7103,7 @@
'warnings' => '1.05',
'warnings::register' => '1.01',
},
+
5.009004 => {
'AnyDBM_File' => '1.00',
'Archive::Tar' => '1.30_01',
@@ -7143,6 +7153,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',
@@ -7576,6 +7587,7 @@
'warnings' => '1.05',
'warnings::register' => '1.01',
},
+
5.009005 => {
'AnyDBM_File' => '1.00',
'Archive::Extract' => '0.22_01',
@@ -8110,6 +8122,7 @@
'warnings' => '1.06',
'warnings::register' => '1.01',
},
+
5.010000 => {
'AnyDBM_File' => '1.00',
'Archive::Extract' => '0.24',
--- perl/os2/OS2/REXX/REXX.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/os2/OS2/REXX/REXX.pm 2008-04-03 09:03:24.000000000 -0700
@@ -11,7 +11,7 @@

748
perl-5.10.0-File-Temp-0.20.patch
View File

@ -1,748 +0,0 @@
diff -up perl-5.10.0/lib/File/Temp.pm.OLD perl-5.10.0/lib/File/Temp.pm
--- perl-5.10.0/lib/File/Temp.pm.OLD 2007-12-18 05:47:07.000000000 -0500
+++ perl-5.10.0/lib/File/Temp.pm 2008-10-23 10:13:10.000000000 -0400
@@ -52,7 +52,9 @@ The C<_can_do_level> method should be mo
($fh, $filename) = tempfile( $template, DIR => $dir);
($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
+ ($fh, $filename) = tempfile( $template, TMPDIR => 1 );
+ binmode( $fh, ":utf8" );
$dir = tempdir( CLEANUP => 1 );
($fh, $filename) = tempfile( DIR => $dir );
@@ -63,13 +65,13 @@ Object interface:
use File::Temp ();
use File::Temp qw/ :seekable /;
- $fh = new File::Temp();
+ $fh = File::Temp->new();
$fname = $fh->filename;
- $fh = new File::Temp(TEMPLATE => $template);
+ $fh = File::Temp->new(TEMPLATE => $template);
$fname = $fh->filename;
- $tmp = new File::Temp( UNLINK => 0, SUFFIX => '.dat' );
+ $tmp = File::Temp->new( UNLINK => 0, SUFFIX => '.dat' );
print $tmp "Some data\n";
print "Filename is $tmp\n";
$tmp->seek( 0, SEEK_END );
@@ -130,6 +132,8 @@ but should be used with caution since th
that was valid when function was called, so cannot guarantee
that the file will not exist by the time the caller opens the filename.
+Filehandles returned by these functions support the seekable methods.
+
=cut
# 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls
@@ -149,7 +153,7 @@ require VMS::Stdio if $^O eq 'VMS';
# us that Carp::Heavy won't load rather than an error telling us we
# have run out of file handles. We either preload croak() or we
# switch the calls to croak from _gettemp() to use die.
-require Carp::Heavy;
+eval { require Carp::Heavy; };
# Need the Symbol package if we are running older perl
require Symbol if $] < 5.006;
@@ -199,7 +203,7 @@ Exporter::export_tags('POSIX','mktemp','
# Version number
-$VERSION = '0.18';
+$VERSION = '0.20';
# This is a list of characters that can be used in random filenames
@@ -229,9 +233,10 @@ use constant HIGH => 2;
# us an optimisation when many temporary files are requested
my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
+my $LOCKFLAG;
unless ($^O eq 'MacOS') {
- for my $oflag (qw/ NOFOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
+ for my $oflag (qw/ NOFOLLOW BINARY LARGEFILE NOINHERIT /) {
my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
no strict 'refs';
$OPENFLAGS |= $bit if eval {
@@ -243,6 +248,12 @@ unless ($^O eq 'MacOS') {
1;
};
}
+ # Special case O_EXLOCK
+ $LOCKFLAG = eval {
+ local $SIG{__DIE__} = sub {};
+ local $SIG{__WARN__} = sub {};
+ &Fcntl::O_EXLOCK();
+ };
}
# On some systems the O_TEMPORARY flag can be used to tell the OS
@@ -256,6 +267,7 @@ my $OPENTEMPFLAGS = $OPENFLAGS;
unless ($^O eq 'MacOS') {
for my $oflag (qw/ TEMPORARY /) {
my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
+ local($@);
no strict 'refs';
$OPENTEMPFLAGS |= $bit if eval {
# Make sure that redefined die handlers do not cause problems
@@ -268,6 +280,9 @@ unless ($^O eq 'MacOS') {
}
}
+# Private hash tracking which files have been created by each process id via the OO interface
+my %FILES_CREATED_BY_OBJECT;
+
# INTERNAL ROUTINES - not to be used outside of package
# Generic routine for getting a temporary filename
@@ -292,6 +307,7 @@ unless ($^O eq 'MacOS') {
# the file as soon as it is closed. Usually indicates
# use of the O_TEMPORARY flag to sysopen.
# Usually irrelevant on unix
+# "use_exlock" => Indicates that O_EXLOCK should be used. Default is true.
# Optionally a reference to a scalar can be passed into the function
# On error this will be used to store the reason for the error
@@ -328,6 +344,7 @@ sub _gettemp {
"mkdir" => 0,
"suffixlen" => 0,
"unlink_on_close" => 0,
+ "use_exlock" => 1,
"ErrStr" => \$tempErrStr,
);
@@ -437,6 +454,10 @@ sub _gettemp {
# not a file -- no point returning a name that includes a directory
# that does not exist or is not writable
+ unless (-e $parent) {
+ ${$options{ErrStr}} = "Parent directory ($parent) does not exist";
+ return ();
+ }
unless (-d $parent) {
${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
return ();
@@ -493,6 +514,7 @@ sub _gettemp {
my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
$OPENTEMPFLAGS :
$OPENFLAGS );
+ $flags |= $LOCKFLAG if (defined $LOCKFLAG && $options{use_exlock});
$open_success = sysopen($fh, $path, $flags, 0600);
}
if ( $open_success ) {
@@ -587,22 +609,6 @@ sub _gettemp {
}
-# Internal routine to return a random character from the
-# character list. Does not do an srand() since rand()
-# will do one automatically
-
-# No arguments. Return value is the random character
-
-# No longer called since _replace_XX runs a few percent faster if
-# I inline the code. This is important if we are creating thousands of
-# temporary files.
-
-sub _randchar {
-
- $CHARS[ int( rand( $#CHARS ) ) ];
-
-}
-
# Internal routine to replace the XXXX... with random characters
# This has to be done by _gettemp() every time it fails to
# open a temp file/dir
@@ -623,11 +629,12 @@ sub _replace_XX {
# and suffixlen=0 returns nothing if used in the substr directly
# Alternatively, could simply set $ignore to length($path)-1
# Don't want to always use substr when not required though.
+ my $end = ( $] >= 5.006 ? "\\z" : "\\Z" );
if ($ignore) {
- substr($path, 0, - $ignore) =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
+ substr($path, 0, - $ignore) =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
} else {
- $path =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
+ $path =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
}
return $path;
}
@@ -678,7 +685,7 @@ sub _is_safe {
# UID is in [4]
if ($info[4] > File::Temp->top_system_uid() && $info[4] != $>) {
- Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$< path='$path'",
+ Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$> path='$path'",
File::Temp->top_system_uid());
$$err_ref = "Directory owned neither by root nor the current user"
@@ -733,6 +740,7 @@ sub _is_verysafe {
# Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
# and If it is not there do the extensive test
+ local($@);
my $chown_restricted;
$chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
@@ -974,7 +982,7 @@ available.
Create a temporary file object.
- my $tmp = new File::Temp();
+ my $tmp = File::Temp->new();
by default the object is constructed as if C<tempfile>
was called without options, but with the additional behaviour
@@ -982,11 +990,11 @@ that the temporary file is removed by th
if UNLINK is set to true (the default).
Supported arguments are the same as for C<tempfile>: UNLINK
-(defaulting to true), DIR and SUFFIX. Additionally, the filename
+(defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename
template is specified using the TEMPLATE option. The OPEN option
is not supported (the file is always opened).
- $tmp = new File::Temp( TEMPLATE => 'tempXXXXX',
+ $tmp = File::Temp->new( TEMPLATE => 'tempXXXXX',
DIR => 'mydir',
SUFFIX => '.dat');
@@ -1024,6 +1032,9 @@ sub new {
# Store the filename in the scalar slot
${*$fh} = $path;
+ # Cache the filename by pid so that the destructor can decide whether to remove it
+ $FILES_CREATED_BY_OBJECT{$$}{$path} = 1;
+
# Store unlink information in hash slot (plus other constructor info)
%{*$fh} = %args;
@@ -1036,9 +1047,48 @@ sub new {
return $fh;
}
+=item B<newdir>
+
+Create a temporary directory using an object oriented interface.
+
+ $dir = File::Temp->newdir();
+
+By default the directory is deleted when the object goes out of scope.
+
+Supports the same options as the C<tempdir> function. Note that directories
+created with this method default to CLEANUP => 1.
+
+ $dir = File::Temp->newdir( $template, %options );
+
+=cut
+
+sub newdir {
+ my $self = shift;
+
+ # need to handle args as in tempdir because we have to force CLEANUP
+ # default without passing CLEANUP to tempdir
+ my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
+ my %options = @_;
+ my $cleanup = (exists $options{CLEANUP} ? $options{CLEANUP} : 1 );
+
+ delete $options{CLEANUP};
+
+ my $tempdir;
+ if (defined $template) {
+ $tempdir = tempdir( $template, %options );
+ } else {
+ $tempdir = tempdir( %options );
+ }
+ return bless { DIRNAME => $tempdir,
+ CLEANUP => $cleanup,
+ LAUNCHPID => $$,
+ }, "File::Temp::Dir";
+}
+
=item B<filename>
-Return the name of the temporary file associated with this object.
+Return the name of the temporary file associated with this object
+(if the object was created using the "new" constructor).
$filename = $tmp->filename;
@@ -1057,6 +1107,15 @@ sub STRINGIFY {
return $self->filename;
}
+=item B<dirname>
+
+Return the name of the temporary directory associated with this
+object (if the object was created using the "newdir" constructor).
+
+ $dirname = $tmpdir->dirname;
+
+This method is called automatically when the object is used in string context.
+
=item B<unlink_on_destroy>
Control whether the file is unlinked when the object goes out of scope.
@@ -1085,7 +1144,15 @@ if UNLINK is not specified).
No error is given if the unlink fails.
-If the global variable $KEEP_ALL is true, the file will not be removed.
+If the object has been passed to a child process during a fork, the
+file will be deleted when the object goes out of scope in the parent.
+
+For a temporary directory object the directory will be removed
+unless the CLEANUP argument was used in the constructor (and set to
+false) or C<unlink_on_destroy> was modified after creation.
+
+If the global variable $KEEP_ALL is true, the file or directory
+will not be removed.
=cut
@@ -1094,6 +1161,9 @@ sub DESTROY {
if (${*$self}{UNLINK} && !$KEEP_ALL) {
print "# ---------> Unlinking $self\n" if $DEBUG;
+ # only delete if this process created it
+ return unless exists $FILES_CREATED_BY_OBJECT{$$}{$self->filename};
+
# The unlink1 may fail if the file has been closed
# by the caller. This leaves us with the decision
# of whether to refuse to remove the file or simply
@@ -1145,6 +1215,12 @@ But see the WARNING at the end.
Translates the template as before except that a directory name
is specified.
+ ($fh, $filename) = tempfile($template, TMPDIR => 1);
+
+Equivalent to specifying a DIR of "File::Spec->tmpdir", writing the file
+into the same temporary directory as would be used if no template was
+specified at all.
+
($fh, $filename) = tempfile($template, UNLINK => 1);
Return the filename and filehandle as before except that the file is
@@ -1163,7 +1239,7 @@ automatically generated. This temporary
(L<File::Spec>) unless a directory is specified explicitly with the
DIR option.
- $fh = tempfile( $template, DIR => $dir );
+ $fh = tempfile( DIR => $dir );
If called in scalar context, only the filehandle is returned and the
file will automatically be deleted when closed on operating systems
@@ -1186,6 +1262,16 @@ if warnings are turned on. Consider usin
and mktemp() functions described elsewhere in this document
if opening the file is not required.
+If the operating system supports it (for example BSD derived systems), the
+filehandle will be opened with O_EXLOCK (open with exclusive file lock).
+This can sometimes cause problems if the intention is to pass the filename
+to another system that expects to take an exclusive lock itself (such as
+DBD::SQLite) whilst ensuring that the tempfile is not reused. In this
+situation the "EXLOCK" option can be passed to tempfile. By default EXLOCK
+will be true (this retains compatibility with earlier releases).
+
+ ($fh, $filename) = tempfile($template, EXLOCK => 0);
+
Options can be combined as required.
Will croak() if there is an error.
@@ -1199,11 +1285,13 @@ sub tempfile {
# Default options
my %options = (
- "DIR" => undef, # Directory prefix
+ "DIR" => undef, # Directory prefix
"SUFFIX" => '', # Template suffix
"UNLINK" => 0, # Do not unlink file on exit
"OPEN" => 1, # Open file
- );
+ "TMPDIR" => 0, # Place tempfile in tempdir if template specified
+ "EXLOCK" => 1, # Open file with O_EXLOCK
+ );
# Check to see whether we have an odd or even number of arguments
my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef);
@@ -1234,10 +1322,15 @@ sub tempfile {
# First generate a template if not defined and prefix the directory
# If no template must prefix the temp directory
if (defined $template) {
+ # End up with current directory if neither DIR not TMPDIR are set
if ($options{"DIR"}) {
$template = File::Spec->catfile($options{"DIR"}, $template);
+ } elsif ($options{TMPDIR}) {
+
+ $template = File::Spec->catfile(File::Spec->tmpdir, $template );
+
}
} else {
@@ -1278,6 +1371,7 @@ sub tempfile {
"unlink_on_close" => $unlink_on_close,
"suffixlen" => length($options{'SUFFIX'}),
"ErrStr" => \$errstr,
+ "use_exlock" => $options{EXLOCK},
) );
# Set up an exit handler that can do whatever is right for the
@@ -1312,7 +1406,15 @@ sub tempfile {
=item B<tempdir>
-This is the recommended interface for creation of temporary directories.
+This is the recommended interface for creation of temporary
+directories. By default the directory will not be removed on exit
+(that is, it won't be temporary; this behaviour can not be changed
+because of issues with backwards compatibility). To enable removal
+either use the CLEANUP option which will trigger removal on program
+exit, or consider using the "newdir" method in the object interface which
+will allow the directory to be cleaned up when the object goes out of
+scope.
+
The behaviour of the function depends on the arguments:
$tempdir = tempdir();
@@ -2045,11 +2147,10 @@ Options are:
=item STANDARD
-Do the basic security measures to ensure the directory exists and
-is writable, that the umask() is fixed before opening of the file,
-that temporary files are opened only if they do not already exist, and
-that possible race conditions are avoided. Finally the L<unlink0|"unlink0">
-function is used to remove files safely.
+Do the basic security measures to ensure the directory exists and is
+writable, that temporary files are opened only if they do not already
+exist, and that possible race conditions are avoided. Finally the
+L<unlink0|"unlink0"> function is used to remove files safely.
=item MEDIUM
@@ -2237,9 +2338,12 @@ themselves to give up if they exceed the
=head2 BINMODE
The file returned by File::Temp will have been opened in binary mode
-if such a mode is available. If that is not correct, use the binmode()
+if such a mode is available. If that is not correct, use the C<binmode()>
function to change the mode of the filehandle.
+Note that you can modify the encoding of a file opened by File::Temp
+also by using C<binmode()>.
+
=head1 HISTORY
Originally began life in May 1999 as an XS interface to the system
@@ -2256,10 +2360,14 @@ L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<Fil
See L<IO::File> and L<File::MkTemp>, L<Apache::TempFile> for
different implementations of temporary file handling.
+See L<File::Tempdir> for an alternative object-oriented wrapper for
+the C<tempdir> function.
+
=head1 AUTHOR
Tim Jenness E<lt>tjenness@cpan.orgE<gt>
+Copyright (C) 2007 Tim Jenness.
Copyright (C) 1999-2007 Tim Jenness and the UK Particle Physics and
Astronomy Research Council. All Rights Reserved. This program is free
software; you can redistribute it and/or modify it under the same
@@ -2272,4 +2380,46 @@ security enhancements.
=cut
+package File::Temp::Dir;
+
+use File::Path qw/ rmtree /;
+use strict;
+use overload '""' => "STRINGIFY", fallback => 1;
+
+# private class specifically to support tempdir objects
+# created by File::Temp->newdir
+
+# ostensibly the same method interface as File::Temp but without
+# inheriting all the IO::Seekable methods and other cruft
+
+# Read-only - returns the name of the temp directory
+
+sub dirname {
+ my $self = shift;
+ return $self->{DIRNAME};
+}
+
+sub STRINGIFY {
+ my $self = shift;
+ return $self->dirname;
+}
+
+sub unlink_on_destroy {
+ my $self = shift;
+ if (@_) {
+ $self->{CLEANUP} = shift;
+ }
+ return $self->{CLEANUP};
+}
+
+sub DESTROY {
+ my $self = shift;
+ if ($self->unlink_on_destroy &&
+ $$ == $self->{LAUNCHPID} && !$File::Temp::KEEP_ALL) {
+ rmtree($self->{DIRNAME}, $File::Temp::DEBUG, 0)
+ if -d $self->{DIRNAME};
+ }
+}
+
+
1;
diff -up perl-5.10.0/lib/File/Temp/t/cmp.t.OLD perl-5.10.0/lib/File/Temp/t/cmp.t
diff -up perl-5.10.0/lib/File/Temp/t/fork.t.OLD perl-5.10.0/lib/File/Temp/t/fork.t
--- perl-5.10.0/lib/File/Temp/t/fork.t.OLD 2008-10-23 10:14:08.000000000 -0400
+++ perl-5.10.0/lib/File/Temp/t/fork.t 2008-10-23 10:14:04.000000000 -0400
@@ -0,0 +1,90 @@
+#!/usr/bin/perl
+$| = 1;
+
+# Note that because fork loses test count we do not use Test::More
+
+use strict;
+
+BEGIN { print "1..8\n"; }
+
+use File::Temp;
+
+# OO interface
+
+my $file = File::Temp->new(CLEANUP=>1);
+
+myok( 1, -f $file->filename, "OO File exists" );
+
+my $children = 2;
+for my $i (1 .. $children) {
+ my $pid = fork;
+ die "Can't fork: $!" unless defined $pid;
+ if ($pid) {
+ # parent process
+ next;
+ } else {
+ # in a child we can't keep the count properly so we do it manually
+ # make sure that child 1 dies first
+ srand();
+ my $time = (($i-1) * 5) +int(rand(5));
+ print "# child $i sleeping for $time seconds\n";
+ sleep($time);
+ my $count = $i + 1;
+ myok( $count, -f $file->filename(), "OO file present in child $i" );
+ print "# child $i exiting\n";
+ exit;
+ }
+}
+
+while ($children) {
+ wait;
+ $children--;
+}
+
+
+
+myok( 4, -f $file->filename(), "OO File exists in parent" );
+
+# non-OO interface
+
+my ($fh, $filename) = File::Temp::tempfile( CLEANUP => 1 );
+
+myok( 5, -f $filename, "non-OO File exists" );
+
+$children = 2;
+for my $i (1 .. $children) {
+ my $pid = fork;
+ die "Can't fork: $!" unless defined $pid;
+ if ($pid) {
+ # parent process
+ next;
+ } else {
+ srand();
+ my $time = (($i-1) * 5) +int(rand(5));
+ print "# child $i sleeping for $time seconds\n";
+ sleep($time);
+ my $count = 5 + $i;
+ myok( $count, -f $filename, "non-OO File present in child $i" );
+ print "# child $i exiting\n";
+ exit;
+ }
+}
+
+while ($children) {
+ wait;
+ $children--;
+}
+myok(8, -f $filename, "non-OO File exists in parent" );
+
+
+# Local ok sub handles explicit number
+sub myok {
+ my ($count, $test, $msg) = @_;
+
+ if ($test) {
+ print "ok $count - $msg\n";
+ } else {
+ print "not ok $count - $msg\n";
+ }
+ return $test;
+}
diff -up perl-5.10.0/lib/File/Temp/t/lock.t.OLD perl-5.10.0/lib/File/Temp/t/lock.t
--- perl-5.10.0/lib/File/Temp/t/lock.t.OLD 2008-10-23 10:14:27.000000000 -0400
+++ perl-5.10.0/lib/File/Temp/t/lock.t 2008-10-23 10:14:24.000000000 -0400
@@ -0,0 +1,60 @@
+#!perl -w
+# Test O_EXLOCK
+
+use Test::More;
+use strict;
+use Fcntl;
+
+BEGIN {
+# see if we have O_EXLOCK
+ eval { &Fcntl::O_EXLOCK; };
+ if ($@) {
+ plan skip_all => 'Do not seem to have O_EXLOCK';
+ } else {
+ plan tests => 4;
+ use_ok( "File::Temp" );
+ }
+}
+
+# Need Symbol package for lexical filehandle on older perls
+require Symbol if $] < 5.006;
+
+# Get a tempfile with O_EXLOCK
+my $fh = new File::Temp();
+ok( -e "$fh", "temp file is present" );
+
+# try to open it with a lock
+my $flags = O_CREAT | O_RDWR | O_EXLOCK;
+
+my $timeout = 5;
+my $status;
+eval {
+ local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
+ alarm $timeout;
+ my $newfh;
+ $newfh = &Symbol::gensym if $] < 5.006;
+ $status = sysopen($newfh, "$fh", $flags, 0600);
+ alarm 0;
+};
+if ($@) {
+ die unless $@ eq "alarm\n"; # propagate unexpected errors
+ # timed out
+}
+ok( !$status, "File $fh is locked" );
+
+# Now get a tempfile with locking disabled
+$fh = new File::Temp( EXLOCK => 0 );
+
+eval {
+ local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
+ alarm $timeout;
+ my $newfh;
+ $newfh = &Symbol::gensym if $] < 5.006;
+ $status = sysopen($newfh, "$fh", $flags, 0600);
+ alarm 0;
+};
+if ($@) {
+ die unless $@ eq "alarm\n"; # propagate unexpected errors
+ # timed out
+}
+ok( $status, "File $fh is not locked");
diff -up perl-5.10.0/lib/File/Temp/t/mktemp.t.OLD perl-5.10.0/lib/File/Temp/t/mktemp.t
diff -up perl-5.10.0/lib/File/Temp/t/object.t.OLD perl-5.10.0/lib/File/Temp/t/object.t
--- perl-5.10.0/lib/File/Temp/t/object.t.OLD 2007-12-18 05:47:07.000000000 -0500
+++ perl-5.10.0/lib/File/Temp/t/object.t 2007-11-19 15:49:20.000000000 -0500
@@ -2,7 +2,7 @@
# Test for File::Temp - OO interface
use strict;
-use Test::More tests => 26;
+use Test::More tests => 30;
use File::Spec;
# Will need to check that all files were unlinked correctly
@@ -44,7 +44,22 @@ ok( (-f "$fh"), "File $fh still exists a
# Check again at exit
push(@files, "$fh");
-# TEMPDIR test
+# OO tempdir
+my $tdir = File::Temp->newdir();
+my $dirname = "$tdir"; # Stringify overload
+ok( -d $dirname, "Directory $tdir exists");
+undef $tdir;
+ok( !-d $dirname, "Directory should now be gone");
+
+# Quick basic tempfile test
+my $qfh = File::Temp->new();
+my $qfname = "$qfh";
+ok (-f $qfname, "temp file exists");
+undef $qfh;
+ok( !-f $qfname, "temp file now gone");
+
+
+# TEMPDIR test as somewhere to put the temp files
# Create temp directory in current dir
my $template = 'tmpdirXXXXXX';
print "# Template: $template\n";
diff -up perl-5.10.0/lib/File/Temp/t/posix.t.OLD perl-5.10.0/lib/File/Temp/t/posix.t
diff -up perl-5.10.0/lib/File/Temp/t/security.t.OLD perl-5.10.0/lib/File/Temp/t/security.t
diff -up perl-5.10.0/lib/File/Temp/t/seekable.t.OLD perl-5.10.0/lib/File/Temp/t/seekable.t
--- perl-5.10.0/lib/File/Temp/t/seekable.t.OLD 2007-12-18 05:47:07.000000000 -0500
+++ perl-5.10.0/lib/File/Temp/t/seekable.t 2007-11-14 19:19:19.000000000 -0500
@@ -6,7 +6,7 @@
# change 'tests => 1' to 'tests => last_test_to_print';
-use Test::More tests => 7;
+use Test::More tests => 10;
BEGIN { use_ok('File::Temp') };
#########################
@@ -21,7 +21,11 @@ isa_ok( $tmp, 'IO::Handle' );
isa_ok( $tmp, 'IO::Seekable' );
# make sure the seek method is available...
-ok( File::Temp->can('seek'), 'tmp can seek' );
+# Note that we need a reasonably modern IO::Seekable
+SKIP: {
+ skip "IO::Seekable is too old", 1 if IO::Seekable->VERSION <= 1.06;
+ ok( File::Temp->can('seek'), 'tmp can seek' );
+}
# make sure IO::Handle methods are still there...
ok( File::Temp->can('print'), 'tmp can print' );
@@ -30,3 +34,7 @@ ok( File::Temp->can('print'), 'tmp can p
$c = scalar @File::Temp::EXPORT;
$l = join ' ', @File::Temp::EXPORT;
ok( $c == 9, "really exporting $c: $l" );
+
+ok(defined eval { SEEK_SET() }, 'SEEK_SET defined by File::Temp') or diag $@;
+ok(defined eval { SEEK_END() }, 'SEEK_END defined by File::Temp') or diag $@;
+ok(defined eval { SEEK_CUR() }, 'SEEK_CUR defined by File::Temp') or diag $@;
diff -up perl-5.10.0/lib/File/Temp/t/tempfile.t.OLD perl-5.10.0/lib/File/Temp/t/tempfile.t
diff -up perl-5.10.0/MANIFEST.OLD perl-5.10.0/MANIFEST
--- perl-5.10.0/MANIFEST.OLD 2008-10-23 10:35:38.000000000 -0400
+++ perl-5.10.0/MANIFEST 2008-10-23 10:36:35.000000000 -0400
@@ -1890,6 +1890,8 @@ lib/File/stat.pm By-name interface to P
lib/File/stat.t See if File::stat works
lib/File/Temp.pm create safe temporary files and file handles
lib/File/Temp/t/cmp.t See if File::Temp works
+lib/File/Temp/t/fork.t See if File::Temp works
+lib/File/Temp/t/lock.t See if File::Temp works
lib/File/Temp/t/mktemp.t See if File::Temp works
lib/File/Temp/t/object.t See if File::Temp works
lib/File/Temp/t/posix.t See if File::Temp works

150
perl-5.10.0-Module-CoreList2.14.patch
View File

@ -1,150 +0,0 @@
diff -up perl-5.10.0/lib/Module/CoreList.pm.crr perl-5.10.0/lib/Module/CoreList.pm
--- perl-5.10.0/lib/Module/CoreList.pm.crr 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Module/CoreList.pm 2008-03-17 16:15:07.000000000 +0100
@@ -1,7 +1,7 @@
package Module::CoreList;
use strict;
use vars qw/$VERSION %released %patchlevel %version %families/;
-$VERSION = '2.13';
+$VERSION = '2.14';
=head1 NAME
@@ -138,6 +138,11 @@ sub find_modules {
return sort keys %mods
}
+sub find_version {
+ my ($class, $v) = @_;
+ return $version{$v} if defined $version{$v};
+ return undef;
+}
# when things escaped
%released = (
@@ -176,7 +181,7 @@ sub find_modules {
%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],
diff -up perl-5.10.0/lib/Module/CoreList/t/corelist.t.crr perl-5.10.0/lib/Module/CoreList/t/corelist.t
diff -up perl-5.10.0/lib/Module/CoreList/t/pod.t.crr perl-5.10.0/lib/Module/CoreList/t/pod.t
--- perl-5.10.0/lib/Module/CoreList/t/pod.t.crr 2008-03-18 09:43:20.000000000 +0100
+++ perl-5.10.0/lib/Module/CoreList/t/pod.t 2006-02-01 14:38:29.000000000 +0100
@@ -0,0 +1,10 @@
+#!perl
+
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+
+plan tests => 2;
+
+pod_file_ok( 'lib/Module/CoreList.pm', 'module pod ok' );
+pod_file_ok( 'corelist', 'script pod ok' );
diff -up perl-5.10.0/lib/Module/CoreList/t/find_modules.t.crr perl-5.10.0/lib/Module/CoreList/t/find_modules.t
diff -up perl-5.10.0/lib/Module/CoreList/bin/corelist.crr perl-5.10.0/lib/Module/CoreList/bin/corelist
--- perl-5.10.0/lib/Module/CoreList/bin/corelist.crr 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Module/CoreList/bin/corelist 2008-03-17 16:14:59.000000000 +0100
@@ -11,14 +11,14 @@ See L<Module::CoreList> for one.
=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 @@ used a module regexp) in the perls Modul
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 @@ use warnings;
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 @@ if(exists $Opts{v} ){
}
$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 @@ sub module_version {
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 module_version {
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;
}

72
perl-5.10.0-Module-Load-Conditional-0.24.patch
View File

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

5550
perl-5.10.0-SysSyslog-0.24.patch
View File

File diff suppressed because it is too large Load Diff

1542
perl-5.10.0-TestSimple0.80.patch
View File

File diff suppressed because it is too large Load Diff

82
perl-5.10.0-links.patch
View File

@ -1,16 +1,16 @@
diff -up perl-5.10.0/lib/File/Fetch.pm.BAD perl-5.10.0/lib/File/Fetch.pm
--- perl-5.10.0/lib/File/Fetch.pm.BAD 2007-12-21 10:41:39.000000000 -0500
+++ perl-5.10.0/lib/File/Fetch.pm 2007-12-21 10:43:00.000000000 -0500
@@ -37,7 +37,7 @@ $WARN = 1;
--- perl-5.10.0.orig/lib/File/Fetch.pm 2009-03-11 14:21:00.000000000 +0100
+++ perl-5.10.0/lib/File/Fetch.pm 2009-03-11 14:23:26.000000000 +0100
@@ -35,7 +35,7 @@ $WARN = 1;
### methods available to fetch the file depending on the scheme
$METHODS = {
- http => [ qw|lwp wget curl lynx| ],
+ http => [ qw|lwp wget curl links| ],
ftp => [ qw|lwp netftp wget curl ncftp ftp| ],
file => [ qw|lwp file| ],
- http => [ qw|lwp wget curl lftp lynx| ],
+ http => [ qw|lwp wget curl lftp links| ],
ftp => [ qw|lwp netftp wget curl lftp ncftp ftp| ],
file => [ qw|lwp lftp file| ],
rsync => [ qw|rsync| ]
@@ -694,9 +694,9 @@ sub _ftp_fetch {
@@ -772,9 +772,9 @@ sub _ftp_fetch {
}
}
@ -23,7 +23,7 @@ diff -up perl-5.10.0/lib/File/Fetch.pm.BAD perl-5.10.0/lib/File/Fetch.pm
my $self = shift;
my %hash = @_;
@@ -706,25 +706,25 @@ sub _lynx_fetch {
@@ -784,21 +784,21 @@ sub _lynx_fetch {
};
check( $tmpl, \%hash ) or return;
@ -42,6 +42,18 @@ diff -up perl-5.10.0/lib/File/Fetch.pm.BAD perl-5.10.0/lib/File/Fetch.pm
+ 'links' ));
}
### check if the HTTP resource exists ###
if ($self->uri =~ /^https?:\/\//i) {
my $cmd = [
- $lynx,
+ $links,
'-head',
'-source',
"-auth=anonymous:$FROM_EMAIL",
@@ -822,14 +822,14 @@ sub _lynx_fetch {
}
}
- ### write to the output file ourselves, since lynx ass_u_mes to much
+ ### write to the output file ourselves, since links ass_u_mes to much
my $local = FileHandle->new(">$to")
@ -55,7 +67,7 @@ diff -up perl-5.10.0/lib/File/Fetch.pm.BAD perl-5.10.0/lib/File/Fetch.pm
'-source',
"-auth=anonymous:$FROM_EMAIL",
];
@@ -750,7 +750,7 @@ sub _lynx_fetch {
@@ -860,7 +860,7 @@ sub _lynx_fetch {
### XXX on a 404 with a special error page, $captured will actually
### hold the contents of that page, and make it *appear* like the
### request was a success, when really it wasn't :(
@ -64,7 +76,7 @@ diff -up perl-5.10.0/lib/File/Fetch.pm.BAD perl-5.10.0/lib/File/Fetch.pm
### code based on a 4XX status or so.
### the closest we can come is using --error_file and parsing that,
### which is very unreliable ;(
@@ -760,7 +760,7 @@ sub _lynx_fetch {
@@ -870,7 +870,7 @@ sub _lynx_fetch {
return $to;
} else {
@ -73,16 +85,16 @@ diff -up perl-5.10.0/lib/File/Fetch.pm.BAD perl-5.10.0/lib/File/Fetch.pm
return;
}
}
@@ -1031,7 +1031,7 @@ Below is a mapping of what utilities wil
@@ -1150,7 +1150,7 @@ Below is a mapping of what utilities wil
for what schemes, if available:
file => LWP, file
- http => LWP, wget, curl, lynx
+ http => LWP, wget, curl, links
ftp => LWP, Net::FTP, wget, curl, ncftp, ftp
file => LWP, lftp, file
- http => LWP, wget, curl, lftp, lynx
+ http => LWP, wget, curl, lftp, links
ftp => LWP, Net::FTP, wget, curl, lftp, ncftp, ftp
rsync => rsync
@@ -1143,7 +1143,7 @@ the $BLACKLIST, $METHOD_FAIL and other i
@@ -1262,7 +1262,7 @@ the $BLACKLIST, $METHOD_FAIL and other i
LWP => lwp
Net::FTP => netftp
wget => wget
@ -91,7 +103,7 @@ diff -up perl-5.10.0/lib/File/Fetch.pm.BAD perl-5.10.0/lib/File/Fetch.pm
ncftp => ncftp
ftp => ftp
curl => curl
@@ -1161,17 +1161,17 @@ example, to use an ftp proxy:
@@ -1281,17 +1281,17 @@ example, to use an ftp proxy:
Refer to the LWP::UserAgent manpage for more details.
@ -114,20 +126,20 @@ diff -up perl-5.10.0/lib/File/Fetch.pm.BAD perl-5.10.0/lib/File/Fetch.pm
=head2 Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do?
diff -up perl-5.10.0/lib/File/Fetch/t/01_File-Fetch.t.BAD perl-5.10.0/lib/File/Fetch/t/01_File-Fetch.t
--- perl-5.10.0/lib/File/Fetch/t/01_File-Fetch.t.BAD 2007-12-21 10:43:38.000000000 -0500
+++ perl-5.10.0/lib/File/Fetch/t/01_File-Fetch.t 2007-12-21 10:43:45.000000000 -0500
@@ -169,7 +169,7 @@ for my $entry (@map) {
{ for my $uri ( 'http://www.cpan.org/index.html',
'http://www.cpan.org/index.html?q=1&y=2'
--- perl-5.10.0.orig/lib/File/Fetch/t/01_File-Fetch.t 2009-03-11 14:21:00.000000000 +0100
+++ perl-5.10.0/lib/File/Fetch/t/01_File-Fetch.t 2009-03-11 14:22:10.000000000 +0100
@@ -177,7 +177,7 @@ for my $entry (@map) {
'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 links]) {
- for (qw[lwp wget curl lftp lynx]) {
+ for (qw[lwp wget curl lftp links]) {
_fetch_uri( http => $uri, $_ );
}
}
diff -up perl-5.10.0/lib/CPAN.pm.BAD perl-5.10.0/lib/CPAN.pm
--- perl-5.10.0/lib/CPAN.pm.BAD 2007-12-21 10:39:16.000000000 -0500
+++ perl-5.10.0/lib/CPAN.pm 2007-12-21 10:41:13.000000000 -0500
--- perl-5.10.0.orig/lib/CPAN.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CPAN.pm 2009-03-11 14:21:21.000000000 +0100
@@ -4318,7 +4318,7 @@ sub hostdlhard {
# Try the most capable first and leave ncftp* for last as it only
@ -250,8 +262,8 @@ diff -up perl-5.10.0/lib/CPAN.pm.BAD perl-5.10.0/lib/CPAN.pm
That's all. Similarly for ncftp or ftp, you would configure something
like
diff -up perl-5.10.0/lib/CPAN/HandleConfig.pm.BAD perl-5.10.0/lib/CPAN/HandleConfig.pm
--- perl-5.10.0/lib/CPAN/HandleConfig.pm.BAD 2007-12-21 10:43:14.000000000 -0500
+++ perl-5.10.0/lib/CPAN/HandleConfig.pm 2007-12-21 10:43:21.000000000 -0500
--- perl-5.10.0.orig/lib/CPAN/HandleConfig.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CPAN/HandleConfig.pm 2009-03-11 14:21:21.000000000 +0100
@@ -49,7 +49,7 @@ $VERSION = sprintf "%.6f", substr(q$Rev:
"inhibit_startup_message",
"keep_source_where",
@ -262,8 +274,8 @@ diff -up perl-5.10.0/lib/CPAN/HandleConfig.pm.BAD perl-5.10.0/lib/CPAN/HandleCon
"make_arg",
"make_install_arg",
diff -up perl-5.10.0/lib/CPAN/FirstTime.pm.BAD perl-5.10.0/lib/CPAN/FirstTime.pm
--- perl-5.10.0/lib/CPAN/FirstTime.pm.BAD 2007-12-21 10:38:30.000000000 -0500
+++ perl-5.10.0/lib/CPAN/FirstTime.pm 2007-12-21 10:38:58.000000000 -0500
--- perl-5.10.0.orig/lib/CPAN/FirstTime.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CPAN/FirstTime.pm 2009-03-11 14:21:21.000000000 +0100
@@ -813,7 +813,7 @@ Shall we use it as the general CPAN buil
make
@ -274,8 +286,8 @@ diff -up perl-5.10.0/lib/CPAN/FirstTime.pm.BAD perl-5.10.0/lib/CPAN/FirstTime.pm
gpg
diff -up perl-5.10.0/pod/perltoc.pod.BAD perl-5.10.0/pod/perltoc.pod
--- perl-5.10.0/pod/perltoc.pod.BAD 2007-12-21 10:44:44.000000000 -0500
+++ perl-5.10.0/pod/perltoc.pod 2007-12-21 10:44:53.000000000 -0500
--- perl-5.10.0.orig/pod/perltoc.pod 2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/pod/perltoc.pod 2009-03-11 14:21:21.000000000 +0100
@@ -14682,7 +14682,7 @@ has_inst($module), has_usable($module),
http firewall, ftp firewall, One way visibility, SOCKS, IP Masquerade
@ -295,8 +307,8 @@ diff -up perl-5.10.0/pod/perltoc.pod.BAD perl-5.10.0/pod/perltoc.pod
=item Files I'm trying to fetch have reserved characters or non-ASCII
characters in them. What do I do?
diff -up perl-5.10.0/pod/perlfaq9.pod.BAD perl-5.10.0/pod/perlfaq9.pod
--- perl-5.10.0/pod/perlfaq9.pod.BAD 2007-12-21 10:44:08.000000000 -0500
+++ perl-5.10.0/pod/perlfaq9.pod 2007-12-21 10:44:32.000000000 -0500
--- perl-5.10.0.orig/pod/perlfaq9.pod 2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/pod/perlfaq9.pod 2009-03-11 14:21:21.000000000 +0100
@@ -212,14 +212,14 @@ examples.
=head2 How do I fetch an HTML file?

5972
perl-5.10.0-removeTestHarness.patch
View File

File diff suppressed because it is too large Load Diff

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

@ -0,0 +1,978 @@
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 Normal file
View File

File diff suppressed because it is too large Load Diff

729
perl-5.10.0-CGI-3.38.patch → perl-update-CGI.patch
View File

File diff suppressed because it is too large Load Diff

444
perl-update-ExtUtils-CBuilder.patch Normal file
View File

@ -0,0 +1,444 @@
perl-update-ExtUtils-CBuilder-0.24
diff -urN perl-5.10.0.orig/lib/ExtUtils/CBuilder/Base.pm perl-5.10.0/lib/ExtUtils/CBuilder/Base.pm
--- perl-5.10.0.orig/lib/ExtUtils/CBuilder/Base.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/ExtUtils/CBuilder/Base.pm 2009-03-11 20:12:36.000000000 +0100
@@ -6,9 +6,10 @@
use Cwd ();
use Config;
use Text::ParseWords;
+use IO::File;
use vars qw($VERSION);
-$VERSION = '0.21';
+$VERSION = '0.24';
sub new {
my $class = shift;
@@ -118,10 +119,8 @@
my $tmpfile = File::Spec->catfile(File::Spec->tmpdir, 'compilet.c');
{
- local *FH;
- open FH, "> $tmpfile" or die "Can't create $tmpfile: $!";
- print FH "int boot_compilet() { return 1; }\n";
- close FH;
+ my $FH = IO::File->new("> $tmpfile") or die "Can't create $tmpfile: $!";
+ print $FH "int boot_compilet() { return 1; }\n";
}
my ($obj_file, @lib_files);
diff -urN perl-5.10.0.orig/lib/ExtUtils/CBuilder/Changes perl-5.10.0/lib/ExtUtils/CBuilder/Changes
--- perl-5.10.0.orig/lib/ExtUtils/CBuilder/Changes 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/ExtUtils/CBuilder/Changes 2009-03-11 20:13:30.000000000 +0100
@@ -1,5 +1,31 @@
Revision history for Perl extension ExtUtils::CBuilder.
+ - Added 'gnu' and 'gnukfreebsd' as Unix variants. [Niko Tyni]
+
+ - Brought in some VMS fixes from bleadperl: "Correct and complete
+ CBuilder's handling of external libraries when linking on VMS."
+ [Craig Berry]
+
+0.23 - Sat Apr 19 22:28:03 2008
+
+ - Fixed some problems (some old, some new) with Strawberry Perl on
+ Windows. [Alberto Simo~es]
+
+ - Will now install in the core perl lib directory when the user's
+ perl is new enough to have us in core. [Yi Ma Mao]
+
+0.22 - Fri Feb 8 21:52:21 2008
+
+ - Replaced the split_like_shell() method on Windows with a
+ near-no-op, which is probably more correct and has the benefit of
+ not messing up UNC paths. [John R. LoVerso, see
+ http://rt.cpan.org/Ticket/Display.html?id=26545]
+
+ - Fixed extra_compiler_flags on Windows, they were being
+ ignored. [Robert May]
+
+0.21 - Tue Oct 30 06:46:01 2007
+
- Clean up perl_src path using Cwd::realpath(). Only affects usage
as part of the perl core.
diff -urN perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/Unix.pm perl-5.10.0/lib/ExtUtils/CBuilder/Platform/Unix.pm
--- perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/Unix.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/ExtUtils/CBuilder/Platform/Unix.pm 2009-03-11 20:12:36.000000000 +0100
@@ -4,7 +4,7 @@
use ExtUtils::CBuilder::Base;
use vars qw($VERSION @ISA);
-$VERSION = '0.21';
+$VERSION = '0.24';
@ISA = qw(ExtUtils::CBuilder::Base);
sub link_executable {
diff -urN perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/VMS.pm perl-5.10.0/lib/ExtUtils/CBuilder/Platform/VMS.pm
--- perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/VMS.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/ExtUtils/CBuilder/Platform/VMS.pm 2009-03-11 20:12:36.000000000 +0100
@@ -4,7 +4,7 @@
use ExtUtils::CBuilder::Base;
use vars qw($VERSION @ISA);
-$VERSION = '0.22';
+$VERSION = '0.24';
@ISA = qw(ExtUtils::CBuilder::Base);
use File::Spec::Functions qw(catfile catdir);
@@ -134,7 +134,7 @@
# In general, we pass through the basic libraries from %Config unchanged.
# The one exception is that if we're building in the Perl source tree, and
# a library spec could be resolved via a logical name, we go to some trouble
- # to insure that the copy in the local tree is used, rather than one to
+ # to ensure that the copy in the local tree is used, rather than one to
# which a system-wide logical may point.
if ($self->perl_src) {
my($lib,$locspec,$type);
diff -urN perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/Windows.pm perl-5.10.0/lib/ExtUtils/CBuilder/Platform/Windows.pm
--- perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/Windows.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/ExtUtils/CBuilder/Platform/Windows.pm 2009-03-11 20:12:36.000000000 +0100
@@ -7,9 +7,10 @@
use File::Spec;
use ExtUtils::CBuilder::Base;
+use IO::File;
use vars qw($VERSION @ISA);
-$VERSION = '0.21';
+$VERSION = '0.24';
@ISA = qw(ExtUtils::CBuilder::Base);
sub new {
@@ -33,61 +34,24 @@
}
sub split_like_shell {
- # As it turns out, Windows command-parsing is very different from
- # Unix command-parsing. Double-quotes mean different things,
- # backslashes don't necessarily mean escapes, and so on. So we
- # can't use Text::ParseWords::shellwords() to break a command string
- # into words. The algorithm below was bashed out by Randy and Ken
- # (mostly Randy), and there are a lot of regression tests, so we
- # should feel free to adjust if desired.
-
+ # Since Windows will pass the whole command string (not an argument
+ # array) to the target program and make the program parse it itself,
+ # we don't actually need to do any processing here.
(my $self, local $_) = @_;
return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
-
- my @argv;
- return @argv unless defined() && length();
-
- my $arg = '';
- my( $i, $quote_mode ) = ( 0, 0 );
-
- while ( $i < length() ) {
-
- my $ch = substr( $_, $i , 1 );
- my $next_ch = substr( $_, $i+1, 1 );
-
- if ( $ch eq '\\' && $next_ch eq '"' ) {
- $arg .= '"';
- $i++;
- } elsif ( $ch eq '\\' && $next_ch eq '\\' ) {
- $arg .= '\\';
- $i++;
- } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) {
- $quote_mode = !$quote_mode;
- $arg .= '"';
- $i++;
- } elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode &&
- ( $i + 2 == length() ||
- substr( $_, $i + 2, 1 ) eq ' ' )
- ) { # for cases like: a"" => [ 'a' ]
- push( @argv, $arg );
- $arg = '';
- $i += 2;
- } elsif ( $ch eq '"' ) {
- $quote_mode = !$quote_mode;
- } elsif ( $ch eq ' ' && !$quote_mode ) {
- push( @argv, $arg ) if $arg;
- $arg = '';
- ++$i while substr( $_, $i + 1, 1 ) eq ' ';
- } else {
- $arg .= $ch;
- }
-
- $i++;
- }
-
- push( @argv, $arg ) if defined( $arg ) && length( $arg );
- return @argv;
+ return unless defined() && length();
+ return ($_);
+}
+
+sub do_system {
+ # See above
+ my $self = shift;
+ my $cmd = join(" ",
+ grep length,
+ map {$a=$_;$a=~s/\t/ /g;$a=~s/^\s+|\s+$//;$a}
+ grep defined, @_);
+ return $self->SUPER::do_system($cmd);
}
sub arg_defines {
@@ -119,7 +83,7 @@
cflags => [
$self->split_like_shell($cf->{ccflags}),
$self->split_like_shell($cf->{cccdlflags}),
- $self->split_like_shell($cf->{extra_compiler_flags}),
+ $self->split_like_shell($args{extra_compiler_flags}),
],
optimize => [ $self->split_like_shell($cf->{optimize}) ],
defines => \@defines,
@@ -329,18 +293,16 @@
$self->add_to_cleanup($script);
print "Generating script '$script'\n" if !$self->{quiet};
- open( SCRIPT, ">$script" )
+ my $SCRIPT = IO::File->new( ">$script" )
or die( "Could not create script '$script': $!" );
- print SCRIPT join( "\n",
+ print $SCRIPT join( "\n",
map { ref $_ ? @{$_} : $_ }
grep defined,
delete(
@spec{ qw(includes cflags optimize defines perlinc) } )
);
- close SCRIPT;
-
push @{$spec{includes}}, '@"' . $script . '"';
return %spec;
@@ -402,10 +364,10 @@
print "Generating script '$script'\n" if !$self->{quiet};
- open( SCRIPT, ">$script" )
+ my $SCRIPT = IO::File->new( ">$script" )
or die( "Could not create script '$script': $!" );
- print SCRIPT join( "\n",
+ print $SCRIPT join( "\n",
map { ref $_ ? @{$_} : $_ }
grep defined,
delete(
@@ -414,8 +376,6 @@
def_file implib map_file) } )
);
- close SCRIPT;
-
push @{$spec{lddlflags}}, '@"' . $script . '"';
return %spec;
@@ -459,7 +419,7 @@
print "Generating script '$script'\n" if !$self->{quiet};
- open( SCRIPT, ">$script" )
+ my $SCRIPT = IO::File->new( ">$script" )
or die( "Could not create script '$script': $!" );
# XXX Borland "response files" seem to be unable to accept macro
@@ -467,15 +427,13 @@
# backslash doesn't work, and any level of quotes are stripped. The
# result is is a floating point number in the source file where a
# string is expected. So we leave the macros on the command line.
- print SCRIPT join( "\n",
+ print $SCRIPT join( "\n",
map { ref $_ ? @{$_} : $_ }
grep defined,
delete(
@spec{ qw(includes cflags optimize perlinc) } )
);
- close SCRIPT;
-
push @{$spec{includes}}, '@"' . $script . '"';
return %spec;
@@ -525,29 +483,25 @@
print "Generating scripts '$ld_script' and '$ld_libs'.\n" if !$self->{quiet};
# Script 1: contains options & names of object files.
- open( LD_SCRIPT, ">$ld_script" )
+ my $LD_SCRIPT = IO::File->new( ">$ld_script" )
or die( "Could not create linker script '$ld_script': $!" );
- print LD_SCRIPT join( " +\n",
+ print $LD_SCRIPT join( " +\n",
map { @{$_} }
grep defined,
delete(
@spec{ qw(lddlflags libpath other_ldflags startup objects) } )
);
- close LD_SCRIPT;
-
# Script 2: contains name of libs to link against.
- open( LD_LIBS, ">$ld_libs" )
+ my $LD_LIBS = IO::File->new( ">$ld_libs" )
or die( "Could not create linker script '$ld_libs': $!" );
- print LD_LIBS join( " +\n",
+ print $LD_LIBS join( " +\n",
(delete $spec{libperl} || ''),
@{delete $spec{perllibs} || []},
);
- close LD_LIBS;
-
push @{$spec{lddlflags}}, '@"' . $ld_script . '"';
push @{$spec{perllibs}}, '@"' . $ld_libs . '"';
@@ -669,32 +623,30 @@
print "Generating script '$script'\n" if !$self->{quiet};
- open( SCRIPT, ">$script" )
+ my $SCRIPT = IO::File->new( ">$script" )
or die( "Could not create script '$script': $!" );
- print( SCRIPT 'SEARCH_DIR(' . $_ . ")\n" )
+ print $SCRIPT ( 'SEARCH_DIR(' . $_ . ")\n" )
for @{delete $spec{libpath} || []};
# gcc takes only one startup file, so the first object in startup is
# specified as the startup file and any others are shifted into the
# beginning of the list of objects.
if ( $spec{startup} && @{$spec{startup}} ) {
- print SCRIPT 'STARTUP(' . shift( @{$spec{startup}} ) . ")\n";
+ print $SCRIPT 'STARTUP(' . shift( @{$spec{startup}} ) . ")\n";
unshift @{$spec{objects}},
@{delete $spec{startup} || []};
}
- print SCRIPT 'INPUT(' . join( ',',
+ print $SCRIPT 'INPUT(' . join( ',',
@{delete $spec{objects} || []}
) . ")\n";
- print SCRIPT 'INPUT(' . join( ' ',
+ print $SCRIPT 'INPUT(' . join( ' ',
(delete $spec{libperl} || ''),
@{delete $spec{perllibs} || []},
) . ")\n";
- close SCRIPT;
-
push @{$spec{other_ldflags}}, '"' . $script . '"';
return %spec;
diff -urN perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/aix.pm perl-5.10.0/lib/ExtUtils/CBuilder/Platform/aix.pm
--- perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/aix.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/ExtUtils/CBuilder/Platform/aix.pm 2009-03-11 20:12:36.000000000 +0100
@@ -5,7 +5,7 @@
use File::Spec;
use vars qw($VERSION @ISA);
-$VERSION = '0.21';
+$VERSION = '0.24';
@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
sub need_prelink { 1 }
diff -urN perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/cygwin.pm perl-5.10.0/lib/ExtUtils/CBuilder/Platform/cygwin.pm
--- perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/cygwin.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/ExtUtils/CBuilder/Platform/cygwin.pm 2009-03-11 20:12:36.000000000 +0100
@@ -5,7 +5,7 @@
use ExtUtils::CBuilder::Platform::Unix;
use vars qw($VERSION @ISA);
-$VERSION = '0.21';
+$VERSION = '0.24';
@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
sub link_executable {
diff -urN perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/darwin.pm perl-5.10.0/lib/ExtUtils/CBuilder/Platform/darwin.pm
--- perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/darwin.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/ExtUtils/CBuilder/Platform/darwin.pm 2009-03-11 20:12:36.000000000 +0100
@@ -4,7 +4,7 @@
use ExtUtils::CBuilder::Platform::Unix;
use vars qw($VERSION @ISA);
-$VERSION = '0.21';
+$VERSION = '0.24';
@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
sub compile {
diff -urN perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/dec_osf.pm perl-5.10.0/lib/ExtUtils/CBuilder/Platform/dec_osf.pm
--- perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/dec_osf.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/ExtUtils/CBuilder/Platform/dec_osf.pm 2009-03-11 20:12:36.000000000 +0100
@@ -6,7 +6,7 @@
use vars qw($VERSION @ISA);
@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
-$VERSION = '0.21';
+$VERSION = '0.24';
sub link_executable {
my $self = shift;
diff -urN perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/os2.pm perl-5.10.0/lib/ExtUtils/CBuilder/Platform/os2.pm
--- perl-5.10.0.orig/lib/ExtUtils/CBuilder/Platform/os2.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/ExtUtils/CBuilder/Platform/os2.pm 2009-03-11 20:12:36.000000000 +0100
@@ -4,7 +4,7 @@
use ExtUtils::CBuilder::Platform::Unix;
use vars qw($VERSION @ISA);
-$VERSION = '0.21';
+$VERSION = '0.24';
@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
sub need_prelink { 1 }
diff -urN perl-5.10.0.orig/lib/ExtUtils/CBuilder/t/01-basic.t perl-5.10.0/lib/ExtUtils/CBuilder/t/01-basic.t
--- perl-5.10.0.orig/lib/ExtUtils/CBuilder/t/01-basic.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/ExtUtils/CBuilder/t/01-basic.t 2009-03-11 20:08:15.000000000 +0100
@@ -53,6 +53,16 @@
}
my @words = $b->split_like_shell(' foo bar');
-ok @words, 2;
-ok $words[0], 'foo';
-ok $words[1], 'bar';
+
+skip(
+ $^O =~ m/MSWin/ ? "Skip under MSWindows" : 0, # whether to skip
+ @words, 2
+ );
+skip(
+ $^O =~ m/MSWin/ ? "Skip under MSWindows" : 0, # whether to skip
+ $words[0], 'foo'
+);
+skip(
+ $^O =~ m/MSWin/ ? "Skip under MSWindows" : 0, # whether to skip
+ $words[1], 'bar'
+);
diff -urN perl-5.10.0.orig/lib/ExtUtils/CBuilder.pm perl-5.10.0/lib/ExtUtils/CBuilder.pm
--- perl-5.10.0.orig/lib/ExtUtils/CBuilder.pm 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/ExtUtils/CBuilder.pm 2009-03-11 20:12:36.000000000 +0100
@@ -5,7 +5,7 @@
use File::Basename ();
use vars qw($VERSION @ISA);
-$VERSION = '0.21';
+$VERSION = '0.24';
$VERSION = eval $VERSION;
# Okay, this is the brute-force method of finding out what kind of
@@ -36,6 +36,8 @@
sunos Unix
cygwin Unix
os2 Unix
+ gnu Unix
+ gnukfreebsd Unix
dos Windows
MSWin32 Windows

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

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

1215
perl-update-File-Path.patch Normal file
View File

File diff suppressed because it is too large Load Diff

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

File diff suppressed because it is too large Load Diff

1893
perl-5.10.0-IPC_Cmd-0.42.patch → perl-update-IPC-Cmd.patch
View File

File diff suppressed because it is too large Load Diff

5715
perl-update-Module-Build.patch Normal file
View File

File diff suppressed because it is too large Load Diff

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

@ -0,0 +1,788 @@
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 Normal file
View File

@ -0,0 +1,178 @@
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;

1998
perl-5.10.0-PodSimple.patch → perl-update-Pod-Simple.patch
View File

File diff suppressed because it is too large Load Diff

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

@ -0,0 +1,965 @@
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" );

39882
perl-5.10.0-TestHarness3.12.patch → perl-update-Test-Harness.patch
View File

File diff suppressed because it is too large Load Diff

6236
perl-update-Test-Simple.patch Normal file
View File

File diff suppressed because it is too large Load Diff

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

@ -0,0 +1,686 @@
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";
}

115
perl-update-constant.patch Normal file
View File

@ -0,0 +1,115 @@
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 \(\)/,

275
perl.spec
View File

@ -7,7 +7,7 @@
Name: perl
Version: %{perl_version}
Release: 59%{?dist}
Release: 60%{?dist}
Epoch: %{perl_epoch}
Summary: Practical Extraction and Report Language
Group: Development/Languages
@ -16,20 +16,15 @@ Group: Development/Languages
License: (GPL+ or Artistic) and (GPLv2+ or Artistic)
Url: http://www.perl.org/
Source0: http://search.cpan.org/CPAN/authors/id/R/RG/RGARCIA/perl-%{perl_version}.tar.gz
Source1: Tar-Archive.tar.gz
# tgz which help testing module IPC::Cmd
Source2: x.tgz
Source11: filter-requires.sh
Source12: perl-5.8.0-libnet.cfg
# Specific to Fedora/RHEL
Patch1: perl-5.8.0-root.patch
# Removes date check, Fedora/RHEL specific
Patch2: perl-5.10.0-perlbug-tag.patch
# Fedora/RHEL use links instead of lynx
Patch3: perl-5.10.0-links.patch
# work around annoying rpath issue
# This is only relevant for Fedora, as it is unlikely
# that upstream will assume the existence of a libperl.so
@ -42,15 +37,14 @@ Patch5: perl-5.8.0-libdir64.patch
Patch6: perl-5.10.0-libresolv.patch
# FIXME: May need the "Fedora" references removed before upstreaming
# patches ExtUtils-MakeMaker
Patch7: perl-5.10.0-USE_MM_LD_RUN_PATH.patch
# Skip hostname tests, since hostname lookup isn't available in Fedora
# buildroots by design.
# patches Net::Config from libnet
Patch8: perl-5.10.0-disable_test_hosts.patch
# Bump Sys::Syslog to 0.24 to fix test failure case
Patch9: perl-5.10.0-SysSyslog-0.24.patch
# The Fedora builders started randomly failing this futime test
# only on x86_64, so we just don't run it. Works fine on normal
# systems.
@ -59,53 +53,22 @@ Patch10: perl-5.10.0-x86_64-io-test-failure.patch
# http://public.activestate.com/cgi-bin/perlbrowse/p/32891
Patch11: 32891.patch
# Update Module::Load::Conditional to 0.24 for clean upgrade
Patch12: perl-5.10.0-Module-Load-Conditional-0.24.patch
# Upgrade Module::CoreList to 2.14
Patch13: perl-5.10.0-Module-CoreList2.14.patch
# Upgrade CGI to 3.38
Patch14: perl-5.10.0-CGI-3.38.patch
# Problem with assertion - add upstream patch
Patch15: perl-5.10.0-bz448392.patch
# Wrong access test
Patch16: perl-5.10.0-accessXOK.patch
# CVE-2008-2827 perl: insecure use of chmod in rmtree
Patch17: perl-5.10.0-CVE-2008-2827.patch
# Upgrade Test::Harness
# first remove old files
Patch18: perl-5.10.0-removeTestHarness.patch
# now include new files perl-5.10.0-TestHarness3.12.patch
Patch19: perl-5.10.0-TestHarness3.12.patch
# pos function handle unicode ok
# fix function pos to handle unicode correctly
Patch20: perl-5.10.0-pos.patch
# 457085 CGI.pm bug in exists() on tied param hash
Patch21: perl-5.10.0-CGI.patch
# 462444 update Test::Simple to 0.80
Patch22: perl-5.10.0-TestSimple0.80.patch
# Archive::Tar update to 1.38 version
Patch23: perl-5.10.0-ArchiveTar1.38.patch
# Storable segfaults when objects are reblessed rt#33242
# patches module Storable
Patch24: perl-5.10.0-Storable.patch
# Pod::Simple 3.07
Patch25: perl-5.10.0-PodSimple.patch
# Fix crash when localizing a symtab entry rt#52740
Patch26: perl-5.10.0-stlocal.patch
# File::Temp 0.20
Patch27: perl-5.10.0-File-Temp-0.20.patch
# Change 33640: More diagnostics for Fatal.pm, version bumps for all non-dual life modules affected
# http://www.nntp.perl.org/group/perl.perl5.changes/2008/04/msg21478.html
Patch28: perl-5.10.0-Change33640.patch
@ -124,11 +87,52 @@ Patch30: perl-5.10.0-Change33896.patch
# http://www.nntp.perl.org/group/perl.perl5.changes/2008/05/msg21733.html
Patch31: perl-5.10.0-Change33897.patch
Patch32: perl-5.10.0-ArchiveTar1.40.patch
Patch33: perl-5.10.0-PerlIO-via-change34025.patch
Patch34: perl-5.10.0-IPC_Cmd-0.42.patch
BuildRoot: %{_tmppath}/%{name}-%{perl_version}-%{release}-root-%(%{__id_u} -n)
# Update some of the bundled modules
# see http://fedoraproject.org/wiki/Perl/perl.spec for instructions
Patch100: perl-update-constant.patch
%define constant_version 1.17
Patch101: perl-update-Archive-Extract.patch
%define Archive_Extract_version 0.30
Patch102: perl-update-Archive-Tar.patch
%define Archive_Tar_version 1.46
Patch103: perl-update-CGI.patch
%define CGI_version 3.42
Patch104: perl-update-ExtUtils-CBuilder.patch
%define ExtUtils-CBuilder_version 0.24
Patch105: perl-update-File-Fetch.patch
%define File_Fetch_version 0.18
Patch106: perl-update-File-Path.patch
%define File_Path_version 2.07
Patch107: perl-update-File-Temp.patch
%define File_Temp_version 0.21
Patch108: perl-update-IPC-Cmd.patch
%define IPC_Cmd_version 0.42
Patch109: perl-update-Module-Build.patch
%define Module_Build_real_version 0.32
# For Module-Build-0.x, the second component has to have four digits.
%define Module_Build_rpm_version 0.3200
Patch110: perl-update-Module-CoreList.patch
%define Module_CoreList_version 2.17
Patch111: perl-update-Module-Load-Conditional.patch
%define Module_Load_Conditional_version 0.30
Patch112: perl-update-Pod-Simple.patch
%define Pod_Simple_version 3.07
Patch113: perl-update-Sys-Syslog.patch
%define Sys_Syslog_version 0.27
Patch114: perl-update-Test-Harness.patch
%define Test_Harness_version 3.16
Patch115: perl-update-Test-Simple.patch
%define Test_Simple_version 0.86
Patch116: perl-update-Time-HiRes.patch
%define Time_HiRes_version 1.9719
# Fedora uses links instead of lynx
# patches File-Fetch and CPAN
Patch201: perl-5.10.0-links.patch
BuildRoot: %(mktemp -ud %{_tmppath}/%{name}-%{version}-%{release}-XXXXXX)
BuildRequires: tcsh, dos2unix, man, groff
BuildRequires: gdbm-devel, db4-devel, zlib-devel
# For tests
@ -190,11 +194,11 @@ Provides: perl(validate.pl)
Provides: perl(Carp::Heavy)
# Long history in 3rd-party repositories:
Provides: perl-File-Temp = 0.20
Provides: perl-File-Temp = %{File_Temp_version}
Obsoletes: perl-File-Temp < 0.20
# Use new testing module perl-Test-Harness, obsolete it outside of this package
Provides: perl-TAP-Harness = 3.10
Provides: perl-TAP-Harness = %{Test_Harness_version}
Obsoletes: perl-TAP-Harness < 3.10
Requires: perl-libs = %{perl_epoch}:%{perl_version}-%{release}
@ -269,7 +273,7 @@ Group: Development/Libraries
License: GPL+ or Artistic
# Epoch bump for clean upgrade over old standalone package
Epoch: 1
Version: 0.24
Version: %{Archive_Extract_version}
Requires: perl = %{perl_epoch}:%{perl_version}-%{release}
%description Archive-Extract
@ -281,7 +285,7 @@ Summary: A module for Perl manipulation of .tar files
Group: Development/Libraries
License: GPL+ or Artistic
Epoch: 0
Version: 1.40
Version: %{Archive_Tar_version}
Requires: perl = %{perl_epoch}:%{perl_version}-%{release}
Requires: perl(Compress::Zlib), perl(IO::Zlib)
@ -376,7 +380,7 @@ Group: Development/Libraries
License: GPL+ or Artistic
# Epoch bump for clean upgrade over old standalone package
Epoch: 1
Version: 0.21
Version: %{ExtUtils_CBuilder_version}
Requires: perl-devel
Requires: perl = %{perl_epoch}:%{perl_version}-%{release}
@ -437,7 +441,7 @@ Summary: Generic file fetching mechanism
Group: Development/Libraries
License: GPL+ or Artistic
Epoch: 0
Version: 0.14
Version: %{File_Fetch_version}
Requires: perl(IPC::Cmd) >= 0.36
Requires: perl(Module::Load::Conditional) >= 0.04
Requires: perl(Params::Check) >= 0.07
@ -499,7 +503,7 @@ License: GPL+ or Artistic
# Epoch bump for clean upgrade over old standalone package
Epoch: 1
# do not upgrade in the future to _something version. They are testing!
Version: 0.42
Version: %{IPC_Cmd_version}
Requires: perl = %{perl_epoch}:%{perl_version}-%{release}
%description IPC-Cmd
@ -560,8 +564,7 @@ Group: Development/Libraries
License: GPL+ or Artistic
# Epoch bump for clean upgrade over old standalone package
Epoch: 1
# Really 0.2808_01, but we drop the _01.
Version: 0.2808
Version: %{Module_Build_rpm_version}
Requires: perl(Archive::Tar) >= 1.08
Requires: perl(ExtUtils::CBuilder) >= 0.15
Requires: perl(ExtUtils::ParseXS) >= 1.02
@ -584,7 +587,7 @@ Summary: Perl core modules indexed by perl versions
Group: Development/Languages
License: GPL+ or Artistic
Epoch: 0
Version: 2.15
Version: %{Module_CoreList_version}
Requires: perl = %{perl_epoch}:%{perl_version}-%{release}
Requires: perl(version)
@ -613,7 +616,7 @@ Summary: Looking up module information / loading at runtime
Group: Development/Libraries
License: GPL+ or Artistic
Epoch: 0
Version: 0.24
Version: %{Module_Load_Conditional_version}
Requires: perl = %{perl_epoch}:%{perl_version}-%{release}
%description Module-Load-Conditional
@ -718,7 +721,7 @@ Group: Development/Libraries
License: GPL+ or Artistic
# Epoch bump for clean upgrade over old standalone package
Epoch: 1
Version: 3.07
Version: %{Pod_Simple_version}
Requires: perl = %{perl_epoch}:%{perl_version}-%{release}
%description Pod-Simple
@ -747,7 +750,7 @@ Summary: Run Perl standard test scripts with statistics
Group: Development/Languages
License: GPL+ or Artistic
Epoch: 0
Version: 3.12
Version: %{Test_Harness_version}
Requires: perl-devel
Requires: perl = %{perl_epoch}:%{perl_version}-%{release}
@ -760,7 +763,7 @@ Summary: Basic utilities for writing tests
Group: Development/Languages
License: GPL+ or Artistic
Epoch: 0
Version: 0.80
Version: %{Test_Simple_version}
Requires: perl-devel
Requires: perl = %{perl_epoch}:%{perl_version}-%{release}
@ -828,10 +831,9 @@ upstream tarball from perl.org.
%prep
%setup -q -a 1
%setup -q
%patch1 -p1
%patch2 -p1
%patch3 -p1
# This patch breaks sparc64 compilation
# We should probably consider removing it for all arches.
%ifnarch sparc64
@ -843,32 +845,36 @@ upstream tarball from perl.org.
%patch6 -p1
%patch7 -p1
%patch8 -p1
%patch9 -p1
%patch10 -p1
%patch11 -p1
%patch12 -p1
%patch13 -p1
%patch14 -p1
%patch15 -p1
%patch16 -p1
%patch17 -p1
%patch18 -p1
%patch19 -p1
%patch20 -p1
%patch21 -p1
%patch22 -p1
%patch23 -p1
%patch24 -p1
%patch25 -p1
%patch26 -p1
%patch27 -p1
%patch28 -p1
%patch29 -p1
%patch30 -p1
%patch31 -p1
%patch32 -p1
%patch33 -p1
%patch34 -p1
%patch100 -p1
%patch101 -p1
%patch102 -p1
%patch103 -p1
%patch104 -p1
%patch105 -p1
%patch106 -p1
%patch107 -p1
%patch108 -p1
%patch109 -p1
%patch110 -p1
%patch111 -p1
%patch112 -p1
%patch113 -p1
%patch114 -p1
%patch115 -p1
%patch116 -p1
%patch201 -p1
#
# Candidates for doc recoding (need case by case review):
@ -972,11 +978,7 @@ echo "RPM Build arch: %{_arch}"
-Ud_endprotoent_r_proto -Ud_setprotoent_r_proto \
-Ud_endservent_r_proto -Ud_setservent_r_proto \
-Dscriptdir='%{_bindir}' \
%ifarch x86_64 ppc64 sparc64
-Dotherlibdirs=/usr/local/lib/perl5/site_perl:/usr/local/%{_lib}/perl5/site_perl:/usr/lib/perl5/site_perl \
%else
-Dotherlibdirs=/usr/local/lib/perl5/site_perl:/usr/lib/perl5/site_perl
%endif
-Dotherlibdirs=/usr/lib/perl5/site_perl
%ifarch sparc64
make
@ -1025,7 +1027,6 @@ done
#
# libnet configuration file
#
mkdir -p -m 755 %{comp_perl_lib}/Net
install -p -m 644 %{SOURCE12} %{comp_perl_lib}/Net/libnet.cfg
#
@ -1070,51 +1071,61 @@ chmod -R u+w $RPM_BUILD_ROOT/*
# Local patch tracking
cd $RPM_BUILD_ROOT%{_libdir}/perl5/%{perl_version}/%{perl_archname}/CORE/
perl -x patchlevel.h 'Fedora Patch1: Permit suidperl to install as nonroot'
perl -x patchlevel.h 'Fedora Patch2: Removes date check, Fedora/RHEL specific'
perl -x patchlevel.h 'Fedora Patch3: Fedora/RHEL use links instead of lynx'
%ifnarch sparc64
perl -x patchlevel.h 'Fedora Patch4: Work around annoying rpath issue'
%endif
%ifarch %{multilib_64_archs}
perl -x patchlevel.h 'Fedora Patch5: support for libdir64'
%endif
perl -x patchlevel.h 'Fedora Patch6: use libresolv instead of libbind'
perl -x patchlevel.h 'Fedora Patch7: USE_MM_LD_RUN_PATH'
perl -x patchlevel.h 'Fedora Patch8: Skip hostname tests, due to builders not being network capable'
perl -x patchlevel.h 'Fedora Patch9: Update Sys::Syslog to 0.24'
perl -x patchlevel.h 'Fedora Patch10: Dont run one io test due to random builder failures'
perl -x patchlevel.h '32891 fix big slowdown in 5.10 @_ parameter passing'
perl -x patchlevel.h 'Fedora Patch12: Update Module::Load::Conditional to 0.24'
perl -x patchlevel.h 'Fedora Patch13: Upgrade Module::CoreList to 2.14'
perl -x patchlevel.h 'Fedora Patch14: Upgrade CGI to 3.38'
perl -x patchlevel.h 'Fedora Patch15: Adopt upstream commit for assertion'
perl -x patchlevel.h 'Fedora Patch16: Access permission - rt49003'
perl -x patchlevel.h 'Fedora Patch17: CVE-2008-2827 perl: insecure use of chmod in rmtree'
perl -x patchlevel.h 'Fedora Patch18: Remove old Test::Harness'
perl -x patchlevel.h 'Fedora Patch19: Update Test::Harness to 3.12'
perl -x patchlevel.h 'Fedora Patch20: pos function handle unicode correct'
perl -x patchlevel.h 'Fedora Patch21: CGI.pm bug in exists() on tied param hash'
perl -x patchlevel.h 'Fedora Patch22: Update Test::Simple to 0.80'
perl -x patchlevel.h 'Fedora Patch23: Update Archive::Tar 1.38'
perl -x patchlevel.h 'Fedora Patch24: Storable fix'
perl -x patchlevel.h 'Fedora Patch25: Update to Pod::Simple 3.07'
perl -x patchlevel.h 'Fedora Patch26: Fix crash when localizing a symtab entry - rt52740'
perl -x patchlevel.h 'Fedora Patch27: Update to File::Temp 0.20'
perl -x patchlevel.h '33640 Integrate Changes 33399, 33621, 33622, 33623, 33624'
perl -x patchlevel.h '33881 Integrate Changes 33825, 33826, 33829'
perl -x patchlevel.h '33896 Eliminate POSIX::int_macro_int, and all the complex AUTOLOAD fandango'
perl -x patchlevel.h '33897 Replaced the WEXITSTATUS, WIFEXITED, WIFSIGNALED, WIFSTOPPED, WSTOPSIG'
perl -x patchlevel.h 'Fedora Patch32: CVE-2007-4829 Update Archive::Tar to 1.40'
perl -x patchlevel.h '54934 Change 34025 refcount of the globs generated by PerlIO::via balanced'
perl -x patchlevel.h 'Fedora Patch34: Update to IPC::Cmd 0.42'
perl -x patchlevel.h \
'Fedora Patch1: Permit suidperl to install as nonroot' \
'Fedora Patch2: Removes date check, Fedora/RHEL specific' \
%ifnarch sparc64 \
'Fedora Patch4: Work around annoying rpath issue' \
%endif \
%ifarch %{multilib_64_archs} \
'Fedora Patch5: support for libdir64' \
%endif \
'Fedora Patch6: use libresolv instead of libbind' \
'Fedora Patch7: USE_MM_LD_RUN_PATH' \
'Fedora Patch8: Skip hostname tests, due to builders not being network capable' \
'Fedora Patch10: Dont run one io test due to random builder failures' \
'32891 fix big slowdown in 5.10 @_ parameter passing' \
'Fedora Patch15: Adopt upstream commit for assertion' \
'Fedora Patch16: Access permission - rt49003' \
'Fedora Patch20: pos function handle unicode correct' \
'Fedora Patch24: Storable fix' \
'Fedora Patch26: Fix crash when localizing a symtab entry - rt52740' \
'33640 Integrate Changes 33399, 33621, 33622, 33623, 33624' \
'33881 Integrate Changes 33825, 33826, 33829' \
'33896 Eliminate POSIX::int_macro_int, and all the complex AUTOLOAD fandango' \
'33897 Replaced the WEXITSTATUS, WIFEXITED, WIFSIGNALED, WIFSTOPPED, WSTOPSIG' \
'54934 Change 34025 refcount of the globs generated by PerlIO::via balanced' \
'Fedora Patch100: Update constant to %{constant_version}' \
'Fedora Patch101: Update Archive::Extract to %{Archive_Extract_version}' \
'Fedora Patch102: Update Archive::Tar to %{Archive_Tar_version}' \
'Fedora Patch103: Update CGI to %{CGI_version}' \
'Fedora Patch104: Update ExtUtils::CBuilder to %{ExtUtils_CBuilder_version}' \
'Fedora Patch105: Update File::Fetch to %{File_Fetch_version}' \
'Fedora Patch106: Update File::Path to %{File_Path_version}' \
'Fedora Patch107: Update File::Temp to %{File_Temp_version}' \
'Fedora Patch108: Update IPC::Cmd to %{IPC_Cmd_version}' \
'Fedora Patch109: Update Module::Build to %{Module_Build_version}' \
'Fedora Patch110: Update Module::CoreList to %{Module_CoreList_version}' \
'Fedora Patch111: Update Module::Load::Conditional to %{Module_Load_Conditional_version}' \
'Fedora Patch112: Update Pod::Simple to %{Pod_Simple_version}' \
'Fedora Patch113: Update Sys::Syslog to %{Sys_Syslog_version}' \
'Fedora Patch114: Update Test::Harness to %{Test_Harness_version}' \
'Fedora Patch115: Update Test::Simple to %{Test_Simple_version}' \
'Fedora Patch116: Update Time::HiRes to %{Time_HiRes_version}' \
'Fedora Patch201: Fedora uses links instead of lynx' \
%{nil}
rm patchlevel.bak
%clean
rm -rf $RPM_BUILD_ROOT
%check
%ifnarch sparc64
make test
# work around a bug in Module::Build tests bu setting TMPDIR to a directory
# inside the source tree
mkdir "$PWD/tmp"
TMPDIR="$PWD/tmp" make test
%endif
%post libs -p /sbin/ldconfig
@ -1375,8 +1386,12 @@ make test
# Test::Harness
%exclude %{_bindir}/prove
%exclude %{_prefix}/lib/perl5/%{perl_version}/App*
%exclude %{_prefix}/lib/perl5/%{perl_version}/TAP*
%exclude %{_prefix}/lib/perl5/%{perl_version}/Test/Harness*
%exclude %{_mandir}/man1/prove.1*
%exclude %{_mandir}/man3/App*
%exclude %{_mandir}/man3/TAP*
%exclude %{_mandir}/man3/Test::Harness*
# Test::Simple
@ -1681,8 +1696,12 @@ make test
%files Test-Harness
%defattr(-,root,root,-)
%{_bindir}/prove
%{_prefix}/lib/perl5/%{perl_version}/App*
%{_prefix}/lib/perl5/%{perl_version}/TAP*
%{_prefix}/lib/perl5/%{perl_version}/Test/Harness*
%{_mandir}/man1/prove.1*
%{_mandir}/man3/App*
%{_mandir}/man3/TAP*
%{_mandir}/man3/Test::Harness*
%files Test-Simple
@ -1715,6 +1734,20 @@ make test
# Old changelog entries are preserved in CVS.
%changelog
* Tue Mar 11 2009 Stepan Kasal <skasal@redhat.com> - 4:5.10.0-60
- remove compatibility obsolete sitelib directories
- use a better BuildRoot
- drop a redundant mkdir in %%install
- call patchlevel.h only once; rm patchlevel.bak
- update modules Sys::Syslog, Module::Load::Conditional, Module::CoreList,
Test::Harness, Test::Simple, CGI.pm (dropping the upstreamed patch),
File::Path (that includes our perl-5.10.0-CVE-2008-2827.patch),
constant, Pod::Simple, Archive::Tar, Archive::Extract, File::Fetch,
File::Temp, IPC::Cmd, Time::HiRes, Module::Build, ExtUtils::CBuilder
- standardize the patches for updating embedded modules
- work around a bug in Module::Build tests bu setting TMPDIR to a directory
inside the source tree
* Sun Mar 08 2009 Robert Scheck <robert@fedoraproject.org> - 4:5.10.0-59
- Rebuilt for https://fedoraproject.org/wiki/Fedora_11_Mass_Rebuild

2
sources
View File

@ -1,3 +1 @@
d2c39b002ebfd2c3c5dba589365c5a71 perl-5.10.0.tar.gz
20fc625176668dd02a8b07ef0acd451d Tar-Archive.tar.gz
62965ff8dacdd3855fcb801ebe336332 x.tgz