rpms/perl/F-10 perl-5.10.0-fix_file_path_rmtree_setuid.patch, NONE, 1.1 perl-update-Archive-Extract.patch, NONE, 1.1 perl-update-Archive-Tar.patch, NONE, 1.1 perl-update-CGI.patch, NONE, 1.1 perl-update-ExtUtils-CBuilder.patch, NONE, 1.1 perl-update-File-Fetch.patch, NONE, 1.1 perl-update-File-Path.patch, NONE, 1.1 perl-update-File-Temp.patch, NONE, 1.1 perl-update-IPC-Cmd.patch, NONE, 1.1 perl-update-Module-Build.patch, NONE, 1.1 perl-update-Module-CoreList.patch, NONE, 1.1 perl-update-Module-Load-Conditional.patch, NONE, 1.1 perl-update-Pod-Simple.patch, NONE, 1.1 perl-update-Sys-Syslog.patch, NONE, 1.1 perl-update-Test-Harness.patch, NONE, 1.1 perl-update-Test-Simple.patch, NONE, 1.1 perl-update-Time-HiRes.patch, NONE, 1.1 perl-update-constant.patch, NONE, 1.1 .cvsignore, 1.16, 1.17 perl-5.10.0-Change33640.patch, 1.1, 1.2 perl-5.10.0-links.patch, 1.1, 1.2 perl.spec, 1.205, 1.206 sources, 1.16, 1.17 perl-5.10.0-ArchiveTar1.38.patch, 1.1, NONE perl-5.10.0-ArchiveTar1.40.patch, 1.1, NONE perl-5.10.0-CGI-3.38.patch, 1.1, NONE perl-5.10.0-CGI.patch, 1.1, NONE perl-5.10.0-CVE-2008-2827.patch, 1.1, NONE perl-5.10.0-File-Temp-0.20.patch, 1.1, NONE perl-5.10.0-Module-CoreList2.14.patch, 1.1, NONE perl-5.10.0-Module-Load-Conditional-0.24.patch, 1.1, NONE perl-5.10.0-PodSimple.patch, 1.2, NONE perl-5.10.0-SysSyslog-0.24.patch, 1.1, NONE perl-5.10.0-TestHarness3.12.patch, 1.1, NONE perl-5.10.0-TestSimple0.80.patch, 1.1, NONE perl-5.10.0-removeTestHarness.patch, 1.1, NONE perl-5.8.6-libresolv.patch, 1.1, NONE perl-5.8.8-links.patch, 1.3, NONE

Štěpán Kasal kasal at fedoraproject.org
Mon Mar 23 10:31:07 UTC 2009


Author: kasal

Update of /cvs/extras/rpms/perl/F-10
In directory cvs1.fedora.phx.redhat.com:/tmp/cvs-serv22391

Modified Files:
	.cvsignore perl-5.10.0-Change33640.patch 
	perl-5.10.0-links.patch perl.spec sources 
Added Files:
	perl-5.10.0-fix_file_path_rmtree_setuid.patch 
	perl-update-Archive-Extract.patch 
	perl-update-Archive-Tar.patch perl-update-CGI.patch 
	perl-update-ExtUtils-CBuilder.patch 
	perl-update-File-Fetch.patch perl-update-File-Path.patch 
	perl-update-File-Temp.patch perl-update-IPC-Cmd.patch 
	perl-update-Module-Build.patch 
	perl-update-Module-CoreList.patch 
	perl-update-Module-Load-Conditional.patch 
	perl-update-Pod-Simple.patch perl-update-Sys-Syslog.patch 
	perl-update-Test-Harness.patch perl-update-Test-Simple.patch 
	perl-update-Time-HiRes.patch perl-update-constant.patch 
Removed Files:
	perl-5.10.0-ArchiveTar1.38.patch 
	perl-5.10.0-ArchiveTar1.40.patch perl-5.10.0-CGI-3.38.patch 
	perl-5.10.0-CGI.patch perl-5.10.0-CVE-2008-2827.patch 
	perl-5.10.0-File-Temp-0.20.patch 
	perl-5.10.0-Module-CoreList2.14.patch 
	perl-5.10.0-Module-Load-Conditional-0.24.patch 
	perl-5.10.0-PodSimple.patch perl-5.10.0-SysSyslog-0.24.patch 
	perl-5.10.0-TestHarness3.12.patch 
	perl-5.10.0-TestSimple0.80.patch 
	perl-5.10.0-removeTestHarness.patch perl-5.8.6-libresolv.patch 
	perl-5.8.8-links.patch 
Log Message:
sync with rawhide

perl-5.10.0-fix_file_path_rmtree_setuid.patch:

--- NEW FILE perl-5.10.0-fix_file_path_rmtree_setuid.patch ---
diff -up perl-5.10.0/lib/File/Path.pm.BAD perl-5.10.0/lib/File/Path.pm
--- perl-5.10.0/lib/File/Path.pm.BAD	2009-03-11 17:54:57.000000000 -0400
+++ perl-5.10.0/lib/File/Path.pm	2009-03-11 17:55:32.000000000 -0400
@@ -333,7 +333,7 @@ sub _rmtree {
                 }
                 else {
                     _error($arg, "cannot remove directory", $canon);
-                    if (!chmod($perm, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
+                    if ($Force_Writeable && !chmod($perm, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
                     ) {
                         _error($arg, sprintf("cannot restore permissions to 0%o",$perm), $canon);
                     }

perl-update-Archive-Extract.patch:

--- NEW FILE perl-update-Archive-Extract.patch ---
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

perl-update-Archive-Tar.patch:

--- NEW FILE perl-update-Archive-Tar.patch ---
Archive-Tar-1.46

diff -urN perl-5.10.0.orig/MANIFEST perl-5.10.0/MANIFEST
--- perl-5.10.0.orig/MANIFEST	2009-02-20 18:22:32.000000000 +0100
+++ perl-5.10.0/MANIFEST	2009-03-11 17:11:27.000000000 +0100
@@ -1413,12 +1413,19 @@
 lib/Archive/Tar/t/02_methods.t	Archive::Tar tests
 lib/Archive/Tar/t/03_file.t	Archive::Tar tests
 lib/Archive/Tar/t/04_resolved_issues.t	Archive::Tar tests
+lib/Archive/Tar/t/05_iter.t	Archive::Tar tests
+lib/Archive/Tar/t/90_symlink.t	Archive::Tar tests
+lib/Archive/Tar/t/src/linktest/linktest_missing_dir.tar.packed	Archive::Tar tests
+lib/Archive/Tar/t/src/linktest/linktest_with_dir.tar.packed	Archive::Tar tests
 lib/Archive/Tar/t/src/long/b	Archive::Tar tests
 lib/Archive/Tar/t/src/long/bar.tar.packed	Archive::Tar tests
+lib/Archive/Tar/t/src/long/foo.tbz.packed	Archive::Tar tests
 lib/Archive/Tar/t/src/long/foo.tgz.packed	Archive::Tar tests
 lib/Archive/Tar/t/src/short/b	Archive::Tar tests
 lib/Archive/Tar/t/src/short/bar.tar.packed	Archive::Tar tests
+lib/Archive/Tar/t/src/short/foo.tbz.packed	Archive::Tar tests
 lib/Archive/Tar/t/src/short/foo.tgz.packed	Archive::Tar tests
+lib/Archive/Tar/t/src/header/signed.tar.packed	Archive::Tar tests
 lib/assert.pl			assertion and panic with stack trace
 lib/Attribute/Handlers/Changes	Attribute::Handlers
 lib/Attribute/Handlers/demo/demo2.pl	Attribute::Handlers demo
diff -urN perl-5.10.0.orig/lib/Archive/Tar/Constant.pm perl-5.10.0/lib/Archive/Tar/Constant.pm
--- perl-5.10.0.orig/lib/Archive/Tar/Constant.pm	2009-02-20 11:21:14.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/Constant.pm	2009-03-11 17:11:27.000000000 +0100
@@ -2,20 +2,16 @@
 
 BEGIN {
     require Exporter;
-    $VERSION= '0.02';
-    @ISA    = qw[Exporter];
-    @EXPORT = qw[
-                FILE HARDLINK SYMLINK CHARDEV BLOCKDEV DIR FIFO SOCKET UNKNOWN
-                BUFFER HEAD READ_ONLY WRITE_ONLY UNPACK PACK TIME_OFFSET ZLIB
-                BLOCK_SIZE TAR_PAD TAR_END ON_UNIX BLOCK CAN_READLINK MAGIC 
-                TAR_VERSION UNAME GNAME CAN_CHOWN MODE CHECK_SUM UID GID 
-                GZIP_MAGIC_NUM MODE_READ LONGLINK LONGLINK_NAME PREFIX_LENGTH
-                LABEL NAME_LENGTH STRIP_MODE ON_VMS
-            ];
+    
+    $VERSION    = '0.02';
+    @ISA        = qw[Exporter];
 
     require Time::Local if $^O eq "MacOS";
 }
 
+use Package::Constants;
+ at EXPORT = Package::Constants->list( __PACKAGE__ );
+
 use constant FILE           => 0;
 use constant HARDLINK       => 1;
 use constant SYMLINK        => 2;
@@ -32,6 +28,9 @@
 use constant HEAD           => 512;
 use constant BLOCK          => 512;
 
+use constant COMPRESS_GZIP  => 9;
+use constant COMPRESS_BZIP  => 'bzip2';
+
 use constant BLOCK_SIZE     => sub { my $n = int($_[0]/BLOCK); $n++ if $_[0] % BLOCK; $n * BLOCK };
 use constant TAR_PAD        => sub { my $x = shift || return; return "\0" x (BLOCK - ($x % BLOCK) ) };
 use constant TAR_END        => "\0" x BLOCK;
@@ -61,16 +60,25 @@
 use constant MAGIC          => "ustar";
 use constant TAR_VERSION    => "00";
 use constant LONGLINK_NAME  => '././@LongLink';
+use constant PAX_HEADER     => 'pax_global_header';
 
-                            ### allow ZLIB to be turned off using ENV
-                            ### DEBUG only
+                            ### allow ZLIB to be turned off using ENV: DEBUG only
 use constant ZLIB           => do { !$ENV{'PERL5_AT_NO_ZLIB'} and
                                         eval { require IO::Zlib };
-                                    $ENV{'PERL5_AT_NO_ZLIB'} || $@ ? 0 : 1 };
-                                    
+                                    $ENV{'PERL5_AT_NO_ZLIB'} || $@ ? 0 : 1 
+                                };
+
+                            ### allow BZIP to be turned off using ENV: DEBUG only                                
+use constant BZIP           => do { !$ENV{'PERL5_AT_NO_BZIP'} and
+                                        eval { require IO::Uncompress::Bunzip2;
+                                               require IO::Compress::Bzip2; };
+                                    $ENV{'PERL5_AT_NO_BZIP'} || $@ ? 0 : 1 
+                                };
+
 use constant GZIP_MAGIC_NUM => qr/^(?:\037\213|\037\235)/;
+use constant BZIP_MAGIC_NUM => qr/^BZh\d/;
 
-use constant CAN_CHOWN      => do { ($> == 0 and $^O ne "MacOS" and $^O ne "MSWin32") };
+use constant CAN_CHOWN      => sub { ($> == 0 and $^O ne "MacOS" and $^O ne "MSWin32") };
 use constant CAN_READLINK   => ($^O ne 'MSWin32' and $^O !~ /RISC(?:[ _])?OS/i and $^O ne 'VMS');
 use constant ON_UNIX        => ($^O ne 'MSWin32' and $^O ne 'MacOS' and $^O ne 'VMS');
 use constant ON_VMS         => $^O eq 'VMS'; 
diff -urN perl-5.10.0.orig/lib/Archive/Tar/File.pm perl-5.10.0/lib/Archive/Tar/File.pm
--- perl-5.10.0.orig/lib/Archive/Tar/File.pm	2009-02-20 11:21:14.000000000 +0100
+++ perl-5.10.0/lib/Archive/Tar/File.pm	2009-03-11 17:12:58.000000000 +0100
@@ -1,15 +1,18 @@
 package Archive::Tar::File;
 use strict;
 
+use Carp                ();
 use IO::File;
 use File::Spec::Unix    ();
 use File::Spec          ();
 use File::Basename      ();
 
+### avoid circular use, so only require;
+require Archive::Tar;
 use Archive::Tar::Constant;
 
 use vars qw[@ISA $VERSION];
- at ISA        = qw[Archive::Tar];
+#@ISA        = qw[Archive::Tar];
 $VERSION    = '0.02';
 
 ### set value to 1 to oct() it during the unpack ###
@@ -154,13 +157,13 @@
 
 =head1 Methods
 
-=head2 new( file => $path )
+=head2 Archive::Tar::File->new( file => $path )
 
 Returns a new Archive::Tar::File object from an existing file.
 
 Returns undef on failure.
 
-=head2 new( data => $path, $data, $opt )
+=head2 Archive::Tar::File->new( data => $path, $data, $opt )
 
 Returns a new Archive::Tar::File object from data.
 
@@ -171,7 +174,7 @@
 
 Returns undef on failure.
 
-=head2 new( chunk => $chunk )
+=head2 Archive::Tar::File->new( chunk => $chunk )
 
 Returns a new Archive::Tar::File object from a raw 512-byte tar
 archive chunk.
@@ -266,6 +269,29 @@
     my @items       = qw[mode uid gid size mtime];
     my %hash        = map { shift(@items), $_ } (lstat $path)[2,4,5,7,9];
 
+    if (ON_VMS) {
+        ### VMS has two UID modes, traditional and POSIX.  Normally POSIX is
+        ### not used.  We currently do not have an easy way to see if we are in
+        ### POSIX mode.  In traditional mode, the UID is actually the VMS UIC.
+        ### The VMS UIC has the upper 16 bits is the GID, which in many cases
+        ### the VMS UIC will be larger than 209715, the largest that TAR can
+        ### handle.  So for now, assume it is traditional if the UID is larger
+        ### than 0x10000.
+
+        if ($hash{uid} > 0x10000) {
+            $hash{uid} = $hash{uid} & 0xFFFF;
+        }
+
+        ### The file length from stat() is the physical length of the file
+        ### However the amount of data read in may be more for some file types.
+        ### Fixed length files are read past the logical EOF to end of the block
+        ### containing.  Other file types get expanded on read because record
+        ### delimiters are added.
+
+        my $data_len = length $data;
+        $hash{size} = $data_len if $hash{size} < $data_len;
+
+    }
     ### you *must* set size == 0 on symlinks, or the next entry will be
     ### though of as the contents of the symlink, which is wrong.
     ### this fixes bug #7937
@@ -367,6 +393,9 @@
     ### if it's a directory, then $file might be empty
     $file = pop @dirs if $self->is_dir and not length $file;
 
+    ### splitting ../ gives you the relative path in native syntax
+    map { $_ = '..' if $_  eq '-' } @dirs if ON_VMS;
+
     my $prefix = File::Spec::Unix->catdir(
                         grep { length } $vol, @dirs
                     );
@@ -411,7 +440,25 @@
     return 1;
 }
 
-=head2 full_path
+=head2 $bool = $file->extract( [ $alternative_name ] )
+
+Extract this object, optionally to an alternative name. 
+
+See C<< Archive::Tar->extract_file >> for details.
+
+Returns true on success and false on failure.
+
+=cut
+
[...2803 lines suppressed...]
+=head2 $bool = Archive::Tar->has_zlib_support
+
+Returns true if C<Archive::Tar> can extract C<zlib> compressed archives
+
+=cut
+
+sub has_zlib_support { return ZLIB }
+
+=head2 $bool = Archive::Tar->has_bzip2_support
+
+Returns true if C<Archive::Tar> can extract C<bzip2> compressed archives
+
+=cut
+
+sub has_bzip2_support { return BZIP }
+
 =head2 Archive::Tar->can_handle_compressed_files
 
 A simple checking routine, which will return true if C<Archive::Tar>
-is able to uncompress compressed archives on the fly with C<IO::Zlib>,
-or false if C<IO::Zlib> is not installed.
+is able to uncompress compressed archives on the fly with C<IO::Zlib>
+and C<IO::Compress::Bzip2> or false if not both are installed.
 
 You can use this as a shortcut to determine whether C<Archive::Tar>
 will do what you think before passing compressed archives to its
@@ -1498,7 +1712,7 @@
 
 =cut
 
-sub can_handle_compressed_files { return ZLIB ? 1 : 0 }
+sub can_handle_compressed_files { return ZLIB && BZIP ? 1 : 0 }
 
 sub no_string_support {
     croak("You have to install IO::String to support writing archives to strings");
@@ -1542,13 +1756,13 @@
 
 =head2 $Archive::Tar::DO_NOT_USE_PREFIX
 
-By default, C<Archive::Tar> will try to put paths that are over 
+By default, C<Archive::Tar> will try to put paths that are over
 100 characters in the C<prefix> field of your tar header, as
-defined per POSIX-standard. However, some (older) tar programs 
-do not implement this spec. To retain compatibility with these older 
-or non-POSIX compliant versions, you can set the C<$DO_NOT_USE_PREFIX> 
-variable to a true value, and C<Archive::Tar> will use an alternate 
-way of dealing with paths over 100 characters by using the 
+defined per POSIX-standard. However, some (older) tar programs
+do not implement this spec. To retain compatibility with these older
+or non-POSIX compliant versions, you can set the C<$DO_NOT_USE_PREFIX>
+variable to a true value, and C<Archive::Tar> will use an alternate
+way of dealing with paths over 100 characters by using the
 C<GNU Extended Header> feature.
 
 Note that clients who do not support the C<GNU Extended Header>
@@ -1589,11 +1803,11 @@
 
 Allowing this could have security implications, as a malicious
 tar archive could alter or replace any file the extracting user
-has permissions to. Therefor, the default is to not allow 
-insecure extractions. 
+has permissions to. Therefor, the default is to not allow
+insecure extractions.
 
-If you trust the archive, or have other reasons to allow the 
-archive to write files outside your current working directory, 
+If you trust the archive, or have other reasons to allow the
+archive to write files outside your current working directory,
 set this variable to C<true>.
 
 Note that this is a backwards incompatible change from version
@@ -1601,9 +1815,9 @@
 
 =head2 $Archive::Tar::HAS_PERLIO
 
-This variable holds a boolean indicating if we currently have 
+This variable holds a boolean indicating if we currently have
 C<perlio> support loaded. This will be enabled for any perl
-greater than C<5.8> compiled with C<perlio>. 
+greater than C<5.8> compiled with C<perlio>.
 
 If you feel strongly about disabling it, set this variable to
 C<false>. Note that you will then need C<IO::String> installed
@@ -1614,7 +1828,7 @@
 
 =head2 $Archive::Tar::HAS_IO_STRING
 
-This variable holds a boolean indicating if we currently have 
+This variable holds a boolean indicating if we currently have
 C<IO::String> support loaded. This will be enabled for any perl
 that has a loadable C<IO::String> module.
 
@@ -1645,18 +1859,24 @@
 C<IO::Zlib> doesn't support C<seek> on their filehandles, there is little
 choice but to read the archive into memory.
 This is ok if you want to do in-memory manipulation of the archive.
+
 If you just want to extract, use the C<extract_archive> class method
 instead. It will optimize and write to disk immediately.
 
-=item Can't you lazy-load data instead?
+Another option is to use the C<iter> class method to iterate over
+the files in the tarball without reading them all in memory at once.
+
+=item Can you lazy-load data instead?
 
-No, not easily. See previous question.
+In some cases, yes. You can use the C<iter> class method to iterate
+over the files in the tarball without reading them all in memory at once.
 
 =item How much memory will an X kb tar file need?
 
 Probably more than X kb, since it will all be read into memory. If
 this is a problem, and you don't need to do in memory manipulation
-of the archive, consider using C</bin/tar> instead.
+of the archive, consider using the C<iter> class method, or C</bin/tar>
+instead.
 
 =item What do you do with unsupported filetypes in an archive?
 
@@ -1666,8 +1886,9 @@
 
 This does require you to read the entire archive in to memory first,
 since otherwise we wouldn't know what data to fill the copy with.
-(This means that you cannot use the class methods on archives that
-have incompatible filetypes and still expect things to work).
+(This means that you cannot use the class methods, including C<iter>
+on archives that have incompatible filetypes and still expect things
+to work).
 
 For other filetypes, like C<chardevs> and C<blockdevs> we'll warn that
 the extraction of this particular item didn't work.
@@ -1680,7 +1901,7 @@
 C<POSIX header prefix>. Non-POSIX-compatible clients may not support
 this part of the specification, and may only support the C<GNU Extended
 Header> functionality. To facilitate those clients, you can set the
-C<$Archive::Tar::DO_NOT_USE_PREFIX> variable to C<true>. See the 
+C<$Archive::Tar::DO_NOT_USE_PREFIX> variable to C<true>. See the
 C<GLOBAL VARIABLES> section for details on this variable.
 
 Note that GNU tar earlier than version 1.14 does not cope well with
@@ -1696,9 +1917,9 @@
 based on your criteria. For example, to extract only files that have
 the string C<foo> in their title, you would use:
 
-    $tar->extract( 
+    $tar->extract(
         grep { $_->full_path =~ /foo/ } $tar->get_files
-    ); 
+    );
 
 This way, you can filter on any attribute of the files in the archive.
 Consult the C<Archive::Tar::File> documentation on how to use these
@@ -1775,22 +1996,22 @@
 
     $tar->add_data('file.txt', $data);
 
-A opposite problem occurs if you extract a UTF8-encoded file from a 
+A opposite problem occurs if you extract a UTF8-encoded file from a
 tarball. Using C<get_content()> on the C<Archive::Tar::File> object
 will return its content as a bytestring, not as a Unicode string.
 
 If you want it to be a Unicode string (because you want character
 semantics with operations like regular expression matching), you need
-to decode the UTF8-encoded content and have Perl convert it into 
+to decode the UTF8-encoded content and have Perl convert it into
 a Unicode string:
 
     use Encode;
     my $data = $tar->get_content();
-    
+
     # Make it a Unicode string
     $data = decode('utf8', $data);
 
-There is no easy way to provide this functionality in C<Archive::Tar>, 
+There is no easy way to provide this functionality in C<Archive::Tar>,
 because a tarball can contain many files, and each of which could be
 encoded in a different way.
 
@@ -1852,15 +2073,15 @@
 
 =head1 ACKNOWLEDGEMENTS
 
-Thanks to Sean Burke, Chris Nandor, Chip Salzenberg, Tim Heaney and
-especially Andrew Savige for their help and suggestions.
+Thanks to Sean Burke, Chris Nandor, Chip Salzenberg, Tim Heaney, Gisle Aas
+and especially Andrew Savige for their help and suggestions.
 
 =head1 COPYRIGHT
 
-This module is copyright (c) 2002 - 2007 Jos Boumans 
+This module is copyright (c) 2002 - 2008 Jos Boumans
 E<lt>kane at cpan.orgE<gt>. All rights reserved.
 
-This library is free software; you may redistribute and/or modify 
+This library is free software; you may redistribute and/or modify
 it under the same terms as Perl itself.
 
 =cut

perl-update-CGI.patch:

--- NEW FILE perl-update-CGI.patch ---
CGI.pm-3.42

diff -urN perl-5.10.0.orig/lib/CGI/Carp.pm perl-5.10.0/lib/CGI/Carp.pm
--- perl-5.10.0.orig/lib/CGI/Carp.pm	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CGI/Carp.pm	2009-02-13 18:08:50.000000000 +0100
@@ -323,7 +323,7 @@
 
 $main::SIG{__WARN__}=\&CGI::Carp::warn;
 
-$CGI::Carp::VERSION     = '1.29';
+$CGI::Carp::VERSION     = '1.30_01';
 $CGI::Carp::CUSTOM_MSG  = undef;
 $CGI::Carp::DIE_HANDLER = undef;
 
@@ -575,6 +575,7 @@
         print STDOUT $mess;
     }
     else {
+        print STDOUT "Status: 500\n";
         print STDOUT "Content-type: text/html\n\n";
         print STDOUT $mess;
     }
diff -urN perl-5.10.0.orig/lib/CGI/Changes perl-5.10.0/lib/CGI/Changes
--- perl-5.10.0.orig/lib/CGI/Changes	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CGI/Changes	2009-02-13 18:09:15.000000000 +0100
@@ -1,3 +1,70 @@
+
+  Version 3.42
+  1. Added patch from Renee Baecker that makes it possible to subclass
+  CGI::Pretty.
+  2. Added patch from Nicholas Clark to allow ~ characters in temporary directories.
+  3. Added patch from Renee Baecker that fixes the inappropriate escaping of fields
+     in multipart headers.
+
+  Version 3.41
+  1. Fix url() returning incorrect path when query string contains escaped newline.
+  2. Added additional windows temporary directories and environment variables, courtesy patch from Renee Baecker
+  3. Added a handle() method to the lightweight upload
+  filehandles. This method returns a real IO::Handle object.
+  4. Added patch from Tony Vanlingen to fix deep recursion warnings in CGI::Pretty.
+
+  Version 3.40
+  1. Fixed CGI::Fast docs to eliminate references to a "special"
+  version of Perl.
+  2. Makefile.PL now depends on FCGI so that CGI::Fast installs properly.
+  3. Fix script_name() call from Stephane Chazelas.
+
+  Version 3.39
+  1. Fixed regression in "exists" function when using tied interface to CGI via $q->Vars.
+
+  Version 3.38
+  1. Fix annoying warning in http://rt.cpan.org/Ticket/Display.html?id=34551
+  2. Added nobr() function http://rt.cpan.org/Ticket/Display.html?id=35377
+  3. popup_menu() allows multiple items to be selected by default, satisfying
+   http://rt.cpan.org/Ticket/Display.html?id=35376
+  4. Patch from Renee Backer to avoid doubled <http-equiv> headers.
+  5. Fixed documentation bug that describes what happens when a
+  parameter is empty (e.g. "?test1=").
+  6. Fixed minor warning described at http://rt.cpan.org/Public/Bug/Display.html?id=36435
+  7. Fixed overlap of attribute and parameter space described in http://rt.perl.org/rt3//Ticket/Display.html?id=24294
+
+  Version 3.37
+  1. Fix pragmas so that they persist over modperl invocations (e.g. RT 34761)
+  2. Fixed handling of chunked multipart uploads; thanks to Michael Bernhardt
+     who reported and fixed the problem.
+
+  Version 3.36
+  1. Fix CGI::Cookie to support cookies that are separated by "," instead of ";".
+
+  Version 3.35
+  1. Resync with bleadperl, primarily fixing a bug in parsing semicolons in uploaded filenames.
+
+  Version 3.34
+  1. Handle Unicode %uXXXX  escapes properly -- patch from DANKOGAI at cpan.org
+  2. Fix url() method to not choke on path names that contain regex characters.
+
+  Version 3.33
+  1. Remove uninit variable warning when calling url(-relative=>1)
+  2. Fix uninit variable warnings for two lc calls
+  3. Fixed failure of tempfile upload due to sprintf() taint failure in perl 5.10
+
+  Version 3.32
+  1. Patch from Miguel Santinho to prevent sending premature headers under mod_perl 2.0
+
+  Version 3.31
+  1. Patch from Xavier Robin so that CGI::Carp issues a 500 Status code rather than a 200 status code.
+  2. Patch from Alexander Klink to select correct temporary directory in OSX Leopard so that upload works.
+  3. Possibly fixed "wrapped pack" error on 5.10 and higher.
+
+  Version 3.30
+  1. Patch from Mike Barry to handle POSTDATA in the same way as PUT.
+  2. Patch from Rafael Garcia-Suarez to correctly reencode unicode values as byte values.
+
   Version 3.29
   1. The position of file handles is now reset to zero when CGI->new is called.
     (Mark Stosberg)
diff -urN perl-5.10.0.orig/lib/CGI/Cookie.pm perl-5.10.0/lib/CGI/Cookie.pm
--- perl-5.10.0.orig/lib/CGI/Cookie.pm	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CGI/Cookie.pm	2009-02-13 18:08:50.000000000 +0100
@@ -13,7 +13,7 @@
 # wish, but if you redistribute a modified version, please attach a note
 # listing the modifications you have made.
 
-$CGI::Cookie::VERSION='1.28';
+$CGI::Cookie::VERSION='1.29';
 
 use CGI::Util qw(rearrange unescape escape);
 use CGI;
@@ -51,7 +51,7 @@
    my %results;
    my($key,$value);
    
-   my(@pairs) = split("[;,] ?",$raw_cookie);
+   my @pairs = split("[;,] ?",$raw_cookie);
    foreach (@pairs) {
      s/\s*(.*?)\s*/$1/;
      if (/^([^=]+)=(.*)/) {
@@ -88,7 +88,7 @@
   my ($self,$raw_cookie) = @_;
   my %results;
 
-  my(@pairs) = split("; ?",$raw_cookie);
+  my @pairs = split("[;,] ?",$raw_cookie);
   foreach (@pairs) {
     s/\s*(.*?)\s*/$1/;
     my($key,$value) = split("=",$_,2);
diff -urN perl-5.10.0.orig/lib/CGI/Fast.pm perl-5.10.0/lib/CGI/Fast.pm
--- perl-5.10.0.orig/lib/CGI/Fast.pm	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CGI/Fast.pm	2009-02-13 18:08:50.000000000 +0100
@@ -55,6 +55,7 @@
      }
      }
      CGI->_reset_globals;
+     $self->_setup_symbols(@SAVED_SYMBOLS) if @CGI::SAVED_SYMBOLS;
      return $CGI::Q = $self->SUPER::new($initializer, @param);
 }
 
@@ -81,18 +82,17 @@
 
 =head1 DESCRIPTION
 
-CGI::Fast is a subclass of the CGI object created by
-CGI.pm.  It is specialized to work well with the Open Market
-FastCGI standard, which greatly speeds up CGI scripts by
-turning them into persistently running server processes.  Scripts
-that perform time-consuming initialization processes, such as
-loading large modules or opening persistent database connections,
-will see large performance improvements.
+CGI::Fast is a subclass of the CGI object created by CGI.pm.  It is
+specialized to work well FCGI module, which greatly speeds up CGI
+scripts by turning them into persistently running server processes.
+Scripts that perform time-consuming initialization processes, such as
+loading large modules or opening persistent database connections, will
+see large performance improvements.
 
 =head1 OTHER PIECES OF THE PUZZLE
 
-In order to use CGI::Fast you'll need a FastCGI-enabled Web
-server. See http://www.fastcgi.com/ for details.
+In order to use CGI::Fast you'll need the FCGI module.  See
+http://www.cpan.org/ for details.
 
 =head1 WRITING FASTCGI PERL SCRIPTS
 
@@ -105,7 +105,7 @@
 
 A typical FastCGI script will look like this:
 
-    #!/usr/local/bin/perl    # must be a FastCGI version of perl!
+    #!/usr/bin/perl
     use CGI::Fast;
     &do_some_initialization();
     while ($q = new CGI::Fast) {
diff -urN perl-5.10.0.orig/lib/CGI/Pretty.pm perl-5.10.0/lib/CGI/Pretty.pm
--- perl-5.10.0.orig/lib/CGI/Pretty.pm	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CGI/Pretty.pm	2009-02-13 18:08:50.000000000 +0100
@@ -176,6 +176,35 @@
 }
 sub _reset_globals { initialize_globals(); }
 
+# ugly, but quick fix
+sub import {
+    my $self = shift;
+    no strict 'refs';
+    ${ "$self\::AutoloadClass" } = 'CGI';
+
+    # This causes modules to clash.
+    undef %CGI::EXPORT;
+    undef %CGI::EXPORT;
+
+    $self->_setup_symbols(@_);
+    my ($callpack, $callfile, $callline) = caller;
+
+    # To allow overriding, search through the packages
+    # Till we find one in which the correct subroutine is defined.
+    my @packages = ($self,@{"$self\:\:ISA"});
+    foreach my $sym (keys %CGI::EXPORT) {
+	my $pck;
+	my $def = ${"$self\:\:AutoloadClass"} || $CGI::DefaultClass;
+	foreach $pck (@packages) {
+	    if (defined(&{"$pck\:\:$sym"})) {
+		$def = $pck;
+		last;
+	    }
+	}
+	*{"${callpack}::$sym"} = \&{"$def\:\:$sym"};
+    }
+}
+
 1;
 
 =head1 NAME
diff -urN perl-5.10.0.orig/lib/CGI/t/request.t perl-5.10.0/lib/CGI/t/request.t
--- perl-5.10.0.orig/lib/CGI/t/request.t	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CGI/t/request.t	2009-02-13 18:09:57.000000000 +0100
@@ -4,7 +4,7 @@
 ######################### We start with some black magic to print on failure.
 use lib '.','../blib/lib','../blib/arch';
 
-BEGIN {$| = 1; print "1..33\n"; }
+BEGIN {$| = 1; print "1..34\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use CGI ();
 use Config;
@@ -74,6 +74,7 @@
 test(29,$p->{bar} eq 'froz',"tied interface fetch");
 $p->{bar} = join("\0",qw(foo bar baz));
 test(30,join(' ',$q->param('bar')) eq 'foo bar baz','tied interface store');
+test(31,exists $p->{bar});
 
 # test posting
 $q->_reset_globals;
@@ -88,11 +89,11 @@
     exit 0;
   }
   # at this point, we're in a new (child) process
-  test(31,$q=new CGI,"CGI::new() from POST");
-  test(32,$q->param('weather') eq 'nice',"CGI::param() from POST");
-  test(33,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
+  test(32,$q=new CGI,"CGI::new() from POST");
+  test(33,$q->param('weather') eq 'nice',"CGI::param() from POST");
+  test(34,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
 } else {
-  print "ok 31 # Skip\n";
   print "ok 32 # Skip\n";
   print "ok 33 # Skip\n";
+  print "ok 34 # Skip\n";
 }
diff -urN perl-5.10.0.orig/lib/CGI/Util.pm perl-5.10.0/lib/CGI/Util.pm
--- perl-5.10.0.orig/lib/CGI/Util.pm	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CGI/Util.pm	2009-02-13 18:08:50.000000000 +0100
@@ -4,7 +4,7 @@
 use vars qw($VERSION @EXPORT_OK @ISA $EBCDIC @A2E @E2A);
 require Exporter;
 @ISA = qw(Exporter);
- at EXPORT_OK = qw(rearrange make_attributes unescape escape 
+ at EXPORT_OK = qw(rearrange rearrange_header make_attributes unescape escape 
 		expires ebcdic2ascii ascii2ebcdic);
 
 $VERSION = '1.5_01';
@@ -70,16 +70,34 @@
 }
 
 # Smart rearrangement of parameters to allow named parameter
-# calling.  We do the rearangement if:
+# calling.  We do the rearrangement if:
 # the first parameter begins with a -
+
 sub rearrange {
+    my ($order, at param) = @_;
+    my ($result, $leftover) = _rearrange_params( $order, @param );
+    push @$result, make_attributes( $leftover, defined $CGI::Q ? $CGI::Q->{escape} : 1 ) 
+	if keys %$leftover;
+    @$result;
+}
+
+sub rearrange_header {
+    my ($order, at param) = @_;
+
+    my ($result,$leftover) = _rearrange_params( $order, @param );
+    push @$result, make_attributes( $leftover, 0, 1 ) if keys %$leftover;
+
+    @$result;
+}
+
+sub _rearrange_params {
     my($order, at param) = @_;
-    return () unless @param;
+    return [] unless @param;
 
     if (ref($param[0]) eq 'HASH') {
 	@param = %{$param[0]};
     } else {
-	return @param 
+	return \@param 
 	    unless (defined($param[0]) && substr($param[0],0,1) eq '-');
     }
 
@@ -103,14 +121,17 @@
 	}
     }
 
-    push (@result,make_attributes(\%leftover,defined $CGI::Q ? $CGI::Q->{escape} : 1)) if %leftover;
-    @result;
+    return \@result, \%leftover;
 }
 
 sub make_attributes {
     my $attr = shift;
     return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
     my $escape =  shift || 0;
+    my $do_not_quote = shift;
+
+    my $quote = $do_not_quote ? '' : '"';
+
     my(@att);
     foreach (keys %{$attr}) {
 	my($key) = $_;
@@ -122,7 +143,7 @@
 	($key="\L$key") =~ tr/_/-/; # parameters are lower case, use dashes
 
 	my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_};
-	push(@att,defined($attr->{$_}) ? qq/$key="$value"/ : qq/$key/);
+	push(@att,defined($attr->{$_}) ? qq/$key=$quote$value$quote/ : qq/$key/);
     }
     return @att;
 }
