Change 33113: Integrate:

[nwc10+ (Nicholas Clark)]

Change 33113 by ***@nicholas-saigo on 2008/01/29 22:22:25

Integrate:
[ 32652]
Upgrade to File-Temp-0.19

[ 32657]
Fix a File::Temp test to deal with new Test::More changes.

[ 32665]
Subject: Re: [perl #48769] [PATCH] SelfLoader.pm 1.0904 - Whitespace in subroutine
From: Steffen Mueller <***@sneakemail.com>
Date: Tue, 18 Dec 2007 11:58:19 +0100
Message-ID: <***@sneakemail.com>

[ 32666]
Correct the test count in lib/File/Temp/t/lock.t
I guess that it was skipped in rather too many places, so no-one
noticed.

[ 32735]
Upgrade to File-Temp-0.20

[ 32787]
Upgrade to AutoLoader-5.64

[ 32800]
Upgrade to constant-1.15

[ 32814]
Upgrade to Net-Ping-2.34

[ 32829]
Move the SelfLoader test files in their own subdirectory

[ 32830]
Upgrade to SelfLoader 1.13_03

[ 32871]
Subject: Re: Smoke [5.11.0] 32864 FAIL(F) MSWin32 Win2003 SP2 (x86/1 cpu)
From: Abe Timmerman <***@ztreet.demon.nl>
Date: Sun, 06 Jan 2008 12:24:10 +0100
Message-ID: <***@ztreet.demon.nl>

Skip lib/File/Temp/t/fork.t when there is no fork.

[ 32885]
Subject: [PATCH] Cleanup File::Temp test file (revised)
From: "Jerry D. Hedden" <***@cpan.org>
Date: Fri, 4 Jan 2008 12:39:35 -0500
Message-ID: <***@mail.gmail.com>

[ 32903]
Subject: [PATCH] AutoLoader: Remove AutoLoader::can
From: Steffen Mueller <***@sneakemail.com>
Date: Fri, 30 Nov 2007 23:02:03 +0100
Message-ID: <***@lists.develooper.com>

[ 33097]
Upgrade to SelfLoader-1.15

[ 33098]
Upgrade to Archive-Extract-0.26

[ 33099]
Upgrade to Tie-RefHash-1.38

Affected files ...

... //depot/maint-5.10/perl/MANIFEST#6 integrate
... //depot/maint-5.10/perl/lib/Archive/Extract.pm#2 integrate
... //depot/maint-5.10/perl/lib/Archive/Extract/t/01_Archive-Extract.t#2 integrate
... //depot/maint-5.10/perl/lib/Archive/Extract/t/src/x.lzma.packed#1 branch
... //depot/maint-5.10/perl/lib/AutoLoader.pm#2 integrate
... //depot/maint-5.10/perl/lib/AutoLoader.t#2 delete
... //depot/maint-5.10/perl/lib/AutoLoader/t/01AutoLoader.t#1 branch
... //depot/maint-5.10/perl/lib/AutoLoader/t/02AutoSplit.t#1 branch
... //depot/maint-5.10/perl/lib/AutoSplit.pm#2 integrate
... //depot/maint-5.10/perl/lib/AutoSplit.t#2 delete
... //depot/maint-5.10/perl/lib/File/Temp.pm#2 integrate
... //depot/maint-5.10/perl/lib/File/Temp/t/fork.t#1 branch
... //depot/maint-5.10/perl/lib/File/Temp/t/lock.t#1 branch
... //depot/maint-5.10/perl/lib/File/Temp/t/object.t#2 integrate
... //depot/maint-5.10/perl/lib/File/Temp/t/seekable.t#2 integrate
... //depot/maint-5.10/perl/lib/Net/Ping.pm#2 integrate
... //depot/maint-5.10/perl/lib/Net/Ping/t/510_ping_udp.t#2 integrate
... //depot/maint-5.10/perl/lib/SelfLoader-buggy.t#2 delete
... //depot/maint-5.10/perl/lib/SelfLoader.pm#2 integrate
... //depot/maint-5.10/perl/lib/SelfLoader/t/01SelfLoader.t#1 branch
... //depot/maint-5.10/perl/lib/SelfLoader/t/02SelfLoader-buggy.t#1 branch
... //depot/maint-5.10/perl/lib/Tie/RefHash.pm#2 integrate
... //depot/maint-5.10/perl/lib/Tie/RefHash/threaded.t#2 integrate
... //depot/maint-5.10/perl/lib/constant.pm#2 integrate
... //depot/maint-5.10/perl/lib/constant.t#2 integrate

Differences ...

==== //depot/maint-5.10/perl/MANIFEST#6 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#5~33111~ 2008-01-29 11:03:04.000000000 -0800
+++ perl/MANIFEST 2008-01-29 14:22:25.000000000 -0800
@@ -1394,6 +1394,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
@@ -1446,10 +1447,10 @@
lib/Attribute/Handlers/t/linerep.t See if Attribute::Handlers works
lib/Attribute/Handlers/t/multi.t See if Attribute::Handlers works
lib/attributes.pm For "sub foo : attrlist"
+lib/AutoLoader/t/01AutoLoader.t See if AutoLoader works
+lib/AutoLoader/t/02AutoSplit.t See if AutoSplit works
lib/AutoLoader.pm Autoloader base class
-lib/AutoLoader.t See if AutoLoader works
lib/AutoSplit.pm Split up autoload functions
-lib/AutoSplit.t See if AutoSplit works
lib/autouse.pm Load and call a function only when it's used
lib/autouse.t See if autouse works
lib/base/Changes base.pm changelog
@@ -1894,6 +1895,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
@@ -2554,9 +2557,9 @@
lib/Search/Dict.t See if Search::Dict works
lib/SelectSaver.pm Enforce proper select scoping
lib/SelectSaver.t See if SelectSaver works
-lib/SelfLoader-buggy.t See if SelfLoader works
+lib/SelfLoader/t/02SelfLoader-buggy.t See if SelfLoader works
lib/SelfLoader.pm Load functions only on demand
-lib/SelfLoader.t See if SelfLoader works
+lib/SelfLoader/t/01SelfLoader.t See if SelfLoader works
lib/Shell.pm Make AUTOLOADed system() calls
lib/Shell.t Tests for above
lib/shellwords.pl Perl library to split into words with shell quoting

==== //depot/maint-5.10/perl/lib/Archive/Extract.pm#2 (text) ====
Index: perl/lib/Archive/Extract.pm
--- perl/lib/Archive/Extract.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/Archive/Extract.pm 2008-01-29 14:22:25.000000000 -0800
@@ -28,14 +28,15 @@
use constant BZ2 => 'bz2';
use constant TBZ => 'tbz';
use constant Z => 'Z';
+use constant LZMA => 'lzma';

use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG];

-$VERSION = '0.24';
+$VERSION = '0.26';
$PREFER_BIN = 0;
$WARN = 1;
$DEBUG = 0;
-my @Types = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z ); # same as all constants
+my @Types = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z, LZMA ); # same as all constants

local $Params::Check::VERBOSE = $Params::Check::VERBOSE = 1;

@@ -75,6 +76,7 @@
$ae->is_zip; # is it a .zip file?
$ae->is_bz2; # is it a .bz2 file?
$ae->is_tbz; # is it a .tar.bz2 or .tbz file?
+ $ae->is_lzma; # is it a .lzma file?

### absolute path to the archive you provided ###
$ae->archive;
@@ -84,13 +86,14 @@
$ae->bin_gzip # path to /bin/gzip, if found
$ae->bin_unzip # path to /bin/unzip, if found
$ae->bin_bunzip2 # path to /bin/bunzip2 if found
+ $ae->bin_unlzma # path to /bin/unlzma if found

=head1 DESCRIPTION

Archive::Extract is a generic archive extraction mechanism.

It allows you to extract any archive file of the type .tar, .tar.gz,
-.gz, .Z, tar.bz2, .tbz, .bz2 or .zip without having to worry how it
+.gz, .Z, tar.bz2, .tbz, .bz2, .zip or .lzma without having to worry how it
does so, or use different interfaces for each type by using either
perl modules, or commandline tools on your system.

@@ -101,7 +104,7 @@

### see what /bin/programs are available ###
$PROGRAMS = {};
-for my $pgm (qw[tar unzip gzip bunzip2 uncompress]) {
+for my $pgm (qw[tar unzip gzip bunzip2 uncompress unlzma]) {
$PROGRAMS->{$pgm} = can_run($pgm);
}

@@ -114,6 +117,7 @@
is_tbz => '_untar',
is_bz2 => '_bunzip2',
is_Z => '_uncompress',
+ is_lzma => '_unlzma',
};

