Change 34674 by [EMAIL PROTECTED] on 2008/10/30 23:13:19
Integrate:
[ 34657]
Integrate:
[ 34514]
Upgrade PathTools to 3.28_01
[ 34543]
Cwd.xs won't load in development releases, unless we munge the
XS_VERSION.
[ 34606]
Upgrade Cwd.xs to the Cwd.xs in PathTools 3.26_01:
- abs_path() on Unix(ish) platforms has been upgraded to a much later
version of the underlying C code from BSD. [Michael Schwern]
- If strlcpy() and strlcat() aren't available on the user's system,
we now use ppport.h to provide them, so our C code works. [Steve
Peters]
This unwinds change 32710 (consting from Robin Barker of the old code)
[ 34607]
Grab the second half of r10084 for cwd.t, which wasn't in change 33042.
Update the Changes file with changes from 3.26 to 3.28_01 inclusive.
[ 34609]
Upgrade to PathTools 3.28_03.
[ 34611]
After the upgrade to 3.28_03 we need to revert change 34543.
[ 34643]
Upgrade to PathTools 3.29.
Affected files ...
... //depot/maint-5.8/perl/ext/Cwd/Changes#13 integrate
... //depot/maint-5.8/perl/ext/Cwd/Cwd.xs#13 integrate
... //depot/maint-5.8/perl/ext/Cwd/Makefile.PL#3 integrate
... //depot/maint-5.8/perl/ext/Cwd/t/cwd.t#20 integrate
... //depot/maint-5.8/perl/ext/Cwd/t/win32.t#3 integrate
... //depot/maint-5.8/perl/lib/Cwd.pm#24 integrate
... //depot/maint-5.8/perl/lib/File/Spec.pm#21 integrate
... //depot/maint-5.8/perl/lib/File/Spec/Cygwin.pm#13 integrate
... //depot/maint-5.8/perl/lib/File/Spec/Epoc.pm#9 integrate
... //depot/maint-5.8/perl/lib/File/Spec/Functions.pm#8 integrate
... //depot/maint-5.8/perl/lib/File/Spec/Mac.pm#14 integrate
... //depot/maint-5.8/perl/lib/File/Spec/OS2.pm#14 integrate
... //depot/maint-5.8/perl/lib/File/Spec/Unix.pm#22 integrate
... //depot/maint-5.8/perl/lib/File/Spec/VMS.pm#17 integrate
... //depot/maint-5.8/perl/lib/File/Spec/Win32.pm#17 integrate
... //depot/maint-5.8/perl/lib/File/Spec/t/Spec.t#17 integrate
Differences ...
==== //depot/maint-5.8/perl/ext/Cwd/Changes#13 (text) ====
Index: perl/ext/Cwd/Changes
--- perl/ext/Cwd/Changes#12~33174~ 2008-02-01 12:08:10.000000000 -0800
+++ perl/ext/Cwd/Changes 2008-10-30 16:13:19.000000000 -0700
@@ -1,5 +1,110 @@
Revision history for Perl distribution PathTools.
+3.29 - Wed Oct 29 20:48:11 2008
+
+- Promote to stable release.
+
+3.28_03 - Mon Oct 27 22:12:11 2008
+
+- In Cwd.pm, pass the un-munged $VERSION to XSLoader/DynaLoader,
+ otherwise development releases fail tests on Win32.
+
+3.28_02 - Mon Oct 27 20:13:11 2008
+
+ - Fixed some issues on QNX/NTO related to paths with double
+ slashes. [Matt Kraai & Nicholas Clark]
+
+3.28_01 - Fri Jul 25 21:18:11 2008
+
+ - Fixed and clarified the behavior of splitpath() with a $no_file
+ argument on VMS. [Craig A. Berry, Peter Edwards]
+
+ - Removed some function prototypes and other Perl::Critic violations.
+
+ - canonpath() and catdir() and catfile() on Win32 now make an
+ explicit (and unnecessary) copy of their arguments right away,
+ because apparently if we don't, we sabotage all of Win32dom. [RT
+ #33675]
+
+ - The Makefile.PL now has 'use 5.005;' to explicitly show what
+ minimum version of perl we support. [Spotted by Alexandr Ciornii]
+
+3.2701 - Mon Feb 11 21:43:51 2008
+
+ - Fixed an edge case for Win32 catdir('C:', 'foo') and catfile('C:',
+ 'foo.txt') (which the caller's not really supposed to do, that's
+ what catpath() is for) that changed between versions. Now we're
+ back to the old behavior, which was to return C:\foo and C:\foo.txt .
+ [Audrey Tang]
+
+3.27 - Wed Jan 16 20:20:49 2008
+
+ - If strlcpy() and strlcat() aren't available on the user's system,
+ we now use ppport.h to provide them, so our C code works. [Steve
+ Peters]
+
+ - Upgraded to a newer version of ppport.h [Steve Peters]
+
+3.26 - Sun Jan 13 21:59:20 2008
+
+ - case_tolerant() on Cygwin will now avoid a painful death when
+ Cygwin::mount_flags() isn't defined, as is the case for perl <
+ 5.10. It will now just return 1, which is what it always did
+ before it got so smart. [Spotted by Emanuele Zeppieri]
+
+ - abs_path() on Unix(ish) platforms has been upgraded to a much later
+ version of the underlying C code from BSD. [Michael Schwern]
+
+3.2501 - Mon Dec 24 20:33:02 2007
+
+ - Reimplemented abs_path() on VMS to use
+ VMS::Filespec::vms_realpath() when it's available. [John E. Malmberg]
+
+ - tmpdir() on Cygwin now also looks in $ENV{TMP} and $ENV{TEMP}.
+
+ - case_tolerant() on Cygwin and Win32 now take an optional path
+ argument, defaulting to the C drive, to check for case tolerance,
+ because this fact can vary on different volumes.
+
+ - File::Spec on Unix now uses Cwd::getcwd() rather than Cwd::cwd() to
+ get the current directory because I guess someone on p5p thought it
+ was more appropriate.
+
+ - Added a large set of File::Spec tests for the Cygwin platform.
+
+ - abs_path() now behaves correctly with symbolic links on VMS.
+
+ - Someone fixed a couple of mysterious edge cases in VMS' canonpath()
+ and splitdir().
+
+3.25_01 - Sat Oct 13 21:13:57 2007
+
+ - Major fixes on Win32, including a rewrite of catdir(), catfile(),
+ and canonpath() in terms of a single body of code. [Heinrich Tegethoff]
+
+ - For Win32 and Cygwin, case-tolerance can vary depending on the
+ volume under scrutiny. When Win32API::File is available, it will
+ be employed to determine case-sensitivity of the given filesystem
+ (C: by default), otherwise we still return the default of 1. [Reini
+ Urban]
+
+ - On Cygwin, we added $ENV{'TMP'} and $ENV{'TEMP'} to the list of
+ possible places to look for tmpdir() return values. [Reini Urban]
+
+ - Added lots more tests for Cygwin. [Reini Urban]
+
+ - canonpath() with no arguments and canonpath(undef) now consistently
+ return undef on all platforms. [Spotted by Peter John Edwards]
+
+ - Fixed splitdir('') and splitdir(undef) and splitdir() to return an
+ empty list on VMS and MacOS, like it does on other platforms.
+ [Craig A. Berry]
+
+ - All .pm files now have the same $VERSION number, rather than a
+ hodgepodge of various numbers.
+
+3.25 - Mon May 21 21:07:26 2007
+
- Added a workaround for auto-vivication-of-function-args Perl bug
(triggered by OS/2-specific code). [Ilya Zakharevich]
==== //depot/maint-5.8/perl/ext/Cwd/Cwd.xs#13 (text) ====
Index: perl/ext/Cwd/Cwd.xs
--- perl/ext/Cwd/Cwd.xs#12~33868~ 2008-05-19 08:43:18.000000000 -0700
+++ perl/ext/Cwd/Cwd.xs 2008-10-30 16:13:19.000000000 -0700
@@ -64,148 +64,160 @@
*/
static
char *
-bsd_realpath(const char *path, char *resolved)
+bsd_realpath(const char *path, char resolved[MAXPATHLEN])
{
#ifdef VMS
dTHX;
return Perl_rmsexpand(aTHX_ (char*)path, resolved, NULL, 0);
#else
- int rootd, serrno;
- const char *p;
- char *q, wbuf[MAXPATHLEN];
- int symlinks = 0;
-
- /* Save the starting point. */
-#ifdef HAS_FCHDIR
- int fd;
-
- if ((fd = open(".", O_RDONLY)) < 0) {
- (void)strcpy(resolved, ".");
+ char *p, *q, *s;
+ size_t left_len, resolved_len;
+ unsigned symlinks;
+ int serrno;
+ char left[MAXPATHLEN], next_token[MAXPATHLEN], symlink[MAXPATHLEN];
+
+ serrno = errno;
+ symlinks = 0;
+ if (path[0] == '/') {
+ resolved[0] = '/';
+ resolved[1] = '\0';
+ if (path[1] == '\0')
+ return (resolved);
+ resolved_len = 1;
+ left_len = my_strlcpy(left, path + 1, sizeof(left));
+ } else {
+ if (getcwd(resolved, MAXPATHLEN) == NULL) {
+ my_strlcpy(resolved, ".", MAXPATHLEN);
return (NULL);
}
-#else
- char wd[MAXPATHLEN];
-
- if (getcwd(wd, MAXPATHLEN - 1) == NULL) {
- (void)strcpy(resolved, ".");
+ resolved_len = strlen(resolved);
+ left_len = my_strlcpy(left, path, sizeof(left));
+ }
+ if (left_len >= sizeof(left) || resolved_len >= MAXPATHLEN) {
+ errno = ENAMETOOLONG;
return (NULL);
}
-#endif
/*
- * Find the dirname and basename from the path to be resolved.
- * Change directory to the dirname component.
- * lstat the basename part.
- * if it is a symlink, read in the value and loop.
- * if it is a directory, then change to that directory.
- * get the current directory name and append the basename.
+ * Iterate over path components in `left'.
*/
- (void)strncpy(resolved, path, MAXPATHLEN - 1);
- resolved[MAXPATHLEN - 1] = '\0';
-loop:
- q = strrchr(resolved, '/');
- if (q != NULL) {
- const char *dir;
- p = q + 1;
- if (q == resolved)
- dir = "/";
- else {
- do {
- --q;
- } while (q > resolved && *q == '/');
- q[1] = '\0';
- dir = resolved;
- }
- if (chdir(dir) < 0)
- goto err1;
- } else
- p = resolved;
-
-#if defined(HAS_LSTAT) && defined(HAS_READLINK) && defined(HAS_SYMLINK)
- {
- struct stat sb;
- /* Deal with the last component. */
- if (lstat(p, &sb) == 0) {
- if (S_ISLNK(sb.st_mode)) {
- int n;
- if (++symlinks > MAXSYMLINKS) {
- errno = ELOOP;
- goto err1;
+ while (left_len != 0) {
+ /*
+ * Extract the next path component and adjust `left'
+ * and its length.
+ */
+ p = strchr(left, '/');
+ s = p ? p : left + left_len;
+ if (s - left >= sizeof(next_token)) {
+ errno = ENAMETOOLONG;
+ return (NULL);
}
- n = readlink(p, resolved, MAXPATHLEN-1);
- if (n < 0)
- goto err1;
- resolved[n] = '\0';
- goto loop;
- }
- if (S_ISDIR(sb.st_mode)) {
- if (chdir(p) < 0)
- goto err1;
- p = "";
+ memcpy(next_token, left, s - left);
+ next_token[s - left] = '\0';
+ left_len -= s - left;
+ if (p != NULL)
+ memmove(left, s + 1, left_len + 1);
+ if (resolved[resolved_len - 1] != '/') {
+ if (resolved_len + 1 >= MAXPATHLEN) {
+ errno = ENAMETOOLONG;
+ return (NULL);
}
+ resolved[resolved_len++] = '/';
+ resolved[resolved_len] = '\0';
}
+ if (next_token[0] == '\0')
+ continue;
+ else if (strcmp(next_token, ".") == 0)
+ continue;
+ else if (strcmp(next_token, "..") == 0) {
+ /*
+ * Strip the last path component except when we have
+ * single "/"
+ */
+ if (resolved_len > 1) {
+ resolved[resolved_len - 1] = '\0';
+ q = strrchr(resolved, '/') + 1;
+ *q = '\0';
+ resolved_len = q - resolved;
+ }
+ continue;
}
-#endif
/*
- * Save the last component name and get the full pathname of
- * the current directory.
+ * Append the next path component and lstat() it. If
+ * lstat() fails we still can return successfully if
+ * there are no more path components left.
*/
- (void)strcpy(wbuf, p);
- if (getcwd(resolved, MAXPATHLEN) == 0)
- goto err1;
+ resolved_len = my_strlcat(resolved, next_token, MAXPATHLEN);
+ if (resolved_len >= MAXPATHLEN) {
+ errno = ENAMETOOLONG;
+ return (NULL);
+ }
+ #if defined(HAS_LSTAT) && defined(HAS_READLINK) && defined(HAS_SYMLINK)
+ {
+ struct stat sb;
+ if (lstat(resolved, &sb) != 0) {
+ if (errno == ENOENT && p == NULL) {
+ errno = serrno;
+ return (resolved);
+ }
+ return (NULL);
+ }
+ if (S_ISLNK(sb.st_mode)) {
+ int slen;
+
+ if (symlinks++ > MAXSYMLINKS) {
+ errno = ELOOP;
+ return (NULL);
+ }
+ slen = readlink(resolved, symlink,
sizeof(symlink) - 1);
+ if (slen < 0)
+ return (NULL);
+ symlink[slen] = '\0';
+ if (symlink[0] == '/') {
+ resolved[1] = 0;
+ resolved_len = 1;
+ } else if (resolved_len > 1) {
+ /* Strip the last path component. */
+ resolved[resolved_len - 1] = '\0';
+ q = strrchr(resolved, '/') + 1;
+ *q = '\0';
+ resolved_len = q - resolved;
+ }
/*
- * Join the two strings together, ensuring that the right thing
- * happens if the last component is empty, or the dirname is root.
+ * If there are any path components left, then
+ * append them to symlink. The result is placed
+ * in `left'.
*/
- if (resolved[0] == '/' && resolved[1] == '\0')
- rootd = 1;
- else
- rootd = 0;
-
- if (*wbuf) {
- if (strlen(resolved) + strlen(wbuf) + (1 - rootd) + 1 >
MAXPATHLEN) {
+ if (p != NULL) {
+ if (symlink[slen - 1] != '/') {
+ if (slen + 1 >=
sizeof(symlink)) {
errno = ENAMETOOLONG;
- goto err1;
+ return (NULL);
}
- if (rootd == 0)
- (void)strcat(resolved, "/");
- (void)strcat(resolved, wbuf);
+ symlink[slen] = '/';
+ symlink[slen + 1] = 0;
}
-
- /* Go back to where we came from. */
-#ifdef HAS_FCHDIR
- if (fchdir(fd) < 0) {
- serrno = errno;
- goto err2;
+ left_len = my_strlcat(symlink, left,
sizeof(left));
+ if (left_len >= sizeof(left)) {
+ errno = ENAMETOOLONG;
+ return (NULL);
}
-#else
- if (chdir(wd) < 0) {
- serrno = errno;
- goto err2;
}
-#endif
+ left_len = my_strlcpy(left, symlink,
sizeof(left));
+ }
+ }
+ #endif
+ }
- /* It's okay if the close fails, what's an fd more or less? */
-#ifdef HAS_FCHDIR
- (void)close(fd);
-#endif
+ /*
+ * Remove trailing slash except when the resolved pathname
+ * is a single "/".
+ */
+ if (resolved_len > 1 && resolved[resolved_len - 1] == '/')
+ resolved[resolved_len - 1] = '\0';
return (resolved);
-
-err1: serrno = errno;
-#ifdef HAS_FCHDIR
- (void)fchdir(fd);
-#else
- (void)chdir(wd);
-#endif
-
-err2:
-#ifdef HAS_FCHDIR
- (void)close(fd);
-#endif
- errno = serrno;
- return (NULL);
#endif
}
==== //depot/maint-5.8/perl/ext/Cwd/t/cwd.t#20 (text) ====
Index: perl/ext/Cwd/t/cwd.t
--- perl/ext/Cwd/t/cwd.t#19~33868~ 2008-05-19 08:43:18.000000000 -0700
+++ perl/ext/Cwd/t/cwd.t 2008-10-30 16:13:19.000000000 -0700
@@ -163,23 +163,20 @@
SKIP: {
skip "no symlinks on this platform", 2+$EXTRA_ABSPATH_TESTS unless
$Config{d_symlink};
+ my $file = "linktest";
mkpath([$Test_Dir], 0, 0777);
- symlink $Test_Dir, "linktest";
+ symlink $Test_Dir, $file;
- my $abs_path = Cwd::abs_path("linktest");
- my $fast_abs_path = Cwd::fast_abs_path("linktest");
- my $want = quotemeta(
- File::Spec->rel2abs(
- $ENV{PERL_CORE} ? $Test_Dir :
File::Spec->catdir('t', $Test_Dir)
- )
- );
+ my $abs_path = Cwd::abs_path($file);
+ my $fast_abs_path = Cwd::fast_abs_path($file);
+ my $want = quotemeta( File::Spec->rel2abs($Test_Dir) );
like($abs_path, qr|$want$|i);
like($fast_abs_path, qr|$want$|i);
- like(Cwd::_perl_abs_path("linktest"), qr|$want$|i) if $EXTRA_ABSPATH_TESTS;
+ like(Cwd::_perl_abs_path($file), qr|$want$|i) if $EXTRA_ABSPATH_TESTS;
rmtree($test_dirs[0], 0, 0);
- 1 while unlink "linktest";
+ 1 while unlink $file;
}
if ($ENV{PERL_CORE}) {
==== //depot/maint-5.8/perl/ext/Cwd/t/win32.t#3 (text) ====
Index: perl/ext/Cwd/t/win32.t
--- perl/ext/Cwd/t/win32.t#2~24144~ 2005-04-03 08:18:11.000000000 -0700
+++ perl/ext/Cwd/t/win32.t 2008-10-30 16:13:19.000000000 -0700
@@ -11,7 +11,7 @@
use Test::More;
if( $^O eq 'MSWin32' ) {
- plan tests => 3;
+ plan tests => 4;
} else {
plan skip_all => 'this is not win32';
}
@@ -29,3 +29,10 @@
# May not have a D: drive mounted
ok 1;
}
+
+# Ensure compatibility with naughty versions of Template::Toolkit,
+# which pass in a bare $1 as an argument
+'Foo/strawberry' =~ /(.*)/;
+my $result = File::Spec::Win32->catfile('C:/cache', $1);
+is( $result, 'C:\cache\Foo\strawberry' );
+
==== //depot/maint-5.8/perl/lib/Cwd.pm#24 (text) ====
Index: perl/lib/Cwd.pm
--- perl/lib/Cwd.pm#23~33868~ 2008-05-19 08:43:18.000000000 -0700
+++ perl/lib/Cwd.pm 2008-10-30 16:13:19.000000000 -0700
@@ -171,7 +171,9 @@
use Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
-$VERSION = '3.2701';
+$VERSION = '3.29';
+my $xs_version = $VERSION;
+$VERSION = eval $VERSION;
@ISA = qw/ Exporter /;
@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
@@ -204,11 +206,11 @@
eval {
if ( $] >= 5.006 ) {
require XSLoader;
- XSLoader::load( __PACKAGE__, $VERSION );
+ XSLoader::load( __PACKAGE__, $xs_version);
} else {
require DynaLoader;
push @ISA, 'DynaLoader';
- __PACKAGE__->bootstrap( $VERSION );
+ __PACKAGE__->bootstrap( $xs_version );
}
};
==== //depot/maint-5.8/perl/lib/File/Spec.pm#21 (text) ====
Index: perl/lib/File/Spec.pm
--- perl/lib/File/Spec.pm#20~33868~ 2008-05-19 08:43:18.000000000 -0700
+++ perl/lib/File/Spec.pm 2008-10-30 16:13:19.000000000 -0700
@@ -3,7 +3,7 @@
use strict;
use vars qw(@ISA $VERSION);
-$VERSION = '3.2701';
+$VERSION = '3.29';
$VERSION = eval $VERSION;
my %module = (MacOS => 'Mac',
==== //depot/maint-5.8/perl/lib/File/Spec/Cygwin.pm#13 (text) ====
Index: perl/lib/File/Spec/Cygwin.pm
--- perl/lib/File/Spec/Cygwin.pm#12~33868~ 2008-05-19 08:43:18.000000000
-0700
+++ perl/lib/File/Spec/Cygwin.pm 2008-10-30 16:13:19.000000000 -0700
@@ -4,7 +4,8 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.2701';
+$VERSION = '3.29';
+$VERSION = eval $VERSION;
@ISA = qw(File::Spec::Unix);
@@ -111,7 +112,7 @@
=cut
-sub case_tolerant () {
+sub case_tolerant {
return 1 unless $^O eq 'cygwin'
and defined &Cygwin::mount_flags;
==== //depot/maint-5.8/perl/lib/File/Spec/Epoc.pm#9 (text) ====
Index: perl/lib/File/Spec/Epoc.pm
--- perl/lib/File/Spec/Epoc.pm#8~33868~ 2008-05-19 08:43:18.000000000 -0700
+++ perl/lib/File/Spec/Epoc.pm 2008-10-30 16:13:19.000000000 -0700
@@ -3,7 +3,8 @@
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '3.2701';
+$VERSION = '3.29';
+$VERSION = eval $VERSION;
require File::Spec::Unix;
@ISA = qw(File::Spec::Unix);
==== //depot/maint-5.8/perl/lib/File/Spec/Functions.pm#8 (text) ====
Index: perl/lib/File/Spec/Functions.pm
--- perl/lib/File/Spec/Functions.pm#7~33868~ 2008-05-19 08:43:18.000000000
-0700
+++ perl/lib/File/Spec/Functions.pm 2008-10-30 16:13:19.000000000 -0700
@@ -5,7 +5,8 @@
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
-$VERSION = '3.2701';
+$VERSION = '3.29';
+$VERSION = eval $VERSION;
require Exporter;
==== //depot/maint-5.8/perl/lib/File/Spec/Mac.pm#14 (text) ====
Index: perl/lib/File/Spec/Mac.pm
--- perl/lib/File/Spec/Mac.pm#13~33868~ 2008-05-19 08:43:18.000000000 -0700
+++ perl/lib/File/Spec/Mac.pm 2008-10-30 16:13:19.000000000 -0700
@@ -4,7 +4,8 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.2701';
+$VERSION = '3.29';
+$VERSION = eval $VERSION;
@ISA = qw(File::Spec::Unix);
==== //depot/maint-5.8/perl/lib/File/Spec/OS2.pm#14 (text) ====
Index: perl/lib/File/Spec/OS2.pm
--- perl/lib/File/Spec/OS2.pm#13~33868~ 2008-05-19 08:43:18.000000000 -0700
+++ perl/lib/File/Spec/OS2.pm 2008-10-30 16:13:19.000000000 -0700
@@ -4,7 +4,8 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.2701';
+$VERSION = '3.29';
+$VERSION = eval $VERSION;
@ISA = qw(File::Spec::Unix);
==== //depot/maint-5.8/perl/lib/File/Spec/Unix.pm#22 (text) ====
Index: perl/lib/File/Spec/Unix.pm
--- perl/lib/File/Spec/Unix.pm#21~33868~ 2008-05-19 08:43:18.000000000
-0700
+++ perl/lib/File/Spec/Unix.pm 2008-10-30 16:13:19.000000000 -0700
@@ -3,7 +3,8 @@
use strict;
use vars qw($VERSION);
-$VERSION = '3.2701';
+$VERSION = '3.29';
+$VERSION = eval $VERSION;
=head1 NAME
@@ -49,7 +50,10 @@
# more than two leading slashes shall be treated as a single slash.")
my $node = '';
my $double_slashes_special = $^O eq 'qnx' || $^O eq 'nto';
- if ( $double_slashes_special && $path =~ s{^(//[^/]+)(?:/|\z)}{/}s ) {
+
+
+ if ( $double_slashes_special
+ && ( $path =~ s{^(//[^/]+)/?\z}{}s || $path =~ s{^(//[^/]+)/}{/}s ) )
{
$node = $1;
}
# This used to be
@@ -104,7 +108,7 @@
=cut
-sub curdir () { '.' }
+sub curdir { '.' }
=item devnull
@@ -112,7 +116,7 @@
=cut
-sub devnull () { '/dev/null' }
+sub devnull { '/dev/null' }
=item rootdir
@@ -120,7 +124,7 @@
=cut
-sub rootdir () { '/' }
+sub rootdir { '/' }
=item tmpdir
@@ -169,7 +173,7 @@
=cut
-sub updir () { '..' }
+sub updir { '..' }
=item no_upwards
@@ -190,7 +194,7 @@
=cut
-sub case_tolerant () { 0 }
+sub case_tolerant { 0 }
=item file_name_is_absolute
==== //depot/maint-5.8/perl/lib/File/Spec/VMS.pm#17 (text) ====
Index: perl/lib/File/Spec/VMS.pm
--- perl/lib/File/Spec/VMS.pm#16~33868~ 2008-05-19 08:43:18.000000000 -0700
+++ perl/lib/File/Spec/VMS.pm 2008-10-30 16:13:19.000000000 -0700
@@ -4,7 +4,8 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.2701';
+$VERSION = '3.29';
+$VERSION = eval $VERSION;
@ISA = qw(File::Spec::Unix);
@@ -242,16 +243,34 @@
=item splitpath (override)
-Splits using VMS syntax.
+ ($volume,$directories,$file) = File::Spec->splitpath( $path );
+ ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
+
+Passing a true value for C<$no_file> indicates that the path being
+split only contains directory components, even on systems where you
+can usually (when not supporting a foreign syntax) tell the difference
+between directories and files at a glance.
=cut
sub splitpath {
- my($self,$path) = @_;
- my($dev,$dir,$file) = ('','','');
-
- vmsify($path) =~ /(.+:)?([\[<].*[\]>])?(.*)/s;
- return ($1 || '',$2 || '',$3);
+ my($self,$path, $nofile) = @_;
+ my($dev,$dir,$file) = ('','','');
+ my $vmsify_path = vmsify($path);
+ if ( $nofile ){
+ #vmsify('d1/d2/d3') returns '[.d1.d2]d3'
+ #vmsify('/d1/d2/d3') returns 'd1:[d2]d3'
+ if( $vmsify_path =~ /(.*)\](.+)/ ){
+ $vmsify_path = $1.'.'.$2.']';
+ }
+ $vmsify_path =~ /(.+:)?(.*)/s;
+ $dir = defined $2 ? $2 : ''; # dir can be '0'
+ return ($1 || '',$dir,$file);
+ }
+ else {
+ $vmsify_path =~ /(.+:)?([\[<].*[\]>])?(.*)/s;
+ return ($1 || '',$2 || '',$3);
+ }
}
=item splitdir (override)
@@ -470,7 +489,7 @@
sub fixpath {
my($self,$path,$force_path) = @_;
return '' unless $path;
- $self = bless {} unless ref $self;
+ $self = bless {}, $self unless ref $self;
my($fixedpath,$prefix,$name);
if ($path =~ /\s/) {
==== //depot/maint-5.8/perl/lib/File/Spec/Win32.pm#17 (text) ====
Index: perl/lib/File/Spec/Win32.pm
--- perl/lib/File/Spec/Win32.pm#16~33868~ 2008-05-19 08:43:18.000000000
-0700
+++ perl/lib/File/Spec/Win32.pm 2008-10-30 16:13:19.000000000 -0700
@@ -5,7 +5,8 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.2701';
+$VERSION = '3.29';
+$VERSION = eval $VERSION;
@ISA = qw(File::Spec::Unix);
@@ -41,7 +42,7 @@
return "nul";
}
-sub rootdir () { '\\' }
+sub rootdir { '\\' }
=item tmpdir
@@ -87,7 +88,7 @@
=cut
-sub case_tolerant () {
+sub case_tolerant {
eval { require Win32API::File; } or return 1;
my $drive = shift || "C:";
my $osFsType = "\0"x256;
@@ -375,9 +376,10 @@
=cut
-sub _canon_cat(@) # @path -> path
+sub _canon_cat # @path -> path
{
- my $first = shift;
+ my ($first, @rest) = @_;
+
my $volume = $first =~ s{ \A ([A-Za-z]:) ([\\/]?) }{}x # drive letter
? ucfirst( $1 ).( $2 ? "\\" : "" )
: $first =~ s{ \A (?:\\\\|//) ([^\\/]+)
@@ -387,7 +389,7 @@
: $first =~ s{ \A [\\/] }{}x # root dir
? "\\"
: "";
- my $path = join "\\", $first, @_;
+ my $path = join "\\", $first, @rest;
$path =~ tr#\\/#\\\\#s; # xx/yy --> xx\yy & xx\\yy --> xx\yy
==== //depot/maint-5.8/perl/lib/File/Spec/t/Spec.t#17 (text) ====
Index: perl/lib/File/Spec/t/Spec.t
--- perl/lib/File/Spec/t/Spec.t#16~33868~ 2008-05-19 08:43:18.000000000
-0700
+++ perl/lib/File/Spec/t/Spec.t 2008-10-30 16:13:19.000000000 -0700
@@ -312,6 +312,44 @@
[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]')",
'node"access_spec"::volume:,[d1.d2.d3],' ],
[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]file')",
'node"access_spec"::volume:,[d1.d2.d3],file' ],
+[ "VMS->splitpath('[]')", ',[],'
],
+[ "VMS->splitpath('[-]')", ',[-],'
],
+[ "VMS->splitpath('[]file')", ',[],file'
],
+[ "VMS->splitpath('[-]file')", ',[-],file'
],
+[ "VMS->splitpath('')", ',,'
],
+[ "VMS->splitpath('0')", ',,0'
],
+[ "VMS->splitpath('[0]')", ',[0],'
],
+[ "VMS->splitpath('[.0]')", ',[.0],'
],
+[ "VMS->splitpath('[0.0.0]')", ',[0.0.0],'
],
+[ "VMS->splitpath('[.0.0.0]')", ',[.0.0.0],'
],
+[ "VMS->splitpath('[0]0')", ',[0],0'
],
+[ "VMS->splitpath('[0.0.0]0')", ',[0.0.0],0'
],
+[ "VMS->splitpath('[.0.0.0]0')",
',[.0.0.0],0' ],
+[ "VMS->splitpath('0/0')", ',[.0],0'
],
+[ "VMS->splitpath('0/0/0')", ',[.0.0],0'
],
+[ "VMS->splitpath('/0/0')",
'0:,[000000],0' ],
+[ "VMS->splitpath('/0/0/0')", '0:,[0],0'
],
+[ "VMS->splitpath('d1',1)", ',d1,'
],
+# $no_file tests
+[ "VMS->splitpath('[d1.d2.d3]',1)",
',[d1.d2.d3],' ],
+[ "VMS->splitpath('[.d1.d2.d3]',1)",
',[.d1.d2.d3],' ],
+[ "VMS->splitpath('d1/d2/d3',1)",
',[.d1.d2.d3],' ],
+[ "VMS->splitpath('/d1/d2/d3',1)",
'd1:,[d2.d3],' ],
+[ "VMS->splitpath('node::volume:[d1.d2.d3]',1)",
'node::volume:,[d1.d2.d3],' ],
+[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]',1)",
'node"access_spec"::volume:,[d1.d2.d3],' ],
+[ "VMS->splitpath('[]',1)", ',[],'
],
+[ "VMS->splitpath('[-]',1)", ',[-],'
],
+[ "VMS->splitpath('',1)", ',,'
],
+[ "VMS->splitpath('0',1)", ',0,'
],
+[ "VMS->splitpath('[0]',1)", ',[0],'
],
+[ "VMS->splitpath('[.0]',1)", ',[.0],'
],
+[ "VMS->splitpath('[0.0.0]',1)", ',[0.0.0],'
],
+[ "VMS->splitpath('[.0.0.0]',1)", ',[.0.0.0],'
],
+[ "VMS->splitpath('0/0',1)", ',[.0.0],'
],
+[ "VMS->splitpath('0/0/0',1)", ',[.0.0.0],'
],
+[ "VMS->splitpath('/0/0',1)",
'0:,[000000.0],' ],
+[ "VMS->splitpath('/0/0/0',1)", '0:,[0.0],'
],
+
[ "VMS->catpath('','','file')", 'file'
],
[ "VMS->catpath('','[d1.d2.d3]','')",
'[d1.d2.d3]' ],
[ "VMS->catpath('','[.d1.d2.d3]','')",
'[.d1.d2.d3]' ],
End of Patch.