@@ -141,8 +162,12 @@
 
 sub utf8_chr {
         my $c = shift(@_);
-	return chr($c) if $] >= 5.006;
-
+	if ($] >= 5.006){
+	    require utf8;
+	    my $u = chr($c);
+	    utf8::encode($u); # drop utf8 flag
+	    return $u;
+	}
         if ($c < 0x80) {
                 return sprintf("%c", $c);
         } elsif ($c < 0x800) {
@@ -189,6 +214,17 @@
     if ($EBCDIC) {
       $todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge;
     } else {
+	# handle surrogate pairs first -- dankogai
+	$todecode =~ s{
+			%u([Dd][89a-bA-B][0-9a-fA-F]{2}) # hi
+		        %u([Dd][c-fC-F][0-9a-fA-F]{2})   # lo
+		      }{
+			  utf8_chr(
+				   0x10000 
+				   + (hex($1) - 0xD800) * 0x400 
+				   + (hex($2) - 0xDC00)
+				  )
+		      }gex;
       $todecode =~ s/%(?:([0-9a-fA-F]{2})|u([0-9a-fA-F]{4}))/
 	defined($1)? chr hex($1) : utf8_chr(hex($2))/ge;
     }
@@ -200,8 +236,12 @@
   shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
   my $toencode = shift;
   return undef unless defined($toencode);
+  $toencode = eval { pack("C*", unpack("U0C*", $toencode))} || pack("C*", unpack("C*", $toencode));
+
   # force bytes while preserving backward compatibility -- dankogai
-  $toencode = pack("C*", unpack("U0C*", $toencode));
+  # but commented out because it was breaking CGI::Compress -- lstein
+  # $toencode = eval { pack("U*", unpack("U0C*", $toencode))} || pack("C*", unpack("C*", $toencode));
+
     if ($EBCDIC) {
       $toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
     } else {
diff -urN perl-5.10.0.orig/lib/CGI.pm perl-5.10.0/lib/CGI.pm
--- perl-5.10.0.orig/lib/CGI.pm	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/CGI.pm	2009-02-13 18:08:55.000000000 +0100
@@ -18,13 +18,13 @@
 # The most recent version and complete docs are available at:
 #   http://stein.cshl.org/WWW/software/CGI/
 
-$CGI::revision = '$Id: CGI.pm,v 1.234 2007/04/16 16:58:46 lstein Exp $';
-$CGI::VERSION='3.29';
+$CGI::revision = '$Id: CGI.pm,v 1.260 2008/09/08 14:13:23 lstein Exp $';
+$CGI::VERSION='3.42';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
 # $CGITempFile::TMPDIRECTORY = '/usr/tmp';
-use CGI::Util qw(rearrange make_attributes unescape escape expires ebcdic2ascii ascii2ebcdic);
+use CGI::Util qw(rearrange rearrange_header make_attributes unescape escape expires ebcdic2ascii ascii2ebcdic);
 
 #use constant XHTML_DTD => ['-//W3C//DTD XHTML Basic 1.0//EN',
 #                           'http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd'];
@@ -37,7 +37,12 @@
   $TAINTED = substr("$0$^X",0,0);
 }
 
-$MOD_PERL = 0; # no mod_perl by default
+$MOD_PERL            = 0; # no mod_perl by default
+
+#global settings
+$POST_MAX            = -1; # no limit to uploaded files
+$DISABLE_UPLOADS     = 0;
+
 @SAVED_SYMBOLS = ();
 
 
@@ -91,13 +96,6 @@
     # it can just be renamed, instead of read and written.
     $CLOSE_UPLOAD_FILES = 0;
 
-    # Set this to a positive value to limit the size of a POSTing
-    # to a certain number of bytes:
-    $POST_MAX = -1;
-
-    # Change this to 1 to disable uploads entirely:
-    $DISABLE_UPLOADS = 0;
-
     # Automatically determined -- don't change
     $EBCDIC = 0;
 
@@ -111,6 +109,9 @@
     # use CGI qw(-no_undef_params);
     $NO_UNDEF_PARAMS = 0;
 
+    # return everything as utf-8
+    $PARAM_UTF8      = 0;
+
     # Other globals that you shouldn't worry about.
     undef $Q;
     $BEEN_THERE = 0;
@@ -226,7 +227,7 @@
 			   tt u i b blockquote pre img a address cite samp dfn html head
 			   base body Link nextid title meta kbd start_html end_html
 			   input Select option comment charset escapeHTML/],
-		':html3'=>[qw/div table caption th td TR Tr sup Sub strike applet Param 
+		':html3'=>[qw/div table caption th td TR Tr sup Sub strike applet Param nobr
 			   embed basefont style span layer ilayer font frameset frame script small big Area Map/],
                 ':html4'=>[qw/abbr acronym bdo col colgroup del fieldset iframe
                             ins label legend noframes noscript object optgroup Q 
@@ -352,6 +353,7 @@
       $self->r(Apache->request) unless $self->r;
       my $r = $self->r;
       $r->register_cleanup(\&CGI::_reset_globals);
+      $self->_setup_symbols(@SAVED_SYMBOLS) if @SAVED_SYMBOLS;
     }
     else {
       # XXX: once we have the new API
@@ -360,6 +362,7 @@
       my $r = $self->r;
       $r->subprocess_env unless exists $ENV{REQUEST_METHOD};
       $r->pool->cleanup_register(\&CGI::_reset_globals);
+      $self->_setup_symbols(@SAVED_SYMBOLS) if @SAVED_SYMBOLS;
     }
     undef $NPH;
   }
@@ -437,23 +440,22 @@
 	# If values is provided, then we set it.
 	if (@values or defined $value) {
 	    $self->add_parameter($name);
-	    $self->{$name}=[@values];
+	    $self->{param}{$name}=[@values];
 	}
     } else {
 	$name = $p[0];
     }
 
-    return unless defined($name) && $self->{$name};
+    return unless defined($name) && $self->{param}{$name};
 
-    my $charset = $self->charset || '';
-    my $utf8    = $charset eq 'utf-8';
-    if ($utf8) {
-      eval "require Encode; 1;" if $utf8 && !Encode->can('decode'); # bring in these functions
-      return wantarray ? map {Encode::decode(utf8=>$_) } @{$self->{$name}} 
-                       : Encode::decode(utf8=>$self->{$name}->[0]);
-    } else {
-      return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
+    my @result = @{$self->{param}{$name}};
+
+    if ($PARAM_UTF8) {
+      eval "require Encode; 1;" unless Encode->can('decode'); # bring in these functions
+      @result = map {ref $_ ? $_ : Encode::decode(utf8=>$_) } @result;
     }
+
+    return wantarray ?  @result : $result[0];
 }
 
 sub self_or_default {
@@ -574,14 +576,14 @@
                       $self->add_parameter($param);
                       $self->read_from_client(\$value,$content_length,0)
                         if $content_length > 0;
-                      push (@{$self->{$param}},$value);
+                      push (@{$self->{param}{$param}},$value);
                       $is_xforms = 1;
               } elsif ($ENV{'CONTENT_TYPE'} =~ /multipart\/related.+boundary=\"?([^\";,]+)\"?.+start=\"?\<?([^\"\>]+)\>?\"?/) {
                       my($boundary,$start) = ($1,$2);
                       my($param) = 'XForms:Model';
                       $self->add_parameter($param);
                       my($value) = $self->read_multipart_related($start,$boundary,$content_length,0);
-                      push (@{$self->{$param}},$value);
+                      push (@{$self->{param}{$param}},$value);
                       if ($MOD_PERL) {
                               $query_string = $self->r->args;
                       } else {
@@ -641,7 +643,7 @@
 	  last METHOD;
       }
 
-      if ($meth eq 'POST') {
+      if ($meth eq 'POST' || $meth eq 'PUT') {
 	  $self->read_from_client(\$query_string,$content_length,0)
 	      if $content_length > 0;
 	  # Some people want to have their cake and eat it too!
@@ -667,13 +669,13 @@
   }
 
 # YL: Begin Change for XML handler 10/19/2001
-    if (!$is_xforms && $meth eq 'POST'
+    if (!$is_xforms && ($meth eq 'POST' || $meth eq 'PUT')
         && defined($ENV{'CONTENT_TYPE'})
         && $ENV{'CONTENT_TYPE'} !~ m|^application/x-www-form-urlencoded|
 	&& $ENV{'CONTENT_TYPE'} !~ m|^multipart/form-data| ) {
-        my($param) = 'POSTDATA' ;
+        my($param) = $meth . 'DATA' ;
         $self->add_parameter($param) ;
-      push (@{$self->{$param}},$query_string);
+      push (@{$self->{param}{$param}},$query_string);
       undef $query_string ;
     }
 # YL: End Change for XML handler 10/19/2001
@@ -685,7 +687,7 @@
 	    $self->parse_params($query_string);
 	} else {
 	    $self->add_parameter('keywords');
-	    $self->{'keywords'} = [$self->parse_keywordlist($query_string)];
+	    $self->{param}{'keywords'} = [$self->parse_keywordlist($query_string)];
 	}
     }
 
@@ -752,7 +754,7 @@
     @QUERY_PARAM = $self->param; # save list of parameters
     foreach (@QUERY_PARAM) {
       next unless defined $_;
-      $QUERY_PARAM{$_}=$self->{$_};
+      $QUERY_PARAM{$_}=$self->{param}{$_};
     }
     $QUERY_CHARSET = $self->charset;
     %QUERY_FIELDNAMES = %{$self->{'.fieldnames'}};
@@ -771,7 +773,7 @@
 	$param = unescape($param);
 	$value = unescape($value);
 	$self->add_parameter($param);
-	push (@{$self->{$param}},$value);
+	push (@{$self->{param}{$param}},$value);
     }
 }
 
@@ -779,7 +781,7 @@
     my($self,$param)=@_;
     return unless defined $param;
     push (@{$self->{'.parameters'}},$param) 
-	unless defined($self->{$param});
+	unless defined($self->{param}{$param});
 }
 
 sub all_parameters {
@@ -904,6 +906,7 @@
 	$DEBUG=0,                next if /^[:-]no_?[Dd]ebug$/;
 	$DEBUG=2,                next if /^[:-][Dd]ebug$/;
 	$USE_PARAM_SEMICOLONS++, next if /^[:-]newstyle_urls$/;
+	$PARAM_UTF8++,           next if /^[:-]utf8$/;
 	$XHTML++,                next if /^[:-]xhtml$/;
 	$XHTML=0,                next if /^[:-]no_?xhtml$/;
 	$USE_PARAM_SEMICOLONS=0, next if /^[:-]oldstyle_urls$/;
@@ -1005,7 +1008,7 @@
     my %to_delete;
     foreach my $name (@to_delete)
     {
-        CORE::delete $self->{$name};
+        CORE::delete $self->{param}{$name};
         CORE::delete $self->{'.fieldnames'}->{$name};
         $to_delete{$name}++;
     }
@@ -1054,8 +1057,8 @@
 sub keywords {
     my($self, at values) = self_or_default(@_);
     # If values is provided, then we set it.
-    $self->{'keywords'}=[@values] if @values;
-    my(@result) = defined($self->{'keywords'}) ? @{$self->{'keywords'}} : ();
+    $self->{param}{'keywords'}=[@values] if @values;
+    my(@result) = defined($self->{param}{'keywords'}) ? @{$self->{param}{'keywords'}} : ();
     @result;
 }
 END_OF_FUNC
@@ -1173,7 +1176,7 @@
 
 'EXISTS' => <<'END_OF_FUNC',
 sub EXISTS {
-    exists $_[0]->{$_[1]};
+    exists $_[0]->{param}{$_[1]};
 }
 END_OF_FUNC
 
@@ -1200,7 +1203,7 @@
     my(@values) = defined($value) ? (ref($value) ? @{$value} : $value) : ();
     if (@values) {
 	$self->add_parameter($name);
-	push(@{$self->{$name}}, at values);
+	push(@{$self->{param}{$name}}, at values);
     }
     return $self->param($name);
 }
@@ -1378,7 +1381,7 @@
 'multipart_init' => <<'END_OF_FUNC',
 sub multipart_init {
     my($self, at p) = self_or_default(@_);
-    my($boundary, at other) = rearrange([BOUNDARY], at p);
+    my($boundary, at other) = rearrange_header([BOUNDARY], at p);
     $boundary = $boundary || '------- =_aaaaaaaaaa0';
     $self->{'separator'} = "$CRLF--$boundary$CRLF";
     $self->{'final_separator'} = "$CRLF--$boundary--$CRLF";
@@ -1519,7 +1522,7 @@
     push(@header,map {ucfirst $_} @other);
     push(@header,"Content-Type: $type") if $type ne '';
     my $header = join($CRLF, at header)."${CRLF}${CRLF}";
-    if ($MOD_PERL and not $nph) {
+    if (($MOD_PERL >= 1) && !$nph) {
         $self->r->send_cgi_header($header);
         return '';
     }
@@ -1663,12 +1666,22 @@
 			: qq(<meta name="$_" content="$meta->{$_}">)); }
     }
 
-    push(@result,ref($head) ? @$head : $head) if $head;
+    my $meta_bits_set = 0;
+    if( $head ) {
+        if( ref $head ) {
+            push @result, @$head;
+            $meta_bits_set = 1 if grep { /http-equiv=["']Content-Type/i }@$head;
+        }
+        else {
+            push @result, $head;
+            $meta_bits_set = 1 if $head =~ /http-equiv=["']Content-Type/i;
+        }
+    }
 
     # handle the infrequently-used -style and -script parameters
     push(@result,$self->_style($style))   if defined $style;
     push(@result,$self->_script($script)) if defined $script;
-    push(@result,$meta_bits)              if defined $meta_bits;
+    push(@result,$meta_bits)              if defined $meta_bits and !$meta_bits_set;
 
     # handle -noscript parameter
     push(@result,<<END) if $noscript;
@@ -1699,6 +1712,7 @@
     my $cdata_end   = $XHTML ? "\n/* ]]> */-->\n" : " -->\n";
 
     my @s = ref($style) eq 'ARRAY' ? @$style : $style;
+    my $other = '';
 
     for my $s (@s) {
       if (ref($s)) {
@@ -1708,7 +1722,7 @@
                        ref($s) eq 'ARRAY' ? @$s : %$s));
        my $type = defined $stype ? $stype : 'text/css';
        my $rel  = $alternate ? 'alternate stylesheet' : 'stylesheet';
-       my $other = @other ? join ' ', at other : '';
+       $other = "@other" if @other;
 
        if (ref($src) eq "ARRAY") # Check to see if the $src variable is an array reference
        { # If it is, push a LINK tag for each one
@@ -1831,7 +1845,7 @@
     my($method,$action,$enctype, at other) = 
 	rearrange([METHOD,ACTION,ENCTYPE], at p);
 
-    $method  = $self->escapeHTML(lc($method) || 'post');
+    $method  = $self->escapeHTML(lc($method || 'post'));
     $enctype = $self->escapeHTML($enctype || &URL_ENCODED);
     if (defined $action) {
        $action = $self->escapeHTML($action);
@@ -2147,8 +2161,9 @@
 sub checkbox {
     my($self, at p) = self_or_default(@_);
 
-    my($name,$checked,$value,$label,$override,$tabindex, at other) = 
-	rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE],TABINDEX], at p);
+    my($name,$checked,$value,$label,$labelattributes,$override,$tabindex, at other) =
+       rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,LABELATTRIBUTES,
+                   [OVERRIDE,FORCE],TABINDEX], at p);
 
     $value = defined $value ? $value : 'on';
 
@@ -2165,7 +2180,8 @@
     my($other) = @other ? "@other " : '';
     $tabindex = $self->element_tab($tabindex);
     $self->register_parameter($name);
-    return $XHTML ? CGI::label(qq{<input type="checkbox" name="$name" value="$value" $tabindex$checked$other/>$the_label})
+    return $XHTML ? CGI::label($labelattributes,
+                    qq{<input type="checkbox" name="$name" value="$value" $tabindex$checked$other/>$the_label})
                   : qq{<input type="checkbox" name="$name" value="$value"$checked$other>$the_label};
 }
 END_OF_FUNC
@@ -2192,9 +2208,11 @@
          else {
 	     $toencode =~ s{"}{"}gso;
          }
-         my $latin = uc $self->{'.charset'} eq 'ISO-8859-1' ||
-                     uc $self->{'.charset'} eq 'WINDOWS-1252';
-         if ($latin) {  # bug in some browsers
+         # Handle bug in some browsers with Latin charsets
+         if ($self->{'.charset'} &&
+             (uc($self->{'.charset'}) eq 'ISO-8859-1' ||
+              uc($self->{'.charset'}) eq 'WINDOWS-1252'))
+         {
                 $toencode =~ s{'}{'}gso;
                 $toencode =~ s{\x8b}{‹}gso;
                 $toencode =~ s{\x9b}{›}gso;
@@ -2327,13 +2345,14 @@
     my $self     = shift;
     my $box_type = shift;
 
-    my($name,$values,$defaults,$linebreak,$labels,$attributes,
-       $rows,$columns,$rowheaders,$colheaders,
+    my($name,$values,$defaults,$linebreak,$labels,$labelattributes,
+       $attributes,$rows,$columns,$rowheaders,$colheaders,
        $override,$nolabels,$tabindex,$disabled, at other) =
-       rearrange([      NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LINEBREAK,LABELS,ATTRIBUTES,
-		        ROWS,[COLUMNS,COLS],[ROWHEADERS,ROWHEADER],[COLHEADERS,COLHEADER],
-			[OVERRIDE,FORCE],NOLABELS,TABINDEX,DISABLED
-                 ], at _);
+        rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LINEBREAK,LABELS,LABELATTRIBUTES,
+                       ATTRIBUTES,ROWS,[COLUMNS,COLS],[ROWHEADERS,ROWHEADER],[COLHEADERS,COLHEADER],
+                       [OVERRIDE,FORCE],NOLABELS,TABINDEX,DISABLED
+                  ], at _);
+
 
     my($result,$checked, at elements, at values);
 
@@ -2393,7 +2412,7 @@
 
         if ($XHTML) {
            push @elements,
-              CGI::label(
+              CGI::label($labelattributes,
                    qq(<input type="$box_type" name="$name" value="$_" $checkit$other$tab$attribs$disable/>$label)).${break};
         } else {
             push(@elements,qq/<input type="$box_type" name="$name" value="$_"$checkit$other$tab$attribs$disable>${label}${break}/);
@@ -2428,12 +2447,14 @@
     my($name,$values,$default,$labels,$attributes,$override,$tabindex, at other) =
        rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS,
        ATTRIBUTES,[OVERRIDE,FORCE],TABINDEX], at p);
-    my($result,$selected);
+    my($result,%selected);
 
     if (!$override && defined($self->param($name))) {
-	$selected = $self->param($name);
-    } else {
-	$selected = $default;
+	$selected{$self->param($name)}++;
+    } elsif ($default) {
+	%selected = map {$_=>1} ref($default) eq 'ARRAY' 
+                                ? @$default 
+                                : $default;
     }
     $name=$self->escapeHTML($name);
     my($other) = @other ? " @other" : '';
@@ -2444,20 +2465,22 @@
     $result = qq/<select name="$name" $tabindex$other>\n/;
     foreach (@values) {
         if (/<optgroup/) {
-            foreach (split(/\n/)) {
+            for my $v (split(/\n/)) {
                 my $selectit = $XHTML ? 'selected="selected"' : 'selected';
-                s/(value="$selected")/$selectit $1/ if defined $selected;
-                $result .= "$_\n";
+		for my $selected (keys %selected) {
+		    $v =~ s/(value="$selected")/$selectit $1/;
+		}
+                $result .= "$v\n";
             }
         }
         else {
-          my $attribs = $self->_set_attributes($_, $attributes);
-	  my($selectit) = defined($selected) ? $self->_selected($selected eq $_) : '';
-	  my($label) = $_;
-	  $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
-	  my($value) = $self->escapeHTML($_);
-	  $label=$self->escapeHTML($label,1);
-          $result .= "<option${attribs} ${selectit}value=\"$value\">$label</option>\n";
+          my $attribs   = $self->_set_attributes($_, $attributes);
+	  my($selectit) = $self->_selected($selected{$_});
+	  my($label)    = $_;
+	  $label        = $labels->{$_} if defined($labels) && defined($labels->{$_});
+	  my($value)    = $self->escapeHTML($_);
+	  $label        = $self->escapeHTML($label,1);
+          $result      .= "<option${attribs} ${selectit}value=\"$value\">$label</option>\n";
         }
     }
 
@@ -2560,6 +2583,7 @@
     $size = $size || scalar(@values);
 
     my(%selected) = $self->previous_or_default($name,$defaults,$override);
+
     my($is_multiple) = $multiple ? qq/ multiple="multiple"/ : '';
     my($has_size) = $size ? qq/ size="$size"/: '';
     my($other) = @other ? " @other" : '';
@@ -2692,12 +2716,13 @@
     my $request_uri =  unescape($self->request_uri) || '';
     my $query_str   =  $self->query_string;
 
-    my $rewrite_in_use = $request_uri && $request_uri !~ /^$script_name/;
+    my $rewrite_in_use = $request_uri && $request_uri !~ /^\Q$script_name/;
     undef $path if $rewrite_in_use && $rewrite;  # path not valid when rewriting active
 
     my $uri         =  $rewrite && $request_uri ? $request_uri : $script_name;
-    $uri            =~ s/\?.*$//;                                 # remove query string
-    $uri            =~ s/\Q$path\E$//      if defined $path;      # remove path
+    $uri            =~ s/\?.*$//s;                                # remove query string
+    $uri            =~ s/\Q$ENV{PATH_INFO}\E$// if defined $ENV{PATH_INFO};
+#    $uri            =~ s/\Q$path\E$//      if defined $path;      # remove path
 
     if ($full) {
 	my $protocol = $self->protocol();
@@ -2723,6 +2748,7 @@
 
     $url .= $path         if $path_info and defined $path;
     $url .= "?$query_str" if $query     and $query_str ne '';
+    $url ||= '';
     $url =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/sprintf("%%%02X",ord($1))/eg;
     return $url;
 }
@@ -2793,12 +2819,12 @@
 sub param_fetch {
     my($self, at p) = self_or_default(@_);
     my($name) = rearrange([NAME], at p);
-    unless (exists($self->{$name})) {
+    unless (exists($self->{param}{$name})) {
 	$self->add_parameter($name);
-	$self->{$name} = [];
+	$self->{param}{$name} = [];
     }
     
-    return $self->{$name};
+    return $self->{param}{$name};
 }
 END_OF_FUNC
 
@@ -2824,30 +2850,58 @@
 }
 END_OF_FUNC
 
-# WE USE THIS TO COMPENSATE FOR A BUG IN APACHE 2 PRESENT AT LEAST UP THROUGH 2.0.54
+# This function returns a potentially modified version of SCRIPT_NAME
+# and PATH_INFO. Some HTTP servers do sanitise the paths in those
+# variables. It is the case of at least Apache 2. If for instance the
+# user requests: /path/./to/script.cgi/x//y/z/../x?y, Apache will set:
+# REQUEST_URI=/path/./to/script.cgi/x//y/z/../x?y
+# SCRIPT_NAME=/path/to/env.cgi
+# PATH_INFO=/x/y/x
+#
+# This is all fine except that some bogus CGI scripts expect
+# PATH_INFO=/http://foo when the user requests
+# http://xxx/script.cgi/http://foo
+#
+# Old versions of this module used to accomodate with those scripts, so
+# this is why we do this here to keep those scripts backward compatible.
+# Basically, we accomodate with those scripts but within limits, that is
+# we only try to preserve the number of / that were provided by the user
+# if $REQUEST_URI and "$SCRIPT_NAME$PATH_INFO" only differ by the number
+# of consecutive /.
+#
+# So for instance, in: http://foo/x//y/script.cgi/a//b, we'll return a
+# script_name of /x//y/script.cgi and a path_info of /a//b, but in:
+# http://foo/./x//z/script.cgi/a/../b//c, we'll return the versions
+# possibly sanitised by the HTTP server, so in the case of Apache 2:
+# script_name == /foo/x/z/script.cgi and path_info == /b/c.
+#
+# Future versions of this module may no longer do that, so one should
+# avoid relying on the browser, proxy, server, and CGI.pm preserving the
+# number of consecutive slashes as no guarantee can be made there.
 '_name_and_path_from_env' => <<'END_OF_FUNC',
 sub _name_and_path_from_env {
-   my $self = shift;
-   my $raw_script_name = $ENV{SCRIPT_NAME} || '';
-   my $raw_path_info   = $ENV{PATH_INFO}   || '';
-   my $uri             = unescape($self->request_uri) || '';
-
-   my $protected    = quotemeta($raw_path_info);
-   $raw_script_name =~ s/$protected$//;
-
-   my @uri_double_slashes  = $uri =~ m^(/{2,}?)^g;
-   my @path_double_slashes = "$raw_script_name $raw_path_info" =~ m^(/{2,}?)^g;
-
-   my $apache_bug      = @uri_double_slashes != @path_double_slashes;
-   return ($raw_script_name,$raw_path_info) unless $apache_bug;
-
-   my $path_info_search = quotemeta($raw_path_info);
-   $path_info_search    =~ s!/!/+!g;
-   if ($uri =~ m/^(.+)($path_info_search)/) {
-       return ($1,$2);
-   } else {
-       return ($raw_script_name,$raw_path_info);
-   }
+    my $self = shift;
+    my $script_name = $ENV{SCRIPT_NAME}  || '';
+    my $path_info   = $ENV{PATH_INFO}    || '';
+    my $uri         = $self->request_uri || '';
+
+    $uri =~ s/\?.*//s;
+    $uri = unescape($uri);
+
+    if ($uri ne "$script_name$path_info") {
+        my $script_name_pattern = quotemeta($script_name);
+        my $path_info_pattern = quotemeta($path_info);
+        $script_name_pattern =~ s{(?:\\/)+}{/+}g;
+        $path_info_pattern =~ s{(?:\\/)+}{/+}g;
+
+        if ($uri =~ /^($script_name_pattern)($path_info_pattern)$/s) {
+            # REQUEST_URI and SCRIPT_NAME . PATH_INFO only differ by the
+            # numer of consecutive slashes, so we can extract the info from
+            # REQUEST_URI:
+            ($script_name, $path_info) = ($1, $2);
+        }
+    }
+    return ($script_name,$path_info);
 }
 END_OF_FUNC
 
@@ -2931,7 +2985,9 @@
     my($self,$search) = self_or_CGI(@_);
     my(%prefs,$type,$pref,$pat);
     
-    my(@accept) = split(',',$self->http('accept'));
+    my(@accept) = defined $self->http('accept') 
+                ? split(',',$self->http('accept'))
+                : ();
 
     foreach (@accept) {
 	($pref) = /q=(\d\.\d+|\d+)/;
@@ -3284,10 +3340,10 @@
 
     if (!$override && ($self->{'.fieldnames'}->{$name} || 
 		       defined($self->param($name)) ) ) {
-	grep($selected{$_}++,$self->param($name));
+	$selected{$_}++ for $self->param($name);
     } elsif (defined($defaults) && ref($defaults) && 
 	     (ref($defaults) eq 'ARRAY')) {
-	grep($selected{$_}++,@{$defaults});
+	$selected{$_}++ for @{$defaults};
     } else {
 	$selected{$defaults}++ if defined($defaults);
     }
@@ -3368,11 +3424,20 @@
 	    return;
 	}
 
+	$header{'Content-Disposition'} ||= ''; # quench uninit variable warning
+
 	my($param)= $header{'Content-Disposition'}=~/ name="([^"]*)"/;
         $param .= $TAINTED;
 
-	# Bug:  Netscape doesn't escape quotation marks in file names!!!
-	my($filename) = $header{'Content-Disposition'}=~/ filename="([^"]*)"/;
+        # See RFC 1867, 2183, 2045
+        # NB: File content will be loaded into memory should
+        # content-disposition parsing fail.
+        my ($filename) = $header{'Content-Disposition'}
+	               =~/ filename=(("[^"]*")|([a-z\d!\#'\*\+,\.^_\`\{\}\|\~]*))/i;
+
+	$filename ||= ''; # quench uninit variable warning
+
+        $filename =~ s/^"([^"]*)"$/$1/;
 	# Test for Opera's multiple upload feature
 	my($multipart) = ( defined( $header{'Content-Type'} ) &&
 		$header{'Content-Type'} =~ /multipart\/mixed/ ) ?
@@ -3386,7 +3451,7 @@
 	if ( ( !defined($filename) || $filename eq '' ) && !$multipart ) {
 	    my($value) = $buffer->readBody;
             $value .= $TAINTED;
-	    push(@{$self->{$param}},$value);
+	    push(@{$self->{param}{$param}},$value);
 	    next;
 	}
 
@@ -3431,7 +3496,7 @@
 
 	  my ($data);
 	  local($\) = '';
-          my $totalbytes;
+          my $totalbytes = 0;
           while (defined($data = $buffer->read)) {
               if (defined $self->{'.upload_hook'})
                {
@@ -3462,7 +3527,7 @@
 	      name => $tmpfile,
 	      info => {%header},
 	  };
-	  push(@{$self->{$param}},$filehandle);
+	  push(@{$self->{param}{$param}},$filehandle);
       }
     }
 }
@@ -3564,7 +3629,7 @@
 	      name => $tmpfile,
 	      info => {%header},
 	  };
-	  push(@{$self->{$param}},$filehandle);
+	  push(@{$self->{param}{$param}},$filehandle);
       }
     }
     return $returnvalue;
@@ -3645,6 +3710,7 @@
 
 ################### Fh -- lightweight filehandle ###############
 package Fh;
+
 use overload 
     '""'  => \&asString,
     'cmp' => \&compare,
