r12754 - in /branches/upstream/libfile-spec-perl/current: ./ lib/File/ lib/File/Spec/ t/
tincho-guest at users.alioth.debian.org
tincho-guest at users.alioth.debian.org
Tue Jan 15 04:55:22 UTC 2008
Author: tincho-guest
Date: Tue Jan 15 04:55:20 2008
New Revision: 12754
URL: http://svn.debian.org/wsvn/?sc=1&rev=12754
Log:
[svn-upgrade] Integrating new upstream version, libfile-spec-perl (3.2600)
Modified:
branches/upstream/libfile-spec-perl/current/Changes
branches/upstream/libfile-spec-perl/current/Cwd.pm
branches/upstream/libfile-spec-perl/current/Cwd.xs
branches/upstream/libfile-spec-perl/current/META.yml
branches/upstream/libfile-spec-perl/current/SIGNATURE
branches/upstream/libfile-spec-perl/current/lib/File/Spec.pm
branches/upstream/libfile-spec-perl/current/lib/File/Spec/Cygwin.pm
branches/upstream/libfile-spec-perl/current/lib/File/Spec/Epoc.pm
branches/upstream/libfile-spec-perl/current/lib/File/Spec/Functions.pm
branches/upstream/libfile-spec-perl/current/lib/File/Spec/Mac.pm
branches/upstream/libfile-spec-perl/current/lib/File/Spec/OS2.pm
branches/upstream/libfile-spec-perl/current/lib/File/Spec/Unix.pm
branches/upstream/libfile-spec-perl/current/lib/File/Spec/VMS.pm
branches/upstream/libfile-spec-perl/current/lib/File/Spec/Win32.pm
branches/upstream/libfile-spec-perl/current/t/Spec.t
branches/upstream/libfile-spec-perl/current/t/crossplatform.t
branches/upstream/libfile-spec-perl/current/t/cwd.t
branches/upstream/libfile-spec-perl/current/t/tmpdir.t
Modified: branches/upstream/libfile-spec-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/Changes?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/Changes (original)
+++ branches/upstream/libfile-spec-perl/current/Changes Tue Jan 15 04:55:20 2008
@@ -1,4 +1,19 @@
Revision history for Perl distribution PathTools.
+
+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}.
@@ -16,6 +31,32 @@
- 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
Modified: branches/upstream/libfile-spec-perl/current/Cwd.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/Cwd.pm?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/Cwd.pm (original)
+++ branches/upstream/libfile-spec-perl/current/Cwd.pm Tue Jan 15 04:55:20 2008
@@ -171,7 +171,7 @@
use Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
-$VERSION = '3.2501';
+$VERSION = '3.26';
@ISA = qw/ Exporter /;
@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
@@ -540,8 +540,8 @@
local *PARENT;
unless (opendir(PARENT, $dotdots))
{
- _carp("opendir($dotdots): $!");
- return '';
+ # probably a permissions issue. Try the native command.
+ return File::Spec->rel2abs( $start, _backtick_pwd() );
}
unless (@cst = stat($dotdots))
{
@@ -653,6 +653,25 @@
return _vms_abs_path($link_target);
}
+ if (defined &VMS::Filespec::vms_realpath) {
+ my $path = $_[0];
+ if ($path =~ m#(?<=\^)/# ) {
+ # Unix format
+ return VMS::Filespec::vms_realpath($path);
+ }
+
+ # VMS format
+
+ my $new_path = VMS::Filespec::vms_realname($path);
+
+ # Perl expects directories to be in directory format
+ $new_path = VMS::Filespec::pathify($new_path) if -d $path;
+ return $new_path;
+ }
+
+ # Fallback to older algorithm if correct ones are not
+ # available.
+
# may need to turn foo.dir into [.foo]
my $pathified = VMS::Filespec::pathify($path);
$path = $pathified if defined $pathified;
Modified: branches/upstream/libfile-spec-perl/current/Cwd.xs
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/Cwd.xs?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/Cwd.xs (original)
+++ branches/upstream/libfile-spec-perl/current/Cwd.xs Tue Jan 15 04:55:20 2008
@@ -10,9 +10,8 @@
# include <unistd.h>
#endif
-/* The realpath() implementation from OpenBSD 2.9 (realpath.c 1.4)
+/* The realpath() implementation from OpenBSD 3.9 to 4.2 (realpath.c 1.13)
* Renamed here to bsd_realpath() to avoid library conflicts.
- * --jhi 2000-06-20
*/
/* See
@@ -22,11 +21,7 @@
*/
/*
- * Copyright (c) 1994
- * The Regents of the University of California. All rights reserved.
- *
- * This code is derived from software contributed to Berkeley by
- * Jan-Simon Pendry.
+ * Copyright (c) 2003 Constantin S. Svintsoff <kostik at iclub.nsu.ru>
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
@@ -36,14 +31,14 @@
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
- * 3. Neither the name of the University nor the names of its contributors
- * may be used to endorse or promote products derived from this software
- * without specific prior written permission.
+ * 3. The names of the authors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
*
- * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
@@ -53,10 +48,6 @@
* SUCH DAMAGE.
*/
-#if defined(LIBC_SCCS) && !defined(lint)
-static char *rcsid = "$OpenBSD: realpath.c,v 1.4 1998/05/18 09:55:19 deraadt Exp $";
-#endif /* LIBC_SCCS and not lint */
-
/* OpenBSD system #includes removed since the Perl ones should do. --jhi */
#ifndef MAXSYMLINKS
@@ -64,7 +55,7 @@
#endif
/*
- * char *realpath(const char *path, char resolved_path[MAXPATHLEN]);
+ * char *realpath(const char *path, char resolved[MAXPATHLEN]);
*
* Find the real name of path, by removing all ".", ".." and symlink
* components. Returns (resolved) on success, or (NULL) on failure,
@@ -72,146 +63,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;
- char *p, *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 = strlcpy(left, path + 1, sizeof(left));
+ } else {
+ if (getcwd(resolved, MAXPATHLEN) == NULL) {
+ strlcpy(resolved, ".", MAXPATHLEN);
return (NULL);
}
-#else
- char wd[MAXPATHLEN];
-
- if (getcwd(wd, MAXPATHLEN - 1) == NULL) {
- (void)strcpy(resolved, ".");
+ resolved_len = strlen(resolved);
+ left_len = 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) {
- p = q + 1;
- if (q == resolved)
- q = "/";
- else {
- do {
- --q;
- } while (q > resolved && *q == '/');
- q[1] = '\0';
- q = resolved;
+ 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);
+ }
+ 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);
}
- if (chdir(q) < 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;
+ 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;
}
- n = readlink(p, resolved, MAXPATHLEN-1);
- if (n < 0)
- goto err1;
- resolved[n] = '\0';
- goto loop;
+ continue;
+ }
+
+ /*
+ * Append the next path component and lstat() it. If
+ * lstat() fails we still can return successfully if
+ * there are no more path components left.
+ */
+ resolved_len = strlcat(resolved, next_token, MAXPATHLEN);
+ if (resolved_len >= MAXPATHLEN) {
+ errno = ENAMETOOLONG;
+ return (NULL);
}
- if (S_ISDIR(sb.st_mode)) {
- if (chdir(p) < 0)
- goto err1;
- p = "";
+ #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;
+ }
+
+ /*
+ * If there are any path components left, then
+ * append them to symlink. The result is placed
+ * in `left'.
+ */
+ if (p != NULL) {
+ if (symlink[slen - 1] != '/') {
+ if (slen + 1 >= sizeof(symlink)) {
+ errno = ENAMETOOLONG;
+ return (NULL);
}
- }
- }
-#endif
+ symlink[slen] = '/';
+ symlink[slen + 1] = 0;
+ }
+ left_len = strlcat(symlink, left, sizeof(left));
+ if (left_len >= sizeof(left)) {
+ errno = ENAMETOOLONG;
+ return (NULL);
+ }
+ }
+ left_len = strlcpy(left, symlink, sizeof(left));
+ }
+ }
+ #endif
+ }
/*
- * Save the last component name and get the full pathname of
- * the current directory.
+ * Remove trailing slash except when the resolved pathname
+ * is a single "/".
*/
- (void)strcpy(wbuf, p);
- if (getcwd(resolved, MAXPATHLEN) == 0)
- goto err1;
-
- /*
- * Join the two strings together, ensuring that the right thing
- * happens if the last component is empty, or the dirname is root.
- */
- if (resolved[0] == '/' && resolved[1] == '\0')
- rootd = 1;
- else
- rootd = 0;
-
- if (*wbuf) {
- if (strlen(resolved) + strlen(wbuf) + (1 - rootd) + 1 > MAXPATHLEN) {
- errno = ENAMETOOLONG;
- goto err1;
- }
- if (rootd == 0)
- (void)strcat(resolved, "/");
- (void)strcat(resolved, wbuf);
- }
-
- /* Go back to where we came from. */
-#ifdef HAS_FCHDIR
- if (fchdir(fd) < 0) {
- serrno = errno;
- goto err2;
- }
-#else
- if (chdir(wd) < 0) {
- serrno = errno;
- goto err2;
- }
-#endif
-
- /* It's okay if the close fails, what's an fd more or less? */
-#ifdef HAS_FCHDIR
- (void)close(fd);
-#endif
+ 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
}
Modified: branches/upstream/libfile-spec-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/META.yml?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/META.yml (original)
+++ branches/upstream/libfile-spec-perl/current/META.yml Tue Jan 15 04:55:20 2008
@@ -1,6 +1,6 @@
---
name: PathTools
-version: 3.2501
+version: 3.26
author:
- 'Maintained by Ken Williams <KWILLIAMS at cpan.org>'
abstract: Tools for working with paths and file specs across platforms
@@ -21,34 +21,34 @@
provides:
Cwd:
file: Cwd.pm
- version: 3.2501
+ version: 3.26
File::Spec:
file: lib/File/Spec.pm
- version: 3.2501
+ version: 3.26
File::Spec::Cygwin:
file: lib/File/Spec/Cygwin.pm
- version: 3.2501
+ version: 3.26
File::Spec::Epoc:
file: lib/File/Spec/Epoc.pm
- version: 3.2501
+ version: 3.26
File::Spec::Functions:
file: lib/File/Spec/Functions.pm
- version: 3.2501
+ version: 3.26
File::Spec::Mac:
file: lib/File/Spec/Mac.pm
- version: 3.2501
+ version: 3.26
File::Spec::OS2:
file: lib/File/Spec/OS2.pm
- version: 3.2501
+ version: 3.26
File::Spec::Unix:
file: lib/File/Spec/Unix.pm
- version: 3.2501
+ version: 3.26
File::Spec::VMS:
file: lib/File/Spec/VMS.pm
- version: 3.2501
+ version: 3.26
File::Spec::Win32:
file: lib/File/Spec/Win32.pm
- version: 3.2501
+ version: 3.26
generated_by: Module::Build version 0.2808
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.2.html
Modified: branches/upstream/libfile-spec-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/SIGNATURE?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/SIGNATURE (original)
+++ branches/upstream/libfile-spec-perl/current/SIGNATURE Tue Jan 15 04:55:20 2008
@@ -15,39 +15,39 @@
Hash: SHA1
SHA1 1197012d986a400414e13e25d519db39d392c730 Build.PL
-SHA1 b19dd58f5158f9e3fe023a43bbea540471714054 Changes
-SHA1 727d160573c97f453dcabc11b644f6140abe9048 Cwd.pm
-SHA1 cdbc14186a5fa967a7a39709690992a1516ee8e4 Cwd.xs
+SHA1 eab11e119fe35808830c2cb127e1b6c504221ac2 Changes
+SHA1 288bc8275fdd5497f8175a04098bed96c524a5b1 Cwd.pm
+SHA1 d82dce7018f78896bcaaedc338d248965a38fcd7 Cwd.xs
SHA1 ac6246562c365a8ad62f910ef31ce514d5a7e292 INSTALL
SHA1 58c981892283d338e23971c5926089e0a6812caf MANIFEST
-SHA1 16c91be2a8c9bc6acd162d44c9256b8f6f518cbe META.yml
+SHA1 50ff849966b4597ecce8e19206fe924e54f632a9 META.yml
SHA1 3fb144a9fe45192b55f0b2950c7074241b4f4aa8 Makefile.PL
-SHA1 f5341cd20701f88bfe6d7d933674473c6e6bd919 lib/File/Spec.pm
-SHA1 62cadf2e17c47d75a3e67c3761366665f3ce5a17 lib/File/Spec/Cygwin.pm
-SHA1 1a8a9e95c25317638751462eb0fb5c2acc6dfa7d lib/File/Spec/Epoc.pm
-SHA1 a8ab06ad1067ce48f4550323bb641be1db228590 lib/File/Spec/Functions.pm
-SHA1 fdf446bc0ce3a3d72ff9360a16c79b2f1678bbed lib/File/Spec/Mac.pm
-SHA1 281103fbe3c27f474501305c204bf50a4ef91e3a lib/File/Spec/OS2.pm
-SHA1 a0486e9dd65e6303c2fad92601bfbf4930f39b54 lib/File/Spec/Unix.pm
-SHA1 f28f1c9236ce3e7360a79ad2fab4cf5c1824111c lib/File/Spec/VMS.pm
-SHA1 48a43ce342ca192dca33378d38deef2544715d69 lib/File/Spec/Win32.pm
+SHA1 e64e921cd208693270738f5f5888ee8f5a25c0b4 lib/File/Spec.pm
+SHA1 8a006b1e4bd37b9e58ba95df8ae3c9d39aaa4350 lib/File/Spec/Cygwin.pm
+SHA1 bfb37e2567a3644b14482fabd5d519a0e3466573 lib/File/Spec/Epoc.pm
+SHA1 6ac4ab6f0f0cd9e4982946212da48d2a27faa66b lib/File/Spec/Functions.pm
+SHA1 4a8b7afe5b75196631064d3fc952e6927055d60a lib/File/Spec/Mac.pm
+SHA1 674a4edfa335d265945b148af75c25fa3679b356 lib/File/Spec/OS2.pm
+SHA1 653fbb778c5089e294b97ffaddafebf74a01cc76 lib/File/Spec/Unix.pm
+SHA1 522c3d1e779d548d8eb93164c9e4146e3cb2eeef lib/File/Spec/VMS.pm
+SHA1 7226fad1a1f59c1dcbd5394868a4a69f1e258c75 lib/File/Spec/Win32.pm
SHA1 3d896f74f9c954a5f58b7727b510f3b58354799c ppport.h
SHA1 77d045c1404fbe4c0910ed986b286f7b7b7d560d t/Functions.t
-SHA1 5efcb86ed24a529cb75ac59f06af8dc2fc4547ee t/Spec.t
-SHA1 931627255cda4e3fdc2cfd4c1b1478c92c0c3baa t/crossplatform.t
-SHA1 df1d559021f28a87a507b2613f32245e51a246c0 t/cwd.t
+SHA1 8cad7c6b3037360884d7d8c265253387e56a587a t/Spec.t
+SHA1 88e00161e3c3108009dfba94ca64146badeceb7e t/crossplatform.t
+SHA1 9862a3f294bb4a7d372cea0df551afa0f7a58177 t/cwd.t
SHA1 220a2b1de7f23aedf2f9daba53238c3d0b06db63 t/lib/Test/Builder.pm
SHA1 0bac03ea869f3ae55a84fa25ac0754c9e0c0f86d t/lib/Test/More.pm
SHA1 706f1f8f3b928c91a7d70f476fd3f62d2055ac1c t/lib/Test/Simple.pm
SHA1 23537c5ecebd2e0fefa6986c106b994f5d1c8e7a t/lib/Test/Tutorial.pod
SHA1 1eb98918332df0f2c7e76f8e17b74b03851cd8e6 t/rel2abs2rel.t
SHA1 3069528f07a6835dd076ec6831a2a6327b09483e t/taint.t
-SHA1 856b7cad801917cf14ad306edf837ae17e7c72cf t/tmpdir.t
+SHA1 7e845682c82fff7d3fc35240b3dcd30ecb3bbc01 t/tmpdir.t
SHA1 9e5be2014f97483e76636bcbeb591392b0d68d16 t/win32.t
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.5 (Darwin)
-iD8DBQFHcGvOgrvMBLfvlHYRAjCDAKDB9yY3cBbYxBaLDvq52ji6oSykkwCglNQe
-8ZGjHA+wzI0oFwKdDW5Ttts=
-=WT9v
+iD8DBQFHit5NgrvMBLfvlHYRAsI2AJ9c1ByLPMORsQw6SdPMRNCAfGgeYQCeKha+
+IZhMVpbBWlVctA3HiwWzyFc=
+=GXMD
-----END PGP SIGNATURE-----
Modified: branches/upstream/libfile-spec-perl/current/lib/File/Spec.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/lib/File/Spec.pm?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/lib/File/Spec.pm (original)
+++ branches/upstream/libfile-spec-perl/current/lib/File/Spec.pm Tue Jan 15 04:55:20 2008
@@ -3,7 +3,7 @@
use strict;
use vars qw(@ISA $VERSION);
-$VERSION = '3.2501';
+$VERSION = '3.26';
$VERSION = eval $VERSION;
my %module = (MacOS => 'Mac',
Modified: branches/upstream/libfile-spec-perl/current/lib/File/Spec/Cygwin.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/lib/File/Spec/Cygwin.pm?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/lib/File/Spec/Cygwin.pm (original)
+++ branches/upstream/libfile-spec-perl/current/lib/File/Spec/Cygwin.pm Tue Jan 15 04:55:20 2008
@@ -4,7 +4,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.2501';
+$VERSION = '3.26';
@ISA = qw(File::Spec::Unix);
@@ -39,6 +39,8 @@
sub canonpath {
my($self,$path) = @_;
+ return unless defined $path;
+
$path =~ s|\\|/|g;
# Handle network path names beginning with double slash
@@ -51,6 +53,7 @@
sub catdir {
my $self = shift;
+ return unless @_;
# Don't create something that looks like a //network/path
if ($_[0] and ($_[0] eq '/' or $_[0] eq '\\')) {
@@ -109,9 +112,9 @@
=cut
sub case_tolerant () {
- if ($^O ne 'cygwin') {
- return 1;
- }
+ return 1 unless $^O eq 'cygwin'
+ and defined &Cygwin::mount_flags;
+
my $drive = shift;
if (! $drive) {
my @flags = split(/,/, Cygwin::mount_flags('/cygwin'));
Modified: branches/upstream/libfile-spec-perl/current/lib/File/Spec/Epoc.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/lib/File/Spec/Epoc.pm?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/lib/File/Spec/Epoc.pm (original)
+++ branches/upstream/libfile-spec-perl/current/lib/File/Spec/Epoc.pm Tue Jan 15 04:55:20 2008
@@ -3,7 +3,7 @@
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '3.2501';
+$VERSION = '3.26';
require File::Spec::Unix;
@ISA = qw(File::Spec::Unix);
@@ -45,6 +45,7 @@
sub canonpath {
my ($self,$path) = @_;
+ return unless defined $path;
$path =~ s|/+|/|g; # xx////xx -> xx/xx
$path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx
Modified: branches/upstream/libfile-spec-perl/current/lib/File/Spec/Functions.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/lib/File/Spec/Functions.pm?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/lib/File/Spec/Functions.pm (original)
+++ branches/upstream/libfile-spec-perl/current/lib/File/Spec/Functions.pm Tue Jan 15 04:55:20 2008
@@ -5,7 +5,7 @@
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
-$VERSION = '3.2501';
+$VERSION = '3.26';
require Exporter;
Modified: branches/upstream/libfile-spec-perl/current/lib/File/Spec/Mac.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/lib/File/Spec/Mac.pm?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/lib/File/Spec/Mac.pm (original)
+++ branches/upstream/libfile-spec-perl/current/lib/File/Spec/Mac.pm Tue Jan 15 04:55:20 2008
@@ -4,7 +4,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.2501';
+$VERSION = '3.26';
@ISA = qw(File::Spec::Unix);
@@ -530,7 +530,7 @@
my @result = ();
my ($head, $sep, $tail, $volume, $directories);
- return ('') if ( (!defined($path)) || ($path eq '') );
+ return @result if ( (!defined($path)) || ($path eq '') );
return (':') if ($path eq ':');
( $volume, $sep, $directories ) = $path =~ m|^((?:[^:]+:)?)(:*)(.*)|s;
Modified: branches/upstream/libfile-spec-perl/current/lib/File/Spec/OS2.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/lib/File/Spec/OS2.pm?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/lib/File/Spec/OS2.pm (original)
+++ branches/upstream/libfile-spec-perl/current/lib/File/Spec/OS2.pm Tue Jan 15 04:55:20 2008
@@ -4,7 +4,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.2501';
+$VERSION = '3.26';
@ISA = qw(File::Spec::Unix);
@@ -54,6 +54,8 @@
sub canonpath {
my ($self,$path) = @_;
+ return unless defined $path;
+
$path =~ s/^([a-z]:)/\l$1/s;
$path =~ s|\\|/|g;
$path =~ s|([^/])/+|$1/|g; # xx////xx -> xx/xx
Modified: branches/upstream/libfile-spec-perl/current/lib/File/Spec/Unix.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/lib/File/Spec/Unix.pm?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/lib/File/Spec/Unix.pm (original)
+++ branches/upstream/libfile-spec-perl/current/lib/File/Spec/Unix.pm Tue Jan 15 04:55:20 2008
@@ -3,7 +3,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = '3.2501';
+$VERSION = '3.26';
=head1 NAME
@@ -41,6 +41,7 @@
sub canonpath {
my ($self,$path) = @_;
+ return unless defined $path;
# Handle POSIX-style node names beginning with double slash (qnx, nto)
# (POSIX says: "a pathname that begins with two successive slashes
Modified: branches/upstream/libfile-spec-perl/current/lib/File/Spec/VMS.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/lib/File/Spec/VMS.pm?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/lib/File/Spec/VMS.pm (original)
+++ branches/upstream/libfile-spec-perl/current/lib/File/Spec/VMS.pm Tue Jan 15 04:55:20 2008
@@ -4,7 +4,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.2501';
+$VERSION = '3.26';
@ISA = qw(File::Spec::Unix);
Modified: branches/upstream/libfile-spec-perl/current/lib/File/Spec/Win32.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/lib/File/Spec/Win32.pm?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/lib/File/Spec/Win32.pm (original)
+++ branches/upstream/libfile-spec-perl/current/lib/File/Spec/Win32.pm Tue Jan 15 04:55:20 2008
@@ -5,7 +5,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.2501';
+$VERSION = '3.26';
@ISA = qw(File::Spec::Unix);
@@ -126,23 +126,27 @@
=cut
sub catfile {
- my $self = shift;
- my $file = $self->canonpath(pop @_);
- return $file unless @_;
- my $dir = $self->catdir(@_);
- $dir .= "\\" unless substr($dir,-1) eq "\\";
- return $dir.$file;
+ shift;
+
+ # Legacy / compatibility support
+ #
+ shift, return _canon_cat( "/", @_ )
+ if $_[0] eq "";
+
+ return _canon_cat( @_ );
}
sub catdir {
- my $self = shift;
- my @args = @_;
- foreach (@args) {
- tr[/][\\];
- # append a backslash to each argument unless it has one there
- $_ .= "\\" unless m{\\$};
- }
- return $self->canonpath(join('', @args));
+ shift;
+
+ # Legacy / compatibility support
+ #
+ return ""
+ unless @_;
+ shift, return _canon_cat( "/", @_ )
+ if $_[0] eq "";
+
+ return _canon_cat( @_ );
}
sub path {
@@ -165,25 +169,10 @@
=cut
sub canonpath {
- my ($self,$path) = @_;
-
- $path =~ s/^([a-z]:)/\u$1/s;
- $path =~ s|/|\\|g;
- $path =~ s|([^\\])\\+|$1\\|g; # xx\\\\xx -> xx\xx
- $path =~ s|(\\\.)+\\|\\|g; # xx\.\.\xx -> xx\xx
- $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # .\xx -> xx
- $path =~ s|\\\Z(?!\n)||
- unless $path =~ m{^([A-Z]:)?\\\Z(?!\n)}s; # xx\ -> xx
- # xx1/xx2/xx3/../../xx -> xx1/xx
- $path =~ s|\\\.\.\.\\|\\\.\.\\\.\.\\|g; # \...\ is 2 levels up
- $path =~ s|^\.\.\.\\|\.\.\\\.\.\\|g; # ...\ is 2 levels up
- return $path if $path =~ m|^\.\.|; # skip relative paths
- return $path unless $path =~ /\.\./; # too few .'s to cleanup
- return $path if $path =~ /\.\.\.\./; # too many .'s to cleanup
- $path =~ s{^\\\.\.$}{\\}; # \.. -> \
- 1 while $path =~ s{^\\\.\.}{}; # \..\xx -> \xx
-
- return $self->_collapse($path);
+ # Legacy / compatibility support
+ #
+ return $_[1] if !defined($_[1]) or $_[1] eq '';
+ return _canon_cat( $_[1] );
}
=item splitpath
@@ -375,4 +364,69 @@
=cut
+
+sub _canon_cat(@) # @path -> path
+{
+ my $first = shift;
+ my $volume = $first =~ s{ \A ([A-Za-z]:) ([\\/]?) }{}x # drive letter
+ ? ucfirst( $1 ).( $2 ? "\\" : "" )
+ : $first =~ s{ \A (?:\\\\|//) ([^\\/]+)
+ (?: [\\/] ([^\\/]+) )?
+ [\\/]? }{}xs # UNC volume
+ ? "\\\\$1".( defined $2 ? "\\$2" : "" )."\\"
+ : $first =~ s{ \A [\\/] }{}x # root dir
+ ? "\\"
+ : "";
+ my $path = join "\\", $first, @_;
+
+ $path =~ tr#\\/#\\\\#s; # xx/yy --> xx\yy & xx\\yy --> xx\yy
+
+ # xx/././yy --> xx/yy
+ $path =~ s{(?:
+ (?:\A|\\) # at begin or after a slash
+ \.
+ (?:\\\.)* # and more
+ (?:\\|\z) # at end or followed by slash
+ )+ # performance boost -- I do not know why
+ }{\\}gx;
+
+ # XXX I do not know whether more dots are supported by the OS supporting
+ # this ... annotation (NetWare or symbian but not MSWin32).
+ # Then .... could easily become ../../.. etc:
+ # Replace \.\.\. by (\.\.\.+) and substitute with
+ # { $1 . ".." . "\\.." x (length($2)-2) }gex
+ # ... --> ../..
+ $path =~ s{ (\A|\\) # at begin or after a slash
+ \.\.\.
+ (?=\\|\z) # at end or followed by slash
+ }{$1..\\..}gx;
+ # xx\yy\..\zz --> xx\zz
+ while ( $path =~ s{(?:
+ (?:\A|\\) # at begin or after a slash
+ [^\\]+ # rip this 'yy' off
+ \\\.\.
+ (?<!\A\.\.\\\.\.) # do *not* replace ^..\..
+ (?<!\\\.\.\\\.\.) # do *not* replace \..\..
+ (?:\\|\z) # at end or followed by slash
+ )+ # performance boost -- I do not know why
+ }{\\}sx ) {}
+
+ $path =~ s#\A\\##; # \xx --> xx NOTE: this is *not* root
+ $path =~ s#\\\z##; # xx\ --> xx
+
+ if ( $volume =~ m#\\\z# )
+ { # <vol>\.. --> <vol>\
+ $path =~ s{ \A # at begin
+ \.\.
+ (?:\\\.\.)* # and more
+ (?:\\|\z) # at end or followed by slash
+ }{}x;
+
+ return $1 # \\HOST\SHARE\ --> \\HOST\SHARE
+ if $path eq ""
+ and $volume =~ m#\A(\\\\.*)\\\z#s;
+ }
+ return $path ne "" || $volume ? $volume.$path : ".";
+}
+
1;
Modified: branches/upstream/libfile-spec-perl/current/t/Spec.t
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/t/Spec.t?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/t/Spec.t (original)
+++ branches/upstream/libfile-spec-perl/current/t/Spec.t Tue Jan 15 04:55:20 2008
@@ -191,10 +191,10 @@
[ "Win32->catdir('\\d1','d2')", '\\d1\\d2' ],
[ "Win32->catdir('\\d1','\\d2')", '\\d1\\d2' ],
[ "Win32->catdir('\\d1','\\d2\\')", '\\d1\\d2' ],
-[ "Win32->catdir('','/d1','d2')", '\\\\d1\\d2' ],
-[ "Win32->catdir('','','/d1','d2')", '\\\\\\d1\\d2' ],
-[ "Win32->catdir('','//d1','d2')", '\\\\\\d1\\d2' ],
-[ "Win32->catdir('','','//d1','d2')", '\\\\\\\\d1\\d2' ],
+[ "Win32->catdir('','/d1','d2')", '\\d1\\d2' ],
+[ "Win32->catdir('','','/d1','d2')", '\\d1\\d2' ],
+[ "Win32->catdir('','//d1','d2')", '\\d1\\d2' ],
+[ "Win32->catdir('','','//d1','d2')", '\\d1\\d2' ],
[ "Win32->catdir('','d1','','d2','')", '\\d1\\d2' ],
[ "Win32->catdir('','d1','d2','d3','')", '\\d1\\d2\\d3' ],
[ "Win32->catdir('d1','d2','d3','')", 'd1\\d2\\d3' ],
@@ -206,13 +206,14 @@
[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\B:\\d2\\d3' ],
[ "Win32->catdir('A:/')", 'A:\\' ],
[ "Win32->catdir('\\', 'foo')", '\\foo' ],
-
+[ "Win32->catdir('','','..')", '\\' ],
[ "Win32->catfile('a','b','c')", 'a\\b\\c' ],
[ "Win32->catfile('a','b','.\\c')", 'a\\b\\c' ],
[ "Win32->catfile('.\\a','b','c')", 'a\\b\\c' ],
[ "Win32->catfile('c')", 'c' ],
[ "Win32->catfile('.\\c')", 'c' ],
+[ "Win32->catfile('a/..','../b')", '..\\b' ],
[ "Win32->canonpath('')", '' ],
@@ -224,9 +225,9 @@
[ "Win32->canonpath('//a\\b//c')", '\\\\a\\b\\c' ],
[ "Win32->canonpath('/a/..../c')", '\\a\\....\\c' ],
[ "Win32->canonpath('//a/b\\c')", '\\\\a\\b\\c' ],
-[ "Win32->canonpath('////')", '\\\\\\' ],
+[ "Win32->canonpath('////')", '\\' ],
[ "Win32->canonpath('//')", '\\' ],
-[ "Win32->canonpath('/.')", '\\.' ],
+[ "Win32->canonpath('/.')", '\\' ],
[ "Win32->canonpath('//a/b/../../c')", '\\\\a\\b\\c' ],
[ "Win32->canonpath('//a/b/c/../d')", '\\\\a\\b\\d' ],
[ "Win32->canonpath('//a/b/c/../../d')",'\\\\a\\b\\d' ],
@@ -694,6 +695,7 @@
[ "Cygwin->rel2abs('..','/t1/t2/t3')", '/t1/t2/t3/..' ],
[ "Cygwin->rel2abs('../t4','/t1/t2/t3')", '/t1/t2/t3/../t4' ],
[ "Cygwin->rel2abs('/t1','/t1/t2/t3')", '/t1' ],
+[ "Cygwin->rel2abs('//t1/t2/t3','/foo')", '//t1/t2/t3' ],
) ;
Modified: branches/upstream/libfile-spec-perl/current/t/crossplatform.t
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/t/crossplatform.t?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/t/crossplatform.t (original)
+++ branches/upstream/libfile-spec-perl/current/t/crossplatform.t Tue Jan 15 04:55:20 2008
@@ -7,7 +7,7 @@
local $|=1;
my @platforms = qw(Cygwin Epoc Mac OS2 Unix VMS Win32);
-my $tests_per_platform = 7;
+my $tests_per_platform = 10;
plan tests => 1 + @platforms * $tests_per_platform;
@@ -56,6 +56,17 @@
is $module->file_name_is_absolute($base), 1, "$base is absolute on $platform";
+ # splitdir('') -> ()
+ my @result = $module->splitdir('');
+ is @result, 0, "$platform->splitdir('') -> ()";
+
+ # canonpath() -> undef
+ $result = $module->canonpath();
+ is $result, undef, "$platform->canonpath() -> undef";
+
+ # canonpath(undef) -> undef
+ $result = $module->canonpath(undef);
+ is $result, undef, "$platform->canonpath(undef) -> undef";
# abs2rel('A:/foo/bar', 'A:/foo') -> 'bar'
$file = $module->catpath($v, $module->catdir($module->rootdir, 'foo', 'bar'), 'file');
Modified: branches/upstream/libfile-spec-perl/current/t/cwd.t
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/t/cwd.t?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/t/cwd.t (original)
+++ branches/upstream/libfile-spec-perl/current/t/cwd.t Tue Jan 15 04:55:20 2008
@@ -135,16 +135,11 @@
# Cwd::chdir should also update $ENV{PWD}
dir_ends_with( $ENV{PWD}, $Test_Dir, 'Cwd::chdir() updates $ENV{PWD}' );
my $updir = File::Spec->updir;
-Cwd::chdir $updir;
-print "#$ENV{PWD}\n";
-Cwd::chdir $updir;
-print "#$ENV{PWD}\n";
-Cwd::chdir $updir;
-print "#$ENV{PWD}\n";
-Cwd::chdir $updir;
-print "#$ENV{PWD}\n";
-Cwd::chdir $updir;
-print "#$ENV{PWD}\n";
+
+for (1.. at test_dirs) {
+ Cwd::chdir $updir;
+ print "#$ENV{PWD}\n";
+}
rmtree($test_dirs[0], 0, 0);
@@ -168,19 +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";
-
- my $abs_path = Cwd::abs_path("linktest");
- my $fast_abs_path = Cwd::fast_abs_path("linktest");
- my $want = quotemeta( File::Spec->rel2abs( $Test_Dir ) );
+ symlink $Test_Dir, $file;
+
+ 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}) {
Modified: branches/upstream/libfile-spec-perl/current/t/tmpdir.t
URL: http://svn.debian.org/wsvn/branches/upstream/libfile-spec-perl/current/t/tmpdir.t?rev=12754&op=diff
==============================================================================
--- branches/upstream/libfile-spec-perl/current/t/tmpdir.t (original)
+++ branches/upstream/libfile-spec-perl/current/t/tmpdir.t Tue Jan 15 04:55:20 2008
@@ -14,9 +14,8 @@
ok scalar keys %ENV, $num_keys, "tmpdir() shouldn't change the contents of %ENV";
if ($^O eq 'VMS') {
- skip('Can\'t make list assignment to \%ENV on this system', 1);
-}
-else {
+ skip("Can't make list assignment to %ENV on this system", 1);
+} else {
local %ENV;
File::Spec::Win32->tmpdir;
ok scalar keys %ENV, 0, "Win32->tmpdir() shouldn't change the contents of %ENV";
More information about the Pkg-perl-cvs-commits
mailing list