{
@@ -183,6 +187,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.
@@ -209,6 +218,7 @@
$ar =~ /.+?\.(?:tbz2?|tar\.bz2?)$/i ? TBZ :
$ar =~ /.+?\.bz2$/i ? BZ2 :
$ar =~ /.+?\.Z$/ ? Z :
+ $ar =~ /.+?\.lzma$/ ? LZMA :
'';

}
@@ -283,9 +293,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 ) {
@@ -418,6 +428,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 +443,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 +459,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 +472,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 +500,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 it's version..
+ ### *sigh*
+ ### Even if the file exists, it won't clobber or change it.
my $buffer;
- scalar run( command => [$self->bin_bunzip2, '--version'],
+ scalar run(
+ command => [$self->bin_bunzip2, '--version', 'NoSuchFile'],
verbose => 0,
buffer => \$buffer
);
@@ -499,7 +529,6 @@
#
#################################

-
### untar wrapper... goes to either Archive::Tar or /bin/tar
### depending on $PREFER_BIN
sub _untar {
@@ -1141,6 +1170,96 @@

#################################
#
+# unlzma code
+#
+#################################
+
+### unlzma wrapper... goes to either Compress::unLZMA or /bin/unlzma
+### depending on $PREFER_BIN
+sub _unlzma {
+ my $self = shift;
+
+ my @methods = qw[_unlzma_cz _unlzma_bin];
+ @methods = reverse @methods if $PREFER_BIN;
+
+ for my $method (@methods) {
+ $self->_extractor($method) && return 1 if $self->$method();
+ }
+
+ return $self->_error(loc("Unable to unlzma file '%1'", $self->archive));
+}
+
+sub _unlzma_bin {
+ my $self = shift;
+
+ ### check for /bin/unlzma -- we need it ###
+ return $self->_error(loc("No '%1' program found", '/bin/unlzma'))
+ unless $self->bin_unlzma;
+
+ my $fh = FileHandle->new('>'. $self->_gunzip_to) or
+ return $self->_error(loc("Could not open '%1' for writing: %2",
+ $self->_gunzip_to, $! ));
+
+ my $cmd = [ $self->bin_unlzma, '-c', $self->archive ];
+
+ my $buffer;
+ unless( scalar run( command => $cmd,
+ verbose => $DEBUG,
+ buffer => \$buffer )
+ ) {
+ return $self->_error(loc("Unable to unlzma '%1': %2",
+ $self->archive, $buffer));
+ }
+
+ ### no buffers available?
+ if( !IPC::Cmd->can_capture_buffer and !$buffer ) {
+ $self->_error( $self->_no_buffer_content( $self->archive ) );
+ }
+
+ print $fh $buffer if defined $buffer;
+
+ close $fh;
+
+ ### set what files where extract, and where they went ###
+ $self->files( [$self->_gunzip_to] );
+ $self->extract_path( File::Spec->rel2abs(cwd()) );
+
+ return 1;
+}
+
+sub _unlzma_cz {
+ my $self = shift;
+
+ my $use_list = { 'Compress::unLZMA' => '0.0' };
+ unless( can_load( modules => $use_list ) ) {
+ return $self->_error(loc("You do not have '%1' installed - Please " .
+ "install it as soon as possible.", 'Compress::unLZMA'));
+ }
+
+ my $fh = FileHandle->new('>'. $self->_gunzip_to) or
+ return $self->_error(loc("Could not open '%1' for writing: %2",
+ $self->_gunzip_to, $! ));
+
+ my $buffer;
+ $buffer = Compress::unLZMA::uncompressfile( $self->archive );
+ unless ( defined $buffer ) {
+ return $self->_error(loc("Could not unlzma '%1': %2",
+ $self->archive, $@));
+ }
+
+ print $fh $buffer if defined $buffer;
+
+ close $fh;
+
+ ### set what files where extract, and where they went ###
+ $self->files( [$self->_gunzip_to] );
+ $self->extract_path( File::Spec->rel2abs(cwd()) );
+
+ return 1;
+}
+
+#################################
+#
# Error code
#
#################################
@@ -1208,7 +1327,7 @@

C<Archive::Extract> 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.

==== //depot/maint-5.10/perl/lib/Archive/Extract/t/01_Archive-Extract.t#2 (text) ====
Index: perl/lib/Archive/Extract/t/01_Archive-Extract.t
--- perl/lib/Archive/Extract/t/01_Archive-Extract.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/Archive/Extract/t/01_Archive-Extract.t 2008-01-29 14:22:25.000000000 -0800
@@ -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
@@ -291,7 +297,7 @@
### 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);


==== //depot/maint-5.10/perl/lib/Archive/Extract/t/src/x.lzma.packed#1 (text) ====
Index: perl/lib/Archive/Extract/t/src/x.lzma.packed
--- /dev/null 2008-01-25 10:48:57.533235220 -0800
+++ perl/lib/Archive/Extract/t/src/x.lzma.packed 2008-01-29 14:22:25.000000000 -0800
@@ -0,0 +1,207 @@
+#########################################################################
+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 Mon Jan 28 14:00:38 2008
+#########################################################################
+__UU__
+M(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C
+M(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(PI4:&ES(&ES(&$@8FEN87)Y
+M(&9I;&4@=&AA="!W87,@<&%C:V5D('=I=&@@=&AE("=U=7!A8VMT;V]L+G!L
+M)R!W:&EC:`II<R!I;F-L=61E9"!I;B!T:&***@4&5R;"!D:7-T<FEB=71I;VXN
+M"@I4;R!U;G!A8VL@=&AI<R!F:6QE('5S92!T:&***@9F]L;&]W:6YG(&-O;6UA
+M;F0Z"@H@("`@('5U<&%C:W1O;VPN<&P@+74@;&EB+T%R8VAI=F4O17AT<F%C
+M="]T+W-R8R]X+FQZ;6$@=75P86-K=&]O;"YP;`H*5&\@<F5C<F5A=&4@:70@
+M=7-E('1H92!F;VQL;W=I;F<@8V]M;6%N9#H*"B`@("`@=75P86-K=&]O;"YP
+M;"`M<"!U=7!A8VMT;V]L+G!L(&QI8B]!<F-H:79E+T5X=')A8W0O="]S<F,O
+M>"YL>FUA"@I#<F5A=&5D(&%T($UO;B!*86X@,C@@,3,Z-3DZ,S<@,C`P.`HC
+M(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C
+M(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C(R,C"E]?555?7PI-*%(E4#DW*4PB
+M0$E5/%8T0#Q7,5(Z-BU4+E!)53Q6-$`]5B52.T9%3CE7+%LB1S53.3(A)SDW
+M,4\\)S!:"DTN1%%/.T8\6R)'-5,Y,B$F.C9112Y#22(X-RU%.T8E33DS3"H]
+M-RU%*"0Y23LF-%HN12U0.38L6R)`22(*33$T/2DS0B%;(D)@0"@B(4DY0F!(
+M*259+***@F-5$H(CTV,S4L1RHR(5LB0F!`*")@0"@B8$`\1C51/39%***@I-.3(A
+M-C,U+%HN1#E).R8U4SPF-4,N4$A`*")@0"@B8$`H)D5-/"9=4CTB(38S-2Q:
+M+D0Y23LF-5,\)C5#"DTN4$A`*")@0#\P25TB0$DG.3<Q3SPG,%HN1%%/.T8\
+M6BY$+4\[1CE).5<U4CDR0$<[1ET_.C8]3CM7*44*33=6+4$\5C1'*C-,*B)&
+M754\0F!$,R8E4STE-5`Y)B54.3)@***@B52TH(C!0+E!(*CQ7-4(H)D%!.T8Q
+M3`I-.35=1CHV444H)TPJ*")@0"@F55DH(C%//"<***@B8$`H(U1`/%9!23E'
+M,%LB0F!`*"(A33XR8$0Y1D5,"DTY,F!`*")@***@G+***@Z-CE4*"9=***@F,4DY
+M,F!",T8U13DB(48Z-E%%-R980BM"(54\5B5'.3)`22Y02$`****@B8$`[-T1`
+M*29=53TF.4D[)C1`+S(A4SHF148](B%</R)@1RE33"HH(F!`*"(Q1CHV444H
+M(U1`/4954PI--U8M2#DV+4LW5EE!.S8T2"DF.4D[)C1)*"9%***@B,3XS4B%%
+M/#)@1S5$53,I4TPJ*")@0"@F55DH(C%-"DT[5C%%*")@0"@C5$`J)RU4.#<P
+M2"DF.4D[)C1)*C5,4C<R8$8H(V!7+5,\5RY02"HH(F!`*"9=4#DV6$`*33LW
+M1$`I)CE(*R)@0B\B*$PH(C%&.C9112)"8$`H(F!`*")@0#M7*$`Y)EQ`/E(A
+***@W*4XH(BDC.U<U3`I-.2(A3CM7,$`[5R%%.T(A23M'(54](B%&***@B
+M,48Z-E%%+D)@1"@R*%LH)C58.C<P0"PB(5TN4$A`"DTH(F!`.S=$0"DG+50\
+M0F!=*"***@G3$`[)EU#.#900"DB7%LH(U!$.49`***@G5%LB0$A`*")@0"A2
+M+$,****@G-4X\)B5#.E-<****@B8$`H)E59*"(Q3STW,5,])RA;(D)@0"@B(4DY
+M0D!`*29=4#TG+$TO1TU5/S)@20I-*"=,****@B8$`H(F!`*"(A23E"0$`H,C%/
+M/3<Q1CHV444H(D1`/E!(0"@B8$`H(F!`*")@0"@B8$0[5S54"DTY1D5,.3)@
+***@B,48Z-E%%+E!(0"@B8$`H(F!`*")@0"@B8$0[5S54.49%3#DR8%T_0B%3
+M*U503CPF)4,*33I6-40W)TA/*U-,****@B8$`H(F!`*"(A72)"8$`H(F!`*")@
+M0#LW1$`J(C%(.38E1"LB8$0X1EU$/C)$0`I-+S(A4SPF44D](F!/-U5=-34U
+M73\W)EA/*R)@1#Q7,5(N4$A`*")@0"@B8$`H)C%).3)@0C!6)4XI5S!`"DT]
+M-EE0.#***@F54$[)CE//$9513DB(40X-S%!*"9%***@B/$0Y1D5,.3(]/#M"
+M*"HH(F!`*")@0"@B8$`****@B8$`Z-CA`*#(Q2#DV)40N4$A`*")@0"@B8$`H
+M(C%//3<Q4STG*$`O,B%5.T<A03A63$`I5S1'*R)@1`I-.$9=1#XS3"HB0F!`
+M*"(***@F-4P\5C1`/E!(0"@B8$`H(F!`*"(Q3STW,48Z-E%%*"=17"\R8$0Y
+M1D5,"DTY,F!.*"(\3CPF)4,Z5C5$*5-,*B)"8$`H(F!`*")@0#LW1$`I)E5%
+M*"-40#A&)5,Y-EE!.S8T2"DC8$D*32Y02"HH(F!`*")@0"@B8$0[5S54/%<Q
+***@C5$`O(U!",31=)C!$434T1"A"*")80#PF)4,Z4F!'/3(\3`I-*"(Q4STG
+M*%LB0BQ#*%(L0RA2+$,H4BQ#*%(L0RA2+$,H4BQ#*%(L0RA2+$,H4BQ#*%(L
+M0RA2+$,H4BQ#"DTH4BQ#*%(L0RA2+$,H4BQ#*%(L0RA2+$,H4BQ#*%(L0RA2
+M+$,H4BQ#*%(L0RA2+"HU)D%)/%(A23Q2(4$****@F*4D[1B52/C(A1CHV444H
+M)S%(.#<P0#U6)5,H)R%!.%9-13DB(5<Z-S%(*"<Q2#DR8$<]-S50.#8M2PI-
+M/29=3SLB65`[(CQ`/59!23A60"HZ-RQ`.C990SLG-40Y-C!`.C980#TF044H
+M)2%%/$900#DF15,])RE)"DTX1S54.C9=3BM`2"HU)EQ`/3994#@V+4LH)S%(
+M.C<L0#E&14PY,B%5/%8T0#TF044H)CE/.R913SU614X*33E2(4,[5E5-.#99
+M1"Y`2"HH(F!`*")@1#LV-$`K-S1`*29=53TF.4D[)C1`*28Y23LF-"HB13%/
+M*"<I10I-.%<***@W,44H)D54*"<U4SDR(50Z)C1`.49=3#LF75<Z-EE'*"8M
+M3SLV54$[1C!:(D!(0"@B8$`H(C%-"DTY,F!-/")@1#E&14PY,F!$.U<U5#E&
+M14PY,$@J,%<***@W,44Y(B%!/2(A8#Y535,X5B5,.#<H0#LF74,****@V450Z
+M-E5%-S=4*BA2+$,H4BQ#*%(L0RA2+$,H4BQ#*%(L0RA2+$,H4BQ#*%(L0RA2
+M+$,H4BQ#*%(L0PI-*%(L0RA2+$,H4BQ#*%(L0RA2+$,H4BQ#*%(L0RA2+$,H
+M4BQ#*%(L0RA2+$,H4BQ#*%!)/S=5-34W55PJ"DTQ-%TF,$11-31$*"HH(F!`
+M*"=4*B)"8$`H(F!#*%(L0#M7-50\)S54*"<Q2#DR(48Z-E%%(D)@0"@B(4D*
+M33E"0$`I)EU0/2<L32]'3$<\4CU=*")$0#Y02$`H(F!`*")@0"@G(5(Z-EE4
+M*"4M-#$D734U(F!$.U<U5`I-/%<Q4BY02$`H(F!`/S(A13LG+44H)TPJ*")@
+M0"@B8$`H(F!$.U<U5#E&14PY,F!=*"4Y+3132%HQ1D5,"DTY-RU0.38L6BY'
+M.4T\5D5&/C)`1#M7-50Y1D5,.3)$0#HV.$`I)5DO*"***@B/38S-2Q'+E!(
+M0"@B8$`****@B8$`H)R%2.C995"@B*3<\***@B,48Z-E%%*"9%3CTF
+M7$`I)EU5/28Y23LF-3P[0BA`.C8X0`I-*29=4#TG+$TO1TQ'/4(]72Y02$`H
+M(F!`*")@0"@F75`Y-EA`.S=$0"DF754])CE(*R)@0B]"*$PH(C%/"DT]-S%&
+M.C9112)"8$`H(F!`*")@0"@B8$`H)EU2*"***@G3$`]5B52.T)@0C!6754[
+M)C!`.T9=5"@F75`*33DV6$`I)EU5/28Y23LF-$`Y1EU2*"<]4CHW,4D[1CQ:
+M*"(P02A#3$`Y-T%)/2)@4"@G5%LB0F!`*")@0`I-*")@0#A&14X[-EU$.3)@
+M1#M7-50Y1D!;(D)@0"@B8$`H(F!`*%(***@B,4\]-S%3/2<H0#LV14<Z)S!`
+M"DTX1C1`.3954#TG1$PH)D5&*"<Q2#DR(48Z-E%%*"<]03Q2(44[-R%4/C!(
+M0"@B8$`H(F!`*"<A4CHV650****@B,4\]-S%&.B)@1#M7-50\5S%2*"9%***@B
+M,4\]-S%3/2<H6R)"8$`H(F!`*")@0#A644\\5C1`*29=50I-/28Y2"Y02"HH
+M(F!`*")@0"@B(4,Z)E5/.2)@1#LV740Y,E!`*29=53TF.4D[)C1;(D)@0"@B
+M(5TB0$A`"DTH(F!`*%(***@F,44[)C54.3(A4SM7-5(X5C1`.49%3#DS7"HH
+M(F!`*"9%1BHB8$0[5R%4/%)47CY2/20*32E75$`X-EE$*"(Q1CHV444H)EE%
+M*"(Q3STW,48Z-E%%*")$0#Y02$`H(F!`*")@0"@C)$`]5D%).R8T0`I-/399
+M3#HV64LH(C%&.C9112Y02$`H(F!`/S!)72)`25,]-BA`.$<U3#I575`\1EU#
+M.3<***@G3"HH(F!`"DTH)E59*"(Q3SPG,5,H(U1`/%9!23E',%LB0F!`*"(A
+M33XR8$0S-B5..C8Y13Q7,$`O,F!$.U<A5#Q25%X*33Y2/4TI5U1;(D!(0"@B
+M8$`[5R%%.T(A33XR8$0Y1D!,*"(H7"A"4$`I)%5!.T9%1CDW+50H)EU2*"8Q
+M20I-.3)@0C!6754[)C!`.T9=5"@F75`Y-EA`*5(Q+***@V64DY1C53/2(\6BDB
+M)$(N4$@J*")@0"@G(5(Z-EE4"DTH(BDR.38E1#HV64<H(C$M.#9923E&-5,]
+M)5%.*$!(0"@B8$`H(F!`*")@0"@B(4DY0F!$.U<A5#Q25%X*33Y2/58I5U1;
+M(D!(0"@B8$`[-T1`*28M3STV650H(U1`+"-,****@B8$`H)E59*"(Q3#HV644\
+M4F!=*"-@6PI-(D)@0"@B(5<Z)D5,.3)`0#LW1$`I)E%).T8T0"\R8%PI)CE(
+M+T)@***@G3"HH(F!`*")@0"@B(4,Z)EU-"DT\(F!$.R9%3CDS3"HH(F!`*")@
+M0"@B(4T^,F!(*28Y23LF-$DH(U1`/%<A3#HW,$`K55%3*E)<3"@B,4P*33HV
+M644N4$@J*")@0"@B8$`H(F!$.R9%3CDW+$LJ4TPJ(D)@0"@B8$`H(F!`.T8U
+M6#TB(54[1E%%/%<L0`I-*28Y23LF-$`O-UA`*U503CPF)4,Z5C5$*U-,*B)"
+M8$`H(F!`*")@0"DF+4\]-EE4*E),6R)`2$`H(F!`"DTH(F!`*"***@B,4\]
+M-S!`+S)@1#E&14PY,TPJ*")@0"@B8$`H(F!$.U<U5"@C55XH)RQ/-R)94#@V
+M+4L*33DV,3P^0EQ/+E!(0"@B8$`H(F!`*"(Q3STW,$`O,B%6.S<M/SA6044X
+M5DT_.T8E33DR0$0[5S54*C(A20I-.4)@1#=$7$`Y-R1`*54Y+312/%LB0$A`
+M*")@0"@B8$`H(BQ#*%(A53M'(4$X5DPJ*")@0"@B8$`H(B%)"DTY0D!`*#(Q
+M3SPG,5,K,UE;*58L1S\R8$DH)TPJ*")@0"@B8$`H(F!`*")@0"HB8$0[5S54
+M*R)@1#E&14P*33DR8$DH(U1`*B)@1#E&14PY,E!`*29=53TB8$DH)D5&*"(Q
+M3SPG,5,K,UE;*5=@1S\S3"HH(F!`*")@0`I-*")@0"@B8$`Z-CA`*B)***@B
+M,4\]-S!)*"=,****@B8$`H(F!`*")@0"@B8$`H(F!`*"***@B,4,Z)B5."DTY
+M5C5$*"-40"LT5$`W4TPJ*")@0"@B8$`H(F!`*")@0"@B8$`H)D5&*")`1#A6
+M04$[1CU%.2)@7"@B,2P****@W+50U-R%$.#<***@F)4XY(F!$.%9!03M&/44Y
+M(F!<*")5+***@B,48Z-E%%*C(A6R)"8$`H(F!`*")@0`I-*")@0"@B8$`H(F!`
+M*")@0#PG*4D[1S!`*$4M2SHW(5`Z-EE'*"(\1#E&14PY,CQ`.#<L0"E2,4\]
+M-S!'"DTH)D53*"<U4"LW,4\K-C%!/28T3C<F6$(B0F!`*")@0"@B8$`H(F!`
+M*")@0"@B8$`H(F!`*")@0"@F148****@B,4\\)S%3*S-96RE7.$<_,TPJ*")@
+M0"@B8$`H(F!`*")@0"@B8$`H(F!`*"(A3CDW050N4$A`*")@0`I-*")@0"@B
+M8$`H(F!`*")@0#\P2$`H(F!`*")@0"@B8$`H(B%=(D)@0"@B8$`H(F!`*")@
+M0"@F04$[1C%,"DTY-5U&.C9112HB,4\\)S%3*R)@1#E&14PY,E!`*29=53TB
+M1%LB0F!`*")@0"@B8$`H(F!`*"<A4CHV650****@B*2,[5EE6.3<I5#DV,$`I
+M4C%&.C9112E2(50[4F!'*29=53TB/3P[***@J*")@0"@B8$`H(F!`*")@0`I-
+M*")@0"@F148H(C%//"<Q4RLS65LI5SA'/S-,*B)"8$`H(F!`*")@0"A2+$,H
+M)BU,***@G-5`B0F!`"DTH(F!`*")@0#\R(44[)RU%*"=,*B)"8$`H(F!`
+M*")@0"@B8$`H(BQ#*%(A1CHV444H)C58.C<M5#Q37"H****@B8$`H(F!`*")@
+M0"@B8$`]-EE,.3<M4RHB8$TY,F!$.U<U5"@B1$`^4$A`*")@0"@B8$`H(F!`
+M*")@0`I-*")@0#PG*4D[1S!`*$0Y23LF-$`I4C%&.C9112E2(5<X-RQ`.T9=
+M5"@G-4X\)B5#.E8U1"@F14X])EQ`"DTI4C%//3<P1RM"(2,X-EA`.T9=5"@G
+M*44[-EU6.3)9/#M"*%LB0$A`*")@0"@B8$`H(F!`*")@0RA2+$`*33Q&-4T[
+M5SE%*"9%5")"8$`H(F!`*")@0"@B8$`H)U1`.3914SDR(5LB0F!`*")@0"@B
+M8$`H(F!`*")@0`I-*"(A4#Q&14X](F!"-$8U33M7.4D[1CQ`*5(Q3STW,$<W
+M)EA"+E!(0"@B8$`H(F!`*")@0"@B8$`H(F!`"DTL,B%7.B9%3#DR(54[1E%)
+M.T9,0"DF754](TPJ*")@0"@B8$`H(F!`*")@0#\P2$`H(F!`*")@0"@G5"H*
+***@B8$`H)U0J*")@0"@G(5(Z-EE4*"(I)CM7-4XY(F!$.%9=53M',$`Y1D5,
+M.3<L0#TF7$`\)RE/.%8U4PI-/%(A3STW,$`[5CA`*29123M&-5,H)D5.*"(\
+M1#,V)4XZ-CE%/%<P1S<F6$(B0F!`*")@0"@B8$`H(F!`"DTH)D5&*"(Q3SPG
+M,5,K,UE;*5<X1S\S3"H_,$@J/%<***@G-5,X-CU%*"=,****@B8$`H)RE%/2<U
+M4CM"(5$*33PU3"HU-RU!***@B,3XV(F!$+"(A.RLV,$`Y)D52-S(A.RLW
+M.3TH)4Q-.%540#92520W,F!-/"=030I-/3(A.SM7*4DY4B$[/"8E0SI6-40_
+M(E53-S(A7"@B54TH)4U-.#9923E&-5,])54](D!(0"@B8$`R)B5."DTY)E%%
+M*"8I23M&)5(^,B%&.C9113Q2(4D[0B%3.U<U4CA6-$`])RE%.3)80#!6)4XH
+M)BE%*"<U4SDV,$`*33TF7$`\)B5#.E(A3SQ`2$`H(F!`/3994#@V+4LH)CE)
+***@F14XY)D56.C8Q23TV)4P[)T1`.U<H0`I-.#<L0#Q7(44X5D5&.C8U
+M1"@F*5DH)B1`.S8E3CHV.44\5S!`.49%3#DR6"HB1%U0/29%3SM'+%HB0F!`
+M"DTH(F!-/3)@0#4V65`X-BU+*"8Y23LF-5,H(D%$.38Y03TV450\4B%4.U)@
+M33TR(54[1E%%/%<L0"LW8$`*33HW+$`\5R%%.%9%1CHV-40J,$A`*")@0"LW
+M8$`H)2%!.%9,0#E&14PY-RPJ*")@0"@B54,H(B$C.R8U00I-.T(A53PB(4$[
+M)E!`/3994#@V+4LY-C!`.49%3#DW+$XH)$5-/"9123DW+$`K-E0J(D)@0"@B
+M8$TQ(F!`"DTQ)C5,.3<***@G+4\]-RE#.3(A1CHV444H)B5&/***@F-4XX
+M5EU$.C991RM6,44X5EU$.C991R)`2$`****@B8$`K-RQ`*"1=53TG(54](B%4
+M.U(A,S4D,2\U-3!`/$8E5#HF-5(H)S%(.#980#-5-30T)34T-U0Y*0I-,R0T
+M****@B8$`H(E5-*"(A-3Q6-$`[-B5..C8Y13Q7,$`Y1D5,.3)00#HV.$`[1EU.
+M.3(A23Q2(44^)R%,"DTZ-BU)/***@G(5([5SE).28U1"@F,44Y1B55.R<Q
+***@G,4\H(CTM,#19*3%$-3,U(CPJ(D)@0"@B8$T*33DB8$`P5D%!.T8]***@F
+M,4D\1C5#/29=4CXR(50[4B%$.C<H0#A&-48[5RE%*"<A4CM6+44\5RU).T8\
+M*@I-(D)@0"@B8$T]0F!`-$<***@G.44\1BE//%8U3#XP2$`H(F!`*S9`0"@D
+M,4D\5R%,.#=$0#TF04D\4B%("DTY-E%0*"9513Q7+4$Y5C0J-S-,*C\P2"H\
+M5S5"*"<Y33Q574,Z)C5#.E5=***@V544H)TPJ(D(L0#0F)4,*33I6-40H)CE)
+***@G,44[1C!`/29<0#HF)58Y,B%-/3915#HW(4PY,B%$.U<Q4RLB(5<Z
+M)D5#.B(A5`I-.B8T0#!5*30S(B%-.#=$0#M7*$`[-B59*"993STB(***@X-EE$
+M.R8T*BA2(5`\1EU0.3<I3#XR4$`\5EQ`"DTX5EU./48U4CTB(50[4B%..#<Q
+M23U&-$`Y1EU2.S8E5"M"8$`P-EE$*"8Q13PF-4XY)D5..5(A3SM"(4@*33M7
+M/$`])D%%*"8E4CA604D]1C1`/58E4R)"+$`]-EE0.#8M2SDV,$PH)CE/.U)9
+***@W*$XX1B5:*"9500I-/C(A0CDR(48[5ET_.$8E4BM&*4$^0B%//$(A1CM6
+M7$XX1B52-U8I03Y"6$`H)%A.,$)80#4F04D\4B%#"DTZ)C5#.E<L0#E&75(B
+M0BQ`.3=!23Q7,44[1BU%*R(A4SM2(4D\4B%..U<P0#Q7-4D])B5".R8T0#@W
+M+$T*33HW+$`])EQ`.58U3CDW*4$])C1`,U0Q,RLS*$T\5B5&.3(***@V544\
+M4B%).T(A4#Q&-5`X-RE!/29%3PI-.T!(***@F.4\\0B%&***@F+5(Y-B54
+M.C9=3BM`2"HH(F!`*"***@B,48Z-E%%*"-40#Q604DY1S!;"DTB0$A`*")@
+M0"DF.4D[)C1`+S(A-C,U+%HN1#E).R8U4SPF-4,N0TE6.S<M23E'1$@I)CE)
+M.R8T22Y02$`****@B8$`\1C54/3<***@B,48Z-E%%*"9%***@B544H(C%&.C91
+M12Y02"HH(F!`*"***@B0$0]1EU,*R(Q1`I-.C<I4RLB,4(X-RU%*C)@***@D
+M.4D[)C1:+D4M4#DV+$TO1RU0.R9%5#PF)50Z(D!$.49%3#DR1%LB0F!`"DTH
+M(B%-/C)@1#TF55`H(U1`*28I03Q6-%LB0F!`*")@***@G/***@Z-E%%*"(Q5#LW
+M8$`O-UA`/%)<2#9563P*32M%5$LJ-5!.*B)82S<B6$XJ4D1/*2,E/RDC*$\N
+M4$A`*")@0#LW1$`I)S%2/C)@***@D.4D[)C1:+D4M4`I-.38L32]&+4$])R%!
+M/29`2"DG.4\[(E!`*28Q23Q'+$PH(C%4.S=@22Y02$`H(F!`/$8U5#TW*4XH
+M(C%4"DT\1T1`.C8X0"LV-$`I)S%2/C-,*B)"8$`H(F!$/2954"@C5$`I)BE!
+M/%8T6R)"8$`H(F!1*"<]2#HV444****@B,50[-V!`+S=80#Q27$@K0DT\*T)8
+M2RHU4$XJ)4T^-R)9/2I21$\I(R4_*2,H3RY02$`H(F!`*2<***@I-/C)@***@D
+M.4D[)C1:+D4M4#DV+$TO1BU!/2<A03TF0$@I)SE/.R)00"DF,4D\1RQ,*"(Q
+M5#LW8$DN4$A`"DTH(F!`/$8U5#TW*4XH(C%4/$=$0#HV.$`K-C1`*2<Q4CXS
+M3"HB0F!`*"(A4CDW,54\1EA`*28Y23LF-%L*32)'5"HB1E59*"(Q3SPG,5,H
+M(U1`/E=46R)$/44])%U0/29%3SM'+$@I)EU0/2<L3"E7-$<K(CU0*5)01PI-
+M.%(\3"@B/20I4E!`*5946CQ2/$PI5RQ'*R(]1"\W+$<K(CU6*5)01SHB/$DN
+M4$@J.29%***@B*2,X-EA'"DT](B%0.#***@F)4XY(B%5.T<A03A63$`X-S!`
+M/29!***@G+4$[-C1`/29%33DR)3P[0BA,*"<***@V/44*32HB1"HH(F!`*"9%
+***@B,4\\)S%3*S-96RE7-$<_,F!&*4)@1#M7(50\4E1>/E(]4"E75%LB1C%)
+M.3(A50I-/%8E1SDR0$DH)D5&*"(Q3SPG,5,K,UE;*59`1S\S3"HB1D5&*")`
+M0"DF75`])RQ-+T=,1SDB/5TH(D1`"DT^4$A`*")@0#A6040Z-RA`*29=4#TG
+M+$TO1TQ'.2(]72)"8$`H(F!`*")@0#M7*$`Y)D5%*"(I)***@V14P*33DV,$`]
+M)EQ`.%9!1#HW*$`])EQ`*5(Q3SPG,5,K,UE;*58P1S\R/%HI(B1"+E!)72)"
+M,4\\)S%3*S-96PI-*5<T1S\R8%TH(R1`.C8X0"@R,4\\)S%3*S-96RE78$<_
+M,TPJ.$9%3CLV740Y,B$S-20Q+S4U,$`Z-CA`"DTI)EU0/2<L32]'3$<\4CU=
+M+E!)23E"8$@H)C58.C<M5#Q28$0[5R%4/%)47CY2/4TI5U1`.U<H0#DW04D*
+M33Q7,5,H(C%//"<Q4RLS65LI5BQ'/S)@***@G3"HH(F!`*"(Q3SPG,5,K,UE;
+M*5941S\R(5P_(U1`*$15(0I-,T1%)C$U+30H0TPJ*")@0"@F*54[)DT_/"<I
+M3SA6-5,\4D!$.U<A5#Q21%LB0F!`*"(A13XF150J(V!)"DTN4$E=*"8U3#Q6
+M-$`^4$A`*")@0#HV.$`J)"$A-$0]-BHR(5LB0F!`*")@0"@B8$`Z)B5..291
+M13=6.4D*33LF-$@I)EU0/2<L3"@D(2$T1#TV*C-,****@B8$`H)U1`.3914SDR
+M(5LB0F!`*")@0"@B8$`Y)D5%*"(I+@I-.U(A1CHV444H)S%/*"<A4CM6+44\
+M5RQ`/%<A13A6148Z-C5$*#513BA"4$`]-RU!.58T2"HS3"HH(F!`"D$H)U0J
+I*")@0"@F-***@Z-S!(+")$6R)'5"HB0$E$.C8T0#TW+4$Y5C1(*C-,*@H`

==== //depot/maint-5.10/perl/lib/AutoLoader.pm#2 (text) ====
Index: perl/lib/AutoLoader.pm
--- perl/lib/AutoLoader.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/AutoLoader.pm 2008-01-29 14:22:25.000000000 -0800
@@ -15,7 +15,7 @@
$is_epoc = $^O eq 'epoc';
$is_vms = $^O eq 'VMS';
$is_macos = $^O eq 'MacOS';
- $VERSION = '5.63';
+ $VERSION = '5.64_01';
}

AUTOLOAD {
@@ -51,21 +51,6 @@
goto &$sub;
}

-sub can {
- my ($self, $method) = @_;
-
- my $parent = $self->SUPER::can( $method );
- return $parent if $parent;
-
- my $package = ref( $self ) || $self;
- my $filename = AutoLoader::find_filename( $package . '::' . $method );
- local $@;
- return unless eval { require $filename };
-
- no strict 'refs';
- return \&{ $package . '::' . $method };
-}
-
sub find_filename {
my $sub = shift;
my $filename;
@@ -152,7 +137,6 @@
if ( @_ and $_[0] =~ /^&?AUTOLOAD$/ ) {
no strict 'refs';
*{ $callpkg . '::AUTOLOAD' } = \&AUTOLOAD;
- *{ $callpkg . '::can' } = \&can;
}
}

@@ -198,7 +182,7 @@

no strict 'refs';

- for my $exported (qw( AUTOLOAD can )) {
+ for my $exported (qw( AUTOLOAD )) {
my $symname = $callpkg . '::' . $exported;
undef *{ $symname } if \&{ $symname } == \&{ $exported };
*{ $symname } = \&{ $symname };
@@ -369,4 +353,73 @@

L<SelfLoader> - an autoloader that doesn't use external files.

+=head1 AUTHOR
+
+C<AutoLoader> is maintained by the perl5-porters. Please direct
+any questions to the canonical mailing list. Anything that
+is applicable to the CPAN release can be sent to its maintainer,
+though.
+
+Author and Maintainer: The Perl5-Porters <perl5-***@perl.org>
+
+Maintainer of the CPAN release: Steffen Mueller <***@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This package has been part of the perl core since the first release
+of perl5. It has been released separately to CPAN so older installations
+can benefit from bug fixes.
+
+This package has the same copyright and license as the perl core:
+
+ Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
+
+ All rights reserved.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of either:
+
+ a) the GNU General Public License as published by the Free
+ Software Foundation; either version 1, or (at your option) any
+ later version, or
+
+ b) the "Artistic License" which comes with this Kit.
+
+ This program 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. See either
+ the GNU General Public License or the Artistic License for more details.
+
+ You should have received a copy of the Artistic License with this
+ Kit, in the file named "Artistic". If not, I'll be glad to provide one.
+
+ You should also have received a copy of the GNU General Public License
+ along with this program in the file named "Copying". If not, write to the
+ Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+ 02111-1307, USA or visit their web page on the internet at
+ http://www.gnu.org/copyleft/gpl.html.
+
+ For those of you that choose to use the GNU General Public License,
+ my interpretation of the GNU General Public License is that no Perl
+ script falls under the terms of the GPL unless you explicitly put
+ said script under the terms of the GPL yourself. Furthermore, any
+ object code linked with perl does not automatically fall under the
+ terms of the GPL, provided such object code only adds definitions
+ of subroutines and variables, and does not otherwise impair the
+ resulting interpreter from executing any standard Perl script. I
+ consider linking in C subroutines in this manner to be the moral
+ equivalent of defining subroutines in the Perl language itself. You
+ may sell such an object file as proprietary provided that you provide
+ or offer to provide the Perl source, as specified by the GNU General
+ Public License. (This is merely an alternate way of specifying input
+ to the program.) You may also sell a binary produced by the dumping of
+ a running Perl script that belongs to you, provided that you provide or
+ offer to provide the Perl source as specified by the GPL. (The
+ fact that a Perl interpreter and your code are in the same binary file
+ is, in this case, a form of mere aggregation.) This is my interpretation
+ of the GPL. If you still have concerns or difficulties understanding
+ my intent, feel free to contact me. Of course, the Artistic License
+ spells all this out for your protection, so you may prefer to use that.
+
=cut

==== //depot/maint-5.10/perl/lib/AutoLoader/t/01AutoLoader.t#1 (xtext) ====
Index: perl/lib/AutoLoader/t/01AutoLoader.t
--- /dev/null 2008-01-25 10:48:57.533235220 -0800
+++ perl/lib/AutoLoader/t/01AutoLoader.t 2008-01-29 14:22:25.000000000 -0800
@@ -0,0 +1,173 @@
+#!./perl -w
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+}
+
+use strict;
+use File::Spec;
+use File::Path;
+
+my $dir;
+BEGIN
+{
+ $dir = File::Spec->catdir( "auto-$$" );
+ unshift @INC, $dir;
+}
+
+use Test::More tests => 17;
+
+# First we must set up some autoloader files
+my $fulldir = File::Spec->catdir( $dir, 'auto', 'Foo' );
+mkpath( $fulldir ) or die "Can't mkdir '$fulldir': $!";
+
+open(FOO, '>', File::Spec->catfile( $fulldir, 'foo.al' ))
+ or die "Can't open foo file: $!";
+print FOO <<'EOT';
+package Foo;
+sub foo { shift; shift || "foo" }
+1;
+EOT
+close(FOO);
+
+open(BAZ, '>', File::Spec->catfile( $fulldir, 'bazmarkhian.al' ))
+ or die "Can't open bazmarkhian file: $!";
+print BAZ <<'EOT';
+package Foo;
+sub bazmarkhianish { shift; shift || "baz" }
+1;
+EOT
+close(BAZ);
+
+open(BLECH, '>', File::Spec->catfile( $fulldir, 'blechanawilla.al' ))
+ or die "Can't open blech file: $!";
+print BLECH <<'EOT';
+package Foo;
+sub blechanawilla { compilation error (
+EOT
+close(BLECH);
+
+# This is just to keep the old SVR3 systems happy; they may fail
+# to find the above file so we duplicate it where they should find it.
+open(BLECH, '>', File::Spec->catfile( $fulldir, 'blechanawil.al' ))
+ or die "Can't open blech file: $!";
+print BLECH <<'EOT';
+package Foo;
+sub blechanawilla { compilation error (
+EOT
+close(BLECH);
+
+# Let's define the package
+package Foo;
+require AutoLoader;
+AutoLoader->import( 'AUTOLOAD' );
+
+sub new { bless {}, shift };
+sub foo;
+sub bazmarkhianish;
+
+package main;
+
+my $foo = Foo->new();
+
+my $result = $foo->can( 'foo' );
+ok( $result, 'can() first time' );
+is( $foo->foo, 'foo', 'autoloaded first time' );
+is( $foo->foo, 'foo', 'regular call' );
+is( $result, \&Foo::foo, 'can() returns ref to regular installed sub' );
+
+eval {
+ $foo->will_fail;
+};
+like( $@, qr/^Can't locate/, 'undefined method' );
+
+$result = $foo->can( 'will_fail' );
+ok( ! $result, 'can() should fail on undefined methods' );
+
+# Used to be trouble with this
+eval {
+ my $foo = Foo->new();
+ die "oops";
+};
+like( $@, qr/oops/, 'indirect method call' );
+
+# Pass regular expression variable to autoloaded function. This used
+# to go wrong because AutoLoader used regular expressions to generate
+# autoloaded filename.
+'foo' =~ /(\w+)/;
+
+is( $foo->bazmarkhianish($1), 'foo', 'autoloaded method should not stomp match vars' );
+is( $foo->bazmarkhianish($1), 'foo', '(again)' );
+
+# Used to retry long subnames with shorter filenames on any old
+# exception, including compilation error. Now AutoLoader only
+# tries shorter filenames if it can't find the long one.
+eval {
+ $foo->blechanawilla;
+};
+like( $@, qr/syntax error/i, 'require error propagates' );
+
+# test recursive autoloads
+open(F, '>', File::Spec->catfile( $fulldir, 'a.al'))
+ or die "Cannot make 'a' file: $!";
+print F <<'EOT';
+package Foo;
+BEGIN { b() }
+sub a { ::ok( 1, 'adding a new autoloaded method' ); }
+1;
+EOT
+close(F);
+
+open(F, '>', File::Spec->catfile( $fulldir, 'b.al'))
+ or die "Cannot make 'b' file: $!";
+print F <<'EOT';
+package Foo;
+sub b { ::ok( 1, 'adding a new autoloaded method' ) }
+1;
+EOT
+close(F);
+Foo::a();
+
+package Bar;
+AutoLoader->import();
+::ok( ! defined &AUTOLOAD, 'AutoLoader should not export AUTOLOAD by default' );
+::ok( ! defined &can, '... nor can()' );
+
+package Foo;
+AutoLoader->unimport();
+eval { Foo->baz() };
+::like( $@, qr/locate object method "baz"/,
+ 'unimport() should remove imported AUTOLOAD()' );
+
+package Baz;
+
+sub AUTOLOAD { 'i am here' }
+
+AutoLoader->import();
+AutoLoader->unimport();
+
+::is( Baz->AUTOLOAD(), 'i am here', '... but not non-imported AUTOLOAD()' );
+
+
+package SomeClass;
+use AutoLoader 'AUTOLOAD';
+sub new {
+ bless {} => shift;
+}
+
+package main;
+
+$INC{"SomeClass.pm"} = $0; # Prepare possible recursion
+{
+ my $p = SomeClass->new();
+} # <-- deep recursion in AUTOLOAD looking for SomeClass::DESTROY?
+::ok(1, "AutoLoader shouldn't loop forever if \%INC is modified");
+
+# cleanup
+END {
+ return unless $dir && -d $dir;
+ rmtree $dir;
+}

==== //depot/maint-5.10/perl/lib/AutoLoader/t/02AutoSplit.t#1 (text) ====
Index: perl/lib/AutoLoader/t/02AutoSplit.t
--- /dev/null 2008-01-25 10:48:57.533235220 -0800
+++ perl/lib/AutoLoader/t/02AutoSplit.t 2008-01-29 14:22:25.000000000 -0800
@@ -0,0 +1,417 @@
+# AutoLoader.t runs before this test, so it seems safe to assume that it will
+# work.
+
+my($incdir, $lib);
+BEGIN {
+ chdir 't' if -d 't';
+ if ($^O eq 'dos') {
+ print "1..0 # This test is not 8.3-aware.\n";
+ exit 0;
+ }
+ if ($^O eq 'MacOS') {
+ $incdir = ":auto-$$";
+ $lib = '-I::lib:';
+ } else {
+ $incdir = "auto-$$";
+ $lib = '"-I../lib"'; # ok on unix, nt, The extra \" are for VMS
+ }
+ unshift @INC, $incdir;
+ unshift @INC, '../lib';
+}
+my $runperl = "$^X $lib";
+
+use warnings;
+use strict;
+use Test::More tests => 58;
+use File::Spec;
+use File::Find;
+
+require AutoSplit; # Run time. Check it compiles.
+ok (1, "AutoSplit loaded");
+
+END {
+ use File::Path;
+ print "# $incdir being removed...\n";
+ rmtree($incdir);
+}
+
+mkdir $incdir,0755;
+
+my @tests;
+{
+ # local this else it buggers up the chomp() below.
+ # Hmm. Would be nice to have this as a regexp.
+ local $/
+ = "################################################################\n";
+ @tests = <DATA>;
+ close DATA;
+}
+
+my $pathsep = $^O eq 'MSWin32' ? '\\' : $^O eq 'MacOS' ? ':' : '/';
+my $endpathsep = $^O eq 'MacOS' ? ':' : '';
+
+sub split_a_file {
+ my $contents = shift;
+ my $file = $_[0];
+ if (defined $contents) {
+ open FILE, ">$file" or die "Can't open $file: $!";
+ print FILE $contents;
+ close FILE or die "Can't close $file: $!";
+ }
+
+ # Assumption: no characters in arguments need escaping from the shell or perl
+ my $com = qq($runperl -e "use AutoSplit; autosplit (qw(@_))");
+ print "# command: $com\n";
+ # There may be a way to capture STDOUT without spawning a child process, but
+ # it's probably worthwhile spawning, as it ensures that nothing in AutoSplit
+ # can load functions from split modules into this perl.
+ my $output = `$com`;
+ warn "Exit status $? from running: >>$com<<" if $?;
+ return $output;
+}
+
+my $i = 0;
+my $dir = File::Spec->catdir($incdir, 'auto');
+if ($^O eq 'VMS') {
+ $dir = VMS::Filespec::unixify($dir);
+ $dir =~ s/\/$//;
+} elsif ($^O eq 'MacOS') {
+ $dir =~ s/:$//;
+}
+
+foreach (@tests) {
+ my $module = 'A' . $i . '_' . $$ . 'splittest';
+ my $file = File::Spec->catfile($incdir,"$module.pm");
+ s/\*INC\*/$incdir/gm;
+ s/\*DIR\*/$dir/gm;
+ s/\*MOD\*/$module/gm;
+ s/\*PATHSEP\*/$pathsep/gm;
+ s/\*ENDPATHSEP\*/$endpathsep/gm;
+ s#//#/#gm;
+ # Build a hash for this test.
+ my %args = /^\#\#\ ([^\n]*)\n # Key is on a line starting ##
+ ((?:[^\#]+ # Any number of characters not #
+ | \#(?!\#) # or a # character not followed by #
+ | (?<!\n)\# # or a # character not preceded by \n
+ )*)/sgmx;
+ foreach ($args{Name}, $args{Require}, $args{Extra}) {
+ chomp $_ if defined $_;
+ }
+ $args{Get} ||= '';
+
+ my @extra_args = !defined $args{Extra} ? () : split /,/, $args{Extra};
+ my ($output, $body);
+ if ($args{File}) {
+ $body ="package $module;\n" . $args{File};
+ $output = split_a_file ($body, $file, $dir, @extra_args);
+ } else {
+ # Repeat tests
+ $output = split_a_file (undef, $file, $dir, @extra_args);
+ }
+
+ if ($^O eq 'VMS') {
+ my ($filespec, $replacement);
+ while ($output =~ m/(\[.+\])/) {
+ $filespec = $1;
+ $replacement = VMS::Filespec::unixify($filespec);
+ $replacement =~ s/\/$//;
+ $output =~ s/\Q$filespec\E/$replacement/;
+ }
+ }
+
+ # test n+1
+ is($output, $args{Get}, "Output from autosplit()ing $args{Name}");
+
+ if ($args{Files}) {
+ $args{Files} =~ s!/!:!gs if $^O eq 'MacOS';
+ my (%missing, %got);
+ find (sub {$got{$File::Find::name}++ unless -d $_}, $dir);
+ foreach (split /\n/, $args{Files}) {
+ next if /^#/;
+ $_ = lc($_) if $^O eq 'VMS';
+ unless (delete $got{$_}) {
+ $missing{$_}++;
+ }
+ }
+ my @missing = keys %missing;
+ # test n+2
+ unless (ok (!@missing, "Are any expected files missing?")) {
+ print "# These files are missing\n";
+ print "# $_\n" foreach sort @missing;
+ }
+ my @extra = keys %got;
+ # test n+3
+ unless (ok (!@extra, "Are any extra files present?")) {
+ print "# These files are unexpectedly present:\n";
+ print "# $_\n" foreach sort @extra;
+ }
+ }
+ if ($args{Require}) {
+ $args{Require} =~ s|/|:|gm if $^O eq 'MacOS';
+ my $com = 'require "' . File::Spec->catfile ('auto', $args{Require}) . '"';
+ $com =~ s{\\}{/}gm if ($^O eq 'MSWin32');
+ eval $com;
+ # test n+3
+ ok ($@ eq '', $com) or print "# \$\@ = '$@'\n";
+ if (defined $body) {
+ eval $body or die $@;
+ }
+ }
+ # match tests to check for prototypes
+ if ($args{Match}) {
+ local $/;
+ my $file = File::Spec->catfile($dir, $args{Require});
+ open IX, $file or die "Can't open '$file': $!";
+ my $ix = <IX>;
+ close IX or die "Can't close '$file': $!";
+ foreach my $pat (split /\n/, $args{Match}) {
+ next if $pat =~ /^\#/;
+ like ($ix, qr/^\s*$pat\s*$/m, "match $pat");
+ }
+ }
+ # code tests contain eval{}ed ok()s etc
+ if ($args{Tests}) {
+ foreach my $code (split /\n/, $args{Tests}) {
+ next if $code =~ /^\#/;
+ defined eval $code or fail(), print "# Code: $code\n# Error: $@";
+ }
+ }
+ if (my $sleepfor = $args{Sleep}) {
+ # We need to sleep for a while
+ # Need the sleep hack else the next test is so fast that the timestamp
+ # compare routine in AutoSplit thinks that it shouldn't split the files.
+ my $time = time;
+ my $until = $time + $sleepfor;
+ my $attempts = 3;
+ do {
+ sleep ($sleepfor)
+ } while (time < $until && --$attempts > 0);
+ if ($attempts == 0) {
+ printf << "EOM", time;
+# Attempted to sleep for $sleepfor second(s), started at $time, now %d.
+# sleep attempt ppears to have failed; some tests may fail as a result.
+EOM
+ }
+ }
+ unless ($args{SameAgain}) {
+ $i++;
+ rmtree($dir);
+ mkdir $dir, 0775;
+ }
+}
+
+__DATA__
+## Name
+tests from the end of the AutoSplit module.
+## File
+use AutoLoader 'AUTOLOAD';
+{package Just::Another;
+ use AutoLoader 'AUTOLOAD';
+}
+@Yet::Another::AutoSplit::ISA = 'AutoLoader';
+1;
+__END__
+sub test1 ($) { "test 1"; }
+sub test2 ($$) { "test 2"; }
+sub test3 ($$$) { "test 3"; }
+sub testtesttesttest4_1 { "test 4"; }
+sub testtesttesttest4_2 { "duplicate test 4"; }
+sub Just::Another::test5 { "another test 5"; }
+sub test6 { return join ":", __FILE__,__LINE__; }
+package Yet::Another::AutoSplit;
+sub testtesttesttest4_1 ($) { "another test 4"; }
+sub testtesttesttest4_2 ($$) { "another duplicate test 4"; }
+package Yet::More::Attributes;
+sub test_a1 ($) : locked :locked { 1; }
+sub test_a2 : locked { 1; }
+# And that was all it has. You were expected to manually inspect the output
+## Get
+Warning: AutoSplit had to create top-level *DIR* unexpectedly.
+AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*)
+*INC**PATHSEP**MOD*.pm: some names are not unique when truncated to 8 characters:
+ directory *DIR**PATHSEP**MOD**ENDPATHSEP*:
+ testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest
+ directory *DIR**PATHSEP*Yet*PATHSEP*Another*PATHSEP*AutoSplit*ENDPATHSEP*:
+ testtesttesttest4_1.al, testtesttesttest4_2.al truncate to testtest
+## Files
+*DIR*/*MOD*/autosplit.ix
+*DIR*/*MOD*/test1.al
+*DIR*/*MOD*/test2.al
+*DIR*/*MOD*/test3.al
+*DIR*/*MOD*/testtesttesttest4_1.al
+*DIR*/*MOD*/testtesttesttest4_2.al
+*DIR*/Just/Another/test5.al
+*DIR*/*MOD*/test6.al
+*DIR*/Yet/Another/AutoSplit/testtesttesttest4_1.al
+*DIR*/Yet/Another/AutoSplit/testtesttesttest4_2.al
+*DIR*/Yet/More/Attributes/test_a1.al
+*DIR*/Yet/More/Attributes/test_a2.al
+## Require
+*MOD*/autosplit.ix
+## Match
+# Need to find these lines somewhere in the required file
+sub test1\s*\(\$\);
+sub test2\s*\(\$\$\);
+sub test3\s*\(\$\$\$\);
+sub testtesttesttest4_1\s*\(\$\);
+sub testtesttesttest4_2\s*\(\$\$\);
+sub test_a1\s*\(\$\)\s*:\s*locked\s*:\s*locked\s*;
+sub test_a2\s*:\s*locked\s*;
+## Tests
+is (*MOD*::test1 (1), 'test 1');
+is (*MOD*::test2 (1,2), 'test 2');
+is (*MOD*::test3 (1,2,3), 'test 3');
+ok (!defined eval "*MOD*::test1 () eq 'test 1'" and $@ =~ /^Not enough arguments for *MOD*::test1/, "Check prototypes mismatch fails") or print "# \$\@='$@'";
+is (&*MOD*::testtesttesttest4_1, "test 4");
+is (&*MOD*::testtesttesttest4_2, "duplicate test 4");
+is (&Just::Another::test5, "another test 5");
+# very messy way to interpolate function into regexp, but it's going to be
+# needed to get : for Mac filespecs
+like (&*MOD*::test6, qr!^\Q*INC**PATHSEP**MOD*\E\.pm \(autosplit into \Q@{[File::Spec->catfile('*DIR*','*MOD*', 'test6.al')]}\E\):\d+$!);
+ok (Yet::Another::AutoSplit->testtesttesttest4_1 eq "another test 4");
+################################################################
+## Name
+missing use AutoLoader;
+## File
+1;
+__END__
+## Get
+## Files
+# There should be no files.
+################################################################
+## Name
+missing use AutoLoader; (but don't skip)
+## Extra
+0, 0
+## File
+1;
+__END__
+## Get
+AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*)
+## Require
+*MOD*/autosplit.ix
+## Files
+*DIR*/*MOD*/autosplit.ix
+################################################################
+## Name
+Split prior to checking whether obsolete files get deleted
+## File
+use AutoLoader 'AUTOLOAD';
+1;
+__END__
+sub obsolete {our $hidden_a; return $hidden_a++;}
+sub gonner {warn "This gonner function should never get called"}
+## Get
+AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*)
+## Require
+*MOD*/autosplit.ix
+## Files
+*DIR*/*MOD*/autosplit.ix
+*DIR*/*MOD*/gonner.al
+*DIR*/*MOD*/obsolete.al
+## Tests
+is (&*MOD*::obsolete, 0);
+is (&*MOD*::obsolete, 1);
+## Sleep
+4
+## SameAgain
+True, so don't scrub this directory.
+IIRC DOS FAT filesystems have only 2 second granularity.
+################################################################
+## Name
+Check whether obsolete files get deleted
+## File
+use AutoLoader 'AUTOLOAD';
+1;
+__END__
+sub skeleton {"bones"};
+sub ghost {"scream"}; # This definition gets overwritten with the one below
+sub ghoul {"wail"};
+sub zombie {"You didn't use fire."};
+sub flying_pig {"Oink oink flap flap"};
+## Get
+AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*)
+## Require
+*MOD*/autosplit.ix
+## Files
+*DIR*/*MOD*/autosplit.ix
+*DIR*/*MOD*/skeleton.al
+*DIR*/*MOD*/zombie.al
+*DIR*/*MOD*/ghost.al
+*DIR*/*MOD*/ghoul.al
+*DIR*/*MOD*/flying_pig.al
+## Tests
+is (&*MOD*::skeleton, "bones", "skeleton");
+eval {&*MOD*::gonner}; ok ($@ =~ m!^Can't locate auto/*MOD*/gonner.al in \@INC!, "Check &*MOD*::gonner is now a gonner") or print "# \$\@='$@'\n";
+## Sleep
+4
+## SameAgain
+True, so don't scrub this directory.
+################################################################
+## Name
+Check whether obsolete files remain when keep is 1
+## Extra
+1, 1
+## File
+use AutoLoader 'AUTOLOAD';
+1;
+__END__
+sub ghost {"bump"};
+sub wraith {9};
+## Get
+AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*)
+## Require
+*MOD*/autosplit.ix
+## Files
+*DIR*/*MOD*/autosplit.ix
+*DIR*/*MOD*/skeleton.al
+*DIR*/*MOD*/zombie.al
+*DIR*/*MOD*/ghost.al
+*DIR*/*MOD*/ghoul.al
+*DIR*/*MOD*/wraith.al
+*DIR*/*MOD*/flying_pig.al
+## Tests
+is (&*MOD*::ghost, "bump");
+is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies undead?");
+## Sleep
+4
+## SameAgain
+True, so don't scrub this directory.
+################################################################
+## Name
+Without the timestamp check make sure that nothing happens
+## Extra
+0, 1, 1
+## Require
+*MOD*/autosplit.ix
+## Files
+*DIR*/*MOD*/autosplit.ix
+*DIR*/*MOD*/skeleton.al
+*DIR*/*MOD*/zombie.al
+*DIR*/*MOD*/ghost.al
+*DIR*/*MOD*/ghoul.al
+*DIR*/*MOD*/wraith.al
+*DIR*/*MOD*/flying_pig.al
+## Tests
+is (&*MOD*::ghoul, "wail", "still haunted");
+is (&*MOD*::zombie, "You didn't use fire.", "Are our zombies still undead?");
+## Sleep
+4
+## SameAgain
+True, so don't scrub this directory.
+################################################################
+## Name
+With the timestamp check make sure that things happen (stuff gets deleted)
+## Extra
+0, 1, 0
+## Get
+AutoSplitting *INC**PATHSEP**MOD*.pm (*DIR**PATHSEP**MOD**ENDPATHSEP*)
+## Require
+*MOD*/autosplit.ix
+## Files
+*DIR*/*MOD*/autosplit.ix
+*DIR*/*MOD*/ghost.al
+*DIR*/*MOD*/wraith.al
+## Tests
+is (&*MOD*::wraith, 9);
+eval {&*MOD*::flying_pig}; ok ($@ =~ m!^Can't locate auto/*MOD*/flying_pig.al in \@INC!, "There are no flying pigs") or print "# \$\@='$@'\n";

==== //depot/maint-5.10/perl/lib/AutoSplit.pm#2 (text) ====
Index: perl/lib/AutoSplit.pm
--- perl/lib/AutoSplit.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/AutoSplit.pm 2008-01-29 14:22:25.000000000 -0800
@@ -128,6 +128,75 @@
C<AutoSplit> will also emit general diagnostics for inability to
create directories or files.

+=head1 AUTHOR
+
+C<AutoSplit> is maintained by the perl5-porters. Please direct
+any questions to the canonical mailing list. Anything that
+is applicable to the CPAN release can be sent to its maintainer,
+though.
+
+Author and Maintainer: The Perl5-Porters <perl5-***@perl.org>
+
+Maintainer of the CPAN release: Steffen Mueller <***@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This package has been part of the perl core since the first release
+of perl5. It has been released separately to CPAN so older installations
+can benefit from bug fixes.
+
+This package has the same copyright and license as the perl core:
+
+ Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
+
+ All rights reserved.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of either:
+
+ a) the GNU General Public License as published by the Free
+ Software Foundation; either version 1, or (at your option) any
+ later version, or
+
+ b) the "Artistic License" which comes with this Kit.
+
+ This program 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. See either
+ the GNU General Public License or the Artistic License for more details.
+
+ You should have received a copy of the Artistic License with this
+ Kit, in the file named "Artistic". If not, I'll be glad to provide one.
+
+ You should also have received a copy of the GNU General Public License
+ along with this program in the file named "Copying". If not, write to the
+ Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+ 02111-1307, USA or visit their web page on the internet at
+ http://www.gnu.org/copyleft/gpl.html.
+
+ For those of you that choose to use the GNU General Public License,
+ my interpretation of the GNU General Public License is that no Perl
+ script falls under the terms of the GPL unless you explicitly put
+ said script under the terms of the GPL yourself. Furthermore, any
+ object code linked with perl does not automatically fall under the
+ terms of the GPL, provided such object code only adds definitions
+ of subroutines and variables, and does not otherwise impair the
+ resulting interpreter from executing any standard Perl script. I
+ consider linking in C subroutines in this manner to be the moral
+ equivalent of defining subroutines in the Perl language itself. You
+ may sell such an object file as proprietary provided that you provide
+ or offer to provide the Perl source, as specified by the GNU General
+ Public License. (This is merely an alternate way of specifying input
+ to the program.) You may also sell a binary produced by the dumping of
+ a running Perl script that belongs to you, provided that you provide or
+ offer to provide the Perl source as specified by the GPL. (The
+ fact that a Perl interpreter and your code are in the same binary file
+ is, in this case, a form of mere aggregation.) This is my interpretation
+ of the GPL. If you still have concerns or difficulties understanding
+ my intent, feel free to contact me. Of course, the Artistic License
+ spells all this out for your protection, so you may prefer to use that.
+
=cut

# for portability warn about names longer than $maxlen

==== //depot/maint-5.10/perl/lib/File/Temp.pm#2 (text) ====
Index: perl/lib/File/Temp.pm
--- perl/lib/File/Temp.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/File/Temp.pm 2008-01-29 14:22:25.000000000 -0800
@@ -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
@@ -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;
@@ -199,7 +203,7 @@

# Version number

-$VERSION = '0.18';
+$VERSION = '0.20';

# This is a list of characters that can be used in random filenames

@@ -229,9 +233,10 @@
# 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
@@ -328,6 +344,7 @@
"mkdir" => 0,
"suffixlen" => 0,
"unlink_on_close" => 0,
+ "use_exlock" => 1,
"ErrStr" => \$tempErrStr,
);

@@ -437,6 +454,10 @@
# not a file -- no point returning a name that includes a directory
# that does not exist or is not writable

+ unless (-e $parent) {
+ ${$options{ErrStr}} = "Parent directory ($parent) does not exist";
+ return ();
+ }
unless (-d $parent) {
${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
return ();
@@ -493,6 +514,7 @@
my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
$OPENTEMPFLAGS :
$OPENFLAGS );
+ $flags |= $LOCKFLAG if (defined $LOCKFLAG && $options{use_exlock});
$open_success = sysopen($fh, $path, $flags, 0600);
}
if ( $open_success ) {
@@ -587,22 +609,6 @@

}

-# Internal routine to return a random character from the
-# character list. Does not do an srand() since rand()
-# will do one automatically
-
-# No arguments. Return value is the random character
-
-# No longer called since _replace_XX runs a few percent faster if
-# I inline the code. This is important if we are creating thousands of
-# temporary files.
-
-sub _randchar {
-
- $CHARS[ int( rand( $#CHARS ) ) ];
-
-}
-
# Internal routine to replace the XXXX... with random characters
# This has to be done by _gettemp() every time it fails to
# open a temp file/dir
@@ -623,11 +629,12 @@
# and suffixlen=0 returns nothing if used in the substr directly
# Alternatively, could simply set $ignore to length($path)-1
# Don't want to always use substr when not required though.
+ my $end = ( $] >= 5.006 ? "\\z" : "\\Z" );

if ($ignore) {
- substr($path, 0, - $ignore) =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
+ substr($path, 0, - $ignore) =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
} else {
- $path =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
+ $path =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
}
return $path;
}
@@ -678,7 +685,7 @@
# UID is in [4]
if ($info[4] > File::Temp->top_system_uid() && $info[4] != $>) {

- Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$< path='$path'",
+ Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$> path='$path'",
File::Temp->top_system_uid());

$$err_ref = "Directory owned neither by root nor the current user"
@@ -733,6 +740,7 @@

# Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
# and If it is not there do the extensive test
+ local($@);
my $chown_restricted;
$chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
@@ -974,7 +982,7 @@

Create a temporary file object.

- my $tmp = new File::Temp();
+ my $tmp = File::Temp->new();

by default the object is constructed as if C<tempfile>
was called without options, but with the additional behaviour
@@ -982,11 +990,11 @@
if UNLINK is set to true (the default).

Supported arguments are the same as for C<tempfile>: UNLINK
-(defaulting to true), DIR and SUFFIX. Additionally, the filename
+(defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename
template is specified using the TEMPLATE option. The OPEN option
is not supported (the file is always opened).

- $tmp = new File::Temp( TEMPLATE => 'tempXXXXX',
+ $tmp = File::Temp->new( TEMPLATE => 'tempXXXXX',
DIR => 'mydir',
SUFFIX => '.dat');

@@ -1024,6 +1032,9 @@
# Store the filename in the scalar slot
${*$fh} = $path;

+ # Cache the filename by pid so that the destructor can decide whether to remove it
+ $FILES_CREATED_BY_OBJECT{$$}{$path} = 1;
+
# Store unlink information in hash slot (plus other constructor info)
%{*$fh} = %args;

@@ -1036,9 +1047,48 @@
return $fh;
}

+=item B<newdir>
+
+Create a temporary directory using an object oriented interface.
+
+ $dir = File::Temp->newdir();
+
+By default the directory is deleted when the object goes out of scope.
+
+Supports the same options as the C<tempdir> function. Note that directories
+created with this method default to CLEANUP => 1.
+
+ $dir = File::Temp->newdir( $template, %options );
+
+=cut
+
+sub newdir {
+ my $self = shift;
+
+ # need to handle args as in tempdir because we have to force CLEANUP
+ # default without passing CLEANUP to tempdir
+ my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
+ my %options = @_;
+ my $cleanup = (exists $options{CLEANUP} ? $options{CLEANUP} : 1 );
+
+ delete $options{CLEANUP};
+
+ my $tempdir;
+ if (defined $template) {
+ $tempdir = tempdir( $template, %options );
+ } else {
+ $tempdir = tempdir( %options );
+ }
+ return bless { DIRNAME => $tempdir,
+ CLEANUP => $cleanup,
+ LAUNCHPID => $$,
+ }, "File::Temp::Dir";
+}
+
=item B<filename>

-Return the name of the temporary file associated with this object.
+Return the name of the temporary file associated with this object
+(if the object was created using the "new" constructor).

$filename = $tmp->filename;

@@ -1057,6 +1107,15 @@
return $self->filename;
}

+=item B<dirname>
+
+Return the name of the temporary directory associated with this
+object (if the object was created using the "newdir" constructor).
+
+ $dirname = $tmpdir->dirname;
+
+This method is called automatically when the object is used in string context.
+
=item B<unlink_on_destroy>

Control whether the file is unlinked when the object goes out of scope.
@@ -1085,7 +1144,15 @@

No error is given if the unlink fails.

-If the global variable $KEEP_ALL is true, the file will not be removed.
+If the object has been passed to a child process during a fork, the
+file will be deleted when the object goes out of scope in the parent.
+
+For a temporary directory object the directory will be removed
+unless the CLEANUP argument was used in the constructor (and set to
+false) or C<unlink_on_destroy> was modified after creation.
+
+If the global variable $KEEP_ALL is true, the file or directory
+will not be removed.

=cut

@@ -1094,6 +1161,9 @@
if (${*$self}{UNLINK} && !$KEEP_ALL) {
print "# ---------> Unlinking $self\n" if $DEBUG;

+ # only delete if this process created it
+ return unless exists $FILES_CREATED_BY_OBJECT{$$}{$self->filename};
+
# The unlink1 may fail if the file has been closed
# by the caller. This leaves us with the decision
# of whether to refuse to remove the file or simply
@@ -1145,6 +1215,12 @@
Translates the template as before except that a directory name
is specified.

+ ($fh, $filename) = tempfile($template, TMPDIR => 1);
+
+Equivalent to specifying a DIR of "File::Spec->tmpdir", writing the file
+into the same temporary directory as would be used if no template was
+specified at all.
+
($fh, $filename) = tempfile($template, UNLINK => 1);

Return the filename and filehandle as before except that the file is
@@ -1163,7 +1239,7 @@
(L<File::Spec>) unless a directory is specified explicitly with the
DIR option.

- $fh = tempfile( $template, DIR => $dir );
+ $fh = tempfile( DIR => $dir );

If called in scalar context, only the filehandle is returned and the
file will automatically be deleted when closed on operating systems
@@ -1186,6 +1262,16 @@
and mktemp() functions described elsewhere in this document
if opening the file is not required.

+If the operating system supports it (for example BSD derived systems), the
+filehandle will be opened with O_EXLOCK (open with exclusive file lock).
+This can sometimes cause problems if the intention is to pass the filename
+to another system that expects to take an exclusive lock itself (such as
+DBD::SQLite) whilst ensuring that the tempfile is not reused. In this
+situation the "EXLOCK" option can be passed to tempfile. By default EXLOCK
+will be true (this retains compatibility with earlier releases).
+
+ ($fh, $filename) = tempfile($template, EXLOCK => 0);
+
Options can be combined as required.

Will croak() if there is an error.
@@ -1199,11 +1285,13 @@

# Default options
my %options = (
- "DIR" => undef, # Directory prefix
+ "DIR" => undef, # Directory prefix
"SUFFIX" => '', # Template suffix
"UNLINK" => 0, # Do not unlink file on exit
"OPEN" => 1, # Open file
- );
+ "TMPDIR" => 0, # Place tempfile in tempdir if template specified
+ "EXLOCK" => 1, # Open file with O_EXLOCK
+ );

# Check to see whether we have an odd or even number of arguments
my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef);
@@ -1234,10 +1322,15 @@
# First generate a template if not defined and prefix the directory
# If no template must prefix the temp directory
if (defined $template) {
+ # End up with current directory if neither DIR not TMPDIR are set
if ($options{"DIR"}) {

$template = File::Spec->catfile($options{"DIR"}, $template);

+ } elsif ($options{TMPDIR}) {
+
+ $template = File::Spec->catfile(File::Spec->tmpdir, $template );
+
}

} else {
@@ -1278,6 +1371,7 @@
"unlink_on_close" => $unlink_on_close,
"suffixlen" => length($options{'SUFFIX'}),
"ErrStr" => \$errstr,
+ "use_exlock" => $options{EXLOCK},
) );

# Set up an exit handler that can do whatever is right for the
@@ -1312,7 +1406,15 @@

=item B<tempdir>

-This is the recommended interface for creation of temporary directories.
+This is the recommended interface for creation of temporary
+directories. By default the directory will not be removed on exit
+(that is, it won't be temporary; this behaviour can not be changed
+because of issues with backwards compatibility). To enable removal
+either use the CLEANUP option which will trigger removal on program
+exit, or consider using the "newdir" method in the object interface which
+will allow the directory to be cleaned up when the object goes out of
+scope.
+
The behaviour of the function depends on the arguments:

$tempdir = tempdir();
@@ -2045,11 +2147,10 @@

=item STANDARD

-Do the basic security measures to ensure the directory exists and
-is writable, that the umask() is fixed before opening of the file,
-that temporary files are opened only if they do not already exist, and
-that possible race conditions are avoided. Finally the L<unlink0|"unlink0">
-function is used to remove files safely.
+Do the basic security measures to ensure the directory exists and is
+writable, that temporary files are opened only if they do not already
+exist, and that possible race conditions are avoided. Finally the
+L<unlink0|"unlink0"> function is used to remove files safely.

=item MEDIUM

@@ -2237,9 +2338,12 @@
=head2 BINMODE

The file returned by File::Temp will have been opened in binary mode
-if such a mode is available. If that is not correct, use the binmode()
+if such a mode is available. If that is not correct, use the C<binmode()>
function to change the mode of the filehandle.

+Note that you can modify the encoding of a file opened by File::Temp
+also by using C<binmode()>.
+
=head1 HISTORY

Originally began life in May 1999 as an XS interface to the system
@@ -2256,10 +2360,14 @@
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>***@cpan.orgE<gt>

+Copyright (C) 2007 Tim Jenness.
Copyright (C) 1999-2007 Tim Jenness and the UK Particle Physics and
Astronomy Research Council. All Rights Reserved. This program is free
software; you can redistribute it and/or modify it under the same
@@ -2272,4 +2380,46 @@

=cut

+package File::Temp::Dir;
+
+use File::Path qw/ rmtree /;
+use strict;
+use overload '""' => "STRINGIFY", fallback => 1;
+
+# private class specifically to support tempdir objects
+# created by File::Temp->newdir
+
+# ostensibly the same method interface as File::Temp but without
+# inheriting all the IO::Seekable methods and other cruft
+
+# Read-only - returns the name of the temp directory
+
+sub dirname {
+ my $self = shift;
+ return $self->{DIRNAME};
+}
+
+sub STRINGIFY {
+ my $self = shift;
+ return $self->dirname;
+}
+
+sub unlink_on_destroy {
+ my $self = shift;
+ if (@_) {
+ $self->{CLEANUP} = shift;
+ }
+ return $self->{CLEANUP};
+}
+
+sub DESTROY {
+ my $self = shift;
+ if ($self->unlink_on_destroy &&
+ $$ == $self->{LAUNCHPID} && !$File::Temp::KEEP_ALL) {
+ rmtree($self->{DIRNAME}, $File::Temp::DEBUG, 0)
+ if -d $self->{DIRNAME};
+ }
+}
+
+
1;

==== //depot/maint-5.10/perl/lib/File/Temp/t/fork.t#1 (text) ====
Index: perl/lib/File/Temp/t/fork.t
--- /dev/null 2008-01-25 10:48:57.533235220 -0800
+++ perl/lib/File/Temp/t/fork.t 2008-01-29 14:22:25.000000000 -0800
@@ -0,0 +1,99 @@
+#!/usr/bin/perl
+$| = 1;
+
+# Note that because fork loses test count we do not use Test::More
+
+use strict;
+
+BEGIN {
+ require Config;
+ if ( $Config::Config{d_fork} ) {
+ print "1..8\n";
+ } else {
+ print "1..0 # Skip No fork available\n";
+ exit;
+ }
+}
+
+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();
+
+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" );
+unlink($filename); # Cleanup
+
+
+# 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;
+}

==== //depot/maint-5.10/perl/lib/File/Temp/t/lock.t#1 (text) ====
Index: perl/lib/File/Temp/t/lock.t
--- /dev/null 2008-01-25 10:48:57.533235220 -0800
+++ perl/lib/File/Temp/t/lock.t 2008-01-29 14:22:25.000000000 -0800
@@ -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");

==== //depot/maint-5.10/perl/lib/File/Temp/t/object.t#2 (text) ====
Index: perl/lib/File/Temp/t/object.t
--- perl/lib/File/Temp/t/object.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/File/Temp/t/object.t 2008-01-29 14:22:25.000000000 -0800
@@ -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";

==== //depot/maint-5.10/perl/lib/File/Temp/t/seekable.t#2 (text) ====
Index: perl/lib/File/Temp/t/seekable.t
--- perl/lib/File/Temp/t/seekable.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/File/Temp/t/seekable.t 2008-01-29 14:22:25.000000000 -0800
@@ -6,7 +6,7 @@

# change 'tests => 1' to 'tests => last_test_to_print';

-use Test::More tests => 7;
+use Test::More tests => 10;
BEGIN { use_ok('File::Temp') };

#########################
@@ -21,7 +21,11 @@
isa_ok( $tmp, 'IO::Seekable' );

# make sure the seek method is available...
-ok( File::Temp->can('seek'), 'tmp can seek' );
+# Note that we need a reasonably modern IO::Seekable
+SKIP: {
+ skip "IO::Seekable is too old", 1 if IO::Seekable->VERSION <= 1.06;
+ ok( File::Temp->can('seek'), 'tmp can seek' );
+}

# make sure IO::Handle methods are still there...
ok( File::Temp->can('print'), 'tmp can print' );
@@ -30,3 +34,7 @@
$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 $@;

==== //depot/maint-5.10/perl/lib/Net/Ping.pm#2 (text) ====
Index: perl/lib/Net/Ping.pm
--- perl/lib/Net/Ping.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/Net/Ping.pm 2008-01-29 14:22:25.000000000 -0800
@@ -16,7 +16,7 @@

@ISA = qw(Exporter);
@EXPORT = qw(pingecho);
-$VERSION = "2.33";
+$VERSION = "2.34";

sub SOL_IP { 0; };
sub IP_TOS { 1; };

==== //depot/maint-5.10/perl/lib/Net/Ping/t/510_ping_udp.t#2 (text) ====
Index: perl/lib/Net/Ping/t/510_ping_udp.t
--- perl/lib/Net/Ping/t/510_ping_udp.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/Net/Ping/t/510_ping_udp.t 2008-01-29 14:22:25.000000000 -0800
@@ -13,7 +13,7 @@
exit;
}
unless (getservbyname('echo', 'udp')) {
- print "1..0 \# Skip: no udp echo port\n";
+ print "1..0 \# Skip: no echo port\n";
exit;
}


==== //depot/maint-5.10/perl/lib/SelfLoader.pm#2 (text) ====
Index: perl/lib/SelfLoader.pm
--- perl/lib/SelfLoader.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/SelfLoader.pm 2008-01-29 14:22:25.000000000 -0800
@@ -1,21 +1,18 @@
package SelfLoader;
-
-use 5.009005; # due to new regexp features
+use 5.008;
use strict;
+our $VERSION = "1.15";

-use Exporter;
-our @ISA = qw(Exporter);
-our @EXPORT = qw(AUTOLOAD);
-our $VERSION = "1.11";
-sub Version {$VERSION}
-sub DEBUG () { 0 }
-
-my %Cache; # private cache for all SelfLoader's client packages
-
+# The following bit of eval-magic is necessary to make this work on
+# perls < 5.009005.
+use vars qw/$AttrList/;
+BEGIN {
+ if ($] > 5.009004) {
+ eval <<'NEWERPERL';
+use 5.009005; # due to new regexp features
# allow checking for valid ': attrlist' attachments
# see also AutoSplit
-
-my $attr_list = qr{
+$AttrList = qr{
\s* : \s*
(?:
# one attribute
@@ -27,6 +24,28 @@
)*
}x;

+NEWERPERL
+ }
+ else {
+ eval <<'OLDERPERL';
+# allow checking for valid ': attrlist' attachments
+# (we use 'our' rather than 'my' here, due to the rather complex and buggy
+# behaviour of lexicals with qr// and (??{$lex}) )
+our $nested;
+$nested = qr{ \( (?: (?> [^()]+ ) | (??{ $nested }) )* \) }x;
+our $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x;
+$AttrList = qr{ \s* : \s* (?: $one_attr )* }x;
+OLDERPERL
+ }
+}
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(AUTOLOAD);
+sub Version {$VERSION}
+sub DEBUG () { 0 }
+
+my %Cache; # private cache for all SelfLoader's client packages
+
# in croak and carp, protect $@ from "require Carp;" RT #40216

sub croak { { local $@; require Carp; } goto &Carp::croak }
@@ -88,7 +107,7 @@

local($/) = "\n";
while(defined($line = <$fh>) and $line !~ m/^__END__/) {
- if ($line =~ m/^sub\s+([\w:]+)\s*((?:\([\\\$\@\%\&\*\;]*\))?(?:$attr_list)?)/) {
+ if ($line =~ m/^\s*sub\s+([\w:]+)\s*((?:\([\\\$\@\%\&\*\;]*\))?(?:$AttrList)?)/) {
push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
$protoype = $2;
@lines = ($line);
@@ -343,4 +362,73 @@
B<SelfLoader> C<AUTOLOAD> method when the data after C<__DATA__> is first
parsed.

+=head1 AUTHOR
+
+C<SelfLoader> is maintained by the perl5-porters. Please direct
+any questions to the canonical mailing list. Anything that
+is applicable to the CPAN release can be sent to its maintainer,
+though.
+
+Author and Maintainer: The Perl5-Porters <perl5-***@perl.org>
+
+Maintainer of the CPAN release: Steffen Mueller <***@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This package has been part of the perl core since the first release
+of perl5. It has been released separately to CPAN so older installations
+can benefit from bug fixes.
+
+This package has the same copyright and license as the perl core:
+
+ Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
+
+ All rights reserved.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of either:
+
+ a) the GNU General Public License as published by the Free
+ Software Foundation; either version 1, or (at your option) any
+ later version, or
+
+ b) the "Artistic License" which comes with this Kit.
+
+ This program 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. See either
+ the GNU General Public License or the Artistic License for more details.
+
+ You should have received a copy of the Artistic License with this
+ Kit, in the file named "Artistic". If not, I'll be glad to provide one.
+
+ You should also have received a copy of the GNU General Public License
+ along with this program in the file named "Copying". If not, write to the
+ Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+ 02111-1307, USA or visit their web page on the internet at
+ http://www.gnu.org/copyleft/gpl.html.
+
+ For those of you that choose to use the GNU General Public License,
+ my interpretation of the GNU General Public License is that no Perl
+ script falls under the terms of the GPL unless you explicitly put
+ said script under the terms of the GPL yourself. Furthermore, any
+ object code linked with perl does not automatically fall under the
+ terms of the GPL, provided such object code only adds definitions
+ of subroutines and variables, and does not otherwise impair the
+ resulting interpreter from executing any standard Perl script. I
+ consider linking in C subroutines in this manner to be the moral
+ equivalent of defining subroutines in the Perl language itself. You
+ may sell such an object file as proprietary provided that you provide
+ or offer to provide the Perl source, as specified by the GNU General
+ Public License. (This is merely an alternate way of specifying input
+ to the program.) You may also sell a binary produced by the dumping of
+ a running Perl script that belongs to you, provided that you provide or
+ offer to provide the Perl source as specified by the GPL. (The
+ fact that a Perl interpreter and your code are in the same binary file
+ is, in this case, a form of mere aggregation.) This is my interpretation
+ of the GPL. If you still have concerns or difficulties understanding
+ my intent, feel free to contact me. Of course, the Artistic License
+ spells all this out for your protection, so you may prefer to use that.
+
=cut

==== //depot/maint-5.10/perl/lib/SelfLoader/t/01SelfLoader.t#1 (xtext) ====
Index: perl/lib/SelfLoader/t/01SelfLoader.t
--- /dev/null 2008-01-25 10:48:57.533235220 -0800
+++ perl/lib/SelfLoader/t/01SelfLoader.t 2008-01-29 14:22:25.000000000 -0800
@@ -0,0 +1,217 @@
+BEGIN {
+ chdir 't' if -d 't';
+ $dir = "self-$$";
+ $sep = "/";
+
+ if ($^O eq 'MacOS') {
+ $dir = ":" . $dir;
+ $sep = ":";
+ }
+
+ unshift @INC, $dir;
+ unshift @INC, '../lib';
+
+ print "1..20\n";
+
+ # First we must set up some selfloader files
+ mkdir $dir, 0755 or die "Can't mkdir $dir: $!";
+
+ open(FOO, ">$dir${sep}Foo.pm") or die;
+ print FOO <<'EOT';
+package Foo;
+use SelfLoader;
+
+sub new { bless {}, shift }
+sub foo;
+sub bar;
+sub bazmarkhianish;
+sub a;
+sub never; # declared but definition should never be read
+1;
+__DATA__
+
+sub foo { shift; shift || "foo" };
+
+sub bar { shift; shift || "bar" }
+
+sub bazmarkhianish { shift; shift || "baz" }
+
+package sheep;
+sub bleat { shift; shift || "baa" }
+__END__
+sub never { die "D'oh" }
+EOT
+
+ close(FOO);
+
+ open(BAR, ">$dir${sep}Bar.pm") or die;
+ print BAR <<'EOT';
+package Bar;
+use SelfLoader;
+
+@ISA = 'Baz';
+
+sub new { bless {}, shift }
+sub a;
+sub with_whitespace_in_front;
+
+1;
+__DATA__
+
+sub a { 'a Bar'; }
+sub b { 'b Bar' }
+
+ sub with_whitespace_in_front {
+ "with_whitespace_in_front Bar"
+}
+
+__END__ DATA
+sub never { die "D'oh" }
+EOT
+
+ close(BAR);
+};
+
+
+package Baz;
+
+sub a { 'a Baz' }
+sub b { 'b Baz' }
+sub c { 'c Baz' }
+
+
+package main;
+use Foo;
+use Bar;
+
+$foo = new Foo;
+
+print "not " unless $foo->foo eq 'foo'; # selfloaded first time
+print "ok 1\n";
+
+print "not " unless $foo->foo eq 'foo'; # regular call
+print "ok 2\n";
+
+# Try an undefined method
+eval {
+ $foo->will_fail;
+};
+if ($@ =~ /^Undefined subroutine/) {
+ print "ok 3\n";
+} else {
+ print "not ok 3 $@\n";
+}
+
+# Used to be trouble with this
+eval {
+ my $foo = new Foo;
+ die "oops";
+};
+if ($@ =~ /oops/) {
+ print "ok 4\n";
+} else {
+ print "not ok 4 $@\n";
+}
+
+# Pass regular expression variable to autoloaded function. This used
+# to go wrong in AutoLoader because it used regular expressions to generate
+# autoloaded filename.
+"foo" =~ /(\w+)/;
+print "not " unless $1 eq 'foo';
+print "ok 5\n";
+
+print "not " unless $foo->bar($1) eq 'foo';
+print "ok 6\n";
+
+print "not " unless $foo->bar($1) eq 'foo';
+print "ok 7\n";
+
+print "not " unless $foo->bazmarkhianish($1) eq 'foo';
+print "ok 8\n";
+
+print "not " unless $foo->bazmarkhianish($1) eq 'foo';
+print "ok 9\n";
+
+# Check nested packages inside __DATA__
+print "not " unless sheep::bleat() eq 'baa';
+print "ok 10\n";
+
+# Now check inheritance:
+
+$bar = new Bar;
+
+# Before anything is SelfLoaded there is no declaration of Foo::b so we should
+# get Baz::b
+print "not " unless $bar->b() eq 'b Baz';
+print "ok 11\n";
+
+# There is no Bar::c so we should get Baz::c
+print "not " unless $bar->c() eq 'c Baz';
+print "ok 12\n";
+
+# check that subs with whitespace in front work
+print "not " unless $bar->with_whitespace_in_front() eq 'with_whitespace_in_front Bar';
+print "ok 13\n";
+
+# This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side
+# effect
+print "not " unless $bar->a() eq 'a Bar';
+print "ok 14\n";
+
+print "not " unless $bar->b() eq 'b Bar';
+print "ok 15\n";
+
+print "not " unless $bar->c() eq 'c Baz';
+print "ok 16\n";
+
+
+
+# Check that __END__ is honoured
+# Try an subroutine that should never be noticed by selfloader
+eval {
+ $foo->never;
+};
+if ($@ =~ /^Undefined subroutine/) {
+ print "ok 17\n";
+} else {
+ print "not ok 17 $@\n";
+}
+
+# Try to read from the data file handle
+{
+ local $SIG{__WARN__} = sub { my $warn = shift; };
+ my $foodata = <Foo::DATA>;
+ close Foo::DATA;
+ if (defined $foodata) {
+ print "not ok 18 # $foodata\n";
+ } else {
+ print "ok 18\n";
+ }
+}
+
+# Check that __END__ DATA is honoured
+# Try an subroutine that should never be noticed by selfloader
+eval {
+ $bar->never;
+};
+if ($@ =~ /^Undefined subroutine/) {
+ print "ok 19\n";
+} else {
+ print "not ok 19 $@\n";
+}
+
+# Try to read from the data file handle
+my $bardata = <Bar::DATA>;
+close Bar::DATA;
+if ($bardata ne "sub never { die \"D'oh\" }\n") {
+ print "not ok 20 # $bardata\n";
+} else {
+ print "ok 20\n";
+}
+
+# cleanup
+END {
+return unless $dir && -d $dir;
+unlink "$dir${sep}Foo.pm", "$dir${sep}Bar.pm";
+rmdir "$dir";
+}

==== //depot/maint-5.10/perl/lib/SelfLoader/t/02SelfLoader-buggy.t#1 (text) ====
Index: perl/lib/SelfLoader/t/02SelfLoader-buggy.t
--- /dev/null 2008-01-25 10:48:57.533235220 -0800
+++ perl/lib/SelfLoader/t/02SelfLoader-buggy.t 2008-01-29 14:22:25.000000000 -0800
@@ -0,0 +1,46 @@
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+}
+
+use SelfLoader;
+print "1..1\n";
+
+# this script checks that errors on self-loaded
+# subroutines that affect $@ are reported
+
+eval { buggy(); };
+unless ($@ =~ /^syntax error/) {
+ print "not ";
+}
+print "ok 1 - syntax errors are reported\n";
+
+__END__
+
+sub buggy
+{
+ +>*;
+}
+
+
+# RT 40216
+#
+# by Bo Lindbergh <***@hagernas.com>, at Aug 22, 2006 5:42 PM
+#
+# In the example below, there's a syntax error in the selfloaded
+# code for main::buggy. When the eval fails, SelfLoader::AUTOLOAD
+# tries to report this with "croak $@;". Unfortunately,
+# SelfLoader::croak does "require Carp;" without protecting $@,
+# which gets clobbered. The program then dies with the
+# uninformative message " at ./example line 3".
+#
+# #! /usr/local/bin/perl
+# use SelfLoader;
+# buggy();
+# __END__
+# sub buggy
+# {
+# +>*;
+# }

==== //depot/maint-5.10/perl/lib/Tie/RefHash.pm#2 (text) ====
Index: perl/lib/Tie/RefHash.pm
--- perl/lib/Tie/RefHash.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/Tie/RefHash.pm 2008-01-29 14:22:25.000000000 -0800
@@ -2,7 +2,7 @@

use vars qw/$VERSION/;

-$VERSION = "1.37";
+$VERSION = "1.38";

use 5.005;


==== //depot/maint-5.10/perl/lib/Tie/RefHash/threaded.t#2 (text) ====
Index: perl/lib/Tie/RefHash/threaded.t
--- perl/lib/Tie/RefHash/threaded.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/Tie/RefHash/threaded.t 2008-01-29 14:22:25.000000000 -0800
@@ -14,8 +14,15 @@
# this is sucky because threads.pm has to be loaded before Test::Builder
use Config;
eval { require Scalar::Util };
- if ( $Config{usethreads} and !$Config{use5005threads} and defined(&Scalar::Util::weaken) ) {
- require threads; "threads"->import;
+
+ if ( $^O eq 'MSWin32' ) {
+ print "1..0 # Skip -- this test is generally broken on windows for unknown reasons. If you can help debug this patches would be very welcome.\n";
+ exit 0;
+ }
+ if ( $Config{usethreads} and !$Config{use5005threads}
+ and defined(&Scalar::Util::weaken)
+ and eval { require threads; "threads"->import }
+ ) {
print "1..14\n";
} else {
print "1..0 # Skip -- threads aren't enabled in your perl, or Scalar::Util::weaken is missing\n";

==== //depot/maint-5.10/perl/lib/constant.pm#2 (text) ====
Index: perl/lib/constant.pm
--- perl/lib/constant.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/constant.pm 2008-01-29 14:22:25.000000000 -0800
@@ -4,7 +4,7 @@
use warnings::register;

use vars qw($VERSION %declared);
-$VERSION = '1.13';
+$VERSION = '1.15';

#=======================================================================


==== //depot/maint-5.10/perl/lib/constant.t#2 (text) ====
Index: perl/lib/constant.t
--- perl/lib/constant.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/constant.t 2008-01-29 14:22:25.000000000 -0800
@@ -305,7 +305,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 \(\)/,
End of Patch.

[Steve Hay]

Post by nwc10+ (Nicholas Clark)
[ 32871]
Subject: Re: Smoke [5.11.0] 32864 FAIL(F) MSWin32 Win2003 SP2

(x86/1

Post by nwc10+ (Nicholas Clark)
Date: Sun, 06 Jan 2008 12:24:10 +0100
Skip lib/File/Temp/t/fork.t when there is no fork.
Affected files ...
//depot/maint-5.10/perl/lib/File/Temp/t/fork.t#1 branch ...

That test was further updated by #32889, which hasn't been integrated
yet. Was that deliberate or an oversight?

Also, I see this latest round of integrations went into maint-5.10
rather than 5.8. Who's the maint pumpking for that now? Are you doing
5.10 as well as 5.8? (Indeed, did you mean to integrate to 5.10 rather
than 5.8?)

[Nicholas Clark]

Post by nwc10+ (Nicholas Clark)

Post by nwc10+ (Nicholas Clark)
[ 32871]
Subject: Re: Smoke [5.11.0] 32864 FAIL(F) MSWin32 Win2003 SP2

(x86/1

Post by nwc10+ (Nicholas Clark)
Date: Sun, 06 Jan 2008 12:24:10 +0100
Skip lib/File/Temp/t/fork.t when there is no fork.
Affected files ...
//depot/maint-5.10/perl/lib/File/Temp/t/fork.t#1 branch ...

That test was further updated by #32889, which hasn't been integrated
yet. Was that deliberate or an oversight?

Oversight. For some reason it wasn't in my pending changelist mailbox

Post by nwc10+ (Nicholas Clark)
Also, I see this latest round of integrations went into maint-5.10
rather than 5.8. Who's the maint pumpking for that now? Are you doing
5.10 as well as 5.8? (Indeed, did you mean to integrate to 5.10 rather
than 5.8?)

For now I'm merging "obvious" changes back to maint-5.10, so that I can then
merge them onwards to maint-5.8

I probably could have got away with just the dual life modules and key
bugfixes, but it's actually easier to reduce the size of my pending
changelist mailbox by merging anything else that is quick and easy.
("changes the API in the headers" or "core patch to a dual-life module" need
thinking about, so generally aren't. Tests to dual life modules are a bit of
a grey area)

Nicholas Clark