@@ -3696,7 +3762,7 @@
     (my $safename = $name) =~ s/([':%])/ sprintf '%%%02X', ord $1 /eg;
     my $fv = ++$FH . $safename;
     my $ref = \*{"Fh::$fv"};
-    $file =~ m!^([a-zA-Z0-9_ \'\":/.\$\\-]+)$! || return;
+    $file =~ m!^([a-zA-Z0-9_\+ \'\":/.\$\\~-]+)$! || return;
     my $safe = $1;
     sysopen($ref,$safe,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return;
     unlink($safe) if $delete;
@@ -3705,6 +3771,14 @@
 }
 END_OF_FUNC
 
+'handle' => <<'END_OF_FUNC',
+sub handle {
+  my $self = shift;
+  eval "require IO::Handle" unless IO::Handle->can('new_from_fd');
+  return IO::Handle->new_from_fd(fileno $self,"<");
+}
+END_OF_FUNC
+
 );
 END_OF_AUTOLOAD
 
@@ -3768,7 +3842,7 @@
     }
 
     my $self = {LENGTH=>$length,
-		CHUNKED=>!defined $length,
+		CHUNKED=>!$length,
 		BOUNDARY=>$boundary,
 		INTERFACE=>$interface,
 		BUFFER=>'',
@@ -3986,6 +4060,14 @@
 	   "${vol}${SL}Temporary Items",
            "${SL}WWW_ROOT", "${SL}SYS\$SCRATCH",
 	   "C:${SL}system${SL}temp");
+    
+    if( $CGI::OS eq 'WINDOWS' ){
+       unshift @TEMP,
+           $ENV{TEMP},
+           $ENV{TMP},
+           $ENV{WINDIR} . $SL . 'TEMP';
+    }
+
     unshift(@TEMP,$ENV{'TMPDIR'}) if defined $ENV{'TMPDIR'};
 
     # this feature was supposed to provide per-user tmpfiles, but
@@ -4014,7 +4096,7 @@
 
 sub DESTROY {
     my($self) = @_;
-    $$self =~ m!^([a-zA-Z0-9_ \'\":/.\$\\-]+)$! || return;
+    $$self =~ m!^([a-zA-Z0-9_ \'\":/.\$\\~-]+)$! || return;
     my $safe = $1;             # untaint operation
     unlink $safe;              # get rid of the file
 }
@@ -4032,10 +4114,10 @@
     my $filename;
     find_tempdir() unless -w $TMPDIRECTORY;
     for (my $i = 0; $i < $MAXTRIES; $i++) {
-	last if ! -f ($filename = sprintf("${TMPDIRECTORY}${SL}CGItemp%d",$sequence++));
+	last if ! -f ($filename = sprintf("\%s${SL}CGItemp%d", $TMPDIRECTORY, $sequence++));
     }
     # check that it is a more-or-less valid filename
-    return unless $filename =~ m!^([a-zA-Z0-9_ \'\":/.\$\\-]+)$!;
+    return unless $filename =~ m!^([a-zA-Z0-9_\+ \'\":/.\$\\~-]+)$!;
     # this used to untaint, now it doesn't
     # $filename = $1;
     return bless \$filename;
@@ -4109,6 +4191,8 @@
 	     hr;
    }
 
+   print end_html;
+
 =head1 ABSTRACT
 
 This perl library uses perl5 objects to make it easy to create Web
@@ -4392,8 +4476,7 @@
 the method will return a single value.
 
 If a value is not given in the query string, as in the queries
-"name1=&name2=" or "name1&name2", it will be returned as an empty
-string.  This feature is new in 2.63.
+"name1=&name2=", it will be returned as an empty string.
 
 
 If the parameter does not exist at all, then param() will return undef
@@ -4477,6 +4560,10 @@
 
    my $data = $query->param('POSTDATA');
 
+Likewise if PUTed data can be retrieved with code like this:
+
+   my $data = $query->param('PUTDATA');
+
 (If you don't know what the preceding means, don't worry about it.  It
 only affects people trying to use CGI for XML processing and other
 specialized tasks.)
@@ -4812,6 +4899,16 @@
 XHTML will automatically be disabled without needing to use this 
 pragma.
 
+=item -utf8
+
+This makes CGI.pm treat all parameters as UTF-8 strings. Use this with
+care, as it will interfere with the processing of binary uploads. It
+is better to manually select which fields are expected to return utf-8
+strings and convert them using code like this:
+
+ use Encode;
+ my $arg = decode utf8=>param('foo');
+
 =item -nph
 
 This makes CGI.pm produce a header appropriate for an NPH (no
@@ -5388,7 +5485,7 @@
 If Apache's mod_rewrite is turned on, then the script name and path
 info probably won't match the request that the user sent. Set
 -rewrite=>1 (default) to return URLs that match what the user sent
-(the original request URI). Set -rewrite->0 to return URLs that match
+(the original request URI). Set -rewrite=>0 to return URLs that match
 the URL after mod_rewrite's rules have run. Because the additional
 path information only makes sense in the context of the rewritten URL,
 -rewrite is set to false when you request path info in the URL.
@@ -5987,24 +6084,27 @@
 
 To be safe, use the I<upload()> function (new in version 2.47).  When
 called with the name of an upload field, I<upload()> returns a
-filehandle, or undef if the parameter is not a valid filehandle.
+filehandle-like object, or undef if the parameter is not a valid
+filehandle.
 
      $fh = upload('uploaded_file');
      while (<$fh>) {
 	   print;
      }
 
-In an list context, upload() will return an array of filehandles.
+In a list context, upload() will return an array of filehandles.
 This makes it possible to create forms that use the same name for
 multiple upload fields.
 
 This is the recommended idiom.
 
-For robust code, consider reseting the file handle position to beginning of the
-file. Inside of larger frameworks, other code may have already used the query
-object and changed the filehandle postion:
+The lightweight filehandle returned by CGI.pm is not compatible with
+IO::Handle; for example, it does not have read() or getline()
+functions, but instead must be manipulated using read($fh) or
+<$fh>. To get a compatible IO::Handle object, call the handle's
+handle() method:
 
-  seek($fh,0,0); # reset postion to beginning of file.
+  my $real_io_handle = upload('uploaded_file')->handle;
 
 When a file is uploaded the browser usually sends along some
 information along with it in the format of headers.  The information
@@ -6102,7 +6202,7 @@
 
    print popup_menu(-name=>'menu_name',
 			    -values=>['eenie','meenie','minie'],
-			    -default=>'meenie',
+			    -default=>['meenie','minie'],
           -labels=>\%labels,
           -attributes=>\%attributes);
 
@@ -6125,7 +6225,8 @@
 
 The optional third parameter (-default) is the name of the default
 menu choice.  If not specified, the first item will be the default.
-The values of the previous choice will be maintained across queries.
+The values of the previous choice will be maintained across
+queries. Pass an array reference to select multiple defaults.
 
 =item 4.
 
@@ -6389,6 +6490,9 @@
   -tabindex => ['moe','minie','eenie','meenie']  # tab in this order
   -tabindex => {meenie=>100,moe=>101,minie=>102,eenie=>200} # tab in this order
 
+The optional B<-labelattributes> argument will contain attributes
+attached to the <label> element that surrounds each button.
+
 When the form is processed, all checked boxes will be returned as
 a list under the parameter name 'group_name'.  The values of the
 "on" checkboxes can be retrieved with:
@@ -6546,6 +6650,9 @@
 with the attribute's name as the key and the attribute's value as the
 value.
 
+The optional B<-labelattributes> argument will contain attributes
+attached to the <label> element that surrounds each button.
+
 When the form is processed, the selected radio button can
 be retrieved using:
 
@@ -7658,10 +7765,8 @@
 
 =head1 AUTHOR INFORMATION
 
-Copyright 1995-1998, Lincoln D. Stein.  All rights reserved.  
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+The GD.pm interface is copyright 1995-2007, Lincoln D. Stein.  It is
+distributed under GPL and the Artistic License 2.0.
 
 Address bug reports and comments to: lstein at cshl.org.  When sending
 bug reports, please provide the version of CGI.pm, the version of

perl-update-ExtUtils-CBuilder.patch:

--- NEW FILE perl-update-ExtUtils-CBuilder.patch ---
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

perl-update-File-Fetch.patch:

--- NEW FILE perl-update-File-Fetch.patch ---
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 at 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
 

perl-update-File-Path.patch:

--- NEW FILE perl-update-File-Path.patch ---
File-Path-2.07

diff -urN perl-5.10.0.orig/lib/File/Path.pm perl-5.10.0/lib/File/Path.pm
--- perl-5.10.0.orig/lib/File/Path.pm	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/File/Path.pm	2009-02-17 14:50:05.000000000 +0100
@@ -16,13 +16,14 @@
 }
 
 use Exporter ();
-use vars qw($VERSION @ISA @EXPORT);
-$VERSION = '2.04';
- at ISA     = qw(Exporter);
- at EXPORT  = qw(mkpath rmtree);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+$VERSION   = '2.07';
+ at ISA       = qw(Exporter);
+ at EXPORT    = qw(mkpath rmtree);
+ at EXPORT_OK = qw(make_path remove_tree);
 
-my $Is_VMS   = $^O eq 'VMS';
-my $Is_MacOS = $^O eq 'MacOS';
+my $Is_VMS     = $^O eq 'VMS';
+my $Is_MacOS   = $^O eq 'MacOS';
 
 # These OSes complain if you want to remove a file that you have no
 # write permission to:
@@ -45,22 +46,21 @@
 
     if ($arg->{error}) {
         $object = '' unless defined $object;
-        push @{${$arg->{error}}}, {$object => "$message: $!"};
+        $message .= ": $!" if $!;
+        push @{${$arg->{error}}}, {$object => $message};
     }
     else {
         _carp(defined($object) ? "$message for $object: $!" : "$message: $!");
     }
 }
 
+sub make_path {
+    push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH');
+    goto &mkpath;
+}
+
 sub mkpath {
-    my $old_style = (
-        UNIVERSAL::isa($_[0],'ARRAY')
-        or (@_ == 2 and (defined $_[1] ? $_[1] =~ /\A\d+\z/ : 1))
-        or (@_ == 3
-            and (defined $_[1] ? $_[1] =~ /\A\d+\z/ : 1)
-            and (defined $_[2] ? $_[2] =~ /\A\d+\z/ : 1)
-        )
-    ) ? 1 : 0;
+    my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH'));
 
     my $arg;
     my $paths;
@@ -69,19 +69,14 @@
         my ($verbose, $mode);
         ($paths, $verbose, $mode) = @_;
         $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY');
-        $arg->{verbose} = defined $verbose ? $verbose : 0;
-        $arg->{mode}    = defined $mode    ? $mode    : 0777;
+        $arg->{verbose} = $verbose;
+        $arg->{mode}    = defined $mode ? $mode : 0777;
     }
     else {
-        if (@_ > 0 and UNIVERSAL::isa($_[-1], 'HASH')) {
-            $arg = pop @_;
-            exists $arg->{mask} and $arg->{mode} = delete $arg->{mask};
-            $arg->{mode} = 0777 unless exists $arg->{mode};
-            ${$arg->{error}} = [] if exists $arg->{error};
-        }
-        else {
-            @{$arg}{qw(verbose mode)} = (0, 0777);
-        }
+        $arg = pop @_;
+        $arg->{mode}      = delete $arg->{mask} if exists $arg->{mask};
+        $arg->{mode}      = 0777 unless exists $arg->{mode};
+        ${$arg->{error}}  = [] if exists $arg->{error};
         $paths = [@_];
     }
     return _mkpath($arg, $paths);
@@ -91,10 +86,9 @@
     my $arg   = shift;
     my $paths = shift;
 
-    local($")=$Is_MacOS ? ":" : "/";
     my(@created,$path);
     foreach $path (@$paths) {
-        next unless length($path);
+        next unless defined($path) and length($path);
         $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT 
         # Logic wants Unix paths, so go with the flow.
         if ($Is_VMS) {
@@ -129,15 +123,13 @@
     return @created;
 }
 
+sub remove_tree {
+    push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH');
+    goto &rmtree;
+}
+
 sub rmtree {
-    my $old_style = (
-        UNIVERSAL::isa($_[0],'ARRAY')
-        or (@_ == 2 and (defined $_[1] ? $_[1] =~ /\A\d+\z/ : 1))
-        or (@_ == 3
-            and (defined $_[1] ? $_[1] =~ /\A\d+\z/ : 1)
-            and (defined $_[2] ? $_[2] =~ /\A\d+\z/ : 1)
-        )
-    ) ? 1 : 0;
+    my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH'));
 
     my $arg;
     my $paths;
@@ -145,7 +137,7 @@
     if ($old_style) {
         my ($verbose, $safe);
         ($paths, $verbose, $safe) = @_;
-        $arg->{verbose} = defined $verbose ? $verbose : 0;
+        $arg->{verbose} = $verbose;
         $arg->{safe}    = defined $safe    ? $safe    : 0;
 
         if (defined($paths) and length($paths)) {
@@ -157,32 +149,55 @@
         }
     }
     else {
-        if (@_ > 0 and UNIVERSAL::isa($_[-1],'HASH')) {
-            $arg = pop @_;
-            ${$arg->{error}}  = [] if exists $arg->{error};
-            ${$arg->{result}} = [] if exists $arg->{result};
-        }
-        else {
-            @{$arg}{qw(verbose safe)} = (0, 0);
-        }
+        $arg = pop @_;
+        ${$arg->{error}}  = [] if exists $arg->{error};
+        ${$arg->{result}} = [] if exists $arg->{result};
         $paths = [@_];
     }
 
     $arg->{prefix} = '';
     $arg->{depth}  = 0;
 
+    my @clean_path;
     $arg->{cwd} = getcwd() or do {
         _error($arg, "cannot fetch initial working directory");
         return 0;
     };
     for ($arg->{cwd}) { /\A(.*)\Z/; $_ = $1 } # untaint
 
-    @{$arg}{qw(device inode)} = (stat $arg->{cwd})[0,1] or do {
+    for my $p (@$paths) {
+        # need to fixup case and map \ to / on Windows
+        my $ortho_root = $^O eq 'MSWin32' ? _slash_lc($p)          : $p;
+        my $ortho_cwd  = $^O eq 'MSWin32' ? _slash_lc($arg->{cwd}) : $arg->{cwd};
+        my $ortho_root_length = length($ortho_root);
+        $ortho_root_length-- if $^O eq 'VMS'; # don't compare '.' with ']'
+        if ($ortho_root_length
+            && (substr($ortho_root, 0, $ortho_root_length) 
+             eq substr($ortho_cwd, 0, $ortho_root_length))) {
+            local $! = 0;
+            _error($arg, "cannot remove path when cwd is $arg->{cwd}", $p);
+            next;
+        }
+
+        if ($Is_MacOS) {
+            $p  = ":$p" unless $p =~ /:/;
+            $p .= ":"   unless $p =~ /:\z/;
+        }
+        elsif ($^O eq 'MSWin32') {
+            $p =~ s{[/\\]\z}{};
+        }
+        else {
+            $p =~ s{/\z}{};
+        }
+        push @clean_path, $p;
+    }
+
+    @{$arg}{qw(device inode perm)} = (lstat $arg->{cwd})[0,1] or do {
         _error($arg, "cannot stat initial working directory", $arg->{cwd});
         return 0;
     };
 
-    return _rmtree($arg, $paths);
+    return _rmtree($arg, \@clean_path);
 }
 
 sub _rmtree {
@@ -196,14 +211,6 @@
     my (@files, $root);
     ROOT_DIR:
     foreach $root (@$paths) {
-        if ($Is_MacOS) {
-            $root  = ":$root" unless $root =~ /:/;
-            $root .= ":"      unless $root =~ /:\z/;
-        }
-        else {
-            $root =~ s{/\z}{};
-        }
-
         # since we chdir into each directory, it may not be obvious
         # to figure out where we are if we generate a message about
         # a file name. We therefore construct a semi-canonical
@@ -234,13 +241,13 @@
                 }
             }
 
-            my ($device, $inode, $perm) = (stat $curdir)[0,1,2] or do {
+            my ($cur_dev, $cur_inode, $perm) = (stat $curdir)[0,1,2] or do {
                 _error($arg, "cannot stat current working directory", $canon);
                 next ROOT_DIR;
             };
 
-            ($ldev eq $device and $lino eq $inode)
-                or _croak("directory $canon changed before chdir, expected dev=$ldev inode=$lino, actual dev=$device ino=$inode, aborting.");
+            ($ldev eq $cur_dev and $lino eq $cur_inode)
+                or _croak("directory $canon changed before chdir, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting.");
 
             $perm &= 07777; # don't forget setuid, setgid, sticky bits
             my $nperm = $perm | 0700;
@@ -287,7 +294,7 @@
                 # remove the contained files before the directory itself
                 my $narg = {%$arg};
                 @{$narg}{qw(device inode cwd prefix depth)}
-                    = ($device, $inode, $updir, $canon, $arg->{depth}+1);
+                    = ($cur_dev, $cur_inode, $updir, $canon, $arg->{depth}+1);
                 $count += _rmtree($narg, \@files);
             }
 
@@ -304,11 +311,11 @@
 
             # ensure that a chdir upwards didn't take us somewhere other
             # than we expected (see CVE-2002-0435)
-            ($device, $inode) = (stat $curdir)[0,1]
+            ($cur_dev, $cur_inode) = (stat $curdir)[0,1]
                 or _croak("cannot stat prior working directory $arg->{cwd}: $!, aborting.");
 
-            ($arg->{device} eq $device and $arg->{inode} eq $inode)
-                or _croak("previous directory $arg->{cwd} changed before entering $canon, expected dev=$ldev inode=$lino, actual dev=$device ino=$inode, aborting.");
+            ($arg->{device} eq $cur_dev and $arg->{inode} eq $cur_inode)
+                or _croak("previous directory $arg->{cwd} changed before entering $canon, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting.");
 
             if ($arg->{depth} or !$arg->{keep_root}) {
                 if ($arg->{safe} &&
@@ -316,10 +323,8 @@
                     print "skipped $root\n" if $arg->{verbose};
                     next ROOT_DIR;
                 }
-                if (!chmod $perm | 0700, $root) {
-                    if ($Force_Writeable) {
-                        _error($arg, "cannot make directory writeable", $canon);
-                    }
+                if ($Force_Writeable and !chmod $perm | 0700, $root) {
+                    _error($arg, "cannot make directory writeable", $canon);
                 }
                 print "rmdir $root\n" if $arg->{verbose};
                 if (rmdir $root) {
@@ -338,7 +343,7 @@
         else {
             # not a directory
             $root = VMS::Filespec::vmsify("./$root")
-                if $Is_VMS 
+                if $Is_VMS
                    && !File::Spec->file_name_is_absolute($root)
                    && ($root !~ m/(?<!\^)[\]>]+/);  # not already in VMS syntax
 
@@ -351,10 +356,8 @@
             }
 
             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 and $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
@@ -373,10 +376,17 @@
             }
         }
     }
-
     return $count;
 }
 
+sub _slash_lc {
+    # fix up slashes and case on MSWin32 so that we can determine that
+    # c:\path\to\dir is underneath C:/Path/To
+    my $path = shift;
+    $path =~ tr{\\}{/};
+    return lc($path);
+}
+
 1;
 __END__
 
@@ -386,59 +396,65 @@
 
 =head1 VERSION
 
-This document describes version 2.04 of File::Path, released
-2007-11-13.
+This document describes version 2.07 of File::Path, released
+2008-11-09.
 
 =head1 SYNOPSIS
 
-    use File::Path;
-
-    # modern
-    mkpath( 'foo/bar/baz', '/zug/zwang', {verbose => 1} );
+  use File::Path qw(make_path remove_tree);
 
-    rmtree(
-        'foo/bar/baz', '/zug/zwang',
-        { verbose => 1, error  => \my $err_list }
-    );
-
-    # traditional
-    mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);
-    rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);
+  make_path('foo/bar/baz', '/zug/zwang');
+  make_path('foo/bar/baz', '/zug/zwang', {
+      verbose => 1,
+      mode => 0711,
+  });
+
+  remove_tree('foo/bar/baz', '/zug/zwang');
+  remove_tree('foo/bar/baz', '/zug/zwang', {
+      verbose => 1,
+      error  => \my $err_list,
+  });
+
+  # legacy (interface promoted before v2.00)
+  mkpath('/foo/bar/baz');
+  mkpath('/foo/bar/baz', 1, 0711);
+  mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);
+  rmtree('foo/bar/baz', 1, 1);
+  rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);
+
+  # legacy (interface promoted before v2.06)
+  mkpath('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 });
+  rmtree('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 });
 
 =head1 DESCRIPTION
 
-The C<mkpath> function provides a convenient way to create directories
-of arbitrary depth. Similarly, the C<rmtree> function provides a
-convenient way to delete an entire directory subtree from the
-filesystem, much like the Unix command C<rm -r>.
-
-Both functions may be called in one of two ways, the traditional,
-compatible with code written since the dawn of time, and modern,
-that offers a more flexible and readable idiom. New code should use
-the modern interface.
-
-=head2 FUNCTIONS
-
-The modern way of calling C<mkpath> and C<rmtree> is with a list
-of directories to create, or remove, respectively, followed by an
-optional hash reference containing keys to control the
-function's behaviour.
-
-=head3 C<mkpath>
-
-The following keys are recognised as parameters to C<mkpath>.
-The function returns the list of files actually created during the
-call.
-
-  my @created = mkpath(
-    qw(/tmp /flub /home/nobody),
-    {verbose => 1, mode => 0750},
-  );
-  print "created $_\n" for @created;
+This module provide a convenient way to create directories of
+arbitrary depth and to delete an entire directory subtree from the
+filesystem.
 
-=over 4
+The following functions are provided:
+
+=over
+
+=item make_path( $dir1, $dir2, .... )
 
-=item mode
+=item make_path( $dir1, $dir2, ...., \%opts )
+
+The C<make_path> function creates the given directories if they don't
+exists before, much like the Unix command C<mkdir -p>.
+
+The function accepts a list of directories to be created. Its
+behaviour may be tuned by an optional hashref appearing as the last
+parameter on the call.
+
+The function returns the list of directories actually created during
+the call; in scalar context the number of directories created.
+
+The following keys are recognised in the option hash:
+
+=over
+
+=item mode => $num
 
 The numeric permissions mode to apply to each created directory
 (defaults to 0777), to be modified by the current C<umask>. If the
@@ -447,16 +463,17 @@
 
 C<mask> is recognised as an alias for this parameter.
 
-=item verbose
+=item verbose => $bool
 
-If present, will cause C<mkpath> to print the name of each directory
+If present, will cause C<make_path> to print the name of each directory
 as it is created. By default nothing is printed.
 
-=item error
+=item error => \$err
 
-If present, will be interpreted as a reference to a list, and will
-be used to store any errors that are encountered.  See the ERROR
-HANDLING section for more information.
+If present, it should be a reference to a scalar.
+This scalar will be made to reference an array, which will
+be used to store any errors that are encountered.  See the L</"ERROR
+HANDLING"> section for more information.
 
 If this parameter is not used, certain error conditions may raise
 a fatal error that will cause the program will halt, unless trapped
@@ -464,53 +481,80 @@
 
 =back
 
-=head3 C<rmtree>
+=item mkpath( $dir )
 
-=over 4
+=item mkpath( $dir, $verbose, $mode )
+
+=item mkpath( [$dir1, $dir2,...], $verbose, $mode )
+
+=item mkpath( $dir1, $dir2,..., \%opt )
+
+The mkpath() function provide the legacy interface of make_path() with
+a different interpretation of the arguments passed.  The behaviour and
+return value of the function is otherwise identical to make_path().
 
-=item verbose
+=item remove_tree( $dir1, $dir2, .... )
 
-If present, will cause C<rmtree> to print the name of each file as
+=item remove_tree( $dir1, $dir2, ...., \%opts )
+
+The C<remove_tree> function deletes the given directories and any
+files and subdirectories they might contain, much like the Unix
+command C<rm -r> or C<del /s> on Windows.
+
+The function accepts a list of directories to be
+removed. Its behaviour may be tuned by an optional hashref
+appearing as the last parameter on the call.
+
+The functions returns the number of files successfully deleted.
+
+The following keys are recognised in the option hash:
+
+=over
+
+=item verbose => $bool
+
+If present, will cause C<remove_tree> to print the name of each file as
 it is unlinked. By default nothing is printed.
 
-=item safe
+=item safe => $bool
 
-When set to a true value, will cause C<rmtree> to skip the files
+When set to a true value, will cause C<remove_tree> to skip the files
 for which the process lacks the required privileges needed to delete
 files, such as delete privileges on VMS. In other words, the code
 will make no attempt to alter file permissions. Thus, if the process
 is interrupted, no filesystem object will be left in a more
 permissive mode.
 
-=item keep_root
+=item keep_root => $bool
 
 When set to a true value, will cause all files and subdirectories
 to be removed, except the initially specified directories. This comes
 in handy when cleaning out an application's scratch directory.
 
-  rmtree( '/tmp', {keep_root => 1} );
+  remove_tree( '/tmp', {keep_root => 1} );
 
-=item result
+=item result => \$res
 
-If present, will be interpreted as a reference to a list, and will
-be used to store the list of all files and directories unlinked
-during the call. If nothing is unlinked, a reference to an empty
-list is returned (rather than C<undef>).
+If present, it should be a reference to a scalar.
+This scalar will be made to reference an array, which will
+be used to store all files and directories unlinked
+during the call. If nothing is unlinked, the array will be empty.
 
-  rmtree( '/tmp', {result => \my $list} );
+  remove_tree( '/tmp', {result => \my $list} );
   print "unlinked $_\n" for @$list;
 
 This is a useful alternative to the C<verbose> key.
 
-=item error
+=item error => \$err
 
-If present, will be interpreted as a reference to a list,
-and will be used to store any errors that are encountered.
-See the ERROR HANDLING section for more information.
+If present, it should be a reference to a scalar.
+This scalar will be made to reference an array, which will
+be used to store any errors that are encountered.  See the L</"ERROR
+HANDLING"> section for more information.
 
 Removing things is a much more dangerous proposition than
 creating things. As such, there are certain conditions that
-C<rmtree> may encounter that are so dangerous that the only
+C<remove_tree> may encounter that are so dangerous that the only
 sane action left is to kill the program.
 
 Use C<error> to trap all that is reasonable (problems with
@@ -519,131 +563,67 @@
 
 =back
 
-=head2 TRADITIONAL INTERFACE
-
-The old interfaces of C<mkpath> and C<rmtree> take a reference to
-a list of directories (to create or remove), followed by a series
-of positional, numeric, modal parameters that control their behaviour.
-
-This design made it difficult to add additional functionality, as
-well as posed the problem of what to do when the calling code only
-needs to set the last parameter. Even though the code doesn't care
-how the initial positional parameters are set, the programmer is
-forced to learn what the defaults are, and specify them.
-
-Worse, if it turns out in the future that it would make more sense
-to change the default behaviour of the first parameter (for example,
-to avoid a security vulnerability), all existing code will remain
-hard-wired to the wrong defaults.
-
-Finally, a series of numeric parameters are much less self-documenting
-in terms of communicating to the reader what the code is doing. Named
-parameters do not have this problem.
-
-In the traditional API, C<mkpath> takes three arguments:
-
-=over 4
-
-=item *
-
-The name of the path to create, or a reference to a list of paths
-to create,
+=item rmtree( $dir )
 
-=item *
+=item rmtree( $dir, $verbose, $safe )
 
-a boolean value, which if TRUE will cause C<mkpath> to print the
-name of each directory as it is created (defaults to FALSE), and
+=item rmtree( [$dir1, $dir2,...], $verbose, $safe )
 
-=item *
+=item rmtree( $dir1, $dir2,..., \%opt )
 
-the numeric mode to use when creating the directories (defaults to
-0777), to be modified by the current umask.
+The rmtree() function provide the legacy interface of remove_tree()
+with a different interpretation of the arguments passed. The behaviour
+and return value of the function is otherwise identical to
+remove_tree().
 
 =back
 
-It returns a list of all directories (including intermediates, determined
-using the Unix '/' separator) created.  In scalar context it returns
-the number of directories created.
-
-If a system error prevents a directory from being created, then the
-C<mkpath> function throws a fatal error with C<Carp::croak>. This error
-can be trapped with an C<eval> block:
-
-  eval { mkpath($dir) };
-  if ($@) {
-    print "Couldn't create $dir: $@";
-  }
-
-In the traditional API, C<rmtree> takes three arguments:
+=head2 ERROR HANDLING
 
 =over 4
 
-=item *
+=item B<NOTE:>
 
-the root of the subtree to delete, or a reference to a list of
-roots. All of the files and directories below each root, as well
-as the roots themselves, will be deleted. If you want to keep
-the roots themselves, you must use the modern API.
-
-=item *
-
-a boolean value, which if TRUE will cause C<rmtree> to print a
-message each time it examines a file, giving the name of the file,
-and indicating whether it's using C<rmdir> or C<unlink> to remove
-it, or that it's skipping it.  (defaults to FALSE)
-
-=item *
-
-a boolean value, which if TRUE will cause C<rmtree> to skip any
-files to which you do not have delete access (if running under VMS)
-or write access (if running under another OS). This will change
-in the future when a criterion for 'delete permission' under OSs
-other than VMS is settled.  (defaults to FALSE)
+The following error handling mechanism is considered
+experimental and is subject to change pending feedback from
+users.
 
 =back
 
-It returns the number of files, directories and symlinks successfully
-deleted.  Symlinks are simply deleted and not followed.
-
-Note also that the occurrence of errors in C<rmtree> using the
-traditional interface can be determined I<only> by trapping diagnostic
-messages using C<$SIG{__WARN__}>; it is not apparent from the return
-value. (The modern interface may use the C<error> parameter to
-record any problems encountered).
-
-=head2 ERROR HANDLING
-
-If C<mkpath> or C<rmtree> encounter an error, a diagnostic message
-will be printed to C<STDERR> via C<carp> (for non-fatal errors),
-or via C<croak> (for fatal errors).
+If C<make_path> or C<remove_tree> encounter an error, a diagnostic
+message will be printed to C<STDERR> via C<carp> (for non-fatal
+errors), or via C<croak> (for fatal errors).
 
 If this behaviour is not desirable, the C<error> attribute may be
 used to hold a reference to a variable, which will be used to store
-the diagnostics. The result is a reference to a list of hash
-references. For each hash reference, the key is the name of the
-file, and the value is the error message (usually the contents of
-C<$!>). An example usage looks like:
-
-  rmpath( 'foo/bar', 'bar/rat', {error => \my $err} );
-  for my $diag (@$err) {
-    my ($file, $message) = each %$diag;
-    print "problem unlinking $file: $message\n";
+the diagnostics. The variable is made a reference to an array of hash
+references.  Each hash contain a single key/value pair where the key
+is the name of the file, and the value is the error message (including
+the contents of C<$!> when appropriate).  If a general error is
+encountered the diagnostic key will be empty.
+
+An example usage looks like:
+
+  remove_tree( 'foo/bar', 'bar/rat', {error => \my $err} );
+  if (@$err) {
+      for my $diag (@$err) {
+          my ($file, $message) = %$diag;
+          if ($file eq '') {
+              print "general error: $message\n";
+          }
+          else {
+              print "problem unlinking $file: $message\n";
+          }
+      }
   }
-
-If no errors are encountered, C<$err> will point to an empty list
-(thus there is no need to test for C<undef>). If a general error
-is encountered (for instance, C<rmtree> attempts to remove a directory
-tree that does not exist), the diagnostic key will be empty, only
-the value will be set:
-
-  rmpath( '/no/such/path', {error => \my $err} );
-  for my $diag (@$err) {
-    my ($file, $message) = each %$diag;
-    if ($file eq '') {
-      print "general error: $message\n";
-    }
+  else {
+      print "No error encountered\n";
   }
 
+Note that if no errors are encountered, C<$err> will reference an
+empty array.  This means that C<$err> will always end up TRUE; so you
+need to test C<@$err> to determine if errors occured.
+
 =head2 NOTES
 
 C<File::Path> blindly exports C<mkpath> and C<rmtree> into the
@@ -653,38 +633,18 @@
 
   use File::Path 'rmtree';
 
-=head3 HEURISTICS
+The routines C<make_path> and C<remove_tree> are B<not> exported
+by default. You must specify which ones you want to use.
 
-The functions detect (as far as possible) which way they are being
-called and will act appropriately. It is important to remember that
-the heuristic for detecting the old style is either the presence
-of an array reference, or two or three parameters total and second
-and third parameters are numeric. Hence...
+  use File::Path 'remove_tree';
 
-    mkpath 486, 487, 488;
+Note that a side-effect of the above is that C<mkpath> and C<rmtree>
+are no longer exported at all. This is due to the way the C<Exporter>
+module works. If you are migrating a codebase to use the new
+interface, you will have to list everything explicitly. But that's
+just good practice anyway.
 
-... will not assume the modern style and create three directories, rather
-it will create one directory verbosely, setting the permission to
-0750 (488 being the decimal equivalent of octal 750). Here, old
-style trumps new. It must, for backwards compatibility reasons.
-
-If you want to ensure there is absolutely no ambiguity about which
-way the function will behave, make sure the first parameter is a
-reference to a one-element list, to force the old style interpretation:
-
-    mkpath [486], 487, 488;
-
-and get only one directory created. Or add a reference to an empty
-parameter hash, to force the new style:
-
-    mkpath 486, 487, 488, {};
-
-... and hence create the three directories. If the empty hash
-reference seems a little strange to your eyes, or you suspect a
-subsequent programmer might I<helpfully> optimise it away, you
-can add a parameter set to a default value:
-
-    mkpath 486, 487, 488, {verbose => 0};
+  use File::Path qw(remove_tree rmtree);
 
 =head3 SECURITY CONSIDERATIONS
 
@@ -701,7 +661,7 @@
 
 Additionally, unless the C<safe> parameter is set (or the
 third parameter in the traditional interface is TRUE), should a
-C<rmtree> be interrupted, files that were originally in read-only
+C<remove_tree> be interrupted, files that were originally in read-only
 mode may now have their permissions set to a read-write (or "delete
 OK") mode.
 
@@ -723,43 +683,43 @@
 
 =item mkdir [path]: [errmsg] (SEVERE)
 
-C<mkpath> was unable to create the path. Probably some sort of
+C<make_path> was unable to create the path. Probably some sort of
 permissions error at the point of departure, or insufficient resources
 (such as free inodes on Unix).
 
 =item No root path(s) specified
 
-C<mkpath> was not given any paths to create. This message is only
+C<make_path> was not given any paths to create. This message is only
 emitted if the routine is called with the traditional interface.
 The modern interface will remain silent if given nothing to do.
 
 =item No such file or directory
 
-On Windows, if C<mkpath> gives you this warning, it may mean that
+On Windows, if C<make_path> gives you this warning, it may mean that
 you have exceeded your filesystem's maximum path length.
 
 =item cannot fetch initial working directory: [errmsg]
 
-C<rmtree> attempted to determine the initial directory by calling
+C<remove_tree> attempted to determine the initial directory by calling
 C<Cwd::getcwd>, but the call failed for some reason. No attempt
 will be made to delete anything.
 
 =item cannot stat initial working directory: [errmsg]
 
-C<rmtree> attempted to stat the initial directory (after having
+C<remove_tree> attempted to stat the initial directory (after having
 successfully obtained its name via C<getcwd>), however, the call
 failed for some reason. No attempt will be made to delete anything.
 
 =item cannot chdir to [dir]: [errmsg]
 
-C<rmtree> attempted to set the working directory in order to
+C<remove_tree> attempted to set the working directory in order to
 begin deleting the objects therein, but was unsuccessful. This is
 usually a permissions issue. The routine will continue to delete
 other things, but this directory will be left intact.
 
-=item directory [dir] changed before chdir, expected dev=[n] inode=[n], actual dev=[n] ino=[n], aborting. (FATAL)
+=item directory [dir] changed before chdir, expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL)
 
-C<rmtree> recorded the device and inode of a directory, and then
+C<remove_tree> recorded the device and inode of a directory, and then
 moved into it. It then performed a C<stat> on the current directory
 and detected that the device and inode were no longer the same. As
 this is at the heart of the race condition problem, the program
@@ -767,14 +727,14 @@
 
 =item cannot make directory [dir] read+writeable: [errmsg]
 
-C<rmtree> attempted to change the permissions on the current directory
+C<remove_tree> attempted to change the permissions on the current directory
 to ensure that subsequent unlinkings would not run into problems,
 but was unable to do so. The permissions remain as they were, and
 the program will carry on, doing the best it can.
 
 =item cannot read [dir]: [errmsg]
 
-C<rmtree> tried to read the contents of the directory in order
+C<remove_tree> tried to read the contents of the directory in order
 to acquire the names of the directory entries to be unlinked, but
 was unsuccessful. This is usually a permissions issue. The
 program will continue, but the files in this directory will remain
@@ -782,61 +742,70 @@
 
 =item cannot reset chmod [dir]: [errmsg]
 
-C<rmtree>, after having deleted everything in a directory, attempted
+C<remove_tree>, after having deleted everything in a directory, attempted
 to restore its permissions to the original state but failed. The
 directory may wind up being left behind.
 
+=item cannot remove [dir] when cwd is [dir]
+
+The current working directory of the program is F</some/path/to/here>
+and you are attempting to remove an ancestor, such as F</some/path>.
+The directory tree is left untouched.
+
+The solution is to C<chdir> out of the child directory to a place
+outside the directory tree to be removed.
+
 =item cannot chdir to [parent-dir] from [child-dir]: [errmsg], aborting. (FATAL)
 
-C<rmtree>, after having deleted everything and restored the permissions
-of a directory, was unable to chdir back to the parent. This is usually
-a sign that something evil this way comes.
+C<remove_tree>, after having deleted everything and restored the permissions
+of a directory, was unable to chdir back to the parent. The program
+halts to avoid a race condition from occurring.
 
 =item cannot stat prior working directory [dir]: [errmsg], aborting. (FATAL)
 
-C<rmtree> was unable to stat the parent directory after have returned
+C<remove_tree> was unable to stat the parent directory after have returned
 from the child. Since there is no way of knowing if we returned to
 where we think we should be (by comparing device and inode) the only
 way out is to C<croak>.
 
-=item previous directory [parent-dir] changed before entering [child-dir], expected dev=[n] inode=[n], actual dev=[n] ino=[n], aborting. (FATAL)
+=item previous directory [parent-dir] changed before entering [child-dir], expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL)
 
-When C<rmtree> returned from deleting files in a child directory, a
+When C<remove_tree> returned from deleting files in a child directory, a
 check revealed that the parent directory it returned to wasn't the one
 it started out from. This is considered a sign of malicious activity.
 
 =item cannot make directory [dir] writeable: [errmsg]
 
 Just before removing a directory (after having successfully removed
-everything it contained), C<rmtree> attempted to set the permissions
+everything it contained), C<remove_tree> attempted to set the permissions
 on the directory to ensure it could be removed and failed. Program
 execution continues, but the directory may possibly not be deleted.
 
 =item cannot remove directory [dir]: [errmsg]
 
-C<rmtree> attempted to remove a directory, but failed. This may because
+C<remove_tree> attempted to remove a directory, but failed. This may because
 some objects that were unable to be removed remain in the directory, or
 a permissions issue. The directory will be left behind.
 
 =item cannot restore permissions of [dir] to [0nnn]: [errmsg]
 
-After having failed to remove a directory, C<rmtree> was unable to
+After having failed to remove a directory, C<remove_tree> was unable to
 restore its permissions from a permissive state back to a possibly
 more restrictive setting. (Permissions given in octal).
 
 =item cannot make file [file] writeable: [errmsg]
 
-C<rmtree> attempted to force the permissions of a file to ensure it
+C<remove_tree> attempted to force the permissions of a file to ensure it
 could be deleted, but failed to do so. It will, however, still attempt
 to unlink the file.
 
 =item cannot unlink file [file]: [errmsg]
 
-C<rmtree> failed to remove a file. Probably a permissions issue.
+C<remove_tree> failed to remove a file. Probably a permissions issue.
 
 =item cannot restore permissions of [file] to [0nnn]: [errmsg]
 
-After having failed to remove a file, C<rmtree> was also unable
+After having failed to remove a file, C<remove_tree> was also unable
 to restore the permissions on the file to a possibly less permissive
 setting. (Permissions given in octal).
 
@@ -879,16 +848,18 @@
 That code was used as a basis for the current code. Their efforts
 are greatly appreciated.
 
+Gisle Aas made a number of improvements to the documentation for
+2.07 and his advice and assistance is also greatly appreciated.
+
 =head1 AUTHORS
 
-Tim Bunce <F<Tim.Bunce at ig.co.uk>> and Charles Bailey
-<F<bailey at newman.upenn.edu>>. Currently maintained by David Landgren
+Tim Bunce and Charles Bailey. Currently maintained by David Landgren
 <F<david at landgren.net>>.
 
 =head1 COPYRIGHT
 
 This module is copyright (C) Charles Bailey, Tim Bunce and
-David Landgren 1995-2007.  All rights reserved.
+David Landgren 1995-2008. All rights reserved.
 
 =head1 LICENSE
 
diff -urN perl-5.10.0.orig/lib/File/Path.t perl-5.10.0/lib/File/Path.t
--- perl-5.10.0.orig/lib/File/Path.t	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/File/Path.t	2009-02-17 14:53:32.000000000 +0100
@@ -2,17 +2,19 @@
 
 use strict;
 
-use Test::More tests => 99;
+use Test::More tests => 114;
+use Config;
 
 BEGIN {
-    use_ok('File::Path');
+    use_ok('Cwd');
+    use_ok('File::Path', qw(rmtree mkpath make_path remove_tree));
     use_ok('File::Spec::Functions');
 }
 
 eval "use Test::Output";
 my $has_Test_Output = $@ ? 0 : 1;
 
-my $Is_VMS   = $^O eq 'VMS';
+my $Is_VMS = $^O eq 'VMS';
 
 # first check for stupid permissions second for full, so we clean up
 # behind ourselves
@@ -45,7 +47,7 @@
 );
 
 # create them
-my @created = mkpath(@dir);
+my @created = mkpath([@dir]);
 
 is(scalar(@created), 7, "created list of directories");
 
@@ -79,18 +81,98 @@
 my $dir;
 my $dir2;
 
+sub gisle {
+    # background info: @_ = 1; !shift # gives '' not 0
+    # Message-Id: <3C820CE6-4400-4E91-AF43-A3D19B356E68 at activestate.com>
+    # http://www.nntp.perl.org/group/perl.perl5.porters/2008/05/msg136625.html
+    mkpath(shift, !shift, 0755);
+}
+
+sub count {
+    opendir D, shift or return -1;
+    my $count = () = readdir D;
+    closedir D or return -1;
+    return $count;
+}
+
+{
+    mkdir 'solo', 0755;
+    chdir 'solo';
+    open my $f, '>', 'foo.dat';
+    close $f;
+    my $before = count(curdir());
+    cmp_ok($before, '>', 0, "baseline $before");
+
+    gisle('1st', 1);
+    is(count(curdir()), $before + 1, "first after $before");
+
+    $before = count(curdir());
+    gisle('2nd', 1);
+    is(count(curdir()), $before + 1, "second after $before");
+
+    chdir updir();
+    rmtree 'solo';
+}
+
+{
+    mkdir 'solo', 0755;
+    chdir 'solo';
+    open my $f, '>', 'foo.dat';
+    close $f;
+    my $before = count(curdir());
+    cmp_ok($before, '>', 0, "ARGV $before");
+    {
+        local @ARGV = (1);
+        mkpath('3rd', !shift, 0755);
+    }
+    is(count(curdir()), $before + 1, "third after $before");
+
+    $before = count(curdir());
+    {
+        local @ARGV = (1);
+        mkpath('4th', !shift, 0755);
+    }
+    is(count(curdir()), $before + 1, "fourth after $before");
+
+    chdir updir();
+    rmtree 'solo';
+}
+
 SKIP: {
-    $dir = catdir($tmp_base, 'B');
-    $dir2 = catdir($dir, updir());
-    # IOW: File::Spec->catdir( qw(foo bar), File::Spec->updir ) eq 'foo'
-    # rather than foo/bar/..    
-    skip "updir() canonicalises path on this platform", 2
-        if $dir2 eq $tmp_base
-            or $^O eq 'cygwin';
-        
-    @created = mkpath($dir2, {mask => 0700});
-    is(scalar(@created), 1, "make directory with trailing parent segment");
-    is($created[0], $dir, "made parent");
+    # tests for rmtree() of ancestor directory
+    my $nr_tests = 6;
+    my $cwd = getcwd() or skip "failed to getcwd: $!", $nr_tests;
+    my $dir  = catdir($cwd, 'remove');
+    my $dir2 = catdir($cwd, 'remove', 'this', 'dir');
+
+    skip "failed to mkpath '$dir2': $!", $nr_tests
+        unless mkpath($dir2, {verbose => 0});
+    skip "failed to chdir dir '$dir2': $!", $nr_tests
+        unless chdir($dir2);
+
+    rmtree($dir, {error => \$error});
+    my $nr_err = @$error;
+    is($nr_err, 1, "ancestor error");
+
+    if ($nr_err) {
+        my ($file, $message) = each %{$error->[0]};
+        is($file, $dir, "ancestor named");
+        my $ortho_dir = $^O eq 'MSWin32' ? File::Path::_slash_lc($dir2) : $dir2;
+        $^O eq 'MSWin32' and $message
+            =~ s/\A(cannot remove path when cwd is )(.*)\Z/$1 . File::Path::_slash_lc($2)/e;
+        is($message, "cannot remove path when cwd is $ortho_dir", "ancestor reason");
+        ok(-d $dir2, "child not removed");
+        ok(-d $dir, "ancestor not removed");
+    }
+    else {
+        fail( "ancestor 1");
+        fail( "ancestor 2");
+        fail( "ancestor 3");
+        fail( "ancestor 4");
+    }
+    chdir $cwd;
+    rmtree($dir);
+    ok(!(-d $dir), "ancestor now removed");
 };
 
 my $count = rmtree({error => \$error});
@@ -104,7 +186,7 @@
 $dir = catdir($tmp_base,'C');
 # mkpath returns unix syntax filespecs on VMS
 $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
- at created = mkpath($tmp_base, $dir);
+ at created = make_path($tmp_base, $dir);
 is(scalar(@created), 1, "created directory (new style 1)");
 is($created[0], $dir, "created directory (new style 1) cross-check");
 
@@ -115,7 +197,7 @@
 $dir2 = catdir($tmp_base,'D');
 # mkpath returns unix syntax filespecs on VMS
 $dir2 = VMS::Filespec::unixify($dir2) if $Is_VMS;
- at created = mkpath($tmp_base, $dir, $dir2);
+ at created = make_path($tmp_base, $dir, $dir2);
 is(scalar(@created), 1, "created directory (new style 2)");
 is($created[0], $dir2, "created directory (new style 2) cross-check");
 
@@ -123,8 +205,7 @@
 is($count, 1, "removed directory unsafe mode");
 
 $count = rmtree($dir2, 0, 1);
-my $removed = $Is_VMS ? 0 : 1;
-is($count, $removed, "removed directory safe mode");
+is($count, 1, "removed directory safe mode");
 
 # mkdir foo ./E/../Y
 # Y should exist
@@ -135,7 +216,7 @@
 cmp_ok(scalar(@created), '<=', 2, "made less than two dirs because of ..");
 ok( -d catdir($tmp_base, 'Y'), "directory after parent" );
 
- at created = mkpath(catdir(curdir(), $tmp_base));
+ at created = make_path(catdir(curdir(), $tmp_base));
 is(scalar(@created), 0, "nothing created")
     or diag(@created);
 
@@ -195,22 +276,22 @@
 $dir   = catdir('a', 'd1');
 $dir2  = catdir('a', 'd2');
 
- at created = mkpath( $dir, 0, $dir2 );
+ at created = make_path( $dir, 0, $dir2 );
 is(scalar @created, 3, 'new-style 3 dirs created');
 
-$count = rmtree( $dir, 0, $dir2, );
+$count = remove_tree( $dir, 0, $dir2, );
 is($count, 3, 'new-style 3 dirs removed');
 
- at created = mkpath( $dir, $dir2, 1 );
+ at created = make_path( $dir, $dir2, 1 );
 is(scalar @created, 3, 'new-style 3 dirs created (redux)');
 
-$count = rmtree( $dir, $dir2, 1 );
+$count = remove_tree( $dir, $dir2, 1 );
 is($count, 3, 'new-style 3 dirs removed (redux)');
 
- at created = mkpath( $dir, $dir2 );
+ at created = make_path( $dir, $dir2 );
 is(scalar @created, 2, 'new-style 2 dirs created');
 
-$count = rmtree( $dir, $dir2 );
+$count = remove_tree( $dir, $dir2 );
 is($count, 2, 'new-style 2 dirs removed');
 
 if (chdir updir()) {
@@ -220,6 +301,43 @@
     fail("chdir parent: $!");
 }
 
+SKIP: {
+    # test bug http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=487319
+    skip "Don't need Force_Writeable semantics on $^O", 4
+        if grep {$^O eq $_} qw(amigaos dos epoc MSWin32 MacOS os2);
+    skip "Symlinks not available", 4 unless $Config{'d_symlink'};
+    $dir  = 'bug487319';
+    $dir2 = 'bug487319-symlink';
+    @created = make_path($dir, {mask => 0700});
+    is(scalar @created, 1, 'bug 487319 setup');
+    symlink($dir, $dir2);
+    ok(-e $dir2, "debian bug 487319 setup symlink") or diag($dir2);
+
+    chmod 0500, $dir;
+    my $mask_initial = (stat $dir)[2];
+    remove_tree($dir2);
+
+    my $mask = (stat $dir)[2];
+    is( $mask, $mask_initial, 'mask of symlink target dir unchanged (debian bug 487319)');
+
+    # now try a file
+    my $file = catfile($dir, 'file');
+    open my $out, '>', $file;
+    close $out;
+
+    chmod 0500, $file;
+    $mask_initial = (stat $file)[2];
+
+    my $file2 = catfile($dir, 'symlink');
+    symlink($file, $file2);
+    remove_tree($file2);
+
+    $mask = (stat $file)[2];
+    is( $mask, $mask_initial, 'mask of symlink target file unchanged (debian bug 487319)');
+
+    remove_tree($dir);
+}
+
 # see what happens if a file exists where we want a directory
 SKIP: {
     my $entry = catdir($tmp_base, "file");
@@ -245,6 +363,7 @@
 SKIP: {
     skip "extra scenarios not set up, see eg/setup-extra-tests", 14
         unless -e $extra;
+    skip "Symlinks not available", 14 unless $Config{'d_symlink'};
 
     my ($list, $err);
     $dir = catdir( 'EXTRA', '1' );
@@ -355,8 +474,8 @@
         "rmtree of empty dir carps sensibly"
     );
 
-    stderr_is( sub { mkpath() }, '', "mkpath no args does not carp" );
-    stderr_is( sub { rmtree() }, '', "rmtree no args does not carp" );
+    stderr_is( sub { make_path() }, '', "make_path no args does not carp" );
+    stderr_is( sub { remove_tree() }, '', "remove_tree no args does not carp" );
 
     stdout_is(
         sub {@created = mkpath($dir, 1)},

perl-update-File-Temp.patch:

--- NEW FILE perl-update-File-Temp.patch ---
File-Temp-0.21

diff -urN perl-5.10.0.orig/MANIFEST perl-5.10.0/MANIFEST
--- perl-5.10.0.orig/MANIFEST	2009-02-20 18:22:32.000000000 +0100
+++ perl-5.10.0/MANIFEST	2009-03-10 15:19:19.000000000 +0100
@@ -1890,6 +1890,8 @@
 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
diff -urN perl-5.10.0.orig/lib/File/Temp/t/fork.t perl-5.10.0/lib/File/Temp/t/fork.t
--- perl-5.10.0.orig/lib/File/Temp/t/fork.t	1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/File/Temp/t/fork.t	2009-03-10 15:26:34.000000000 +0100
@@ -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 -urN perl-5.10.0.orig/lib/File/Temp/t/lock.t perl-5.10.0/lib/File/Temp/t/lock.t
--- perl-5.10.0.orig/lib/File/Temp/t/lock.t	1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/File/Temp/t/lock.t	2009-03-10 15:26:34.000000000 +0100
@@ -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 -urN perl-5.10.0.orig/lib/File/Temp/t/object.t perl-5.10.0/lib/File/Temp/t/object.t
--- perl-5.10.0.orig/lib/File/Temp/t/object.t	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/File/Temp/t/object.t	2009-03-10 15:26:34.000000000 +0100
@@ -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 @@
 # 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 -urN perl-5.10.0.orig/lib/File/Temp/t/seekable.t perl-5.10.0/lib/File/Temp/t/seekable.t
--- perl-5.10.0.orig/lib/File/Temp/t/seekable.t	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/File/Temp/t/seekable.t	2009-03-10 15:26:34.000000000 +0100
@@ -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') };
 
 #########################
@@ -18,10 +18,17 @@
 $tmp = File::Temp->new;
 isa_ok( $tmp, 'File::Temp' );
 isa_ok( $tmp, 'IO::Handle' );
-isa_ok( $tmp, 'IO::Seekable' );
+SKIP: {
+  skip "->isa is broken on 5.6.0", 1 if $] == 5.006000;
+  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 +37,7 @@
 $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 -urN perl-5.10.0.orig/lib/File/Temp.pm perl-5.10.0/lib/File/Temp.pm
--- perl-5.10.0.orig/lib/File/Temp.pm	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/File/Temp.pm	2009-03-10 15:25:28.000000000 +0100
@@ -52,7 +52,9 @@
 
   ($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 @@
   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 @@
 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
@@ -140,7 +144,7 @@
 use File::Spec 0.8;
 use File::Path qw/ rmtree /;
 use Fcntl 1.03;
-use IO::Seekable; # For SEEK_*
+use IO::Seekable;               # For SEEK_*
 use Errno;
 require VMS::Stdio if $^O eq 'VMS';
 
@@ -149,7 +153,7 @@
 # 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;
@@ -171,42 +175,42 @@
 # Export list - to allow fine tuning of export table
 
 @EXPORT_OK = qw{
-	      tempfile
-	      tempdir
-	      tmpnam
-	      tmpfile
-	      mktemp
-	      mkstemp
-	      mkstemps
-	      mkdtemp
-	      unlink0
-	      cleanup
-	      SEEK_SET
-              SEEK_CUR
-              SEEK_END
-		};
+                 tempfile
+                 tempdir
+                 tmpnam
+                 tmpfile
+                 mktemp
+                 mkstemp
+                 mkstemps
+                 mkdtemp
+                 unlink0
+                 cleanup
+                 SEEK_SET
+                 SEEK_CUR
+                 SEEK_END
+             };
 
 # Groups of functions for export
 
 %EXPORT_TAGS = (
-		'POSIX' => [qw/ tmpnam tmpfile /],
-		'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
-		'seekable' => [qw/ SEEK_SET SEEK_CUR SEEK_END /],
-	       );
+                'POSIX' => [qw/ tmpnam tmpfile /],
+                'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
+                'seekable' => [qw/ SEEK_SET SEEK_CUR SEEK_END /],
+               );
 
 # add contents of these tags to @EXPORT
 Exporter::export_tags('POSIX','mktemp','seekable');
 
 # Version number
 
-$VERSION = '0.18';
+$VERSION = '0.21';
 
 # This is a list of characters that can be used in random filenames
 
 my @CHARS = (qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
-	         a b c d e f g h i j k l m n o p q r s t u v w x y z
-	         0 1 2 3 4 5 6 7 8 9 _
-	     /);
+                 a b c d e f g h i j k l m n o p q r s t u v w x y z
+                 0 1 2 3 4 5 6 7 8 9 _
+               /);
 
 # Maximum number of tries to make a temp file before failing
 
@@ -229,9 +233,10 @@
 # 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 @@
       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 @@
 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 @@
   }
 }
 
+# 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 @@
 #                        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
@@ -324,12 +340,13 @@
 
   # Default options
   my %options = (
-		 "open" => 0,
-		 "mkdir" => 0,
-		 "suffixlen" => 0,
-		 "unlink_on_close" => 0,
-		 "ErrStr" => \$tempErrStr,
-		);
+                 "open" => 0,
+                 "mkdir" => 0,
+                 "suffixlen" => 0,
+                 "unlink_on_close" => 0,
+                 "use_exlock" => 1,
+                 "ErrStr" => \$tempErrStr,
+                );
 
   # Read the template
   my $template = shift;
@@ -389,7 +406,7 @@
   # or a tempfile
 
   my ($volume, $directories, $file);
-  my $parent; # parent directory
+  my $parent;                   # parent directory
   if ($options{"mkdir"}) {
     # There is no filename at the end
     ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
@@ -404,16 +421,16 @@
       $parent = File::Spec->curdir;
     } else {
 
-      if ($^O eq 'VMS') {  # need volume to avoid relative dir spec
+      if ($^O eq 'VMS') {     # need volume to avoid relative dir spec
         $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
         $parent = 'sys$disk:[]' if $parent eq '';
       } else {
 
-	# Put it back together without the last one
-	$parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
+        # Put it back together without the last one
+        $parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
 
-	# ...and attach the volume (no filename)
-	$parent = File::Spec->catpath($volume, $parent, '');
+        # ...and attach the volume (no filename)
+        $parent = File::Spec->catpath($volume, $parent, '');
       }
 
     }
@@ -437,15 +454,14 @@
   # 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 ();
   }
-  unless (-w $parent) {
-    ${$options{ErrStr}} = "Parent directory ($parent) is not writable\n";
-      return ();
-  }
-
 
   # Check the stickiness of the directory and chown giveaway if required
   # If the directory is world writable the sticky bit
@@ -475,7 +491,7 @@
 
       # If we are running before perl5.6.0 we can not auto-vivify
       if ($] < 5.006) {
-	$fh = &Symbol::gensym;
+        $fh = &Symbol::gensym;
       }
 
       # Try to make sure this will be marked close-on-exec
@@ -487,52 +503,53 @@
       my $open_success = undef;
       if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
         # make it auto delete on close by setting FAB$V_DLT bit
-	$fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
-	$open_success = $fh;
+        $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
+        $open_success = $fh;
       } else {
-	my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
-		      $OPENTEMPFLAGS :
-		      $OPENFLAGS );
-	$open_success = sysopen($fh, $path, $flags, 0600);
+        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 ) {
 
-	# in case of odd umask force rw
-	chmod(0600, $path);
+        # in case of odd umask force rw
+        chmod(0600, $path);
 
-	# Opened successfully - return file handle and name
-	return ($fh, $path);
+        # Opened successfully - return file handle and name
+        return ($fh, $path);
 
       } else {
 
-	# Error opening file - abort with error
-	# if the reason was anything but EEXIST
-	unless ($!{EEXIST}) {
-	  ${$options{ErrStr}} = "Could not create temp file $path: $!";
-	  return ();
-	}
+        # Error opening file - abort with error
+        # if the reason was anything but EEXIST
+        unless ($!{EEXIST}) {
+          ${$options{ErrStr}} = "Could not create temp file $path: $!";
+          return ();
+        }
 
-	# Loop round for another try
+        # Loop round for another try
 
       }
     } elsif ($options{"mkdir"}) {
 
       # Open the temp directory
       if (mkdir( $path, 0700)) {
-	# in case of odd umask
-	chmod(0700, $path);
+        # in case of odd umask
+        chmod(0700, $path);
 
-	return undef, $path;
+        return undef, $path;
       } else {
 
-	# Abort with error if the reason for failure was anything
-	# except EEXIST
-	unless ($!{EEXIST}) {
-	  ${$options{ErrStr}} = "Could not create directory $path: $!";
-	  return ();
-	}
+        # Abort with error if the reason for failure was anything
+        # except EEXIST
+        unless ($!{EEXIST}) {
+          ${$options{ErrStr}} = "Could not create directory $path: $!";
+          return ();
+        }
 
-	# Loop round for another try
+        # Loop round for another try
 
       }
 
@@ -559,7 +576,7 @@
     # attempt and make sure that none are repeated
 
     my $original = $path;
-    my $counter = 0;  # Stop infinite loop
+    my $counter = 0;            # Stop infinite loop
     my $MAX_GUESS = 50;
 
     do {
@@ -587,22 +604,6 @@
 
 }
 
-# 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 +624,12 @@
   # 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;
 }
@@ -670,16 +672,17 @@
   unless (scalar(@info)) {
     $$err_ref = "stat(path) returned no values";
     return 0;
-  };
-  return 1 if $^O eq 'VMS';  # owner delete control at file level
+  }
+  ;
+  return 1 if $^O eq 'VMS';     # owner delete control at file level
 
   # Check to see whether owner is neither superuser (or a system uid) nor me
   # Use the effective uid from the $> variable
   # 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'",
-		File::Temp->top_system_uid());
+    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"
       if ref($err_ref);
@@ -691,18 +694,18 @@
   # use 022 to check writability
   # Do it with S_IWOTH and S_IWGRP for portability (maybe)
   # mode is in info[2]
-  if (($info[2] & &Fcntl::S_IWGRP) ||   # Is group writable?
-      ($info[2] & &Fcntl::S_IWOTH) ) {  # Is world writable?
+  if (($info[2] & &Fcntl::S_IWGRP) ||  # Is group writable?
+      ($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable?
     # Must be a directory
     unless (-d $path) {
       $$err_ref = "Path ($path) is not a directory"
-      if ref($err_ref);
+        if ref($err_ref);
       return 0;
     }
     # Must have sticky bit set
     unless (-k $path) {
       $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
-	if ref($err_ref);
+        if ref($err_ref);
       return 0;
     }
   }
@@ -727,12 +730,13 @@
 
   my $path = shift;
   print "_is_verysafe testing $path\n" if $DEBUG;
-  return 1 if $^O eq 'VMS';  # owner delete control at file level
+  return 1 if $^O eq 'VMS';     # owner delete control at file level
 
   my $err_ref = shift;
 
   # 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};
@@ -769,9 +773,9 @@
   foreach my $pos (0.. $#dirs) {
     # Get a directory name
     my $dir = File::Spec->catpath($volume,
-				  File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
-				  ''
-				  );
+                                  File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
+                                  ''
+                                 );
 
     print "TESTING DIR $dir\n" if $DEBUG;
 
@@ -863,6 +867,7 @@
 
   # Set up an end block to use these arrays
   END {
+    local($., $@, $!, $^E, $?);
     cleanup();
   }
 
@@ -872,33 +877,38 @@
     if (!$KEEP_ALL) {
       # Files
       my @files = (exists $files_to_unlink{$$} ?
-		   @{ $files_to_unlink{$$} } : () );
+                   @{ $files_to_unlink{$$} } : () );
       foreach my $file (@files) {
-	# close the filehandle without checking its state
-	# in order to make real sure that this is closed
-	# if its already closed then I dont care about the answer
-	# probably a better way to do this
-	close($file->[0]);  # file handle is [0]
-
-	if (-f $file->[1]) {  # file name is [1]
-	  _force_writable( $file->[1] ); # for windows
-	  unlink $file->[1] or warn "Error removing ".$file->[1];
-	}
+        # close the filehandle without checking its state
+        # in order to make real sure that this is closed
+        # if its already closed then I dont care about the answer
+        # probably a better way to do this
+        close($file->[0]);      # file handle is [0]
+
+        if (-f $file->[1]) {       # file name is [1]
+          _force_writable( $file->[1] ); # for windows
+          unlink $file->[1] or warn "Error removing ".$file->[1];
+        }
       }
       # Dirs
       my @dirs = (exists $dirs_to_unlink{$$} ?
-		  @{ $dirs_to_unlink{$$} } : () );
+                  @{ $dirs_to_unlink{$$} } : () );
       foreach my $dir (@dirs) {
-	if (-d $dir) {
-	  rmtree($dir, $DEBUG, 0);
-	}
+        if (-d $dir) {
+          # Some versions of rmtree will abort if you attempt to remove
+          # the directory you are sitting in. We protect that and turn it
+          # into a warning. We do this because this occurs during
+          # cleanup and so can not be caught by the user.
+          eval { rmtree($dir, $DEBUG, 0); };
+          warn $@ if ($@ && $^W);
+        }
       }
 
       # clear the arrays
       @{ $files_to_unlink{$$} } = ()
-	if exists $files_to_unlink{$$};
+        if exists $files_to_unlink{$$};
       @{ $dirs_to_unlink{$$} } = ()
-	if exists $dirs_to_unlink{$$};
+        if exists $dirs_to_unlink{$$};
     }
   }
 
