Change 30321 by [EMAIL PROTECTED] on 2007/02/15 16:52:31
Integrate:
[ 27953]
Subject: Re: [perl #38965] File::Find documentation - is "Don't modify
thesevariables" still valid?
From: David Landgren <[EMAIL PROTECTED]>
Date: Mon, 24 Apr 2006 13:02:02 +0200
Message-ID: <[EMAIL PROTECTED]>
[ 27954]
Reverting change #27953, as it appears that File::Find has
localized the C<$_> usable by the wanted function since
version 1.04 (change #18501, to be exact). Update the
docs to express this change. Finally, bump the version.
[ 27955]
Really bump the version of File::Find.
[ 28665]
Subject: [PATCH] File::Basename add X<> tags, replace regex delimiters
From: "Gabor Szabo" <[EMAIL PROTECTED]>
Date: Sat, 5 Aug 2006 23:00:14 +0300
Message-ID: <[EMAIL PROTECTED]>
[ 28802]
Document mkpath() return value in scalar context.
Document that rmtree() return value include deleted
directories.
[ 28876]
Subject: [perl #40369] File::Find mishandles non-dangling symlinks
From: [EMAIL PROTECTED] (via RT) <[EMAIL PROTECTED]>
Date: Tue, 19 Sep 2006 20:56:32 -0700
Message-ID: <[EMAIL PROTECTED]>
[ 29103]
Subject: [PATCH] FindBin.pm: better fix for PATH entries
From: Alexey Tourbin <[EMAIL PROTECTED]>
Date: Wed, 25 Oct 2006 14:02:55 +0400
Message-ID: <[EMAIL PROTECTED]>
[ 29115]
Subject: [PATCH] Fix typo in File::Find POD
From: "Jerry D. Hedden" <[EMAIL PROTECTED]>
Date: Thu, 26 Oct 2006 06:50:04 -0700 (PDT)
Message-ID: <[EMAIL PROTECTED]>
[ 29272]
Doc patch by Thomas O Smailus :
Subject: Fwd: [perl #40866] Error on doc page? (File::Basename)
From: "Adriano Rodrigues" <[EMAIL PROTECTED]>
Date: Tue, 14 Nov 2006 10:24:38 -0200
Message-ID: <[EMAIL PROTECTED]>
[ 30002]
Let File::Path report the extended system error message
when available (Ilya Zakharevich)
[ 30035]
For VMS, a belated entry into the $^O jungle that is
File::Find::_find_dir.
[ 30037]
For FindBin to work as advertised on VMS, $FindBin::Bin
must be in unix syntax.
[ 30215]
Another tiny typo in File::Copy (found by Ruud.)
Affected files ...
... //depot/maint-5.8/perl/lib/File/Basename.pm#9 integrate
... //depot/maint-5.8/perl/lib/File/Copy.pm#16 integrate
... //depot/maint-5.8/perl/lib/File/Find.pm#16 integrate
... //depot/maint-5.8/perl/lib/File/Path.pm#9 integrate
... //depot/maint-5.8/perl/lib/FindBin.pm#4 integrate
Differences ...
==== //depot/maint-5.8/perl/lib/File/Basename.pm#9 (text) ====
Index: perl/lib/File/Basename.pm
--- perl/lib/File/Basename.pm#8~26716~ 2006-01-08 07:57:01.000000000 -0800
+++ perl/lib/File/Basename.pm 2007-02-15 08:52:31.000000000 -0800
@@ -54,7 +54,7 @@
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
-$VERSION = "2.74";
+$VERSION = "2.76";
fileparse_set_fstype($^O);
@@ -62,6 +62,7 @@
=over 4
=item C<fileparse>
+X<fileparse>
my($filename, $directories, $suffix) = fileparse($path);
my($filename, $directories, $suffix) = fileparse($path, @suffixes);
@@ -88,7 +89,7 @@
portion is removed and becomes the $suffix.
# On Unix returns ("baz", "/foo/bar", ".txt")
- fileparse("/foo/bar/baz", qr/\.[^.]*/);
+ fileparse("/foo/bar/baz.txt", qr/\.[^.]*/);
If type is non-Unix (see C<fileparse_set_fstype()>) then the pattern
matching for suffix removal is performed case-insensitively, since
@@ -143,13 +144,13 @@
$dirpath ||= ''; # should always be defined
}
else { # Default to Unix semantics.
- ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#s);
- if ($orig_type eq 'VMS' and $fullname =~ m:^(/[^/]+/000000(/|$))(.*):) {
+ ($dirpath,$basename) = ($fullname =~ m{^(.*/)?(.*)}s);
+ if ($orig_type eq 'VMS' and $fullname =~ m{^(/[^/]+/000000(/|$))(.*)}) {
# dev:[000000] is top of VMS tree, similar to Unix '/'
# so strip it off and treat the rest as "normal"
my $devspec = $1;
my $remainder = $3;
- ($dirpath,$basename) = ($remainder =~ m#^(.*/)?(.*)#s);
+ ($dirpath,$basename) = ($remainder =~ m{^(.*/)?(.*)}s);
$dirpath ||= ''; # should always be defined
$dirpath = $devspec.$dirpath;
}
@@ -178,11 +179,12 @@
=item C<basename>
+X<basename> X<filename>
my $filename = basename($path);
my $filename = basename($path, @suffixes);
-This function is provided for compatibility with the Unix shell command
+This function is provided for compatibility with the Unix shell command
C<basename(1)>. It does B<NOT> always return the file name portion of a
path as you might expect. To be safe, if you want the file name portion of
a path use C<fileparse()>.
@@ -237,6 +239,7 @@
=item C<dirname>
+X<dirname>
This function is provided for compatibility with the Unix shell
command C<dirname(1)> and has inherited some of its quirks. In spite of
@@ -310,7 +313,7 @@
elsif ($type eq 'AmigaOS') {
if ( $dirname =~ /:\z/) { return $dirname }
chop $dirname;
- $dirname =~ s#[^:/]+\z## unless length($basename);
+ $dirname =~ s{[^:/]+\z}{} unless length($basename);
}
else {
_strip_trailing_sep($dirname);
@@ -341,6 +344,7 @@
=item C<fileparse_set_fstype>
+X<filesystem>
my $type = fileparse_set_fstype();
my $previous_type = fileparse_set_fstype($type);
==== //depot/maint-5.8/perl/lib/File/Copy.pm#16 (text) ====
Index: perl/lib/File/Copy.pm
--- perl/lib/File/Copy.pm#15~30174~ 2007-02-08 08:02:24.000000000 -0800
+++ perl/lib/File/Copy.pm 2007-02-15 08:52:31.000000000 -0800
@@ -337,7 +337,7 @@
size used for copying. This is the number of bytes from the
first file, that will be held in memory at any given time, before
being written to the second file. The default buffer size depends
-upon the file, but will generally be the whole file (up to 2Mb), or
+upon the file, but will generally be the whole file (up to 2MB), or
1k for filehandles that do not reference files (eg. sockets).
You may use the syntax C<use File::Copy "cp"> to get at the
@@ -375,7 +375,7 @@
On Mac OS (Classic), C<syscopy> calls C<Mac::MoreFiles::FSpFileCopy>,
if available.
-B<Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)>
+B<Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)>:
If both arguments to C<copy> are not file handles,
then C<copy> will perform a "system copy" of
==== //depot/maint-5.8/perl/lib/File/Find.pm#16 (text) ====
Index: perl/lib/File/Find.pm
--- perl/lib/File/Find.pm#15~26590~ 2006-01-02 15:17:17.000000000 -0800
+++ perl/lib/File/Find.pm 2007-02-15 08:52:31.000000000 -0800
@@ -3,7 +3,7 @@
use strict;
use warnings;
use warnings::register;
-our $VERSION = '1.10';
+our $VERSION = '1.11';
require Exporter;
require Cwd;
@@ -56,7 +56,7 @@
finddepth(\&wanted, @directories);
finddepth(\%options, @directories);
-C<finddepth()> works just like C<find()> except that is invokes the
+C<finddepth()> works just like C<find()> except that it invokes the
C<&wanted> function for a directory I<after> invoking it for the
directory's contents. It does a postorder traversal instead of a
preorder traversal, working from the bottom of the directory tree up
@@ -215,7 +215,8 @@
=back
-Don't modify these variables.
+The above variables have all been localized and may be changed without
+effecting data outside of the wanted function.
For example, when examining the file F</some/path/foo.ext> you will have:
@@ -779,6 +780,8 @@
$dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
} elsif ($^O eq 'MSWin32') {
$dir_pref = ($p_dir =~ m|\w:/$| ? $p_dir : "$p_dir/" );
+ } elsif ($^O eq 'VMS') {
+ $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
}
else {
$dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
@@ -952,6 +955,17 @@
$dir_name = ($p_dir =~ m|\w:/$| ? "$p_dir$dir_rel" :
"$p_dir/$dir_rel");
$dir_pref = "$dir_name/";
}
+ elsif ($^O eq 'VMS') {
+ if ($p_dir =~ m/[\]>]+$/) {
+ $dir_name = $p_dir;
+ $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
+ $dir_pref = $dir_name;
+ }
+ else {
+ $dir_name = "$p_dir/$dir_rel";
+ $dir_pref = "$dir_name/";
+ }
+ }
else {
$dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
$dir_pref = "$dir_name/";
@@ -1118,7 +1132,7 @@
# ignore if invalid symlink
unless (defined $new_loc) {
- if ($dangling_symlinks) {
+ if (!defined -l _ && $dangling_symlinks) {
if (ref $dangling_symlinks eq 'CODE') {
$dangling_symlinks->($FN, $dir_pref);
} else {
==== //depot/maint-5.8/perl/lib/File/Path.pm#9 (text) ====
Index: perl/lib/File/Path.pm
--- perl/lib/File/Path.pm#8~30320~ 2007-02-15 08:30:05.000000000 -0800
+++ perl/lib/File/Path.pm 2007-02-15 08:52:31.000000000 -0800
@@ -38,7 +38,8 @@
=back
It returns a list of all directories (including intermediates, determined
-using the Unix '/' separator) created.
+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
@@ -81,8 +82,8 @@
=back
-It returns the number of files successfully deleted. Symlinks are
-simply deleted and not followed.
+It returns the number of files, directories and symlinks successfully
+deleted. Symlinks are simply deleted and not followed.
B<NOTE:> There are race conditions internal to the implementation of
C<rmtree> making it unsafe to use on directory trees which may be
@@ -125,7 +126,7 @@
use strict;
use warnings;
-our $VERSION = "1.08";
+our $VERSION = "1.09";
our @ISA = qw( Exporter );
our @EXPORT = qw( mkpath rmtree );
@@ -157,10 +158,11 @@
my $parent = File::Basename::dirname($path);
unless (-d $parent or $path eq $parent) {
push(@created,mkpath($parent, $verbose, $mode));
- }
+ }
print "mkdir $path\n" if $verbose;
unless (mkdir($path,$mode)) {
- my $e = $!;
+ my ($e, $e1) = ($!, $^E);
+ $e .= "; $e1" if $e ne $e1;
# allow for another process to have created it meanwhile
$! = $e, croak ("mkdir $path: $e") unless -d $path;
}
==== //depot/maint-5.8/perl/lib/FindBin.pm#4 (text) ====
Index: perl/lib/FindBin.pm
--- perl/lib/FindBin.pm#3~25453~ 2005-09-17 12:57:51.000000000 -0700
+++ perl/lib/FindBin.pm 2007-02-15 08:52:31.000000000 -0800
@@ -104,7 +104,14 @@
%EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]);
@ISA = qw(Exporter);
-$VERSION = "1.47";
+$VERSION = "1.48";
+
+
+# needed for VMS-specific filename translation
+if( $^O eq 'VMS' ) {
+ require VMS::Filespec;
+ VMS::Filespec->import;
+}
sub cwd2 {
my $cwd = getcwd();
@@ -124,6 +131,7 @@
# perl invoked with -e or script is on C<STDIN>
$Script = $RealScript = $0;
$Bin = $RealBin = cwd2();
+ $Bin = VMS::Filespec::unixify($Bin) if $^O eq 'VMS';
}
else
{
@@ -131,7 +139,9 @@
if ($^O eq 'VMS')
{
- ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*\])(.*)/s;
+ ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*[\]>]+)(.*)/s;
+ # C<use disk:[dev]/lib> isn't going to work, so unixify first
+ ($Bin = VMS::Filespec::unixify($Bin)) =~ s/\/\z//;
($RealBin,$RealScript) = ($Bin,$Script);
}
else
@@ -142,24 +152,19 @@
{
my $dir;
foreach $dir (File::Spec->path)
- {
+ {
my $scr = File::Spec->catfile($dir, $script);
- if(-r $scr && (!$dosish || -x _))
+
+ # $script can been found via PATH but perl could have
+ # been invoked as 'perl file'. Do a dumb check to see
+ # if $script is a perl program, if not then keep $script = $0
+ #
+ # well we actually only check that it is an ASCII file
+ # we know its executable so it is probably a script
+ # of some sort.
+ if(-f $scr && -r _ && ($dosish || -x _) && -s _ && -T _)
{
$script = $scr;
-
- if (-f $0)
- {
- # $script has been found via PATH but perl could have
- # been invoked as 'perl file'. Do a dumb check to see
- # if $script is a perl program, if not then $script = $0
- #
- # well we actually only check that it is an ASCII file
- # we know its executable so it is probably a script
- # of some sort.
-
- $script = $0 unless(-T $script);
- }
last;
}
}
End of Patch.