@@ -923,28 +933,28 @@
 
       if (-d $fname) {
 
-	# Directory exists so store it
-	# first on VMS turn []foo into [.foo] for rmtree
-	$fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
-	$dirs_to_unlink{$$} = [] 
-	  unless exists $dirs_to_unlink{$$};
-	push (@{ $dirs_to_unlink{$$} }, $fname);
+        # Directory exists so store it
+        # first on VMS turn []foo into [.foo] for rmtree
+        $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
+        $dirs_to_unlink{$$} = [] 
+          unless exists $dirs_to_unlink{$$};
+        push (@{ $dirs_to_unlink{$$} }, $fname);
 
       } else {
-	carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
+        carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
       }
 
     } else {
 
       if (-f $fname) {
 
-	# file exists so store handle and name for later removal
-	$files_to_unlink{$$} = []
-	  unless exists $files_to_unlink{$$};
-	push(@{ $files_to_unlink{$$} }, [$fh, $fname]);
+        # file exists so store handle and name for later removal
+        $files_to_unlink{$$} = []
+          unless exists $files_to_unlink{$$};
+        push(@{ $files_to_unlink{$$} }, [$fh, $fname]);
 
       } else {
-	carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
+        carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
       }
 
     }
@@ -974,7 +984,7 @@
 
 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 +992,11 @@
 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');
 
@@ -1008,8 +1018,8 @@
   my $unlink = (exists $args{UNLINK} ? $args{UNLINK} : 1 );
   delete $args{UNLINK};
 
-  # template (store it in an error so that it will
-  # disappear from the arg list of tempfile
+  # template (store it in an array so that it will
+  # disappear from the arg list of tempfile)
   my @template = ( exists $args{TEMPLATE} ? $args{TEMPLATE} : () );
   delete $args{TEMPLATE};
 
@@ -1024,6 +1034,9 @@
   # 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 +1049,48 @@
   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 +1109,15 @@
   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,24 +1146,47 @@
 
 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
 
 sub DESTROY {
+  local($., $@, $!, $^E, $?);
   my $self = shift;
+
+  # Make sure we always remove the file from the global hash
+  # on destruction. This prevents the hash from growing uncontrollably
+  # and post-destruction there is no reason to know about the file.
+  my $file = $self->filename;
+  my $was_created_by_proc;
+  if (exists $FILES_CREATED_BY_OBJECT{$$}{$file}) {
+    $was_created_by_proc = 1;
+    delete $FILES_CREATED_BY_OBJECT{$$}{$file};
+  }
+
   if (${*$self}{UNLINK} && !$KEEP_ALL) {
     print "# --------->   Unlinking $self\n" if $DEBUG;
 
+    # only delete if this process created it
+    return unless $was_created_by_proc;
+
     # 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
     # do an unlink without test. Seems to be silly
     # to do this when we are trying to be careful
     # about security
-    _force_writable( $self->filename ); # for windows
-    unlink1( $self, $self->filename )
-      or unlink($self->filename);
+    _force_writable( $file ); # for windows
+    unlink1( $self, $file )
+      or unlink($file);
   }
 }
 
@@ -1145,6 +1229,12 @@
 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 +1253,7 @@
 (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 +1276,16 @@
 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 +1299,13 @@
 
   # Default options
   my %options = (
-		 "DIR"    => undef,  # Directory prefix
-                "SUFFIX" => '',     # Template suffix
-                "UNLINK" => 0,      # Do not unlink file on exit
-                "OPEN"   => 1,      # Open file
-		);
+                 "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);
@@ -1221,8 +1323,8 @@
 
   if ($options{"DIR"} and $^O eq 'VMS') {
 
-      # on VMS turn []foo into [.foo] for concatenation
-      $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
+    # on VMS turn []foo into [.foo] for concatenation
+    $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
   }
 
   # Construct the template
@@ -1234,10 +1336,15 @@
   # 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 {
@@ -1273,12 +1380,13 @@
   my ($fh, $path, $errstr);
   croak "Error in tempfile() using $template: $errstr"
     unless (($fh, $path) = _gettemp($template,
-				    "open" => $options{'OPEN'},
-				    "mkdir"=> 0 ,
+                                    "open" => $options{'OPEN'},
+                                    "mkdir"=> 0 ,
                                     "unlink_on_close" => $unlink_on_close,
-				    "suffixlen" => length($options{'SUFFIX'}),
-				    "ErrStr" => \$errstr,
-				   ) );
+                                    "suffixlen" => length($options{'SUFFIX'}),
+                                    "ErrStr" => \$errstr,
+                                    "use_exlock" => $options{EXLOCK},
+                                   ) );
 
   # Set up an exit handler that can do whatever is right for the
   # system. This removes files at exit when requested explicitly or when
@@ -1312,7 +1420,15 @@
 
 =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();
@@ -1374,10 +1490,10 @@
 
   # Default options
   my %options = (
-		 "CLEANUP"    => 0,  # Remove directory on exit
-		 "DIR"        => '', # Root directory
-		 "TMPDIR"     => 0,  # Use tempdir with template
-		);
+                 "CLEANUP"    => 0, # Remove directory on exit
+                 "DIR"        => '', # Root directory
+                 "TMPDIR"     => 0,  # Use tempdir with template
+                );
 
   # Check to see whether we have an odd or even number of arguments
   my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
@@ -1409,8 +1525,8 @@
 
       } elsif ($options{TMPDIR}) {
 
-	# Prepend tmpdir
-	$template = File::Spec->catdir(File::Spec->tmpdir, $template);
+        # Prepend tmpdir
+        $template = File::Spec->catdir(File::Spec->tmpdir, $template);
 
       }
 
@@ -1433,7 +1549,7 @@
   # Create the directory
   my $tempdir;
   my $suffixlen = 0;
-  if ($^O eq 'VMS') {  # dir names can end in delimiters
+  if ($^O eq 'VMS') {           # dir names can end in delimiters
     $template =~ m/([\.\]:>]+)$/;
     $suffixlen = length($1);
   }
@@ -1445,11 +1561,11 @@
   my $errstr;
   croak "Error in tempdir() using $template: $errstr"
     unless ((undef, $tempdir) = _gettemp($template,
-				    "open" => 0,
-				    "mkdir"=> 1 ,
-				    "suffixlen" => $suffixlen,
-				    "ErrStr" => \$errstr,
-				   ) );
+                                         "open" => 0,
+                                         "mkdir"=> 1 ,
+                                         "suffixlen" => $suffixlen,
+                                         "ErrStr" => \$errstr,
+                                        ) );
 
   # Install exit handler; must be dynamic to get lexical
   if ( $options{'CLEANUP'} && -d $tempdir) {
@@ -1499,11 +1615,11 @@
   my ($fh, $path, $errstr);
   croak "Error in mkstemp using $template: $errstr"
     unless (($fh, $path) = _gettemp($template,
-				    "open" => 1,
-				    "mkdir"=> 0 ,
-				    "suffixlen" => 0,
-				    "ErrStr" => \$errstr,
-				   ) );
+                                    "open" => 1,
+                                    "mkdir"=> 0 ,
+                                    "suffixlen" => 0,
+                                    "ErrStr" => \$errstr,
+                                   ) );
 
   if (wantarray()) {
     return ($fh, $path);
@@ -1544,11 +1660,11 @@
   my ($fh, $path, $errstr);
   croak "Error in mkstemps using $template: $errstr"
     unless (($fh, $path) = _gettemp($template,
-				    "open" => 1,
-				    "mkdir"=> 0 ,
-				    "suffixlen" => length($suffix),
-				    "ErrStr" => \$errstr,
-				   ) );
+                                    "open" => 1,
+                                    "mkdir"=> 0 ,
+                                    "suffixlen" => length($suffix),
+                                    "ErrStr" => \$errstr,
+                                   ) );
 
   if (wantarray()) {
     return ($fh, $path);
@@ -1582,7 +1698,7 @@
 
   my $template = shift;
   my $suffixlen = 0;
-  if ($^O eq 'VMS') {  # dir names can end in delimiters
+  if ($^O eq 'VMS') {           # dir names can end in delimiters
     $template =~ m/([\.\]:>]+)$/;
     $suffixlen = length($1);
   }
@@ -1593,11 +1709,11 @@
   my ($junk, $tmpdir, $errstr);
   croak "Error creating temp directory from template $template\: $errstr"
     unless (($junk, $tmpdir) = _gettemp($template,
-					"open" => 0,
-					"mkdir"=> 1 ,
-					"suffixlen" => $suffixlen,
-					"ErrStr" => \$errstr,
-				       ) );
+                                        "open" => 0,
+                                        "mkdir"=> 1 ,
+                                        "suffixlen" => $suffixlen,
+                                        "ErrStr" => \$errstr,
+                                       ) );
 
   return $tmpdir;
 
@@ -1626,11 +1742,11 @@
   my ($tmpname, $junk, $errstr);
   croak "Error getting name to temp file from template $template: $errstr"
     unless (($junk, $tmpname) = _gettemp($template,
-					 "open" => 0,
-					 "mkdir"=> 0 ,
-					 "suffixlen" => 0,
-					 "ErrStr" => \$errstr,
-					 ) );
+                                         "open" => 0,
+                                         "mkdir"=> 0 ,
+                                         "suffixlen" => 0,
+                                         "ErrStr" => \$errstr,
+                                        ) );
 
   return $tmpname;
 }
@@ -1680,20 +1796,20 @@
 
 sub tmpnam {
 
-   # Retrieve the temporary directory name
-   my $tmpdir = File::Spec->tmpdir;
+  # Retrieve the temporary directory name
+  my $tmpdir = File::Spec->tmpdir;
 
-   croak "Error temporary directory is not writable"
-     if $tmpdir eq '';
+  croak "Error temporary directory is not writable"
+    if $tmpdir eq '';
 
-   # Use a ten character template and append to tmpdir
-   my $template = File::Spec->catfile($tmpdir, TEMPXXX);
+  # Use a ten character template and append to tmpdir
+  my $template = File::Spec->catfile($tmpdir, TEMPXXX);
 
-   if (wantarray() ) {
-       return mkstemp($template);
-   } else {
-       return mktemp($template);
-   }
+  if (wantarray() ) {
+    return mkstemp($template);
+  } else {
+    return mktemp($template);
+  }
 
 }
 
@@ -1939,12 +2055,12 @@
   # depending on whether it is a file or a handle.
   # Cannot simply compare all members of the stat return
   # Select the ones we can use
-  my @okstat = (0..$#fh);  # Use all by default
+  my @okstat = (0..$#fh);       # Use all by default
   if ($^O eq 'MSWin32') {
     @okstat = (1,2,3,4,5,7,8,9,10);
   } elsif ($^O eq 'os2') {
     @okstat = (0, 2..$#fh);
-  } elsif ($^O eq 'VMS') { # device and file ID are sufficient
+  } elsif ($^O eq 'VMS') {      # device and file ID are sufficient
     @okstat = (0, 1);
   } elsif ($^O eq 'dos') {
     @okstat = (0,2..7,11..$#fh);
@@ -2045,11 +2161,10 @@
 
 =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
 
@@ -2113,15 +2228,15 @@
     if (@_) {
       my $level = shift;
       if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
-	carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
+        carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
       } else {
-	# Dont allow this on perl 5.005 or earlier
-	if ($] < 5.006 && $level != STANDARD) {
-	  # Cant do MEDIUM or HIGH checks
-	  croak "Currently requires perl 5.006 or newer to do the safe checks";
-	}
-	# Check that we are allowed to change level
-	# Silently ignore if we can not.
+        # Dont allow this on perl 5.005 or earlier
+        if ($] < 5.006 && $level != STANDARD) {
+          # Cant do MEDIUM or HIGH checks
+          croak "Currently requires perl 5.006 or newer to do the safe checks";
+        }
+        # Check that we are allowed to change level
+        # Silently ignore if we can not.
         $LEVEL = $level if _can_do_level($level);
       }
     }
@@ -2234,12 +2349,21 @@
 through the same set of random file names and may well cause
 themselves to give up if they exceed the number of retry attempts.
 
+=head2 Directory removal
+
+Note that if you have chdir'ed into the temporary directory and it is
+subsequently cleaned up (either in the END block or as part of object
+destruction), then you will get a warning from File::Path::rmtree().
+
 =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 +2380,14 @@
 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 at cpan.orgE<gt>
 
+Copyright (C) 2007-2008 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 +2400,53 @@
 
 =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;
+  local($., $@, $!, $^E, $?);
+  if ($self->unlink_on_destroy && 
+      $$ == $self->{LAUNCHPID} && !$File::Temp::KEEP_ALL) {
+    if (-d $self->{DIRNAME}) {
+      # Some versions of rmtree will abort if you attempt to remove
+      # the directory you are sitting in. We protect that and turn it
+      # into a warning. We do this because this occurs during object
+      # destruction and so can not be caught by the user.
+      eval { rmtree($self->{DIRNAME}, $File::Temp::DEBUG, 0); };
+      warn $@ if ($@ && $^W);
+    }
+  }
+}
+
+
 1;

perl-update-IPC-Cmd.patch:

--- NEW FILE perl-update-IPC-Cmd.patch ---
IPC-Cmd-0.42

diff -urN perl-5.10.0.orig/lib/IPC/Cmd/t/01_IPC-Cmd.t perl-5.10.0/lib/IPC/Cmd/t/01_IPC-Cmd.t
--- perl-5.10.0.orig/lib/IPC/Cmd/t/01_IPC-Cmd.t	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/IPC/Cmd/t/01_IPC-Cmd.t	2009-03-10 15:43:11.000000000 +0100
@@ -4,30 +4,43 @@
 
 use strict;
 use lib qw[../lib];
-use File::Spec ();
+use File::Spec;
 use Test::More 'no_plan';
 
-my $Class   = 'IPC::Cmd';
-my @Funcs   = qw[run can_run];
-my @Meths   = qw[can_use_ipc_run can_use_ipc_open3 can_capture_buffer];
-my $IsWin32 = $^O eq 'MSWin32';
-my $Verbose = @ARGV ? 1 : 0;
+my $Class       = 'IPC::Cmd';
+my $AClass      = $Class . '::TimeOut';
+my @Funcs       = qw[run can_run QUOTE];
+my @Meths       = qw[can_use_ipc_run can_use_ipc_open3 can_capture_buffer];
+my $IsWin32     = $^O eq 'MSWin32';
+my $Verbose     = @ARGV ? 1 : 0;
 
 use_ok( $Class,         $_ ) for @Funcs;
 can_ok( $Class,         $_ ) for @Funcs, @Meths;
 can_ok( __PACKAGE__,    $_ ) for @Funcs;
 
-my $Have_IPC_Run    = $Class->can_use_ipc_run;
-my $Have_IPC_Open3  = $Class->can_use_ipc_open3;
+my $Have_IPC_Run    = $Class->can_use_ipc_run   || 0;
+my $Have_IPC_Open3  = $Class->can_use_ipc_open3 || 0;
+
+diag("IPC::Run: $Have_IPC_Run   IPC::Open3: $Have_IPC_Open3");    
+
+local $IPC::Cmd::VERBOSE = $Verbose;
+local $IPC::Cmd::VERBOSE = $Verbose;
+local $IPC::Cmd::DEBUG   = $Verbose;
+local $IPC::Cmd::DEBUG   = $Verbose;
 
-$IPC::Cmd::VERBOSE  = $IPC::Cmd::VERBOSE = $Verbose;
 
 ### run tests in various configurations, based on what modules we have
-my @Prefs = ( 
-    [ $Have_IPC_Run, $Have_IPC_Open3 ], 
-    [ 0,             $Have_IPC_Open3 ], 
-    [ 0,             0 ] 
-);
+my @Prefs = ( );
+push @Prefs, [ $Have_IPC_Run, $Have_IPC_Open3 ] if $Have_IPC_Run; 
+
+### run this config twice to ensure FD restores work properly
+push @Prefs, [ 0,             $Have_IPC_Open3 ],     
+             [ 0,             $Have_IPC_Open3 ] if $Have_IPC_Open3;
+
+### run this config twice to ensure FD restores work properly
+### these are the system() tests;
+push @Prefs, [ 0,             0 ],  [ 0,             0 ];     
+
 
 ### can_run tests
 {
@@ -35,59 +48,92 @@
     ok( !can_run('10283lkjfdalskfjaf'), q[Not found non-existant binary] );
 }
 
-### run tests that print only to stdout
-{   ### list of commands and regexes matching output ###
+{   ### list of commands and regexes matching output 
+    ### XXX use " everywhere when using literal strings as commands for
+    ### portability, especially on win32
     my $map = [
-        # command                                    # output regex
-        [ "$^X -v",                                  qr/larry\s+wall/i, ],
-        [ [$^X, '-v'],                               qr/larry\s+wall/i, ],
-        [ "$^X -eprint+42 | $^X -neprint",           qr/42/,            ],
-        [ [$^X,qw[-eprint+42 |], $^X, qw|-neprint|], qr/42/,            ],
+        # command                                    # output regex     # buffer
+
+        ### run tests that print only to stdout
+        [ "$^X -v",                                  qr/larry\s+wall/i, 3, ],
+        [ [$^X, '-v'],                               qr/larry\s+wall/i, 3, ],
+
+        ### pipes
+        [ "$^X -eprint+424 | $^X -neprint+split+2",  qr/44/,            3, ],
+        [ [$^X,qw[-eprint+424 |], $^X, qw|-neprint+split+2|], 
+                                                     qr/44/,            3, ],
+        ### whitespace
+        [ [$^X, '-eprint+shift', q|a b a|],          qr/a b a/,         3, ],
+        [ qq[$^X -eprint+shift "a b a"],             qr/a b a/,         3, ],
+
+        ### whitespace + pipe
+        [ [$^X, '-eprint+shift', q|a b a|, q[|], $^X, qw[-neprint+split+b] ],
+                                                     qr/a  a/,          3, ],
+        [ qq[$^X -eprint+shift "a b a" | $^X -neprint+split+b],
+                                                     qr/a  a/,          3, ],
+
+        ### run tests that print only to stderr
+        [ "$^X -ewarn+42",                           qr/^42 /,          4, ],
+        [ [$^X, '-ewarn+42'],                        qr/^42 /,          4, ],
     ];
 
-    diag( "Running tests that print only to stdout" ) if $Verbose;
+    ### extended test in developer mode
+    ### test if gzip | tar works
+    if( $Verbose ) {   
+        my $gzip = can_run('gzip');
+        my $tar  = can_run('tar');
+        
+        if( $gzip and $tar ) {
+            push @$map,
+                [ [$gzip, qw[-cdf src/x.tgz |], $tar, qw[-tf -]],     
+                                                       qr/a/,           3, ];
+        }
+    }        
+
     ### for each configuarion
     for my $pref ( @Prefs ) {
-        diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" )
-            if $Verbose;
 
-        $IPC::Cmd::USE_IPC_RUN    = $IPC::Cmd::USE_IPC_RUN      = $pref->[0];
-        $IPC::Cmd::USE_IPC_OPEN3  = $IPC::Cmd::USE_IPC_OPEN3    = $pref->[1];
+        local $IPC::Cmd::USE_IPC_RUN    = !!$pref->[0];
+        local $IPC::Cmd::USE_IPC_RUN    = !!$pref->[0];
+        local $IPC::Cmd::USE_IPC_OPEN3  = !!$pref->[1];
+        local $IPC::Cmd::USE_IPC_OPEN3  = !!$pref->[1];
 
         ### for each command
         for my $aref ( @$map ) {
-            my $cmd                 = $aref->[0];
-            my $regex               = $aref->[1];
+            my $cmd    = $aref->[0];
+            my $regex  = $aref->[1];
+            my $index  = $aref->[2];
+
+            my $pp_cmd = ref $cmd ? "Array: @$cmd" : "Scalar: $cmd";
+            $pp_cmd .= " (IPC::Run: $pref->[0] IPC::Open3: $pref->[1])";
 
-            my $pp_cmd = ref $cmd ? "@$cmd" : "$cmd";
-            diag( "Running '$pp_cmd' as " . (ref $cmd ? "ARRAY" : "SCALAR") ) 
-                if $Verbose;
+            diag( "Running '$pp_cmd'") if $Verbose;
 
             ### in scalar mode
-            {   diag( "Running scalar mode" ) if $Verbose;
-                my $buffer;
+            {   my $buffer;
                 my $ok = run( command => $cmd, buffer => \$buffer );
 
-                ok( $ok,        "Ran command succesfully" );
+                ok( $ok,        "Ran '$pp_cmd' command succesfully" );
                 
                 SKIP: {
                     skip "No buffers available", 1 
                                 unless $Class->can_capture_buffer;
                     
                     like( $buffer, $regex,  
-                                "   Buffer filled properly" );
+                                "   Buffer matches $regex -- ($pp_cmd)" );
                 }
             }
                 
             ### in list mode                
             {   diag( "Running list mode" ) if $Verbose;
                 my @list = run( command => $cmd );
-                ok( $list[0],   "Command ran successfully" );
-                ok( !$list[1],  "   No error code set" );
+
+                ok( $list[0],   "Ran '$pp_cmd' successfully" );
+                ok( !$list[1],  "   No error code set -- ($pp_cmd)" );
 
                 my $list_length = $Class->can_capture_buffer ? 5 : 2;
                 is( scalar(@list), $list_length,
-                                "   Output list has $list_length entries" );
+                                "   Output list has $list_length entries -- ($pp_cmd)" );
 
                 SKIP: {
                     skip "No buffers available", 6 
@@ -97,188 +143,81 @@
                     isa_ok( $list[$_], 'ARRAY' ) for 2..4;
 
                     like( "@{$list[2]}", $regex,
-                                "   Combined buffer holds output" );
+                                "   Combined buffer matches $regex -- ($pp_cmd)" );
 
-                    like( "@{$list[3]}", qr/$regex/,
-                            "   Stdout buffer filled" );
-                    is( scalar( @{$list[4]} ), 0,
-                                    "   Stderr buffer empty" );
+                    like( "@{$list[$index]}", qr/$regex/,
+                            "   Proper buffer($index) matches $regex -- ($pp_cmd)" );
+                    is( scalar( @{$list[ $index==3 ? 4 : 3 ]} ), 0,
+                                    "   Other buffer empty -- ($pp_cmd)" );
                 }
             }
         }
     }
 }
+__END__
+### special call to check that output is interleaved properly
+{   my $cmd     = [$^X, File::Spec->catfile( qw[src output.pl] ) ];
 
-### run tests that print only to stderr
-### XXX lots of duplication from stdout tests, only difference
-### is buffer inspection
-{   ### list of commands and regexes matching output ###
-    my $map = [
-        # command                                    # output regex
-        [ "$^X -ewarn+42",                          qr/^42 /, ],
-        [ [$^X, '-ewarn+42'],                       qr/^42 /, ],
-    ];
-
-    diag( "Running tests that print only to stderr" ) if $Verbose;
     ### for each configuarion
     for my $pref ( @Prefs ) {
         diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" )
             if $Verbose;
 
-        $IPC::Cmd::USE_IPC_RUN    = $IPC::Cmd::USE_IPC_RUN      = $pref->[0];
-        $IPC::Cmd::USE_IPC_OPEN3  = $IPC::Cmd::USE_IPC_OPEN3    = $pref->[1];
-
-        ### for each command
-        for my $aref ( @$map ) {
-            my $cmd                 = $aref->[0];
-            my $regex               = $aref->[1];
-
-            my $pp_cmd = ref $cmd ? "@$cmd" : "$cmd";
-            diag( "Running '$pp_cmd' as " . (ref $cmd ? "ARRAY" : "SCALAR") )
-                if $Verbose;
-
-            ### in scalar mode
-            {   diag( "Running stderr command in scalar mode" ) if $Verbose;
-                my $buffer;
-                my $ok = run( command => $cmd, buffer => \$buffer );
-
-                ok( $ok,        "Ran stderr command succesfully in scalar mode." );
-
-                SKIP: {
-           # No buffers are expected if neither IPC::Run nor IPC::Open3 is used.
-                    skip "No buffers available", 1
-                                unless $Class->can_capture_buffer;
+        local $IPC::Cmd::USE_IPC_RUN    = $pref->[0];
+        local $IPC::Cmd::USE_IPC_OPEN3  = $pref->[1];
 
-                    like( $buffer, $regex,
-                                "   Buffer filled properly from stderr" );
-                }
-            }
-
-            ### in list mode
-            {   diag( "Running stderr command in list mode" ) if $Verbose;
-                my @list = run( command => $cmd );
-                ok( $list[0],   "Ran stderr command successfully in list mode." );
-                ok( !$list[1],  "   No error code set" );
-
-                my $list_length = $Class->can_capture_buffer ? 5 : 2;
-                is( scalar(@list), $list_length,
-                                "   Output list has $list_length entries" );
-
-                SKIP: {
-           # No buffers are expected if neither IPC::Run nor IPC::Open3 is used.
-                    skip "No buffers available", 6
-                                unless $Class->can_capture_buffer;
-
-                    ### the last 3 entries from the RV, are they array refs?
-                    isa_ok( $list[$_], 'ARRAY' ) for 2..4;
-
-                    like( "@{$list[2]}", $regex,
-                                "   Combined buffer holds output" );
-
-                    is( scalar( @{$list[3]} ), 0,
-                                    "   Stdout buffer empty" );
-                    like( "@{$list[4]}", qr/$regex/,
-                            "   Stderr buffer filled" );
-                }
+        my @list    = run( command => $cmd, buffer => \my $buffer );
+        ok( $list[0],                   "Ran @{$cmd} successfully" );
+        ok( !$list[1],                  "   No errorcode set" );
+        SKIP: {
+            skip "No buffers available", 3 unless $Class->can_capture_buffer;
+
+            TODO: {
+                local $TODO = qq[Can't interleave input/output buffers yet];
+
+                is( "@{$list[2]}",'1 2 3 4',"   Combined output as expected" );
+                is( "@{$list[3]}", '1 3',   "   STDOUT as expected" );
+                is( "@{$list[4]}", '2 4',   "   STDERR as expected" );
+            
             }
         }
-    }
+    }        
 }
 
+
+
 ### test failures
 {   ### for each configuarion
     for my $pref ( @Prefs ) {
         diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" )
             if $Verbose;
 
-        $IPC::Cmd::USE_IPC_RUN    = $IPC::Cmd::USE_IPC_RUN      = $pref->[0];
-        $IPC::Cmd::USE_IPC_OPEN3  = $IPC::Cmd::USE_IPC_OPEN3    = $pref->[1];
+        local $IPC::Cmd::USE_IPC_RUN    = $pref->[0];
+        local $IPC::Cmd::USE_IPC_OPEN3  = $pref->[1];
 
-        my $ok = run( command => "$^X -ledie" );
-        ok( !$ok,               "Failure caught" );
+        my ($ok,$err) = run( command => "$^X -edie" );
+        ok( !$ok,               "Non-zero exit caught" );
+        ok( $err,               "   Error '$err'" );
     }
-}    
-
-__END__
-
-
-### check if IPC::Run is already loaded, if so, IPC::Run tests
-### from IPC::Run are known to fail on win32
-my $Skip_IPC_Run = ($^O eq 'MSWin32' && exists $INC{'IPC/Run.pm'}) ? 1 : 0;
-
-use_ok( 'IPC::Cmd' ) or diag "Cmd.pm not found.  Dying", die;
-
-IPC::Cmd->import( qw[can_run run] );
-
-### silence it ###
-$IPC::Cmd::VERBOSE = $IPC::Cmd::VERBOSE = $ARGV[0] ? 1 : 0;
-
-{
-    ok( can_run('perl'),                q[Found 'perl' in your path] );
-    ok( !can_run('10283lkjfdalskfjaf'), q[Not found non-existant binary] );
-}
-
+}   
 
-{   ### list of commands and regexes matching output ###
-    my $map = [
-        ["$^X -v",                                  qr/larry\s+wall/i, ],
-        [[$^X, '-v'],                               qr/larry\s+wall/i, ],
-        ["$^X -eprint1 | $^X -neprint",             qr/1/,             ],
-        [[$^X,qw[-eprint1 |], $^X, qw|-neprint|],   qr/1/,             ],
-    ];
-
-    my @prefs = ( [1,1], [0,1], [0,0] );
-
-    ### if IPC::Run is already loaded,remove tests involving IPC::Run
-    ### when on win32
-    shift @prefs if $Skip_IPC_Run;
-
-    for my $pref ( @prefs ) {
-        $IPC::Cmd::USE_IPC_RUN    = $IPC::Cmd::USE_IPC_RUN      = $pref->[0];
-        $IPC::Cmd::USE_IPC_OPEN3  = $IPC::Cmd::USE_IPC_OPEN3    = $pref->[1];
-
-        for my $aref ( @$map ) {
-            my $cmd     = $aref->[0];
-            my $regex   = $aref->[1];
-
-            my $Can_Buffer;
-            my $captured;
-            my $ok = run( command => $cmd,
-                          buffer  => \$captured,
-                    );
-
-            ok($ok,     q[Successful run of command] );
-
-            SKIP: {
-                skip "No buffers returned", 1 unless $captured;
-                like( $captured, $regex,      q[   Buffer filled] );
-
-                ### if we get here, we have buffers ###
-                $Can_Buffer++;
-            }
-
-            my @list = run( command => $cmd );
-            ok( $list[0],       "Command ran successfully" );
-            ok( !$list[1],      "   No error code set" );
-
-            SKIP: {
-                skip "No buffers, cannot do buffer tests", 3
-                        unless $Can_Buffer;
+### timeout tests
+{   my $timeout = 1;
+    for my $pref ( @Prefs ) {
+        diag( "Running config: IPC::Run: $pref->[0] IPC::Open3: $pref->[1]" )
+            if $Verbose;
 
-                ok( (grep /$regex/, @{$list[2]}),
-                                    "   Out buffer filled" );
-                SKIP: {
-                    skip "IPC::Run bug prevents separated " .
-                            "stdout/stderr buffers", 2 if $pref->[0];
+        local $IPC::Cmd::USE_IPC_RUN    = $pref->[0];
+        local $IPC::Cmd::USE_IPC_OPEN3  = $pref->[1];
 
-                    ok( (grep /$regex/, @{$list[3]}),
-                                        "   Stdout buffer filled" );
-                    ok( @{$list[4]} == 0,
-                                        "   Stderr buffer empty" );
-                }
-            }
-        }
+        ### -X to quiet the 'sleep without parens is ambiguous' warning
+        my ($ok,$err) = run( command => "$^X -Xesleep+4", timeout => $timeout );
+        ok( !$ok,               "Timeout caught" );
+        ok( $err,               "   Error stored" );
+        ok( not(ref($err)),     "   Error string is not a reference" );
+        like( $err,qr/^$AClass/,"   Error '$err' mentions $AClass" );
     }
-}
+}    
+    
 
 
diff -urN perl-5.10.0.orig/lib/IPC/Cmd/t/src/output.pl perl-5.10.0/lib/IPC/Cmd/t/src/output.pl
--- perl-5.10.0.orig/lib/IPC/Cmd/t/src/output.pl	1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/IPC/Cmd/t/src/output.pl	2009-03-10 15:43:11.000000000 +0100
@@ -0,0 +1,13 @@
+use strict;
+use warnings;
+use IO::Handle;
+
+STDOUT->autoflush(1);
+STDERR->autoflush(1);
+
+my $max = shift || 4;
+for ( 1..$max ) {
+    $_ % 2 
+        ? print STDOUT $_
+        : print STDERR $_;
+}
diff -urN perl-5.10.0.orig/lib/IPC/Cmd/t/src/x.tgz.packed perl-5.10.0/lib/IPC/Cmd/t/src/x.tgz.packed
--- perl-5.10.0.orig/lib/IPC/Cmd/t/src/x.tgz.packed	1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/IPC/Cmd/t/src/x.tgz.packed	2009-03-10 15:43:43.000000000 +0100
@@ -0,0 +1,18 @@
+#########################################################################
+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/IPC/Cmd/t/src/x.tgz.packed lib/IPC/Cmd/t/src/x.tgz
+
+To recreate it use the following command:
+
+     uupacktool.pl -p lib/IPC/Cmd/t/src/x.tgz lib/IPC/Cmd/t/src/x.tgz.packed
+
+Created at Tue Mar 10 15:43:43 2009
+#########################################################################
+__UU__
+M'XL(`````````^W.NPW"0!!%T2EE2YC%:[N>#7""1,"G?QM##!&.SDE&(]W@
+M]?B_K)E3:Y&;>1KWFZ?W_Q&O)(<Z9!OW/FN4/&!;/.^/?BLE+OUZ_M9MV;(<
+6,0@```````````!^6P'GVS1B`"@`````
diff -urN perl-5.10.0.orig/lib/IPC/Cmd.pm perl-5.10.0/lib/IPC/Cmd.pm
--- perl-5.10.0.orig/lib/IPC/Cmd.pm	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/IPC/Cmd.pm	2009-03-10 15:42:10.000000000 +0100
@@ -4,16 +4,19 @@
 
 BEGIN {
 
-    use constant IS_VMS   => $^O eq 'VMS'                       ? 1 : 0;    
-    use constant IS_WIN32 => $^O eq 'MSWin32'                   ? 1 : 0;
-    use constant IS_WIN98 => (IS_WIN32 and !Win32::IsWinNT())   ? 1 : 0;
+    use constant IS_VMS         => $^O eq 'VMS'                       ? 1 : 0;    
+    use constant IS_WIN32       => $^O eq 'MSWin32'                   ? 1 : 0;
+    use constant IS_WIN98       => (IS_WIN32 and !Win32::IsWinNT())   ? 1 : 0;
+    use constant ALARM_CLASS    => __PACKAGE__ . '::TimeOut';
+    use constant SPECIAL_CHARS  => qw[< > | &];
+    use constant QUOTE          => do { IS_WIN32 ? q["] : q['] };            
 
     use Exporter    ();
     use vars        qw[ @ISA $VERSION @EXPORT_OK $VERBOSE $DEBUG
                         $USE_IPC_RUN $USE_IPC_OPEN3 $WARN
                     ];
 
-    $VERSION        = '0.40_1';
+    $VERSION        = '0.42';
     $VERBOSE        = 0;
     $DEBUG          = 0;
     $WARN           = 1;
@@ -21,12 +24,13 @@
     $USE_IPC_OPEN3  = not IS_VMS;
 
     @ISA            = qw[Exporter];
-    @EXPORT_OK      = qw[can_run run];
+    @EXPORT_OK      = qw[can_run run QUOTE];
 }
 
 require Carp;
 use File::Spec;
 use Params::Check               qw[check];
+use Text::ParseWords            ();             # import ONLY if needed!
 use Module::Load::Conditional   qw[can_load];
 use Locale::Maketext::Simple    Style => 'gettext';
 
@@ -50,7 +54,8 @@
     my $buffer;
     if( scalar run( command => $cmd,
                     verbose => 0,
-                    buffer  => \$buffer )
+                    buffer  => \$buffer,
+                    timeout => 20 )
     ) {
         print "fetched webpage successfully: $buffer\n";
     }
@@ -73,6 +78,7 @@
     ### don't have IPC::Cmd be verbose, ie don't print to stdout or
     ### stderr when running commands -- default is '0'
     $IPC::Cmd::VERBOSE = 0;
+         
 
 =head1 DESCRIPTION
 
@@ -86,7 +92,7 @@
 
 =head1 CLASS METHODS 
 
-=head2 $bool = IPC::Cmd->can_use_ipc_run( [VERBOSE] )
+=head2 $ipc_run_version = IPC::Cmd->can_use_ipc_run( [VERBOSE] )
 
 Utility function that tells you if C<IPC::Run> is available. 
 If the verbose flag is passed, it will print diagnostic messages
@@ -109,10 +115,10 @@
                     );
                     
     ### otherwise, we're good to go
-    return 1;                    
+    return $IPC::Run::VERSION;                    
 }
 
-=head2 $bool = IPC::Cmd->can_use_ipc_open3( [VERBOSE] )
+=head2 $ipc_open3_version = IPC::Cmd->can_use_ipc_open3( [VERBOSE] )
 
 Utility function that tells you if C<IPC::Open3> is available. 
 If the verbose flag is passed, it will print diagnostic messages
@@ -126,17 +132,17 @@
     my $verbose = shift || 0;
 
     ### ipc::open3 is not working on VMS becasue of a lack of fork.
-    ### todo, win32 also does not have fork, so need to do more research.
-    return 0 if IS_VMS;
+    ### XXX todo, win32 also does not have fork, so need to do more research.
+    return if IS_VMS;
 
-    ### ipc::open3 works on every platform, but it can't capture buffers
-    ### on win32 :(
+    ### ipc::open3 works on every non-VMS platform platform, but it can't 
+    ### capture buffers on win32 :(
     return unless can_load(
         modules => { map {$_ => '0.0'} qw|IPC::Open3 IO::Select Symbol| },
         verbose => ($WARN && $verbose),
     );
     
-    return 1;
+    return $IPC::Open3::VERSION;
 }
 
 =head2 $bool = IPC::Cmd->can_capture_buffer
@@ -201,9 +207,9 @@
     }
 }
 
-=head2 $ok | ($ok, $err, $full_buf, $stdout_buff, $stderr_buff) = run( command => COMMAND, [verbose => BOOL, buffer => \$SCALAR] );
+=head2 $ok | ($ok, $err, $full_buf, $stdout_buff, $stderr_buff) = run( command => COMMAND, [verbose => BOOL, buffer => \$SCALAR, timeout => DIGIT] );
 
-C<run> takes 3 arguments:
+C<run> takes 4 arguments:
 
 =over 4
 
@@ -238,6 +244,16 @@
 Of course, this requires that the underlying call supports buffers. See
 the note on buffers right above.
 
+=item timeout
+
+Sets the maximum time the command is allowed to run before aborting,
+using the built-in C<alarm()> call. If the timeout is triggered, the
+C<errorcode> in the return value will be set to an object of the 
+C<IPC::Cmd::TimeOut> class. See the C<errorcode> section below for
+details.
+
+Defaults to C<0>, meaning no timeout is set.
+
 =back
 
 C<run> will return a simple C<true> or C<false> when called in scalar
@@ -251,11 +267,15 @@
 A simple boolean indicating if the command executed without errors or
 not.
 
-=item errorcode
+=item error message
 
 If the first element of the return value (success) was 0, then some
-error occurred. This second element is the error code the command
-you requested exited with, if available.
+error occurred. This second element is the error message the command
+you requested exited with, if available. This is generally a pretty 
+printed value of C<$?> or C<$@>. See C<perldoc perlvar> for details on 
+what they can contain.
+If the error was a timeout, the C<error message> will be prefixed with
+the string C<IPC::Cmd::TimeOut>, the timeout class.
 
 =item full_buffer
 
@@ -288,27 +308,48 @@
 
 =cut
 
+{   my @acc = qw[ok error _fds];
+    
+    ### autogenerate accessors ###
+    for my $key ( @acc ) {
+        no strict 'refs';
+        *{__PACKAGE__."::$key"} = sub {
+            $_[0]->{$key} = $_[1] if @_ > 1;
+            return $_[0]->{$key};
+        }
+    }
+}
+
 sub run {
+    ### container to store things in
+    my $self = bless {}, __PACKAGE__;
+
     my %hash = @_;
     
     ### if the user didn't provide a buffer, we'll store it here.
     my $def_buf = '';
     
-    my($verbose,$cmd,$buffer);
+    my($verbose,$cmd,$buffer,$timeout);
     my $tmpl = {
         verbose => { default  => $VERBOSE,  store => \$verbose },
         buffer  => { default  => \$def_buf, store => \$buffer },
         command => { required => 1,         store => \$cmd,
-                     allow    => sub { !ref($_[0]) or ref($_[0]) eq 'ARRAY' } 
+                     allow    => sub { !ref($_[0]) or ref($_[0]) eq 'ARRAY' }, 
         },
+        timeout => { default  => 0,         store => \$timeout },                    
     };
-
+    
     unless( check( $tmpl, \%hash, $VERBOSE ) ) {
-        Carp::carp(loc("Could not validate input: %1", Params::Check->last_error));
+        Carp::carp( loc( "Could not validate input: %1",
+                         Params::Check->last_error ) );
         return;
     };        
 
-    print loc("Running [%1]...\n", (ref $cmd ? "@$cmd" : $cmd)) if $verbose;
+    ### strip any empty elements from $cmd if present
+    $cmd = [ grep { length && defined } @$cmd ] if ref $cmd;
+
+    my $pp_cmd = (ref $cmd ? "@$cmd" : $cmd);
+    print loc("Running [%1]...\n", $pp_cmd ) if $verbose;
 
     ### did the user pass us a buffer to fill or not? if so, set this
     ### flag so we know what is expected of us
@@ -323,7 +364,7 @@
     my $_out_handler = sub {
         my $buf = shift;
         return unless defined $buf;
-        
+       
         print STDOUT $buf if $verbose;
         push @buffer,   $buf;
         push @buff_out, $buf;
@@ -341,39 +382,70 @@
     
 
     ### flag to indicate we have a buffer captured
-    my $have_buffer = __PACKAGE__->can_capture_buffer ? 1 : 0;
+    my $have_buffer = $self->can_capture_buffer ? 1 : 0;
     
     ### flag indicating if the subcall went ok
     my $ok;
     
-    ### IPC::Run is first choice if $USE_IPC_RUN is set.
-    if( $USE_IPC_RUN and __PACKAGE__->can_use_ipc_run( 1 ) ) {
-        ### ipc::run handlers needs the command as a string or an array ref
-
-        __PACKAGE__->_debug( "# Using IPC::Run. Have buffer: $have_buffer" )
-            if $DEBUG;
+    ### dont look at previous errors:
+    local $?;  
+    local $@;
+    local $!;
+
+    ### we might be having a timeout set
+    eval {   
+        local $SIG{ALRM} = sub { die bless sub { 
+            ALARM_CLASS . 
+            qq[: Command '$pp_cmd' aborted by alarm after $timeout seconds]
+        }, ALARM_CLASS } if $timeout;
+        alarm $timeout || 0;
+    
+        ### IPC::Run is first choice if $USE_IPC_RUN is set.
+        if( $USE_IPC_RUN and $self->can_use_ipc_run( 1 ) ) {
+            ### ipc::run handlers needs the command as a string or an array ref
+    
+            $self->_debug( "# Using IPC::Run. Have buffer: $have_buffer" )
+                if $DEBUG;
+                
+            $ok = $self->_ipc_run( $cmd, $_out_handler, $_err_handler );
+    
+        ### since IPC::Open3 works on all platforms, and just fails on
+        ### win32 for capturing buffers, do that ideally
+        } elsif ( $USE_IPC_OPEN3 and $self->can_use_ipc_open3( 1 ) ) {
+    
+            $self->_debug("# Using IPC::Open3. Have buffer: $have_buffer")
+                if $DEBUG;
+    
+            ### in case there are pipes in there;
+            ### IPC::Open3 will call exec and exec will do the right thing 
+            $ok = $self->_open3_run( 
+                                    $cmd, $_out_handler, $_err_handler, $verbose 
+                                );
             
-        $ok = __PACKAGE__->_ipc_run( $cmd, $_out_handler, $_err_handler );
-
-    ### since IPC::Open3 works on all platforms, and just fails on
-    ### win32 for capturing buffers, do that ideally
-    } elsif ( $USE_IPC_OPEN3 and __PACKAGE__->can_use_ipc_open3( 1 ) ) {
-
-        __PACKAGE__->_debug( "# Using IPC::Open3. Have buffer: $have_buffer" )
-            if $DEBUG;
-
-        ### in case there are pipes in there;
-        ### IPC::Open3 will call exec and exec will do the right thing 
-        $ok = __PACKAGE__->_open3_run( 
-                                ( ref $cmd ? "@$cmd" : $cmd ),
-                                $_out_handler, $_err_handler, $verbose 
-                            );
+        ### if we are allowed to run verbose, just dispatch the system command
+        } else {
+            $self->_debug( "# Using system(). Have buffer: $have_buffer" )
+                if $DEBUG;
+            $ok = $self->_system_run( $cmd, $verbose );
+        }
         
-    ### if we are allowed to run verbose, just dispatch the system command
-    } else {
-        __PACKAGE__->_debug( "# Using system(). Have buffer: $have_buffer" )
-            if $DEBUG;
-        $ok = __PACKAGE__->_system_run( (ref $cmd ? "@$cmd" : $cmd), $verbose );
+        alarm 0;
+    };
+   
+    ### restore STDIN after duping, or STDIN will be closed for
+    ### this current perl process!   
+    $self->__reopen_fds( @{ $self->_fds} ) if $self->_fds;
+    
+    my $err;
+    unless( $ok ) {
+        ### alarm happened
+        if ( $@ and ref $@ and $@->isa( ALARM_CLASS ) ) {
+            $err = $@->();  # the error code is an expired alarm
+
+        ### another error happened, set by the dispatchub
+        } else {
+            $err = $self->error;
+        }
     }
     
     ### fill the buffer;
@@ -383,8 +455,8 @@
     ### context, or just a simple 'ok' in scalar
     return wantarray
                 ? $have_buffer
-                    ? ($ok, $?, \@buffer, \@buff_out, \@buff_err)
-                    : ($ok, $? )
+                    ? ($ok, $err, \@buffer, \@buff_out, \@buff_err)
+                    : ($ok, $err )
                 : $ok
     
     
@@ -418,15 +490,30 @@
                             ? qw[STDIN STDOUT STDERR] 
                             : qw[STDIN]
                         );
-    __PACKAGE__->__dup_fds( @fds_to_dup );
+    $self->_fds( \@fds_to_dup );
+    $self->__dup_fds( @fds_to_dup );
     
-
-    my $pid = IPC::Open3::open3(
+    ### pipes have to come in a quoted string, and that clashes with
+    ### whitespace. This sub fixes up such commands so they run properly
+    $cmd = $self->__fix_cmd_whitespace_and_special_chars( $cmd );
+        
+    ### dont stringify @$cmd, so spaces in filenames/paths are
+    ### treated properly
+    my $pid = eval { 
+        IPC::Open3::open3(
                     '<&STDIN',
                     (IS_WIN32 ? '>&STDOUT' : $kidout),
                     (IS_WIN32 ? '>&STDERR' : $kiderror),
-                    $cmd
+                    ( ref $cmd ? @$cmd : $cmd ),
                 );
+    };
+    
+    ### open3 error occurred 
+    if( $@ and $@ =~ /^open3:/ ) {
+        $self->ok( 0 );
+        $self->error( $@ );
+        return;
+    };
 
     ### use OUR stdin, not $kidin. Somehow,
     ### we never get the input.. so jump through
@@ -459,7 +546,7 @@
                 warn(loc("Error reading from process: %1", $!));
                 last OUTER;
             }
-            
+
             ### check for $len. it may be 0, at which point we're
             ### done reading, so don't try to process it.
             ### if we would print anyway, we'd provide bogus information
@@ -478,88 +565,130 @@
 
     ### restore STDIN after duping, or STDIN will be closed for
     ### this current perl process!
-    __PACKAGE__->__reopen_fds( @fds_to_dup );
+    ### done in the parent call now
+    # $self->__reopen_fds( @fds_to_dup );
     
-    return if $?;   # some error occurred
-    return 1;
+    ### some error occurred
+    if( $? ) {
+        $self->error( $self->_pp_child_error( $cmd, $? ) );   
+        $self->ok( 0 );
+        return;
+    } else {
+        return $self->ok( 1 );
+    }
 }
 
+### text::parsewords::shellwordss() uses unix semantics. that will break
+### on win32
+{   my $parse_sub = IS_WIN32 
+                        ? __PACKAGE__->can('_split_like_shell_win32')
+                        : Text::ParseWords->can('shellwords');
+
+    sub _ipc_run {  
+        my $self            = shift;
+        my $cmd             = shift;
+        my $_out_handler    = shift;
+        my $_err_handler    = shift;
+        
+        STDOUT->autoflush(1); STDERR->autoflush(1);
 
-sub _ipc_run {  
-    my $self            = shift;
-    my $cmd             = shift;
-    my $_out_handler    = shift;
-    my $_err_handler    = shift;
-    
-    STDOUT->autoflush(1); STDERR->autoflush(1);
+        ### a command like:
+        # [
+        #     '/usr/bin/gzip',
+        #     '-cdf',
+        #     '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz',
+        #     '|',
+        #     '/usr/bin/tar',
+        #     '-tf -'
+        # ]
+        ### needs to become:
+        # [
+        #     ['/usr/bin/gzip', '-cdf',
+        #       '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz']
+        #     '|',
+        #     ['/usr/bin/tar', '-tf -']
+        # ]
+
+    
+        my @command; 
+        my $special_chars;
+    
+        my $re = do { my $x = join '', SPECIAL_CHARS; qr/([$x])/ };
+        if( ref $cmd ) {
+            my $aref = [];
+            for my $item (@$cmd) {
+                if( $item =~ $re ) {
+                    push @command, $aref, $item;
+                    $aref = [];
+                    $special_chars .= $1;
+                } else {
+                    push @$aref, $item;
+                }
+            }
+            push @command, $aref;
+        } else {
+            @command = map { if( $_ =~ $re ) {
+                                $special_chars .= $1; $_;
+                             } else {
+#                                [ split /\s+/ ]
+                                 [ map { m/[ ]/ ? qq{'$_'} : $_ } $parse_sub->($_) ]
+                             }
+                        } split( /\s*$re\s*/, $cmd );
+        }
 
-    ### a command like:
-    # [
-    #     '/usr/bin/gzip',
-    #     '-cdf',
-    #     '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz',
-    #     '|',
-    #     '/usr/bin/tar',
-    #     '-tf -'
-    # ]
-    ### needs to become:
-    # [
-    #     ['/usr/bin/gzip', '-cdf',
-    #       '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz']
-    #     '|',
-    #     ['/usr/bin/tar', '-tf -']
-    # ]
-
-    
-    my @command; my $special_chars;
-    if( ref $cmd ) {
-        my $aref = [];
-        for my $item (@$cmd) {
-            if( $item =~ /([<>|&])/ ) {
-                push @command, $aref, $item;
-                $aref = [];
-                $special_chars .= $1;
+        ### if there's a pipe in the command, *STDIN needs to 
+        ### be inserted *BEFORE* the pipe, to work on win32
+        ### this also works on *nix, so we should do it when possible
+        ### this should *also* work on multiple pipes in the command
+        ### if there's no pipe in the command, append STDIN to the back
+        ### of the command instead.
+        ### XXX seems IPC::Run works it out for itself if you just
+        ### dont pass STDIN at all.
+        #     if( $special_chars and $special_chars =~ /\|/ ) {
+        #         ### only add STDIN the first time..
+        #         my $i;
+        #         @command = map { ($_ eq '|' && not $i++) 
+        #                             ? ( \*STDIN, $_ ) 
+        #                             : $_ 
+        #                         } @command; 
+        #     } else {
+        #         push @command, \*STDIN;
+        #     }
+  
+        # \*STDIN is already included in the @command, see a few lines up
+        my $ok = eval { IPC::Run::run(   @command, 
+                                fileno(STDOUT).'>',
+                                $_out_handler,
+                                fileno(STDERR).'>',
+                                $_err_handler
+                            )
+                        };
+
+        ### all is well
+        if( $ok ) {
+            return $self->ok( $ok );
+
+        ### some error occurred
+        } else {
+            $self->ok( 0 );
+
+            ### if the eval fails due to an exception, deal with it
+            ### unless it's an alarm 
+            if( $@ and not UNIVERSAL::isa( $@, ALARM_CLASS ) ) {        
+                $self->error( $@ );
+
+            ### if it *is* an alarm, propagate        
+            } elsif( $@ ) {
+                die $@;
+
+            ### some error in the sub command
             } else {
-                push @$aref, $item;
+                $self->error( $self->_pp_child_error( $cmd, $? ) );
             }
+    
+            return;
         }
-        push @command, $aref;
-    } else {
-        @command = map { if( /([<>|&])/ ) {
-                            $special_chars .= $1; $_;
-                         } else {
-                            [ split / +/ ]
-                         }
-                    } split( /\s*([<>|&])\s*/, $cmd );
-    }
- 
-    ### if there's a pipe in the command, *STDIN needs to 
-    ### be inserted *BEFORE* the pipe, to work on win32
-    ### this also works on *nix, so we should do it when possible
-    ### this should *also* work on multiple pipes in the command
-    ### if there's no pipe in the command, append STDIN to the back
-    ### of the command instead.
-    ### XXX seems IPC::Run works it out for itself if you just
-    ### dont pass STDIN at all.
-    #     if( $special_chars and $special_chars =~ /\|/ ) {
-    #         ### only add STDIN the first time..
-    #         my $i;
-    #         @command = map { ($_ eq '|' && not $i++) 
-    #                             ? ( \*STDIN, $_ ) 
-    #                             : $_ 
-    #                         } @command; 
-    #     } else {
-    #         push @command, \*STDIN;
-    #     }
-  
- 
-    # \*STDIN is already included in the @command, see a few lines up
-    return IPC::Run::run(   @command, 
-                            fileno(STDOUT).'>',
-                            $_out_handler,
-                            fileno(STDERR).'>',
-                            $_err_handler
-                        );
+    }
 }
 
 sub _system_run { 
@@ -567,18 +696,117 @@
     my $cmd     = shift;
     my $verbose = shift || 0;
 
+    ### pipes have to come in a quoted string, and that clashes with
+    ### whitespace. This sub fixes up such commands so they run properly
+    $cmd = $self->__fix_cmd_whitespace_and_special_chars( $cmd );
+
     my @fds_to_dup = $verbose ? () : qw[STDOUT STDERR];
-    __PACKAGE__->__dup_fds( @fds_to_dup );
-    
+    $self->_fds( \@fds_to_dup );
+    $self->__dup_fds( @fds_to_dup );
+
     ### system returns 'true' on failure -- the exit code of the cmd
-    system( $cmd );
+    $self->ok( 1 );
+    system( ref $cmd ? @$cmd : $cmd ) == 0 or do {
+        $self->error( $self->_pp_child_error( $cmd, $? ) );
+        $self->ok( 0 );
+    };
+
+    ### done in the parent call now
+    #$self->__reopen_fds( @fds_to_dup );
+
+    return unless $self->ok;
+    return $self->ok;
+}
+
+{   my %sc_lookup = map { $_ => $_ } SPECIAL_CHARS;
+
+
+    sub __fix_cmd_whitespace_and_special_chars {
+        my $self = shift;
+        my $cmd  = shift;
+
+        ### command has a special char in it
+        if( ref $cmd and grep { $sc_lookup{$_} } @$cmd ) {
+            
+            ### since we have special chars, we have to quote white space
+            ### this *may* conflict with the parsing :(
+            my $fixed;
+            my @cmd = map { / / ? do { $fixed++; QUOTE.$_.QUOTE } : $_ } @$cmd;
+            
+            $self->_debug( "# Quoted $fixed arguments containing whitespace" )
+                    if $DEBUG && $fixed;
+            
+            ### stringify it, so the special char isn't escaped as argument
+            ### to the program
+            $cmd = join ' ', @cmd;
+        }
+
+        return $cmd;
+    }
+}
+
+
+### XXX this is cribbed STRAIGHT from M::B 0.30 here:
+### http://search.cpan.org/src/KWILLIAMS/Module-Build-0.30/lib/Module/Build/Platform/Windows.pm:split_like_shell
+### XXX this *should* be integrated into text::parsewords
+sub _split_like_shell_win32 {
+  # 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.
+  
+  local $_ = shift;
+  
+  my @argv;
+  return @argv unless defined() && length();
+  
+  my $arg = '';
+  my( $i, $quote_mode ) = ( 0, 0 );
+  
+  while ( $i < length() ) {
     
-    __PACKAGE__->__reopen_fds( @fds_to_dup );
+    my $ch      = substr( $_, $i  , 1 );
+    my $next_ch = substr( $_, $i+1, 1 );
     
-    return if $?;
-    return 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;
 }
 
+
+
 {   use File::Spec;
     use Symbol;
 
@@ -660,9 +888,50 @@
     return 1;
 }
 
+sub _pp_child_error {
+    my $self    = shift;
+    my $cmd     = shift or return;
+    my $ce      = shift or return;
+    my $pp_cmd  = ref $cmd ? "@$cmd" : $cmd;
+    
+            
+    my $str;
+    if( $ce == -1 ) {
+        ### Include $! in the error message, so that the user can
+        ### see 'No such file or directory' versus 'Permission denied'
+        ### versus 'Cannot fork' or whatever the cause was.
+        $str = "Failed to execute '$pp_cmd': $!";
+
+    } elsif ( $ce & 127 ) {       
+        ### some signal
+        $str = loc( "'%1' died with signal %d, %s coredump\n",
+               $pp_cmd, ($ce & 127), ($ce & 128) ? 'with' : 'without');
+
+    } else {
+        ### Otherwise, the command run but gave error status.
+        $str = "'$pp_cmd' exited with value " . ($ce >> 8);
+    }
+  
+    $self->_debug( "# Child error '$ce' translated to: $str" ) if $DEBUG;
+    
+    return $str;
+}
 
 1;
 
+=head2 $q = QUOTE
+
+Returns the character used for quoting strings on this platform. This is
+usually a C<'> (single quote) on most systems, but some systems use different
+quotes. For example, C<Win32> uses C<"> (double quote). 
+
+You can use it as follows:
+
+  use IPC::Cmd qw[run QUOTE];
+  my $cmd = q[echo ] . QUOTE . q[foo bar] . QUOTE;
+
+This makes sure that C<foo bar> is treated as a string, rather than two
+seperate arguments to the C<echo> function.
 
 __END__
 
@@ -733,11 +1002,28 @@
 
 =over 4
 
-=item Whitespace
+=item Whitespace and IPC::Open3 / system()
 
-When you provide a string as this argument, the string will be
-split on whitespace to determine the individual elements of your
-command. Although this will usually just Do What You Mean, it may
+When using C<IPC::Open3> or C<system>, if you provide a string as the
+C<command> argument, it is assumed to be appropriately escaped. You can
+use the C<QUOTE> constant to use as a portable quote character (see above).
+However, if you provide and C<Array Reference>, special rules apply:
+
+If your command contains C<Special Characters> (< > | &), it will
+be internally stringified before executing the command, to avoid that these
+special characters are escaped and passed as arguments instead of retaining
+their special meaning.
+
+However, if the command contained arguments that contained whitespace, 
+stringifying the command would loose the significance of the whitespace.
+Therefor, C<IPC::Cmd> will quote any arguments containing whitespace in your
+command if the command is passed as an arrayref and contains special characters.
+
+=item Whitespace and IPC::Run
+
+When using C<IPC::Run>, if you provide a string as the C<command> argument, 
+the string will be split on whitespace to determine the individual elements 
+of your command. Although this will usually just Do What You Mean, it may
 break if you have files or commands with whitespace in them.
 
 If you do not wish this to happen, you should provide an array
@@ -765,12 +1051,30 @@
 
 Since this will lead to issues as described above.
 
+
 =item IO Redirect
 
 Currently it is too complicated to parse your command for IO
 Redirections. For capturing STDOUT or STDERR there is a work around
 however, since you can just inspect your buffers for the contents.
 
+=item Interleaving STDOUT/STDERR
+
+Neither IPC::Run nor IPC::Open3 can interleave STDOUT and STDERR. For short
+bursts of output from a program, ie this sample:
+
+    for ( 1..4 ) {
+        $_ % 2 ? print STDOUT $_ : print STDERR $_;
+    }
+
+IPC::[Run|Open3] will first read all of STDOUT, then all of STDERR, meaning 
+the output looks like 1 line on each, namely '13' on STDOUT and '24' on STDERR.
+
+It should have been 1, 2, 3, 4.
+
+This has been recorded in L<rt.cpan.org> as bug #37532: Unable to interleave
+STDOUT and STDERR
+
 =back
 
 =head1 See Also

perl-update-Module-Build.patch:

--- NEW FILE perl-update-Module-Build.patch ---
Module-Build-0.32
perl-5.10.0 contained some fixes in the Module::Build testsuite; all
these have been integrated to Module-Build-0.31012

--- perl-5.10.0.orig/MANIFEST	2009-02-20 18:22:32.000000000 +0100
+++ perl-5.10.0/MANIFEST	2009-03-10 17:07:04.000000000 +0100
@@ -2156,8 +2156,10 @@
 lib/Module/Build/PodParser.pm	Module::Build
 lib/Module/Build/PPMMaker.pm	Module::Build
 lib/Module/Build/scripts/config_data	Module::Build
+lib/Module/Build/t/add_property.t	Module::Build
 lib/Module/Build/t/basic.t	Module::Build
 lib/Module/Build/t/bundled/Tie/CPHash.pm	Module::Build.pm
+lib/Module/Build/t/compat/exit.t	Module::Build
 lib/Module/Build/t/compat.t	Module::Build
 lib/Module/Build/t/destinations.t	Module::Build
 lib/Module/Build/t/extend.t	Module::Build
@@ -2178,9 +2180,12 @@
 lib/Module/Build/t/pod_parser.t	Module::Build
 lib/Module/Build/t/ppm.t	Module::Build
 lib/Module/Build/t/runthrough.t	Module::Build
+lib/Module/Build/t/script_dist.t	Module::Build
+lib/Module/Build/t/test_file_exts.t	Module::Build
 lib/Module/Build/t/test_types.t	Module::Build
 lib/Module/Build/t/test_type.t	Module::Build
 lib/Module/Build/t/tilde.t	Module::Build
+lib/Module/Build/t/use_tap_harness.t	Module::Build
 lib/Module/Build/t/versions.t	Module::Build
 lib/Module/Build/t/xs.t		Module::Build
 lib/Module/Build/Version.pm	Module::Build
diff -urN perl-5.10.0.orig/lib/Module/Build/API.pod perl-5.10.0/lib/Module/Build/API.pod
--- perl-5.10.0.orig/lib/Module/Build/API.pod	2009-02-20 18:22:32.000000000 +0100
+++ perl-5.10.0/lib/Module/Build/API.pod	2009-03-10 16:49:12.000000000 +0100
@@ -211,12 +211,12 @@
 
 [version 0.20]
 
-This should be a short description of the distribution.  This is used
-when generating metadata for F<META.yml> and PPD files.  If it is not
-given then C<Module::Build> looks in the POD of the module from which
-it gets the distribution's version.  It looks for the first line
-matching C<$package\s-\s(.+)>, and uses the captured text as the
-abstract.
+This should be a short description of the distribution.  This is used when
+generating metadata for F<META.yml> and PPD files.  If it is not given
+then C<Module::Build> looks in the POD of the module from which it gets
+the distribution's version.  If it finds a POD section marked "=head1
+NAME", then it looks for the first line matching C<\s+-\s+(.+)>,
+and uses the captured text as the abstract.
 
 =item dist_author
 
@@ -268,6 +268,10 @@
 this process, so there's no real opportunity to change to something
 better.
 
+If the target file of L</dist_version_from> contains more than one package
+declaration, the version returned will be the one matching the configured
+L</module_name>.
+
 =item dynamic_config
 
 [version 0.07]
@@ -502,16 +506,16 @@
 sync with your written documentation if you ever change your licensing
 terms.
 
+You may also use a license type of C<unknown> if you don't wish to
+specify your terms in the metadata.
+
 It is a fatal error to use a license other than the ones mentioned
 above.  This is not because I wish to impose licensing terms on you -
 please let me know if you would like another license option to be
-added to the list.  You may also use a license type of C<unknown> if
-you don't wish to specify your terms (but this is usually not a good
-idea for you to do!).
-
-I just started out with a small set of licenses to keep things simple,
-figuring I'd let people with actual working knowledge in this area
-tell me what to do.  So if that's you, drop me a line.
+added to the list.  I just started out with a small set of licenses to
+keep things simple, figuring I'd let people with actual working
+knowledge in this area tell me what to do.  So if that's you, drop me
+a line.
 
 =item meta_add
 
@@ -683,13 +687,13 @@
 
 An optional parameter specifying a set of files that should be
 installed as executable Perl scripts when the module is installed.
-May be given as an array reference of the files, or as a hash
-reference whose keys are the files (and whose values will currently be
-ignored).
+May be given as an array reference of the files, as a hash reference
+whose keys are the files (and whose values will currently be ignored),
+as a string giving the name of a directory in which to find scripts,
+or as a string giving the name of a single script file.
 
-The default is to install no script files - in other words, there is
-no default location where Module::Build will look for script files to
-install.
+The default is to install any scripts found in a F<bin> directory at
+the top level of the distribution.
 
 For backward compatibility, you may use the parameter C<scripts>
 instead of C<script_files>.  Please consider this usage deprecated,
@@ -725,6 +729,26 @@
 property is true, then the C<t/> directory will be scanned recursively
 for C<*.t> files.
 
+=item use_tap_harness
+
+[version 0.2808_03]
+
+An optional parameter indicating whether or not to use TAP::Harness for
+testing rather than Test::Harness. Defaults to false. If set to true, you must
+therefore be sure to add TAP::Harness as a requirement for your module in
+L</build_requires>. Implicitly set to a true value if C<tap_harness_args> is
+specified.
+
+=item tap_harness_args
+
+[version 0.2808_03]
+
+An optional parameter specifying parameters to be passed to TAP::Harness when
+running tests. Must be given as a hash reference of parameters; see the
+L<TAP::Harness|TAP::Harness> documentation for details. Note that specifying
+this parameter will implicitly set C<use_tap_harness> to a true value. You
+must therefore be sure to add TAP::Harness as a requirement for your module in
+L</build_requires>.
 
 =item xs_files
 
@@ -771,6 +795,86 @@
 defaults to C<MyModuleBuilder>.  The C<code> parameter specifies Perl
 code to use as the body of the subclass.
 
+=item add_property
+
+[version 0.31]
+
+  package 'My::Build';
+  use base 'Module::Build';
+  __PACKAGE__->add_property( 'pedantic' );
+  __PACKAGE__->add_property( answer => 42 );
+  __PACKAGE__->add_property(
+     'epoch',
+      default => sub { time },
+      check   => sub {
+          return 1 if /^\d+$/;
+          shift->property_error( "'$_' is not an epoch time" );
+          return 0;
+      },
+  );
+
+Adds a property to a Module::Build class. Properties are those attributes of a
+Module::Build object which can be passed to the constructor and which have
+accessors to get and set them. All of the core properties, such as
+C<module_name> and C<license>, are defined using this class method.
+
+The first argument to C<add_property()> is always the name of the property.
+The second argument can be either a default value for the property, or a list
+of key/value pairs. The supported keys are:
+
+=over
+
+=item C<default>
+
+The default value. May optionally be specified as a code reference, in which
+case the return value from the execution of the code reference will be used.
+If you need the default to be a code reference, just use a code reference to
+return it, e.g.:
+
+      default => sub { sub { ... } },
+
+=item C<check>
+
+A code reference that checks that a value specified for the property is valid.
+During the execution of the code reference, the new value will be included in
+the C<$_> variable. If the value is correct, the C<check> code reference
+should return true. If the value is not correct, it sends an error message to
+C<property_error()> and returns false.
+
+=back
+
+When this method is called, a new property will be installed in the
+Module::Build class, and an accessor will be built to allow the property to be
+get or set on the build object.
+
+  print $build->pedantic, $/;
+  $build->pedantic(0);
+
+If the default value is a hash reference, this generetes a special-case
+accessor method, wherein individual key/value pairs may be set or fetched:
+
+  print "stuff{foo} is: ", $build->stuff( 'foo' ), $/;
+  $build->stuff( foo => 'bar' );
+  print $build->stuff( 'foo' ), $/; # Outputs "bar"
[...5316 lines suppressed...]
 # cleanup
 $dist->remove;
-
-use File::Path;
-rmtree( $tmp );
diff -urN perl-5.10.0.orig/lib/Module/Build/t/xs.t perl-5.10.0/lib/Module/Build/t/xs.t
--- perl-5.10.0.orig/lib/Module/Build/t/xs.t	2009-02-20 18:22:32.000000000 +0100
+++ perl-5.10.0/lib/Module/Build/t/xs.t	2009-03-10 16:45:37.000000000 +0100
@@ -15,22 +15,23 @@
   } elsif ( $^O eq 'VMS' ) {
     plan skip_all => 'Child test output confuses harness';
   } else {
-    plan tests => 22;
+    plan tests => 23;
   }
 }
 
+ensure_blib('Module::Build');
+
+
 #########################
 
 
-use Cwd ();
-my $cwd = Cwd::cwd;
 my $tmp = MBTest->tmpdir;
 
 use DistGen;
 my $dist = DistGen->new( dir => $tmp, xs => 1 );
 $dist->regen;
 
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
 my $mb = Module::Build->new_from_context;
 
 
@@ -103,7 +104,6 @@
 
 
 # cleanup
-chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 $dist->remove;
 
 
@@ -114,7 +114,7 @@
 $dist = DistGen->new( name => 'Simple::With::Deep::Name',
 		      dir => $tmp, xs => 1 );
 $dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
 
 $mb = Module::Build->new_from_context;
 is $@, '';
@@ -129,7 +129,6 @@
 is $@, '';
 
 # cleanup
-chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 $dist->remove;
 
 
@@ -208,7 +207,7 @@
 ---
 
 $dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
 
 
 $mb = Module::Build->new_from_context;
@@ -224,8 +223,4 @@
 is $@, '';
 
 # cleanup
-chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 $dist->remove;
-
-use File::Path;
-rmtree( $tmp );
diff -urN perl-5.10.0.orig/lib/Module/Build.pm perl-5.10.0/lib/Module/Build.pm
--- perl-5.10.0.orig/lib/Module/Build.pm	2009-02-20 18:22:32.000000000 +0100
+++ perl-5.10.0/lib/Module/Build.pm	2009-03-10 16:49:12.000000000 +0100
@@ -15,7 +15,7 @@
 
 use vars qw($VERSION @ISA);
 @ISA = qw(Module::Build::Base);
-$VERSION = '0.2808_01';
+$VERSION = '0.32';
 $VERSION = eval $VERSION;
 
 # Okay, this is the brute-force method of finding out what kind of
@@ -30,15 +30,18 @@
 		 dynixptx  Unix
 		 freebsd   Unix
 		 linux     Unix
+		 haiku     Unix
 		 hpux      Unix
 		 irix      Unix
 		 darwin    Unix
 		 machten   Unix
 		 midnightbsd Unix
+		 mirbsd    Unix
 		 next      Unix
 		 openbsd   Unix
 		 netbsd    Unix
 		 dec_osf   Unix
+		 nto       Unix
 		 svr4      Unix
 		 svr5      Unix
 		 sco_sv    Unix
@@ -49,7 +52,9 @@
 		 cygwin    Unix
 		 os2       Unix
 		 interix   Unix
-		 
+		 gnu       Unix
+		 gnukfreebsd Unix
+
 		 dos       Windows
 		 MSWin32   Windows
 
@@ -156,11 +161,11 @@
 'actions'.  In this case the actions run are 'build' (the default
 action), 'test', and 'install'.  Other actions defined so far include:
 
-  build                          manifest    
-  clean                          manpages    
-  code                           pardist     
-  config_data                    ppd         
-  diff                           ppmdist     
+  build                          manpages    
+  clean                          pardist     
+  code                           ppd         
+  config_data                    ppmdist     
+  diff                           prereq_data 
   dist                           prereq_report
   distcheck                      pure_install
   distclean                      realclean   
@@ -173,6 +178,7 @@
   help                           testpod     
   html                           testpodcoverage
   install                        versioninstall
+  manifest                                   
 
 
 You can run the 'help' action for a complete list of actions.
@@ -508,6 +514,14 @@
 output, so you can supply C<tar> and/or C<gzip> parameters to affect
 the result.
 
+=item prereq_data
+
+[version 0.32]
+
+This action prints out a Perl data structure of all prerequsites and the versions
+required.  The output can be loaded again using C<eval()>.  This can be useful for
+external tools that wish to query a Build script for prerequisites.
+
 =item prereq_report
 
 [version 0.28]
@@ -557,10 +571,10 @@
 
 [version 0.01]
 
-This will use C<Test::Harness> to run any regression tests and report
-their results.  Tests can be defined in the standard places: a file
-called C<test.pl> in the top-level directory, or several files ending
-with C<.t> in a C<t/> directory.
+This will use C<Test::Harness> or C<TAP::Harness> to run any regression
+tests and report their results. Tests can be defined in the standard
+places: a file called C<test.pl> in the top-level directory, or several
+files ending with C<.t> in a C<t/> directory.
 
 If you want tests to be 'verbose', i.e. show details of test execution
 rather than just summary information, pass the argument C<verbose=1>.
@@ -568,6 +582,14 @@
 If you want to run tests under the perl debugger, pass the argument
 C<debugger=1>.
 
+If you want to have Module::Build find test files with different file
+name extensions, pass the C<test_file_exts> argument with an array
+of extensions, such as C<[qw( .t .s .z )]>.
+
+If you want test to be run by C<TAP::Harness>, rather than C<Test::Harness>,
+pass the argument C<tap_harness_args> as an array reference of arguments to
+pass to the TAP::Harness constructor.
+
 In addition, if a file called C<visual.pl> exists in the top-level
 directory, this file will be executed as a Perl script and its output
 will be shown to the user.  This is a good place to put speed tests or
@@ -611,7 +633,7 @@
     ...
     test_types  => {
       special => '.st',
-      author  => '.at',
+      author  => ['.at', '.pt' ],
     },
     ...
 

perl-update-Module-CoreList.patch:

--- NEW FILE perl-update-Module-CoreList.patch ---
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__

perl-update-Module-Load-Conditional.patch:

--- NEW FILE perl-update-Module-Load-Conditional.patch ---
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;

perl-update-Pod-Simple.patch:

--- NEW FILE perl-update-Pod-Simple.patch ---
Pod-Simple-3.07

diff -urN perl-5.10.0.orig/MANIFEST perl-5.10.0/MANIFEST
--- perl-5.10.0.orig/MANIFEST	2009-02-20 18:22:32.000000000 +0100
+++ perl-5.10.0/MANIFEST	2009-02-23 19:20:15.000000000 +0100
@@ -2508,6 +2508,8 @@
 lib/Pod/Simple/t/verbatim.t		Pod::Simple test file
 lib/Pod/Simple/t/verb_fmt.t	Pod::Simple test file
 lib/Pod/Simple/t/x_nixer.t		Pod::Simple test file
+lib/Pod/Simple/t/xhtml01.t	Pod::Simple test file
+lib/Pod/Simple/t/xhtml05.t	Pod::Simple test file
 lib/Pod/Simple/XMLOutStream.pm	turn Pod into XML
 lib/Pod/t/basic.cap		podlators test
 lib/Pod/t/basic.clr		podlators test
diff -urN perl-5.10.0.orig/lib/Pod/Simple/BlackBox.pm perl-5.10.0/lib/Pod/Simple/BlackBox.pm
--- perl-5.10.0.orig/lib/Pod/Simple/BlackBox.pm	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Pod/Simple/BlackBox.pm	2009-02-23 13:52:51.000000000 +0100
@@ -910,17 +910,10 @@
     return 1;
   }
   
-  unless($content =~ m/^\S+$/s) {  # i.e., unless it's one word
-    $self->whine(
-      $para->[1]{'start_line'},
-      "'=begin' only takes one parameter, not several as in '=begin $content'"
-    );
-    DEBUG and print "Ignoring unintelligible =begin $content\n";
-    return 1;
-  }
-
-
-  $para->[1]{'target'} = $content;  # without any ':'
+  my ($target, $title) = $content =~ m/^(\S+)\s*(.*)$/;
+  $para->[1]{'title'} = $title if ($title);
+  $para->[1]{'target'} = $target;  # without any ':'
+  $content = $target; # strip off the title
 
   $content =~ s/^:!/!:/s;
   my $neg;  # whether this is a negation-match
@@ -1681,8 +1674,11 @@
               [A-Z](?!<)
             )
             |
+            # whitespace is ok, but we don't want to eat the whitespace before
+            # a multiple-bracket end code.
+            # NOTE: we may still have problems with e.g. S<<    >>
             (?:
-              \s(?!\s*>)
+              \s(?!\s*>{2,})
             )
           )+
         )
diff -urN perl-5.10.0.orig/lib/Pod/Simple/ChangeLog perl-5.10.0/lib/Pod/Simple/ChangeLog
--- perl-5.10.0.orig/lib/Pod/Simple/ChangeLog	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Pod/Simple/ChangeLog	2009-02-23 13:51:48.000000000 +0100
@@ -1,6 +1,35 @@
 # ChangeLog for Pod::Simple dist
 #---------------------------------------------------------------------------
 
+2008-06-04   Allison Randal <allison at perl.org>
+	* Release 3.07
+
+	Fix module dependencies, make HTML::Entities optional and require
+	Test::More.
+
+2008-06-03   Allison Randal <allison at perl.org>
+	* Release 3.06
+
+	Fix bugs related to passing $1 to File::Spec, reported by Andrew Hamlin and
+	John McNamara.
+
+	Applied a suggested fix from Kevin Ryde to return a successful exit
+	code when Pod::Simple::HTML is run from the command line.
+
+	Fix handling of complex L<URL> entries, thanks to tests supplied in RT#4896.
+
+	Fix incorrect handling of S<> entries made up of entirely whitespace, thanks
+	to test case from Andreas Koenig.
+
+	Launch Pod::Simple::XHTML, an XHTML compliant, more easily extensible
+	HTML formatter.
+
+	Add feature to parse additional text after =begin target as a block
+	title, requested by Adam Kennedy.
+
+	Thanks to Hans Dieter Pearcey for applying patches, resolving bugs,
+	and generally getting ready for the release.
+
 2007-03-03   Allison Randal <allison at perl.org>
 	* Release 3.05
 
diff -urN perl-5.10.0.orig/lib/Pod/Simple/HTML.pm perl-5.10.0/lib/Pod/Simple/HTML.pm
--- perl-5.10.0.orig/lib/Pod/Simple/HTML.pm	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Pod/Simple/HTML.pm	2009-02-23 13:52:51.000000000 +0100
@@ -164,7 +164,7 @@
 }
 
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-sub go { exit Pod::Simple::HTML->parse_from_file(@ARGV) }
+sub go { Pod::Simple::HTML->parse_from_file(@ARGV); exit 0 }
  # Just so we can run from the command line.  No options.
  #  For that, use perldoc!
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff -urN perl-5.10.0.orig/lib/Pod/Simple/HTMLBatch.pm perl-5.10.0/lib/Pod/Simple/HTMLBatch.pm
--- perl-5.10.0.orig/lib/Pod/Simple/HTMLBatch.pm	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Pod/Simple/HTMLBatch.pm	2009-02-23 13:52:51.000000000 +0100
@@ -607,7 +607,7 @@
     my $url = $chunk->[0];
     my $outfile;
     if( ref($chunk->[-1]) and $url =~ m{^(_[-a-z0-9_]+\.css$)} ) {
-      $outfile = $self->filespecsys->catfile( $outdir, $1 );
+      $outfile = $self->filespecsys->catfile( $outdir, "$1" );
       DEBUG > 5 and print "Noting $$chunk[0] as a file I'll create.\n";
     } else {
       DEBUG > 5 and print "OK, noting $$chunk[0] as an external CSS.\n";
@@ -772,7 +772,7 @@
     my $outfile;
     
     if( ref($script->[-1]) and $url =~ m{^(_[-a-z0-9_]+\.js$)} ) {
-      $outfile = $self->filespecsys->catfile( $outdir, $1 );
+      $outfile = $self->filespecsys->catfile( $outdir, "$1" );
       DEBUG > 5 and print "Noting $$script[0] as a file I'll create.\n";
     } else {
       DEBUG > 5 and print "OK, noting $$script[0] as an external JavaScript.\n";
diff -urN perl-5.10.0.orig/lib/Pod/Simple/XHTML.pm perl-5.10.0/lib/Pod/Simple/XHTML.pm
--- perl-5.10.0.orig/lib/Pod/Simple/XHTML.pm	1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/Pod/Simple/XHTML.pm	2009-02-23 13:52:51.000000000 +0100
@@ -0,0 +1,400 @@
+=pod
+
+=head1 NAME
+
+Pod::Simple::XHTML -- format Pod as validating XHTML
+
+=head1 SYNOPSIS
+
+  use Pod::Simple::XHTML;
+
+  my $parser = Pod::Simple::XHTML->new();
+
+  ...
+
+  $parser->parse_file('path/to/file.pod');
+
+=head1 DESCRIPTION
+
+This class is a formatter that takes Pod and renders it as XHTML
+validating HTML.
+
+This is a subclass of L<Pod::Simple::Methody> and inherits all its
+methods. The implementation is entirely different than
+L<Pod::Simple::HTML>, but it largely preserves the same interface.
+
+=cut
+
+package Pod::Simple::XHTML;
+use strict;
+use vars qw( $VERSION @ISA $HAS_HTML_ENTITIES );
+$VERSION = '3.04';
+use Carp ();
+use Pod::Simple::Methody ();
+ at ISA = ('Pod::Simple::Methody');
+
+BEGIN {
+  $HAS_HTML_ENTITIES = eval "require HTML::Entities; 1";
+}
+
+my %entities = (
+  q{>} => 'gt',
+  q{<} => 'lt',
+  q{'} => '#39',
+  q{"} => 'quot',
+  q{&} => 'amp',
+);
+
+sub encode_entities {
+  return HTML::Entities::encode_entities( $_[0] ) if $HAS_HTML_ENTITIES;
+  my $str = $_[0];
+  my $ents = join '', keys %entities;
+  $str =~ s/([$ents])/'&' . $entities{$1} . ';'/ge;
+  return $str;
+}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+=head1 METHODS
+
+Pod::Simple::XHTML offers a number of methods that modify the format of
+the HTML output. Call these after creating the parser object, but before
+the call to C<parse_file>:
+
+  my $parser = Pod::PseudoPod::HTML->new();
+  $parser->set_optional_param("value");
+  $parser->parse_file($file);
+
+=head2 perldoc_url_prefix
+
+In turning L<Foo::Bar> into http://whatever/Foo%3a%3aBar, what
+to put before the "Foo%3a%3aBar". The default value is
+"http://search.cpan.org/perldoc?".
+
+=head2 perldoc_url_postfix
+
+What to put after "Foo%3a%3aBar" in the URL. This option is not set by
+default.
+
+=head2 title_prefix, title_postfix
+
+What to put before and after the title in the head. The values should
+already be &-escaped.
+
+=head2 html_css
+
+  $parser->html_css('path/to/style.css');
+
+The URL or relative path of a CSS file to include. This option is not
+set by default.
+
+=head2 html_javascript
+
+The URL or relative path of a JavaScript file to pull in. This option is
+not set by default.
+
+=head2 html_doctype
+
+A document type tag for the file. This option is not set by default.
+
+=head2 html_header_tags
+
+Additional arbitrary HTML tags for the header of the document. The
+default value is just a content type header tag:
+
+  <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">
+
+Add additional meta tags here, or blocks of inline CSS or JavaScript
+(wrapped in the appropriate tags).
+
+=head2 default_title
+
+Set a default title for the page if no title can be determined from the
+content. The value of this string should already be &-escaped.
+
+=head2 force_title
+
+Force a title for the page (don't try to determine it from the content).
+The value of this string should already be &-escaped.
+
+=head2 html_header, html_footer
+
+Set the HTML output at the beginning and end of each file. The default
+header includes a title, a doctype tag (if C<html_doctype> is set), a
+content tag (customized by C<html_header_tags>), a tag for a CSS file
+(if C<html_css> is set), and a tag for a Javascript file (if
+C<html_javascript> is set). The default footer simply closes the C<html>
+and C<body> tags.
+
+The options listed above customize parts of the default header, but
+setting C<html_header> or C<html_footer> completely overrides the
+built-in header or footer. These may be useful if you want to use
+template tags instead of literal HTML headers and footers or are
+integrating converted POD pages in a larger website.
+
+If you want no headers or footers output in the HTML, set these options
+to the empty string.
+
+=head2 index
+
+TODO -- Not implemented.
+
+Whether to add a table-of-contents at the top of each page (called an
+index for the sake of tradition).
+
+
+=cut
+
+__PACKAGE__->_accessorize(
+ 'perldoc_url_prefix',
+ 'perldoc_url_postfix',
+ 'title_prefix',  'title_postfix',
+ 'html_css', 
+ 'html_javascript',
+ 'html_doctype',
+ 'html_header_tags',
+ 'title', # Used internally for the title extracted from the content
+ 'default_title',
+ 'force_title',
+ 'html_header',
+ 'html_footer',
+ 'index',
+ 'batch_mode', # whether we're in batch mode
+ 'batch_mode_current_level',
+    # When in batch mode, how deep the current module is: 1 for "LWP",
+    #  2 for "LWP::Procotol", 3 for "LWP::Protocol::GHTTP", etc
+);
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+=head1 SUBCLASSING
+
+If the standard options aren't enough, you may want to subclass
+Pod::Simple::XHMTL. These are the most likely candidates for methods
+you'll want to override when subclassing.
+
+=cut
+
+sub new {
+  my $self = shift;
+  my $new = $self->SUPER::new(@_);
+  $new->{'output_fh'} ||= *STDOUT{IO};
+  $new->accept_targets( 'html', 'HTML' );
+  $new->perldoc_url_prefix('http://search.cpan.org/perldoc?');
+  $new->html_header_tags('<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">');
+  $new->nix_X_codes(1);
+  $new->codes_in_verbatim(1);
+  $new->{'scratch'} = '';
+  return $new;
+}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+=head2 handle_text
+
+This method handles the body of text within any element: it's the body
+of a paragraph, or everything between a "=begin" tag and the
+corresponding "=end" tag, or the text within an L entity, etc. You would
+want to override this if you are adding a custom element type that does
+more than just display formatted text. Perhaps adding a way to generate
+HTML tables from an extended version of POD.
+
+So, let's say you want add a custom element called 'foo'. In your
+subclass's C<new> method, after calling C<SUPER::new> you'd call:
+
+  $new->accept_targets_as_text( 'foo' );
+
+Then override the C<start_for> method in the subclass to check for when
+"$flags->{'target'}" is equal to 'foo' and set a flag that marks that
+you're in a foo block (maybe "$self->{'in_foo'} = 1"). Then override the
+C<handle_text> method to check for the flag, and pass $text to your
+custom subroutine to construct the HTML output for 'foo' elements,
+something like:
+
+  sub handle_text {
+      my ($self, $text) = @_;
+      if ($self->{'in_foo'}) {
+          $self->{'scratch'} .= build_foo_html($text); 
+      } else {
+          $self->{'scratch'} .= $text;
+      }
+  }
+
+=cut
+
+sub handle_text {
+    # escape special characters in HTML (<, >, &, etc)
+    $_[0]{'scratch'} .= $_[0]{'in_verbatim'} ? encode_entities( $_[1] ) : $_[1]
+}
+
+sub start_Para     { $_[0]{'scratch'} = '<p>' }
+sub start_Verbatim { $_[0]{'scratch'} = '<pre><code>'; $_[0]{'in_verbatim'} = 1}
+
+sub start_head1 {  $_[0]{'scratch'} = '<h1>' }
+sub start_head2 {  $_[0]{'scratch'} = '<h2>' }
+sub start_head3 {  $_[0]{'scratch'} = '<h3>' }
+sub start_head4 {  $_[0]{'scratch'} = '<h4>' }
+
+sub start_item_bullet { $_[0]{'scratch'} = '<li>' }
+sub start_item_number { $_[0]{'scratch'} = "<li>$_[1]{'number'}. "  }
+sub start_item_text   { $_[0]{'scratch'} = '<li>'   }
+
+sub start_over_bullet { $_[0]{'scratch'} = '<ul>'; $_[0]->emit }
+sub start_over_text   { $_[0]{'scratch'} = '<ul>'; $_[0]->emit }
+sub start_over_block  { $_[0]{'scratch'} = '<ul>'; $_[0]->emit }
+sub start_over_number { $_[0]{'scratch'} = '<ol>'; $_[0]->emit }
+
+sub end_over_bullet { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit }
+sub end_over_text   { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit }
+sub end_over_block  { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit }
+sub end_over_number { $_[0]{'scratch'} .= '</ol>'; $_[0]->emit }
+
+# . . . . . Now the actual formatters:
+
+sub end_Para     { $_[0]{'scratch'} .= '</p>'; $_[0]->emit }
+sub end_Verbatim {
+    $_[0]{'scratch'}     .= '</code></pre>';
+    $_[0]{'in_verbatim'}  = 0;
+    $_[0]->emit;
+}
+
+sub end_head1       { $_[0]{'scratch'} .= '</h1>'; $_[0]->emit }
+sub end_head2       { $_[0]{'scratch'} .= '</h2>'; $_[0]->emit }
+sub end_head3       { $_[0]{'scratch'} .= '</h3>'; $_[0]->emit }
+sub end_head4       { $_[0]{'scratch'} .= '</h4>'; $_[0]->emit }
+
+sub end_item_bullet { $_[0]{'scratch'} .= '</li>'; $_[0]->emit }
+sub end_item_number { $_[0]{'scratch'} .= '</li>'; $_[0]->emit }
+sub end_item_text   { $_[0]->emit }
+
+# This handles =begin and =for blocks of all kinds.
+sub start_for { 
+  my ($self, $flags) = @_;
+  $self->{'scratch'} .= '<div';
+  $self->{'scratch'} .= ' class="'.$flags->{'target'}.'"' if ($flags->{'target'});
+  $self->{'scratch'} .= '>';
+  $self->emit;
+
+}
+sub end_for { 
+  my ($self) = @_;
+  $self->{'scratch'} .= '</div>';
+  $self->emit;
+}
+
+sub start_Document { 
+  my ($self) = @_;
+  if (defined $self->html_header) {
+    $self->{'scratch'} .= $self->html_header;
+    $self->emit unless $self->html_header eq "";
+  } else {
+    my ($doctype, $title, $metatags);
+    $doctype = $self->html_doctype || '';
+    $title = $self->force_title || $self->title || $self->default_title || '';
+    $metatags = $self->html_header_tags || '';
+    if ($self->html_css) {
+      $metatags .= "\n<link rel='stylesheet' href='" .
+             $self->html_css . "' type='text/css'>";
+    }
+    if ($self->html_javascript) {
+      $metatags .= "\n<script type='text/javascript' src='" .
+                    $self->html_javascript . "'></script>";
+    }
+    $self->{'scratch'} .= <<"HTML";
+$doctype
+<html>
+<head>
+<title>$title</title>
+$metatags
+</head>
+<body>
+HTML
+    $self->emit;
+  }
+}
+
+sub end_Document   { 
+  my ($self) = @_;
+  if (defined $self->html_footer) {
+    $self->{'scratch'} .= $self->html_footer;
+    $self->emit unless $self->html_footer eq "";
+  } else {
+    $self->{'scratch'} .= "</body>\n</html>";
+    $self->emit;
+  }
+}
+
+# Handling code tags
+sub start_B { $_[0]{'scratch'} .= '<b>' }
+sub end_B   { $_[0]{'scratch'} .= '</b>' }
+
+sub start_C { $_[0]{'scratch'} .= '<code>' }
+sub end_C   { $_[0]{'scratch'} .= '</code>' }
+
+sub start_E { $_[0]{'scratch'} .= '&' }
+sub end_E   { $_[0]{'scratch'} .= ';' }
+
+sub start_F { $_[0]{'scratch'} .= '<i>' }
+sub end_F   { $_[0]{'scratch'} .= '</i>' }
+
+sub start_I { $_[0]{'scratch'} .= '<i>' }
+sub end_I   { $_[0]{'scratch'} .= '</i>' }
+
+sub start_L { 
+  my ($self, $flags) = @_;
+    my $url;
+    if ($flags->{'type'} eq 'url') {
+      $url = $flags->{'to'};
+    } elsif ($flags->{'type'} eq 'pod') {
+      $url .= $self->perldoc_url_prefix || '';
+      $url .= $flags->{'to'} || '';
+      $url .= '/' . $flags->{'section'} if ($flags->{'section'});
+      $url .= $self->perldoc_url_postfix || '';
+#    require Data::Dumper;
+#    print STDERR Data::Dumper->Dump([$flags]);
+    }
+
+    $self->{'scratch'} .= '<a href="'. $url . '">';
+}
+sub end_L   { $_[0]{'scratch'} .= '</a>' }
+
+sub start_S { $_[0]{'scratch'} .= '<nobr>' }
+sub end_S   { $_[0]{'scratch'} .= '</nobr>' }
+
+sub emit {
+  my($self) = @_;
+  my $out = $self->{'scratch'} . "\n";
+  print {$self->{'output_fh'}} $out, "\n";
+  $self->{'scratch'} = '';
+  return;
+}
+
+# Bypass built-in E<> handling to preserve entity encoding
+sub _treat_Es {} 
+
+1;
+
+__END__
+
+=head1 SEE ALSO
+
+L<Pod::Simple>, L<Pod::Simple::Methody>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2003-2005 Allison Randal.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. The full text of the license
+can be found in the LICENSE file included with this module.
+
+This library is distributed in the hope that it will be useful, but
+without any warranty; without even the implied warranty of
+merchantability or fitness for a particular purpose.
+
+=head1 AUTHOR
+
+Allison Randal <allison at perl.org>
+
+=cut
+
diff -urN perl-5.10.0.orig/lib/Pod/Simple/t/begin.t perl-5.10.0/lib/Pod/Simple/t/begin.t
--- perl-5.10.0.orig/lib/Pod/Simple/t/begin.t	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Pod/Simple/t/begin.t	2009-02-23 13:56:01.000000000 +0100
@@ -7,7 +7,7 @@
 
 use strict;
 use Test;
-BEGIN { plan tests => 61 };
+BEGIN { plan tests => 62 };
 
 my $d;
 #use Pod::Simple::Debug (\$d, 0);
@@ -114,7 +114,6 @@
   '<Document><Para>I like pie.</Para><Para>Yup.</Para></Document>'
 );
 
-
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 print "# Testing matching because of negated non-acceptance...\n";
@@ -448,8 +447,14 @@
  qq{<Para>Yup.</Para></Document>}
 );
 
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
+print "# Testing matching of begin block titles\n";
+ok( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo Title\n\nstuff\n\n=end mojojojo \n\nYup.\n"),
+  '<Document><Para>I like pie.</Para><for target="mojojojo" target_matching="mojojojo" title="Title"><Data xml:space="preserve">stuff</Data></for><Para>Yup.</Para></Document>'
+);
 
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 print "# Wrapping up... one for the road...\n";
 ok 1;
diff -urN perl-5.10.0.orig/lib/Pod/Simple/t/fcodes_l.t perl-5.10.0/lib/Pod/Simple/t/fcodes_l.t
--- perl-5.10.0.orig/lib/Pod/Simple/t/fcodes_l.t	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Pod/Simple/t/fcodes_l.t	2009-02-23 13:56:01.000000000 +0100
@@ -7,7 +7,7 @@
 
 use strict;
 use Test;
-BEGIN { plan tests => 93 };
+BEGIN { plan tests => 99 };
 
 #use Pod::Simple::Debug (10);
 
@@ -398,6 +398,27 @@
  '<Document><Para>I like <L section="Member Data" type="pod">the <F>various</F> attributes</L>.</Para></Document>'
 );
 
+ok( $x->_out(qq{=pod\n\nI like L<<< B<text>s|http://text.com >>>.\n}),
+'<Document><Para>I like <L to="http://text.com" type="url"><B>text</B>s</L>.</Para></Document>'
+);
+ok( $x->_out(qq{=pod\n\nI like L<<< text|https://text.com/1/2 >>>.\n}),
+'<Document><Para>I like <L to="https://text.com/1/2" type="url">text</L>.</Para></Document>'
+);
+ok( $x->_out(qq{=pod\n\nI like L<<< I<text>|http://text.com >>>.\n}),
+'<Document><Para>I like <L to="http://text.com" type="url"><I>text</I></L>.</Para></Document>'
+);
+ok( $x->_out(qq{=pod\n\nI like L<<< C<text>|http://text.com >>>.\n}),
+'<Document><Para>I like <L to="http://text.com" type="url"><C>text</C></L>.</Para></Document>'
+);
+ok( $x->_out(qq{=pod\n\nI like L<<< I<tI<eI<xI<t>>>>|mailto:earlE<64>text.com >>>.\n}),
+'<Document><Para>I like <L to="mailto:earl at text.com" type="url"><I>t<I>e<I>x<I>t</I></I></I></I></L>.</Para></Document>'
+);
+ok( $x->_out(qq{=pod\n\nI like L<<< textZ<>|http://text.com >>>.\n}),
+'<Document><Para>I like <L to="http://text.com" type="url">text</L>.</Para></Document>'
+);
+
+
+
 
 #
 # TODO: S testing.
diff -urN perl-5.10.0.orig/lib/Pod/Simple/t/fcodes_s.t perl-5.10.0/lib/Pod/Simple/t/fcodes_s.t
--- perl-5.10.0.orig/lib/Pod/Simple/t/fcodes_s.t	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Pod/Simple/t/fcodes_s.t	2009-02-23 13:56:01.000000000 +0100
@@ -7,7 +7,7 @@
 
 use strict;
 use Test;
-BEGIN { plan tests => 13 };
+BEGIN { plan tests => 14 };
 
 #use Pod::Simple::Debug (6);
 
@@ -76,7 +76,30 @@
     qq{=pod\n\nI like L<StuffE<160>I<likeE<160>that>|"bric-a-brac a gogo">.\n},
 ));
 
+use Pod::Simple::Text;
+$x = Pod::Simple::Text->new;
+$x->preserve_whitespace(1);
+# RT#25679
+ok(
+  $x->_out(<<END
+=head1 The Tk::mega manpage showed me how C<< SE<lt> E<gt> foo >> is being rendered
 
+Both pod2text and pod2man S<    > lose the rest of the line
+
+=head1 Do they always S<    > lose the rest of the line?
+
+=cut
+END
+  ),
+  <<END
+The Tk::mega manpage showed me how S< > foo is being rendered
+
+    Both pod2text and pod2man      lose the rest of the line
+
+Do they always      lose the rest of the line?
+
+END
+);
 
 print "# Wrapping up... one for the road...\n";
 ok 1;
diff -urN perl-5.10.0.orig/lib/Pod/Simple/t/xhtml01.t perl-5.10.0/lib/Pod/Simple/t/xhtml01.t
--- perl-5.10.0.orig/lib/Pod/Simple/t/xhtml01.t	1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/Pod/Simple/t/xhtml01.t	2009-02-23 13:56:01.000000000 +0100
@@ -0,0 +1,351 @@
+#!/usr/bin/perl -w
+
+# t/xhtml01.t - check basic output from Pod::Simple::XHTML
+
+BEGIN {
+    chdir 't' if -d 't';
+}
+
+use strict;
+use lib '../lib';
+use Test::More tests => 26;
+
+use_ok('Pod::Simple::XHTML') or exit;
+
+my $parser = Pod::Simple::XHTML->new ();
+isa_ok ($parser, 'Pod::Simple::XHTML');
+
+my $results;
+
+my $PERLDOC = "http://search.cpan.org/perldoc?";
+
+initialize($parser, $results);
+$parser->parse_string_document( "=head1 Poit!" );
+is($results, "<h1>Poit!</h1>\n\n", "head1 level output");
+
+initialize($parser, $results);
+$parser->parse_string_document( "=head2 I think so Brain." );
+is($results, "<h2>I think so Brain.</h2>\n\n", "head2 level output");
+
+initialize($parser, $results);
+$parser->parse_string_document( "=head3 I say, Brain..." );
+is($results, "<h3>I say, Brain...</h3>\n\n", "head3 level output");
+
+initialize($parser, $results);
+$parser->parse_string_document( "=head4 Zort!" );
+is($results, "<h4>Zort!</h4>\n\n", "head4 level output");
+
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+Gee, Brain, what do you want to do tonight?
+EOPOD
+
+is($results, <<'EOHTML', "simple paragraph");
+<p>Gee, Brain, what do you want to do tonight?</p>
+
+EOHTML
+
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+B: Now, Pinky, if by any chance you are captured during this mission,
+remember you are Gunther Heindriksen from Appenzell. You moved to
+Grindelwald to drive the cog train to Murren. Can you repeat that?
+
+P: Mmmm, no, Brain, don't think I can.
+EOPOD
+
+is($results, <<'EOHTML', "multiple paragraphs");
+<p>B: Now, Pinky, if by any chance you are captured during this mission, remember you are Gunther Heindriksen from Appenzell. You moved to Grindelwald to drive the cog train to Murren. Can you repeat that?</p>
+
+<p>P: Mmmm, no, Brain, don't think I can.</p>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=over
+
+=item *
+
+P: Gee, Brain, what do you want to do tonight?
+
+=item *
+
+B: The same thing we do every night, Pinky. Try to take over the world!
+
+=back
+
+EOPOD
+
+is($results, <<'EOHTML', "simple bulleted list");
+<ul>
+
+<li>P: Gee, Brain, what do you want to do tonight?</li>
+
+<li>B: The same thing we do every night, Pinky. Try to take over the world!</li>
+
+</ul>
+
+EOHTML
+
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=over
+
+=item 1
+
+P: Gee, Brain, what do you want to do tonight?
+
+=item 2
+
+B: The same thing we do every night, Pinky. Try to take over the world!
+
+=back
+
+EOPOD
+
+is($results, <<'EOHTML', "numbered list");
+<ol>
+
+<li>1. P: Gee, Brain, what do you want to do tonight?</li>
+
+<li>2. B: The same thing we do every night, Pinky. Try to take over the world!</li>
+
+</ol>
+
+EOHTML
+
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=over
+
+=item Pinky
+
+Gee, Brain, what do you want to do tonight?
+
+=item Brain
+
+The same thing we do every night, Pinky. Try to take over the world!
+
+=back
+
+EOPOD
+
+is($results, <<'EOHTML', "list with text headings");
+<ul>
+
+<li>Pinky
+
+<p>Gee, Brain, what do you want to do tonight?</p>
+
+<li>Brain
+
+<p>The same thing we do every night, Pinky. Try to take over the world!</p>
+
+</ul>
+
+EOHTML
+
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+  1 + 1 = 2;
+  2 + 2 = 4;
+
+EOPOD
+
+is($results, <<'EOHTML', "code block");
+<pre><code>  1 + 1 = 2;
+  2 + 2 = 4;</code></pre>
+
+EOHTML
+
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with a C<functionname>.
+EOPOD
+is($results, <<"EOHTML", "code entity in a paragraph");
+<p>A plain paragraph with a <code>functionname</code>.</p>
+
+EOHTML
+
+
+initialize($parser, $results);
+$parser->html_header("<html>\n<body>");
+$parser->html_footer("</body>\n</html>");
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with body tags turned on.
+EOPOD
+is($results, <<"EOHTML", "adding html body tags");
+<html>
+<body>
+
+<p>A plain paragraph with body tags turned on.</p>
+
+</body>
+</html>
+
+EOHTML
+
+
+initialize($parser, $results);
+$parser->html_css('style.css');
+$parser->html_header(undef);
+$parser->html_footer(undef);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with body tags and css tags turned on.
+EOPOD
+like($results, qr/<link rel='stylesheet' href='style.css' type='text\/css'>/,
+"adding html body tags and css tags");
+
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with S<non breaking text>.
+EOPOD
+is($results, <<"EOHTML", "Non breaking text in a paragraph");
+<p>A plain paragraph with <nobr>non breaking text</nobr>.</p>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with a L<Newlines>.
+EOPOD
+is($results, <<"EOHTML", "Link entity in a paragraph");
+<p>A plain paragraph with a <a href="${PERLDOC}Newlines">Newlines</a>.</p>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with a L<perlport/Newlines>.
+EOPOD
+is($results, <<"EOHTML", "Link entity in a paragraph");
+<p>A plain paragraph with a <a href="${PERLDOC}perlport/Newlines">"Newlines" in perlport</a>.</p>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with a L<Boo|http://link.included.here>.
+EOPOD
+is($results, <<"EOHTML", "A link in a paragraph");
+<p>A plain paragraph with a <a href="http://link.included.here">Boo</a>.</p>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with a L<http://link.included.here>.
+EOPOD
+is($results, <<"EOHTML", "A link in a paragraph");
+<p>A plain paragraph with a <a href="http://link.included.here">http://link.included.here</a>.</p>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with B<bold text>.
+EOPOD
+is($results, <<"EOHTML", "Bold text in a paragraph");
+<p>A plain paragraph with <b>bold text</b>.</p>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with I<italic text>.
+EOPOD
+is($results, <<"EOHTML", "Italic text in a paragraph");
+<p>A plain paragraph with <i>italic text</i>.</p>
+
+EOHTML
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+A plain paragraph with a F<filename>.
+EOPOD
+is($results, <<"EOHTML", "File name in a paragraph");
+<p>A plain paragraph with a <i>filename</i>.</p>
+
+EOHTML
+
+
+initialize($parser, $results);
+$parser->parse_string_document(<<'EOPOD');
+=pod
+
+  # this header is very important & don't you forget it
+  my $text = "File is: " . <FILE>;
+EOPOD
+is($results, <<"EOHTML", "Verbatim text with encodable entities");
+<pre><code>  # this header is very important & don't you forget it
+  my \$text = "File is: " . <FILE>;</code></pre>
+
+EOHTML
+
+SKIP: for my $use_html_entities (0, 1) {
+  if ($use_html_entities and not $Pod::Simple::XHTML::HAS_HTML_ENTITIES) {
+    skip("HTML::Entities not installed", 1);
+  }
+  local $Pod::Simple::XHTML::HAS_HTML_ENTITIES = $use_html_entities;
+  initialize($parser, $results);
+  $parser->parse_string_document(<<'EOPOD');
+=pod
+
+  # this header is very important & don't you forget it
+  B<my $file = <FILEE<gt> || 'Blank!';>
+  my $text = "File is: " . <FILE>;
+EOPOD
+is($results, <<"EOHTML", "Verbatim text with markup and embedded formatting");
+<pre><code>  # this header is very important & don't you forget it
+  <b>my \$file = <FILE> || 'Blank!';</b>
+  my \$text = "File is: " . <FILE>;</code></pre>
+
+EOHTML
+}
+
+######################################
+
+sub initialize {
+	$_[0] = Pod::Simple::XHTML->new ();
+        $_[0]->html_header("");
+        $_[0]->html_footer("");
+	$_[0]->output_string( \$results ); # Send the resulting output to a string
+	$_[1] = '';
+	return;
+}
diff -urN perl-5.10.0.orig/lib/Pod/Simple/t/xhtml05.t perl-5.10.0/lib/Pod/Simple/t/xhtml05.t
--- perl-5.10.0.orig/lib/Pod/Simple/t/xhtml05.t	1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/lib/Pod/Simple/t/xhtml05.t	2009-02-23 13:56:01.000000000 +0100
@@ -0,0 +1,67 @@
+#!/usr/bin/perl -w
+
+# t/xhtml05.t - check block output from Pod::Simple::XHTML
+
+BEGIN {
+    chdir 't' if -d 't';
+}
+
+use strict;
+use lib '../lib';
+use Test::More tests => 6;
+
+use_ok('Pod::Simple::XHTML') or exit;
+
+my $parser = Pod::Simple::XHTML->new ();
+isa_ok ($parser, 'Pod::Simple::XHTML');
+
+my $results;
+initialize($parser, $results);
+$parser->accept_targets_as_text( 'comment' );
+$parser->parse_string_document(<<'EOPOD');
+=for comment
+This is an ordinary for block.
+
+EOPOD
+
+is($results, <<'EOHTML', "a for block");
+<div class="comment">
+
+<p>This is an ordinary for block.</p>
+
+</div>
+
+EOHTML
+
+foreach my $target qw(note tip warning) {
+  initialize($parser, $results);
+  $parser->accept_targets_as_text( $target );
+  $parser->parse_string_document(<<"EOPOD");
+=begin $target
+
+This is a $target.
+
+=end $target
+EOPOD
+
+  is($results, <<"EOHTML", "allow $target blocks");
+<div class="$target">
+
+<p>This is a $target.</p>
+
+</div>
+
+EOHTML
+
+}
+
+######################################
+
+sub initialize {
+	$_[0] = Pod::Simple::XHTML->new ();
+        $_[0]->html_header("");
+        $_[0]->html_footer("");
+	$_[0]->output_string( \$results ); # Send the resulting output to a string
+	$_[1] = '';
+	return;
+}
diff -urN perl-5.10.0.orig/lib/Pod/Simple.pm perl-5.10.0/lib/Pod/Simple.pm
--- perl-5.10.0.orig/lib/Pod/Simple.pm	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Pod/Simple.pm	2009-02-23 13:52:51.000000000 +0100
@@ -18,7 +18,7 @@
 );
 
 @ISA = ('Pod::Simple::BlackBox');
-$VERSION = '3.05';
+$VERSION = '3.07';
 
 @Known_formatting_codes = qw(I B C L E F S X Z); 
 %Known_formatting_codes = map(($_=>1), @Known_formatting_codes);
@@ -983,6 +983,7 @@
   # L<text|name/"sec"> or L<text|name/sec>
   # L<text|/"sec"> or L<text|/sec> or L<text|"sec">
   # L<scheme:...>
+  # Ltext|scheme:...>
 
   my($self, at stack) = @_;
 
@@ -1002,11 +1003,12 @@
       
       
       # By here, $treelet->[$i] is definitely an L node
-      DEBUG > 1 and print "Ogling L node $treelet->[$i]\n";
+      my $ell = $treelet->[$i];
+      DEBUG > 1 and print "Ogling L node $ell\n";
         
       # bitch if it's empty
-      if(  @{$treelet->[$i]} == 2
-       or (@{$treelet->[$i]} == 3 and $treelet->[$i][2] eq '')
+      if(  @{$ell} == 2
+       or (@{$ell} == 3 and $ell->[2] eq '')
       ) {
         $self->whine( $start_line, "An empty L<>" );
         $treelet->[$i] = 'L<>';  # just make it a text node
@@ -1014,55 +1016,70 @@
       }
      
       # Catch URLs:
-      # URLs can, alas, contain E<...> sequences, so we can't /assume/
-      #  that this is one text node.  But it has to START with one text
-      #  node...
-      if(! ref $treelet->[$i][2] and
-        $treelet->[$i][2] =~ m/^\w+:[^:\s]\S*$/s
+
+      # there are a number of possible cases:
+      # 1) text node containing url: http://foo.com
+      #   -> [ 'http://foo.com' ]
+      # 2) text node containing url and text: foo|http://foo.com
+      #   -> [ 'foo|http://foo.com' ]
+      # 3) text node containing url start: mailto:xE<at>foo.com
+      #   -> [ 'mailto:x', [ E ... ], 'foo.com' ]
+      # 4) text node containing url start and text: foo|mailto:xE<at>foo.com
+      #   -> [ 'foo|mailto:x', [ E ... ], 'foo.com' ]
+      # 5) other nodes containing text and url start: OE<39>Malley|http://foo.com
+      #   -> [ 'O', [ E ... ], 'Malley', '|http://foo.com' ]
+      # ... etc.
+
+      # anything before the url is part of the text.
+      # anything after it is part of the url.
+      # the url text node itself may contain parts of both.
+
+      if (my ($url_index, $text_part, $url_part) =
+        # grep is no good here; we want to bail out immediately so that we can
+        # use $1, $2, etc. without having to do the match twice.
+        sub {
+          for (2..$#$ell) {
+            next if ref $ell->[$_];
+            next unless $ell->[$_] =~ m/^(?:([^|]*)\|)?(\w+:[^:\s]\S*)$/s;
+            return ($_, $1, $2);
+          }
+          return;
+        }->()
       ) {
-        $treelet->[$i][1]{'type'} = 'url';
-        $treelet->[$i][1]{'content-implicit'} = 'yes';
+        $ell->[1]{'type'} = 'url';
 
-        # TODO: deal with rel: URLs here?
+        my @text = @{$ell}[2..$url_index-1];
+        push @text, $text_part if defined $text_part;
 
-        if( 3 == @{ $treelet->[$i] } ) {
-          # But if it IS just one text node (most common case)
-          DEBUG > 1 and printf qq{Catching "%s as " as ho-hum L<URL> link.\n},
-            $treelet->[$i][2]
-          ;
-          $treelet->[$i][1]{'to'} = Pod::Simple::LinkSection->new(
-            $treelet->[$i][2]
-          );                   # its own treelet
-        } else {
-          # It's a URL but complex (like "L<foo:bazE<123>bar>").  Feh.
-          #$treelet->[$i][1]{'to'} = [ @{$treelet->[$i]} ];
-          #splice @{ $treelet->[$i][1]{'to'} }, 0,2;
-          #DEBUG > 1 and printf qq{Catching "%s as " as complex L<URL> link.\n},
-          #  join '~', @{$treelet->[$i][1]{'to'  }};
-          
-          $treelet->[$i][1]{'to'} = Pod::Simple::LinkSection->new(
-            $treelet->[$i]  # yes, clone the whole content as a treelet
-          );
-          $treelet->[$i][1]{'to'}[0] = ''; # set the copy's tagname to nil
-          die "SANITY FAILURE" if $treelet->[0] eq ''; # should never happen!
-          DEBUG > 1 and print
-           qq{Catching "$treelet->[$i][1]{'to'}" as a complex L<URL> link.\n};
+        my @url  = @{$ell}[$url_index+1..$#$ell];
+        unshift @url, $url_part;
+
+        unless (@text) {
+          $ell->[1]{'content-implicit'} = 'yes';
+          @text = @url;
         }
 
-        next; # and move on
+        $ell->[1]{to} = Pod::Simple::LinkSection->new(
+          @url == 1
+          ? $url[0]
+          : [ '', {}, @url ],
+        );
+
+        splice @$ell, 2, $#$ell, @text;
+
+        next;
       }
       
-      
       # Catch some very simple and/or common cases
-      if(@{$treelet->[$i]} == 3 and ! ref $treelet->[$i][2]) {
-        my $it = $treelet->[$i][2];
+      if(@{$ell} == 3 and ! ref $ell->[2]) {
+        my $it = $ell->[2];
         if($it =~ m/^[-a-zA-Z0-9]+\([-a-zA-Z0-9]+\)$/s) { # man sections
           # Hopefully neither too broad nor too restrictive a RE
           DEBUG > 1 and print "Catching \"$it\" as manpage link.\n";
-          $treelet->[$i][1]{'type'} = 'man';
+          $ell->[1]{'type'} = 'man';
           # This's the only place where man links can get made.
-          $treelet->[$i][1]{'content-implicit'} = 'yes';
-          $treelet->[$i][1]{'to'  } =
+          $ell->[1]{'content-implicit'} = 'yes';
+          $ell->[1]{'to'  } =
             Pod::Simple::LinkSection->new( $it ); # treelet!
 
           next;
@@ -1071,9 +1088,9 @@
           # Extremely forgiving idea of what constitutes a bare
           #  modulename link like L<Foo::Bar> or even L<Thing::1.0::Docs::Tralala>
           DEBUG > 1 and print "Catching \"$it\" as ho-hum L<Modulename> link.\n";
-          $treelet->[$i][1]{'type'} = 'pod';
-          $treelet->[$i][1]{'content-implicit'} = 'yes';
-          $treelet->[$i][1]{'to'  } =
+          $ell->[1]{'type'} = 'pod';
+          $ell->[1]{'content-implicit'} = 'yes';
+          $ell->[1]{'to'  } =
             Pod::Simple::LinkSection->new( $it ); # treelet!
           next;
         }
@@ -1089,7 +1106,6 @@
       
       
       my $link_text; # set to an arrayref if found
-      my $ell = $treelet->[$i];
       my @ell_content = @$ell;
       splice @ell_content,0,2; # Knock off the 'L' and {} bits
 
@@ -1443,7 +1459,7 @@
    "\nAbout to parse source: {{\n$_[0]\n}}\n\n";
   
   
-  my $parser = $class->new;
+  my $parser = ref $class && $class->isa(__PACKAGE__) ? $class : $class->new;
   $parser->hide_line_numbers(1);
 
   my $out = '';
diff -urN perl-5.10.0.orig/lib/Pod/Simple.pod perl-5.10.0/lib/Pod/Simple.pod
--- perl-5.10.0.orig/lib/Pod/Simple.pod	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Pod/Simple.pod	2009-02-23 13:52:51.000000000 +0100
@@ -211,7 +211,15 @@
 
 Original author: Sean M. Burke C<sburke at cpan.org>
 
-Maintained by: Allison Randal C<allison at perl.org>
+Maintained by: 
+
+=over
+
+=item * Allison Randal C<allison at perl.org>
+
+=item * Hans Dieter Pearcey C<hdp at cpan.org>
+
+=back
 
 =cut
 
diff -up perl-5.10.0/lib/Pod/t/text.t.old perl-5.10.0/lib/Pod/t/text.t
--- perl-5.10.0/lib/Pod/t/text.t.old	2008-10-07 15:21:33.000000000 +0200
+++ perl-5.10.0/lib/Pod/t/text.t	2008-10-07 15:20:10.000000000 +0200
@@ -58,7 +58,7 @@ while (<DATA>) {
     }
     if ($output eq $expected) {
         print "ok $n\n";
-    } elsif ($n == 4 && $Pod::Simple::VERSION < 3.06) {
+    } elsif ($n == 4 && $Pod::Simple::VERSION < 3.08) {
         print "ok $n # skip Pod::Simple S<> parsing bug\n";
     } else {
         print "not ok $n\n";

perl-update-Sys-Syslog.patch:

--- NEW FILE perl-update-Sys-Syslog.patch ---
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 at 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" );

perl-update-Test-Harness.patch:

--- NEW FILE perl-update-Test-Harness.patch ---
Test-Harness-3.16
- disabled perl5lib.t; it runs the installed /usr/bin/perl
- fixed the preamble of harness-bailout.t

diff -urN perl-5.10.0.orig/MANIFEST perl-5.10.0/MANIFEST
--- perl-5.10.0.orig/MANIFEST	2009-02-20 18:22:32.000000000 +0100
+++ perl-5.10.0/MANIFEST	2009-03-10 17:20:31.000000000 +0100
@@ -1094,6 +1094,56 @@
 ext/Sys/Syslog/win32/PerlLog.mc	Sys::Syslog extension Win32 related file
 ext/Sys/Syslog/win32/PerlLog_RES.uu	Sys::Syslog extension Win32 related file
 ext/Sys/Syslog/win32/Win32.pm	Sys::Syslog extension Win32 related file
+ext/Test/Harness/t/000-load.t	test for Test::Harness
+ext/Test/Harness/t/aggregator.t	test for Test::Harness
+ext/Test/Harness/t/bailout.t	test for Test::Harness
+ext/Test/Harness/t/base.t	test for Test::Harness
+ext/Test/Harness/t/callbacks.t	test for Test::Harness
+ext/Test/Harness/t/console.t	test for Test::Harness
+ext/Test/Harness/t/compat/env.t	test for Test::Harness
+ext/Test/Harness/t/compat/failure.t	test for Test::Harness
+ext/Test/Harness/t/compat/inc-propagation.t	test for Test::Harness
+ext/Test/Harness/t/compat/inc_taint.t	test for Test::Harness
+ext/Test/Harness/t/compat/nonumbers.t	test for Test::Harness
+ext/Test/Harness/t/compat/regression.t	test for Test::Harness
+ext/Test/Harness/t/compat/test-harness-compat.t	test for Test::Harness
+ext/Test/Harness/t/compat/version.t	test for Test::Harness
+ext/Test/Harness/t/errors.t	test for Test::Harness
+ext/Test/Harness/t/file.t	test for Test::Harness
+ext/Test/Harness/t/glob-to-regexp.t	test for Test::Harness
+ext/Test/Harness/t/grammar.t	test for Test::Harness
+ext/Test/Harness/t/harness-bailout.t	test for Test::Harness
+ext/Test/Harness/t/harness-subclass.t	test for Test::Harness
+ext/Test/Harness/t/harness.t	test for Test::Harness
+ext/Test/Harness/t/iterators.t	test for Test::Harness
+ext/Test/Harness/t/multiplexer.t	test for Test::Harness
+ext/Test/Harness/t/nofork-mux.t	test for Test::Harness
+ext/Test/Harness/t/nofork.t	test for Test::Harness
+ext/Test/Harness/t/object.t	test for Test::Harness
+ext/Test/Harness/t/parse.t	test for Test::Harness
+ext/Test/Harness/t/parser-config.t	test for Test::Harness
+ext/Test/Harness/t/parser-subclass.t	test for Test::Harness
+ext/Test/Harness/t/premature-bailout.t	test for Test::Harness
+ext/Test/Harness/t/process.t	test for Test::Harness
+ext/Test/Harness/t/prove.t	test for Test::Harness
+ext/Test/Harness/t/proveenv.t	test for Test::Harness
+ext/Test/Harness/t/proverc.t	test for Test::Harness
+ext/Test/Harness/t/proverun.t	test for Test::Harness
+ext/Test/Harness/t/regression.t	test for Test::Harness
+ext/Test/Harness/t/results.t	test for Test::Harness
+ext/Test/Harness/t/scheduler.t	test for Test::Harness
+ext/Test/Harness/t/source.t	test for Test::Harness
+ext/Test/Harness/t/spool.t	test for Test::Harness
+ext/Test/Harness/t/state.t	test for Test::Harness
+ext/Test/Harness/t/state_results.t	test for Test::Harness
+ext/Test/Harness/t/streams.t	test for Test::Harness
+ext/Test/Harness/t/taint.t	test for Test::Harness
+ext/Test/Harness/t/testargs.t	test for Test::Harness
+ext/Test/Harness/t/unicode.t	test for Test::Harness
+ext/Test/Harness/t/utils.t	test for Test::Harness
+ext/Test/Harness/t/yamlish-output.t	test for Test::Harness
+ext/Test/Harness/t/yamlish-writer.t	test for Test::Harness
+ext/Test/Harness/t/yamlish.t	test for Test::Harness
 ext/Text/Soundex/Changes	Changelog for Text::Soundex
 ext/Text/Soundex/Makefile.PL	Text::Soundex extension makefile writer
 ext/Text/Soundex/README		README for Text::Soundex
@@ -2593,34 +2643,9 @@
 lib/Test/Builder.pm		For writing new test libraries
 lib/Test/Builder/Tester/Color.pm	Turn on color in Test::Builder::Tester
 lib/Test/Builder/Tester.pm	For testing Test::Builder based classes
-lib/Test/Harness/Assert.pm	Test::Harness::Assert (internal use only)
 lib/Test/Harness/bin/prove	The prove harness utility
 lib/Test/Harness/Changes	Test::Harness
-lib/Test/Harness/Iterator.pm	Test::Harness::Iterator (internal use only)
 lib/Test/Harness.pm		A test harness
-lib/Test/Harness/Point.pm	Test::Harness::Point (internal use only)
-lib/Test/Harness/Results.pm	object for tracking results from a single test file
-lib/Test/Harness/Straps.pm	Test::Harness::Straps
-lib/Test/Harness/t/00compile.t	Test::Harness test
-lib/Test/Harness/TAP.pod	Documentation for the Test Anything Protocol
-lib/Test/Harness/t/assert.t	Test::Harness::Assert test
-lib/Test/Harness/t/base.t	Test::Harness test
-lib/Test/Harness/t/callback.t	Test::Harness test
-lib/Test/Harness/t/failure.t	Test::Harness test
-lib/Test/Harness/t/from_line.t	Test::Harness test
-lib/Test/Harness/t/harness.t	Test::Harness test
-lib/Test/Harness/t/inc_taint.t	Test::Harness test
-lib/Test/Harness/t/nonumbers.t	Test::Harness test
-lib/Test/Harness/t/ok.t		Test::Harness test
-lib/Test/Harness/t/point-parse.t	Test::Harness test
-lib/Test/Harness/t/point.t	Test::Harness test
-lib/Test/Harness/t/prove-globbing.t	Test::Harness::Straps test
-lib/Test/Harness/t/prove-switches.t	Test::Harness::Straps test
-lib/Test/Harness/t/strap-analyze.t	Test::Harness::Straps test
-lib/Test/Harness/t/strap.t		Test::Harness::Straps test
-lib/Test/Harness/t/test-harness.t	Test::Harness test
-lib/Test/Harness/t/version.t	Test::Harness test
-lib/Test/Harness/Util.pm	Various utility functions for Test::Harness
 lib/Test/More.pm		More utilities for writing tests
 lib/Test.pm			A simple framework for writing test scripts
 lib/Test/Simple/Changes		Test::Simple changes
diff -urN perl-5.10.0.orig/ext/Test/Harness/t/000-load.t perl-5.10.0/ext/Test/Harness/t/000-load.t
--- perl-5.10.0.orig/ext/Test/Harness/t/000-load.t	1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/ext/Test/Harness/t/000-load.t	2009-03-10 17:20:31.000000000 +0100
@@ -0,0 +1,61 @@
+#!/usr/bin/perl -wT
+
+use strict;
+use lib 't/lib';
+
+use Test::More tests => 78;
+
+BEGIN {
+
+    # TAP::Parser must come first
+    my @classes = qw(
+      TAP::Parser
+      App::Prove
+      App::Prove::State
+      App::Prove::State::Result
+      App::Prove::State::Result::Test
+      TAP::Base
+      TAP::Formatter::Color
+      TAP::Formatter::Console::ParallelSession
+      TAP::Formatter::Console::Session
+      TAP::Formatter::Console
+      TAP::Harness
+      TAP::Parser::Aggregator
+      TAP::Parser::Grammar
+      TAP::Parser::Iterator
+      TAP::Parser::Iterator::Array
+      TAP::Parser::Iterator::Process
+      TAP::Parser::Iterator::Stream
+      TAP::Parser::IteratorFactory
+      TAP::Parser::Multiplexer
+      TAP::Parser::Result
+      TAP::Parser::ResultFactory
+      TAP::Parser::Result::Bailout
+      TAP::Parser::Result::Comment
+      TAP::Parser::Result::Plan
+      TAP::Parser::Result::Pragma
+      TAP::Parser::Result::Test
+      TAP::Parser::Result::Unknown
+      TAP::Parser::Result::Version
+      TAP::Parser::Result::YAML
+      TAP::Parser::Result
+      TAP::Parser::Scheduler
+      TAP::Parser::Scheduler::Job
+      TAP::Parser::Scheduler::Spinner
+      TAP::Parser::Source::Perl
+      TAP::Parser::Source
+      TAP::Parser::YAMLish::Reader
+      TAP::Parser::YAMLish::Writer
+      TAP::Parser::Utils
+      Test::Harness
+    );
+
+    foreach my $class (@classes) {
+        use_ok $class or BAIL_OUT("Could not load $class");
+        is $class->VERSION, TAP::Parser->VERSION,
+          "... and $class should have the correct version";
+    }
+
+    diag("Testing Test::Harness $Test::Harness::VERSION, Perl $], $^X")
+      unless $ENV{PERL_CORE};
+}
diff -urN perl-5.10.0.orig/ext/Test/Harness/t/aggregator.t perl-5.10.0/ext/Test/Harness/t/aggregator.t
--- perl-5.10.0.orig/ext/Test/Harness/t/aggregator.t	1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/ext/Test/Harness/t/aggregator.t	2009-03-10 17:20:31.000000000 +0100
@@ -0,0 +1,305 @@
+#!/usr/bin/perl -wT
+
+use strict;
+use lib 't/lib';
+
+use Test::More tests => 81;
+
+use TAP::Parser;
+use TAP::Parser::IteratorFactory;
+use TAP::Parser::Aggregator;
+
+my $tap = <<'END_TAP';
+1..5
+ok 1 - input file opened
+... this is junk
+not ok first line of the input valid # todo some data
+# this is a comment
+ok 3 - read the rest of the file
+not ok 4 - this is a real failure
+ok 5 # skip we have no description
+END_TAP
+
+my $factory = TAP::Parser::IteratorFactory->new;
+my $stream = $factory->make_iterator( [ split /\n/ => $tap ] );
+isa_ok $stream, 'TAP::Parser::Iterator';
+
+my $parser1 = TAP::Parser->new( { stream => $stream } );
+isa_ok $parser1, 'TAP::Parser';
+
+$parser1->run;
+
[...32617 lines suppressed...]
-Its value will be prepended to the switches used to invoke perl on
-each test.  For example, setting C<HARNESS_PERL_SWITCHES> to C<-W> will
-run all tests with all warnings enabled.
-
 =item C<HARNESS_TIMER>
 
 Setting this to true will make the harness display the number of
@@ -1015,155 +516,72 @@
 
 =item C<HARNESS_VERBOSE>
 
-If true, Test::Harness will output the verbose results of running
-its tests.  Setting C<$Test::Harness::verbose> will override this,
-or you can use the C<-v> switch in the F<prove> utility.
-
-If true, Test::Harness will output the verbose results of running
+If true, C<Test::Harness> will output the verbose results of running
 its tests.  Setting C<$Test::Harness::verbose> will override this,
 or you can use the C<-v> switch in the F<prove> utility.
 
-=item C<HARNESS_STRAP_CLASS>
+=item C<HARNESS_OPTIONS>
 
-Defines the Test::Harness::Straps subclass to use.  The value may either
-be a filename or a class name.
+Provide additional options to the harness. Currently supported options are:
 
-If HARNESS_STRAP_CLASS is a class name, the class must be in C<@INC>
-like any other class.
+=over
 
-If HARNESS_STRAP_CLASS is a filename, the .pm file must return the name
-of the class, instead of the canonical "1".
+=item C<< j<n> >>
 
-=back
-
-=head1 EXAMPLE
-
-Here's how Test::Harness tests itself
-
-  $ cd ~/src/devel/Test-Harness
-  $ perl -Mblib -e 'use Test::Harness qw(&runtests $verbose);
-    $verbose=0; runtests @ARGV;' t/*.t
-  Using /home/schwern/src/devel/Test-Harness/blib
-  t/base..............ok
-  t/nonumbers.........ok
-  t/ok................ok
-  t/test-harness......ok
-  All tests successful.
-  Files=4, Tests=24, 2 wallclock secs ( 0.61 cusr + 0.41 csys = 1.02 CPU)
-
-=head1 SEE ALSO
-
-The included F<prove> utility for running test scripts from the command line,
-L<Test> and L<Test::Simple> for writing test scripts, L<Benchmark> for
-the underlying timing routines, and L<Devel::Cover> for test coverage
-analysis.
-
-=head1 TODO
-
-Provide a way of running tests quietly (ie. no printing) for automated
-validation of tests.  This will probably take the form of a version
-of runtests() which rather than printing its output returns raw data
-on the state of the tests.  (Partially done in Test::Harness::Straps)
-
-Document the format.
+Run <n> (default 9) parallel jobs.
 
-Fix HARNESS_COMPILE_TEST without breaking its core usage.
+=item C<< f >>
 
-Figure a way to report test names in the failure summary.
+Use forked parallelism.
 
-Rework the test summary so long test names are not truncated as badly.
-(Partially done with new skip test styles)
-
-Add option for coverage analysis.
-
-Trap STDERR.
-
-Implement Straps total_results()
-
-Remember exit code
-
-Completely redo the print summary code.
+=back
 
-Straps->analyze_file() not taint clean, don't know if it can be
+Multiple options may be separated by colons:
 
-Fix that damned VMS nit.
+    HARNESS_OPTIONS=j9:f make test
 
-Add a test for verbose.
+=back
 
-Change internal list of test results to a hash.
+=head1 Taint Mode
 
-Fix stats display when there's an overrun.
+Normally when a Perl program is run in taint mode the contents of the
+C<PERL5LIB> environment variable do not appear in C<@INC>.
 
-Fix so perls with spaces in the filename work.
+Because C<PERL5LIB> is often used during testing to add build
+directories to C<@INC> C<Test::Harness> (actually
+L<TAP::Parser::Source::Perl>) passes the names of any directories found
+in C<PERL5LIB> as -I switches. The net effect of this is that
+C<PERL5LIB> is honoured even in taint mode.
 
-Keeping whittling away at _run_all_tests()
+=head1 SEE ALSO
 
-Clean up how the summary is printed.  Get rid of those damned formats.
+L<TAP::Harness>
 
 =head1 BUGS
 
 Please report any bugs or feature requests to
 C<bug-test-harness at rt.cpan.org>, or through the web interface at
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Harness>.
-I will be notified, and then you'll automatically be notified of progress on
-your bug as I make changes.
-
-=head1 SUPPORT
-
-You can find documentation for this module with the F<perldoc> command.
-
-    perldoc Test::Harness
-
-You can get docs for F<prove> with
-
-    prove --man
-
-You can also look for information at:
-
-=over 4
-
-=item * AnnoCPAN: Annotated CPAN documentation
-
-L<http://annocpan.org/dist/Test-Harness>
-
-=item * CPAN Ratings
-
-L<http://cpanratings.perl.org/d/Test-Harness>
-
-=item * RT: CPAN's request tracker
-
-L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Harness>
-
-=item * Search CPAN
-
-L<http://search.cpan.org/dist/Test-Harness>
-
-=back
-
-=head1 SOURCE CODE
-
-The source code repository for Test::Harness is at
-L<http://svn.perl.org/modules/Test-Harness>.
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Harness>.  I will be 
+notified, and then you'll automatically be notified of progress on your bug 
+as I make changes.
 
 =head1 AUTHORS
 
-Either Tim Bunce or Andreas Koenig, we don't know. What we know for
-sure is, that it was inspired by Larry Wall's F<TEST> script that came
-with perl distributions for ages. Numerous anonymous contributors
-exist.  Andreas Koenig held the torch for many years, and then
-Michael G Schwern.
+Andy Armstrong  C<< <andy at hexten.net> >>
 
-Current maintainer is Andy Lester C<< <andy at petdance.com> >>.
+L<Test::Harness> 2.64 (maintained by Andy Lester and on which this
+module is based) has this attribution:
 
-=head1 COPYRIGHT
+    Either Tim Bunce or Andreas Koenig, we don't know. What we know for
+    sure is, that it was inspired by Larry Wall's F<TEST> script that came
+    with perl distributions for ages. Numerous anonymous contributors
+    exist.  Andreas Koenig held the torch for many years, and then
+    Michael G Schwern.
 
-Copyright 2002-2006
-by Michael G Schwern C<< <schwern at pobox.com> >>,
-Andy Lester C<< <andy at petdance.com> >>.
+=head1 LICENCE AND COPYRIGHT
 
-This program is free software; you can redistribute it and/or 
-modify it under the same terms as Perl itself.
+Copyright (c) 2007-2008, Andy Armstrong C<< <andy at hexten.net> >>. All rights reserved.
 
-See L<http://www.perl.com/perl/misc/Artistic.html>.
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See L<perlartistic>.
 
-=cut

perl-update-Test-Simple.patch:

--- NEW FILE perl-update-Test-Simple.patch ---
Test-Simple-0.86

the following made the patch smaller:
mv Test-Simple-0.86/t/{Builder,Tester,}

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-17 17:16:40.000000000 +0100
@@ -2626,11 +2626,16 @@
 lib/Test/Simple/Changes		Test::Simple changes
 lib/Test/Simple.pm		Basic utility for writing tests
 lib/Test/Simple/README		Test::Simple README
+lib/Test/Simple/TODO		Test::Simple TODO
 lib/Test/Simple/t/00test_harness_check.t	Test::Simple test
+lib/Test/Simple/t/BEGIN_require_ok.t
+lib/Test/Simple/t/BEGIN_use_ok.t
+lib/Test/Simple/t/Builder.t	Test::Builder tests
+lib/Test/Simple/t/More.t	Test::More test, basic stuff
 lib/Test/Simple/t/bad_plan.t	Test::Builder plan() test
 lib/Test/Simple/t/bail_out.t	Test::Builder BAIL_OUT test
 lib/Test/Simple/t/buffer.t	Test::Builder buffering test
-lib/Test/Simple/t/Builder.t	Test::Builder tests
+lib/Test/Simple/t/c_flag.t
 lib/Test/Simple/t/carp.t	Test::Builder test
 lib/Test/Simple/t/circular_data.t	Test::Simple test
 lib/Test/Simple/t/cmp_ok.t	Test::More test
@@ -2638,19 +2643,22 @@
 lib/Test/Simple/t/curr_test.t	Test::Builder->curr_test tests
 lib/Test/Simple/t/details.t	Test::Builder tests
 lib/Test/Simple/t/diag.t	Test::More diag() test
+lib/Test/Simple/t/died.t
+lib/Test/Simple/t/dont_overwrite_die_handler.t
 lib/Test/Simple/t/eq_set.t	Test::Simple test
 lib/Test/Simple/t/exit.t	Test::Simple test, exit codes
-lib/Test/Simple/t/extra_one.t	Test::Simple test
+lib/Test/Simple/t/explain.t
 lib/Test/Simple/t/extra.t	Test::Simple test
+lib/Test/Simple/t/extra_one.t	Test::Simple test
 lib/Test/Simple/t/fail-like.t	Test::More test, like() failures
 lib/Test/Simple/t/fail-more.t	Test::More test, tests failing
-lib/Test/Simple/t/fail_one.t	Test::Simple test
 lib/Test/Simple/t/fail.t	Test::Simple test, test failures
+lib/Test/Simple/t/fail_one.t	Test::Simple test
 lib/Test/Simple/t/filehandles.t	Test::Simple test, STDOUT can be played with
 lib/Test/Simple/t/fork.t	Test::More fork tests
 lib/Test/Simple/t/harness_active.t	Test::Simple test
-lib/Test/Simple/t/has_plan2.t	Test::More->plan tests
 lib/Test/Simple/t/has_plan.t	Test::Builder->plan tests
+lib/Test/Simple/t/has_plan2.t	Test::More->plan tests
 lib/Test/Simple/t/import.t	Test::More test, importing functions
 lib/Test/Simple/t/is_deeply_dne_bug.t	Test::More test
 lib/Test/Simple/t/is_deeply_fail.t	Test::More test, is_deeply()
@@ -2660,27 +2668,30 @@
 lib/Test/Simple/t/lib/MyOverload.pm	Test::More test module 
 lib/Test/Simple/t/maybe_regex.t	Test::Builder->maybe_regex() tests
 lib/Test/Simple/t/missing.t	Test::Simple test, missing tests
-lib/Test/Simple/t/More.t	Test::More test, basic stuff
+lib/Test/Simple/t/new_ok.t
 lib/Test/Simple/t/no_diag.t	Test::Simple test
 lib/Test/Simple/t/no_ending.t	Test::Builder test, no_ending()
 lib/Test/Simple/t/no_header.t	Test::Builder test, no_header()
 lib/Test/Simple/t/no_plan.t	Test::Simple test, forgot the plan
-lib/Test/Simple/TODO		Test::Simple TODO
+lib/Test/Simple/t/no_tests.t
+lib/Test/Simple/t/note.t
 lib/Test/Simple/t/ok_obj.t	Test::Builder object tests
 lib/Test/Simple/t/output.t	Test::Builder test, output methods
 lib/Test/Simple/t/overload.t		Test::Simple test
 lib/Test/Simple/t/overload_threads.t	Test::Simple test
+lib/Test/Simple/t/plan.t	Test::More test, plan()
 lib/Test/Simple/t/plan_bad.t		Test::Simple test
 lib/Test/Simple/t/plan_is_noplan.t	Test::Simple test, no_plan
 lib/Test/Simple/t/plan_no_plan.t	Test::More test, plan() w/no_plan
 lib/Test/Simple/t/plan_shouldnt_import.t	Test::Simple test
 lib/Test/Simple/t/plan_skip_all.t	Test::More test, plan() w/skip_all
-lib/Test/Simple/t/plan.t	Test::More test, plan()
 lib/Test/Simple/t/require_ok.t	Test::Simple test
 lib/Test/Simple/t/reset.t	Test::Simple test
+lib/Test/Simple/t/reset_outputs.t
 lib/Test/Simple/t/simple.t	Test::Simple test, basic stuff
-lib/Test/Simple/t/skipall.t	Test::More test, skip all tests
 lib/Test/Simple/t/skip.t	Test::More test, SKIP tests
+lib/Test/Simple/t/skipall.t	Test::More test, skip all tests
+lib/Test/Simple/t/tbm_doesnt_set_exported_to.t
 lib/Test/Simple/t/tbt_01basic.t	Test::Builder::Tester test
 lib/Test/Simple/t/tbt_02fhrestore.t	Test::Builder::Tester test
 lib/Test/Simple/t/tbt_03die.t	Test::Builder::Tester test
@@ -2688,13 +2699,14 @@
 lib/Test/Simple/t/tbt_05faildiag.t	Test::Builder::Tester test
 lib/Test/Simple/t/tbt_06errormess.t	Test::Builder::Tester test
 lib/Test/Simple/t/tbt_07args.t	Test::Builder::Tester test
-lib/Test/Simple/t/threads.t	Test::Builder thread-safe checks
 lib/Test/Simple/t/thread_taint.t	Test::Simple test
+lib/Test/Simple/t/threads.t	Test::Builder thread-safe checks
 lib/Test/Simple/t/todo.t	Test::More test, TODO tests
 lib/Test/Simple/t/try.t		Test::More test
 lib/Test/Simple/t/undef.t	Test::More test, undefs don't cause warnings
-lib/Test/Simple/t/useing.t	Test::More test, compile test
 lib/Test/Simple/t/use_ok.t	Test::More test, use_ok()
+lib/Test/Simple/t/useing.t	Test::More test, compile test
+lib/Test/Simple/t/utf8.t
 lib/Test/t/05_about_verbose.t	See if Test works
 lib/Test/t/fail.t		See if Test works
 lib/Test/t/mix.t		See if Test works
diff -urN perl-5.10.0.orig/lib/Test/Builder/Module.pm perl-5.10.0/lib/Test/Builder/Module.pm
--- perl-5.10.0.orig/lib/Test/Builder/Module.pm	2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/Test/Builder/Module.pm	2009-02-17 17:16:40.000000000 +0100
@@ -1,24 +1,24 @@
 package Test::Builder::Module;
+# $Id$
+
+use strict;
 
 use Test::Builder;
 
 require Exporter;
- at ISA = qw(Exporter);
+our @ISA = qw(Exporter);
 
-$VERSION = '0.72';
-
-use strict;
+our $VERSION = '0.86';
 
 # 5.004's Exporter doesn't have export_to_level.
 my $_export_to_level = sub {
-      my $pkg = shift;
-      my $level = shift;
-      (undef) = shift;                  # redundant arg
-      my $callpkg = caller($level);
-      $pkg->export($callpkg, @_);
+    my $pkg   = shift;
+    my $level = shift;
+    (undef) = shift;    # redundant arg
+    my $callpkg = caller($level);
+    $pkg->export( $callpkg, @_ );
 };
 
-
 =head1 NAME
 
 Test::Builder::Module - Base class for test modules
@@ -84,33 +84,35 @@
 sub import {
     my($class) = shift;
 
+    # Don't run all this when loading ourself.
+    return 1 if $class eq 'Test::Builder::Module';
+
     my $test = $class->builder;
 
     my $caller = caller;
 
     $test->exported_to($caller);
 
-    $class->import_extra(\@_);
-    my(@imports) = $class->_strip_imports(\@_);
+    $class->import_extra( \@_ );
+    my(@imports) = $class->_strip_imports( \@_ );
 
     $test->plan(@_);
 
-    $class->$_export_to_level(1, $class, @imports);
+    $class->$_export_to_level( 1, $class, @imports );
 }
 
-
 sub _strip_imports {
     my $class = shift;
     my $list  = shift;
 
     my @imports = ();
     my @other   = ();
-    my $idx = 0;
+    my $idx     = 0;
     while( $idx <= $#{$list} ) {
         my $item = $list->[$idx];
 
         if( defined $item and $item eq 'import' ) {
-            push @imports, @{$list->[$idx+1]};
+            push @imports, @{ $list->[ $idx + 1 ] };
             $idx++;
         }
         else {
@@ -125,7 +127,6 @@
     return @imports;
 }
 
-
 =head3 import_extra
 
     Your::Module->import_extra(\@import_args);
@@ -143,8 +144,7 @@
 
 =cut
 
-sub import_extra {}
-
+sub import_extra { }
[...5837 lines suppressed...]
--- perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/death.plx	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/t/lib/Test/Simple/sample_tests/death.plx	2009-02-17 17:16:41.000000000 +0100
@@ -1,13 +1,16 @@
 require Test::Simple;
+# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
 my($out, $err) = Test::Simple::Catch::caught();
 
+require Dev::Null;
+
 Test::Simple->import(tests => 5);
-close STDERR;
+tie *STDERR, 'Dev::Null';
 
 ok(1);
 ok(1);
 ok(1);
-die "Knife?";
+die "This is a test";
diff -urN perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/death_in_eval.plx perl-5.10.0/t/lib/Test/Simple/sample_tests/death_in_eval.plx
--- perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/death_in_eval.plx	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/t/lib/Test/Simple/sample_tests/death_in_eval.plx	2009-02-17 17:16:41.000000000 +0100
@@ -1,4 +1,5 @@
 require Test::Simple;
+# $Id$
 use Carp;
 
 push @INC, 't/lib';
diff -urN perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/death_with_handler.plx perl-5.10.0/t/lib/Test/Simple/sample_tests/death_with_handler.plx
--- perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/death_with_handler.plx	1970-01-01 01:00:00.000000000 +0100
+++ perl-5.10.0/t/lib/Test/Simple/sample_tests/death_with_handler.plx	2009-02-17 17:16:41.000000000 +0100
@@ -0,0 +1,19 @@
+require Test::Simple;
+# $Id$
+
+push @INC, 't/lib';
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+
+Test::Simple->import(tests => 2);
+
+# Test we still get the right exit code despite having a die
+# handler.
+$SIG{__DIE__} = sub {};
+
+require Dev::Null;
+tie *STDERR, 'Dev::Null';
+
+ok(1);
+ok(1);
+die "This is a test";
diff -urN perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/exit.plx perl-5.10.0/t/lib/Test/Simple/sample_tests/exit.plx
--- perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/exit.plx	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/t/lib/Test/Simple/sample_tests/exit.plx	2009-02-17 17:16:41.000000000 +0100
@@ -1,3 +1,4 @@
 require Test::Builder;
+# $Id$
 
 exit 1;
diff -urN perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/extras.plx perl-5.10.0/t/lib/Test/Simple/sample_tests/extras.plx
--- perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/extras.plx	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/t/lib/Test/Simple/sample_tests/extras.plx	2009-02-17 17:16:41.000000000 +0100
@@ -1,4 +1,5 @@
 require Test::Simple;
+# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
diff -urN perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/five_fail.plx perl-5.10.0/t/lib/Test/Simple/sample_tests/five_fail.plx
--- perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/five_fail.plx	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/t/lib/Test/Simple/sample_tests/five_fail.plx	2009-02-17 17:16:41.000000000 +0100
@@ -1,4 +1,5 @@
 require Test::Simple;
+# $Id$
 
 use lib 't/lib';
 require Test::Simple::Catch;
diff -urN perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/last_minute_death.plx perl-5.10.0/t/lib/Test/Simple/sample_tests/last_minute_death.plx
--- perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/last_minute_death.plx	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/t/lib/Test/Simple/sample_tests/last_minute_death.plx	2009-02-17 17:16:41.000000000 +0100
@@ -1,11 +1,14 @@
 require Test::Simple;
+# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
 my($out, $err) = Test::Simple::Catch::caught();
 
 Test::Simple->import(tests => 5);
-close STDERR;
+
+require Dev::Null;
+tie *STDERR, 'Dev::Null';
 
 ok(1);
 ok(1);
@@ -13,4 +16,4 @@
 ok(1);
 ok(1);
 
-die "Almost there...";
+die "This is a test";
diff -urN perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/one_fail.plx perl-5.10.0/t/lib/Test/Simple/sample_tests/one_fail.plx
--- perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/one_fail.plx	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/t/lib/Test/Simple/sample_tests/one_fail.plx	2009-02-17 17:16:41.000000000 +0100
@@ -1,4 +1,5 @@
 require Test::Simple;
+# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
diff -urN perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/pre_plan_death.plx perl-5.10.0/t/lib/Test/Simple/sample_tests/pre_plan_death.plx
--- perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/pre_plan_death.plx	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/t/lib/Test/Simple/sample_tests/pre_plan_death.plx	2009-02-17 17:16:41.000000000 +0100
@@ -1,4 +1,5 @@
 # ID 20020716.013, the exit code would become 0 if the test died
+# $Id$
 # before a plan.
 
 require Test::Simple;
diff -urN perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/require.plx perl-5.10.0/t/lib/Test/Simple/sample_tests/require.plx
--- perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/require.plx	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/t/lib/Test/Simple/sample_tests/require.plx	2009-02-17 17:16:41.000000000 +0100
@@ -1 +1,2 @@
 require Test::Simple;
+# $Id$
diff -urN perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/success.plx perl-5.10.0/t/lib/Test/Simple/sample_tests/success.plx
--- perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/success.plx	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/t/lib/Test/Simple/sample_tests/success.plx	2009-02-17 17:16:41.000000000 +0100
@@ -1,4 +1,5 @@
 require Test::Simple;
+# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
diff -urN perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/too_few.plx perl-5.10.0/t/lib/Test/Simple/sample_tests/too_few.plx
--- perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/too_few.plx	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/t/lib/Test/Simple/sample_tests/too_few.plx	2009-02-17 17:16:41.000000000 +0100
@@ -1,4 +1,5 @@
 require Test::Simple;
+# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
diff -urN perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/too_few_fail.plx perl-5.10.0/t/lib/Test/Simple/sample_tests/too_few_fail.plx
--- perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/too_few_fail.plx	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/t/lib/Test/Simple/sample_tests/too_few_fail.plx	2009-02-17 17:16:41.000000000 +0100
@@ -1,4 +1,5 @@
 require Test::Simple;
+# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
@@ -9,4 +10,4 @@
 
 ok(0);
 ok(1);
-ok(0);
\ No newline at end of file
+ok(0);
diff -urN perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/two_fail.plx perl-5.10.0/t/lib/Test/Simple/sample_tests/two_fail.plx
--- perl-5.10.0.orig/t/lib/Test/Simple/sample_tests/two_fail.plx	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/t/lib/Test/Simple/sample_tests/two_fail.plx	2009-02-17 17:16:41.000000000 +0100
@@ -1,4 +1,5 @@
 require Test::Simple;
+# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
diff -urN perl-5.10.0.orig/t/lib/TieOut.pm perl-5.10.0/t/lib/TieOut.pm
--- perl-5.10.0.orig/t/lib/TieOut.pm	2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/t/lib/TieOut.pm	2009-02-17 17:16:41.000000000 +0100
@@ -1,13 +1,14 @@
 package TieOut;
+# $Id$
 
 sub TIEHANDLE {
     my $scalar = '';
-    bless( \$scalar, $_[0]);
+    bless( \$scalar, $_[0] );
 }
 
 sub PRINT {
     my $self = shift;
-    $$self .= join('', @_);
+    $$self .= join( '', @_ );
 }
 
 sub PRINTF {
@@ -16,7 +17,7 @@
     $$self .= sprintf $fmt, @_;
 }
 
-sub FILENO {}
+sub FILENO { }
 
 sub read {
     my $self = shift;

perl-update-Time-HiRes.patch:

--- NEW FILE perl-update-Time-HiRes.patch ---
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";
     }

perl-update-constant.patch:

--- NEW FILE perl-update-constant.patch ---
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 at 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 \(\)/,


Index: .cvsignore
===================================================================
RCS file: /cvs/extras/rpms/perl/F-10/.cvsignore,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- .cvsignore	22 Dec 2008 10:47:53 -0000	1.16
+++ .cvsignore	23 Mar 2009 10:31:04 -0000	1.17
@@ -1,2 +1 @@
 perl-5.10.0.tar.gz
-Tar-Archive.tar.gz

perl-5.10.0-Change33640.patch:

Index: perl-5.10.0-Change33640.patch
===================================================================
RCS file: /cvs/extras/rpms/perl/F-10/perl-5.10.0-Change33640.patch,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- perl-5.10.0-Change33640.patch	29 Nov 2008 00:10:08 -0000	1.1
+++ perl-5.10.0-Change33640.patch	23 Mar 2009 10:31:04 -0000	1.2
@@ -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 @@

perl-5.10.0-links.patch:

Index: perl-5.10.0-links.patch
===================================================================
RCS file: /cvs/extras/rpms/perl/F-10/perl-5.10.0-links.patch,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- perl-5.10.0-links.patch	21 Dec 2007 22:38:28 -0000	1.1
+++ perl-5.10.0-links.patch	23 Mar 2009 10:31:05 -0000	1.2
@@ -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 @@
      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 @@
 +                '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 @@
              '-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 @@
          ### 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 @@
          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 @@
      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 @@
  
  =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 @@
  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 @@
       "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 @@
                              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 @@
  =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?


Index: perl.spec
===================================================================
RCS file: /cvs/extras/rpms/perl/F-10/perl.spec,v
retrieving revision 1.205
retrieving revision 1.206
diff -u -r1.205 -r1.206
--- perl.spec	11 Mar 2009 22:23:00 -0000	1.205
+++ perl.spec	23 Mar 2009 10:31:06 -0000	1.206
@@ -7,7 +7,7 @@
 
 Name:           perl
 Version:        %{perl_version}
-Release:        57%{?dist}
+Release:        62%{?dist}
 Epoch:          %{perl_epoch}
 Summary:        Practical Extraction and Report Language
 Group:          Development/Languages
@@ -16,18 +16,15 @@
 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
 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
@@ -40,15 +37,14 @@
 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.
@@ -57,53 +53,22 @@
 # 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
@@ -122,11 +87,10 @@
 # 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
 
 # Change 34507: Fix memory leak in single-char character class optimization
-Patch34:        perl-5.10.0-Change34507.patch
+Patch34:	perl-5.10.0-Change34507.patch
 
 # Reorder @INC: Based on: http://github.com/rafl/perl/commit/b9ba2fadb18b54e35e5de54f945111a56cbcb249
 Patch35:	perl-5.10.0-reorderINC.patch
@@ -166,7 +130,7 @@
 # Fix a segmentation fault occurring in the mod_perl2 test suite.
 # Upstream change 33807
 Patch46:	15_fix_local_symtab
-
+ 
 # Fix the PerlIO_teardown prototype to suppress a compiler warning.
 # Upstream change 33370
 Patch47:	16_fix_perlio_teardown_prototype
@@ -179,48 +143,83 @@
 # Upstream change 33821
 Patch49:	18_fix_bigint_floats
 
-# Fix Sys::Syslog slowness when logging with non-native mechanisms.
-# Fixed upstream in Sys::Syslog 0.25
-Patch50:	27_fix_sys_syslog_timeout
-
 # Fix memory corruption with in-place sorting.
 # Upstream change 33937
-Patch51:	28_fix_inplace_sort
+Patch50:	28_fix_inplace_sort
 
 # Revert an incorrect substitution optimization introduced in 5.10.0.
 # Bug introduced by upstream change 26334, reverted with change 33685 in blead and 33732 in maint-5.10.
-Patch52:	30_fix_freetmps
+Patch51:	30_fix_freetmps
 
 # Fix 'Unknown error' messages with attribute.pm.
 # Upstream change 33265
-Patch53:	31_fix_attributes_unknown_error
+Patch52:	31_fix_attributes_unknown_error
 
 # Stop t/op/fork.t relying on rand().
 # Upstream change 33749
-Patch54:	32_fix_fork_rand
+Patch53:	32_fix_fork_rand
 
 # Fix memory leak with qr//.
 # Adapted from upstream changhe 34506.
-Patch55:	34_fix_qr-memory-leak-2
+Patch54:	34_fix_qr-memory-leak-2
 
 # CVE-2005-0448 revisited: File::Path::rmtree no longer allows creating of setuid files.
-Patch56:	35_fix_file_path_rmtree_setuid
-
-# Make File::Temp warn on cleaning up the current working directory at exit instead of bailing out.
-# Adapted from File::Temp 0.21
-Patch57:	36_fix_file_temp_cleanup
+# We have 2.07, but it is still missing one fix (the debian patch has two fixes, but one is in 2.07)
+Patch55:	perl-5.10.0-fix_file_path_rmtree_setuid.patch
 
 # Fix $? when dumping core.
-Patch58:	37_fix_coredump_indicator
+Patch56:	37_fix_coredump_indicator
 
 # Fix a memory leak with Scalar::Util::weaken().
 # Upstream change 34209
-Patch59:	38_fix_weaken_memleak
+Patch57:	38_fix_weaken_memleak
 
 ### End of Debian Patches ###
 
+# 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:      %{_tmppath}/%{name}-%{perl_version}-%{release}-root-%(%{__id_u} -n)
+BuildRoot:      %(mktemp -ud %{_tmppath}/%{name}-%{version}-%{release}-XXXXXX)
 BuildRequires:  tcsh, dos2unix, man, groff
 BuildRequires:  gdbm-devel, db4-devel, zlib-devel
 # For tests
@@ -282,11 +281,11 @@
 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}
@@ -361,7 +360,7 @@
 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
@@ -373,7 +372,7 @@
 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)
 
@@ -468,7 +467,7 @@
 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}
 
@@ -529,7 +528,7 @@
 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
@@ -590,8 +589,8 @@
 License:        GPL+ or Artistic
 # Epoch bump for clean upgrade over old standalone package
 Epoch:          1
-# Really 0.40_1, but we drop the _1.
-Version:        0.40
+# do not upgrade in the future to _something version. They are testing!
+Version:        %{IPC_Cmd_version}
 Requires:       perl = %{perl_epoch}:%{perl_version}-%{release}
 
 %description IPC-Cmd
@@ -652,8 +651,7 @@
 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
@@ -676,7 +674,7 @@
 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)
 
@@ -705,7 +703,7 @@
 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
@@ -810,7 +808,7 @@
 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
@@ -839,7 +837,7 @@
 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}
 
@@ -852,7 +850,7 @@
 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}
 
@@ -920,10 +918,9 @@
 
 
 %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
@@ -935,30 +932,17 @@
 %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
 %patch35 -p1
@@ -983,8 +967,25 @@
 %patch55 -p1
 %patch56 -p1
 %patch57 -p1
-%patch58 -p1
-%patch59 -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):
@@ -1088,11 +1089,7 @@
         -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
@@ -1141,7 +1138,6 @@
 #
 # libnet configuration file
 #
-mkdir -p -m 755 %{comp_perl_lib}/Net
 install -p -m 644 %{SOURCE12} %{comp_perl_lib}/Net/libnet.cfg
 
 #
@@ -1186,73 +1182,82 @@
 
 # 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 '34507 Fix memory leak in single-char character class optimization'
-perl -x patchlevel.h 'Fedora Patch35: Reorder @INC, based on b9ba2fadb18b54e35e5de54f945111a56cbcb249'
-perl -x patchlevel.h 'Fedora Patch36: Fix from Archive::Extract maintainer to only look at stdout from tar'
-perl -x patchlevel.h '32727 Fix issue with (nested) definition lists in lib/Pod/Html.pm'
-perl -x patchlevel.h '33287 Fix NULLOK items'
-perl -x patchlevel.h '33554 Fix a typo in the predefined common protocols to make "udp" resolve without netbase'
-perl -x patchlevel.h '33388 Fix a segmentation fault with debugperl -Dm'
-perl -x patchlevel.h '33835 Allow the quote mark delimiter also for those #include directives chased with h2ph -a.'
-perl -x patchlevel.h '32910 Disable the v-string in use/require is non-portable warning.'
-perl -x patchlevel.h '33807 Fix a segmentation fault occurring in the mod_perl2 test suite.'
-perl -x patchlevel.h '33370 Fix the PerlIO_teardown prototype to suppress a compiler warning.'
-perl -x patchlevel.h 'Fedora Patch48: Remove numeric overloading of Getopt::Long callback functions.'
-perl -x patchlevel.h '33821 Fix Math::BigFloat::sqrt() breaking with too many digits.'
-perl -x patchlevel.h 'Fedora Patch50: Fix Sys::Syslog slowness when logging with non-native mechanisms'
-perl -x patchlevel.h '33937 Fix memory corruption with in-place sorting'
-perl -x patchlevel.h '33732 Revert an incorrect substitution optimization introduced in 5.10.0'
-perl -x patchlevel.h '33265 Fix Unknown error messages with attribute.pm.'
-perl -x patchlevel.h '33749 Stop t/op/fork.t relying on rand()'
-perl -x patchlevel.h '34506 Fix memory leak with qr//'
-perl -x patchlevel.h 'Fedora Patch56: File::Path::rmtree no longer allows creating of setuid files.'
-perl -x patchlevel.h 'Fedora Patch57: Make File::Temp warn on cleaning up the current working directory at exit instead of bailing out.'
-perl -x patchlevel.h 'Fedora Patch58: Fix $? when dumping core'
-perl -x patchlevel.h '34209 Fix a memory leak with Scalar::Util::weaken()'
+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' \
+	'34507 Fix memory leak in single-char character class optimization' \
+	'Fedora Patch35: Reorder @INC, based on b9ba2fadb18b54e35e5de54f945111a56cbcb249' \
+	'Fedora Patch36: Fix from Archive::Extract maintainer to only look at stdout from tar' \
+	'32727 Fix issue with (nested) definition lists in lib/Pod/Html.pm' \
+	'33287 Fix NULLOK items' \
+	'33554 Fix a typo in the predefined common protocols to make "udp" resolve without netbase' \
+	'33388 Fix a segmentation fault with debugperl -Dm' \
+	'33835 Allow the quote mark delimiter also for those #include directives chased with h2ph -a.' \
+	'32910 Disable the v-string in use/require is non-portable warning.' \
+	'33807 Fix a segmentation fault occurring in the mod_perl2 test suite.' \
+	'33370 Fix the PerlIO_teardown prototype to suppress a compiler warning.' \
+	'Fedora Patch48: Remove numeric overloading of Getopt::Long callback functions.' \
+	'33821 Fix Math::BigFloat::sqrt() breaking with too many digits.' \
+	'33937 Fix memory corruption with in-place sorting' \
+	'33732 Revert an incorrect substitution optimization introduced in 5.10.0' \
+	'33265 Fix Unknown error messages with attribute.pm.' \
+	'33749 Stop t/op/fork.t relying on rand()' \
+	'34506 Fix memory leak with qr//' \
+	'Fedora Patch55: File::Path::rmtree no longer allows creating of setuid files.' \
+	'Fedora Patch56: Fix $? when dumping core' \
+	'34209 Fix a memory leak with Scalar::Util::weaken()' \
+	'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
@@ -1513,8 +1518,12 @@
 
 # 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
@@ -1805,7 +1814,7 @@
 
 %files Pod-Simple
 %defattr(-,root,root,-)
-%{_prefix}/lib/perl5/%{perl_version}/Pod/Simple/
+%{_prefix}/lib/perl5/%{perl_version}/Pod/Simple/ 
 %{_prefix}/lib/perl5/%{perl_version}/Pod/Simple.pm
 %{_prefix}/lib/perl5/%{perl_version}/Pod/Simple.pod
 %{_mandir}/man3/Pod::Simple*
@@ -1819,8 +1828,12 @@
 %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
@@ -1853,28 +1866,53 @@
 
 # Old changelog entries are preserved in CVS.
 %changelog
-* Wed Mar 11 2009 Tom "spot" Callaway <tcallawa at redhat.com> - 4:5.10.0-57
+* Wed Mar 11 2009 Tom "spot" Callaway <tcallawa at redhat.com> - 4:5.10.0-62
+- drop 26_fix_pod2man_upgrade (don't need it)
+
+* Wed Mar 11 2009 Tom "spot" Callaway <tcallawa at redhat.com> - 4:5.10.0-61
 - apply Change 34507: Fix memory leak in single-char character class optimization
 - Reorder @INC, based on b9ba2fadb18b54e35e5de54f945111a56cbcb249
 - fix Archive::Extract to fix test failure caused by tar >= 1.21
 - Merge useful Debian patches
 
-* Mon Feb 16 2009 Tom "spot" Callaway <tcallawa at redhat.com> - 4:5.10.0-56
+* Tue Mar 10 2009 Stepan Kasal <skasal at 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 at fedoraproject.org> - 4:5.10.0-59
+- Rebuilt for https://fedoraproject.org/wiki/Fedora_11_Mass_Rebuild
+
+* Mon Feb 16 2009 Tom "spot" Callaway <tcallawa at redhat.com> - 4:5.10.0-58
 - add /usr/lib/perl5/site_perl to otherlibs (bz 484053)
 
-* Mon Feb 16 2009 Dennis Gilmore <dennis at ausil.us> - 4:5.10.0-55
+* Mon Feb 16 2009 Dennis Gilmore <dennis at ausil.us> - 4:5.10.0-57
 - build sparc64 without _smp_mflags
 
-* Sat Feb 09 2009 Dennis Gilmore <dennis at ausil.us> - 4:5.10.0-54
-- limit %%{?_smp_mflags} to 12 on sparc arches 
+* Sat Feb 07 2009 Dennis Gilmore <dennis at ausil.us> - 4:5.10.0-56
+- limit sparc builds to -j12
+
+* Tue Feb  3 2009 Marcela Mašláňová <mmaslano at redhat.com> - 4:5.10.0-55
+- update IPC::Cmd to v 0.42
 
-* Mon Jan 19 2009 Marcela Mašláňová <mmaslano at redhat.com> - 4:5.10.0-53
+* Mon Jan 19 2009 Marcela Mašláňová <mmaslano at redhat.com> - 4:5.10.0-54
 - 455410 http://rt.perl.org/rt3/Public/Bug/Display.html?id=54934
   Attempt to free unreferenced scalar fiddling with the symbol table
   Keep the refcount of the globs generated by PerlIO::via balanced.
 
-* Mon Dec 22 2008 Marcela Mašláňová <mmaslano at redhat.com> - 4:5.10.0-52
+* Mon Dec 22 2008 Marcela Mašláňová <mmaslano at redhat.com> - 4:5.10.0-53
 - add missing XHTML.pm into Pod::Simple
+
+* Thu Dec 12 2008 Marcela Mašláňová <mmaslano at redhat.com> - 4:5.10.0-52
 - 295021 CVE-2007-4829 perl-Archive-Tar directory traversal flaws
 - add another source for binary files, which test untaring links
 


Index: sources
===================================================================
RCS file: /cvs/extras/rpms/perl/F-10/sources,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- sources	22 Dec 2008 10:47:53 -0000	1.16
+++ sources	23 Mar 2009 10:31:06 -0000	1.17
@@ -1,2 +1 @@
 d2c39b002ebfd2c3c5dba589365c5a71  perl-5.10.0.tar.gz
-20fc625176668dd02a8b07ef0acd451d  Tar-Archive.tar.gz


--- perl-5.10.0-ArchiveTar1.38.patch DELETED ---


--- perl-5.10.0-ArchiveTar1.40.patch DELETED ---


--- perl-5.10.0-CGI-3.38.patch DELETED ---


--- perl-5.10.0-CGI.patch DELETED ---


--- perl-5.10.0-CVE-2008-2827.patch DELETED ---


--- perl-5.10.0-File-Temp-0.20.patch DELETED ---


--- perl-5.10.0-Module-CoreList2.14.patch DELETED ---


--- perl-5.10.0-Module-Load-Conditional-0.24.patch DELETED ---


--- perl-5.10.0-PodSimple.patch DELETED ---


--- perl-5.10.0-SysSyslog-0.24.patch DELETED ---


--- perl-5.10.0-TestHarness3.12.patch DELETED ---


--- perl-5.10.0-TestSimple0.80.patch DELETED ---


--- perl-5.10.0-removeTestHarness.patch DELETED ---


--- perl-5.8.6-libresolv.patch DELETED ---


--- perl-5.8.8-links.patch DELETED ---




More information about the fedora-extras-commits mailing list