Change 25376 by [EMAIL PROTECTED] on 2005/09/10 19:39:28
Integrate:
[ 24161]
Down with K&R function arguments
(the Pathtools part of)
[ 24170]
Add casting to allow g++ (3.3.5) to compile the core code.
A C++ compiler produces lots of warnings that are probably valid
concerns to investigate.
(the Pathtools part of)
[ 24271]
Subject: [PATCH] Symbian port of Perl
From: <[EMAIL PROTECTED]>
Date: Mon, 18 Apr 2005 13:18:30 +0300
Message-ID: <[EMAIL PROTECTED]>
[ 24407]
Upgrade to PathTools 3.07
[ 24607]
Fix failing Cwd tests on Win32
Patch was posted to Ken previously
(see
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2005-05/msg00226.html)
but no reply as yet. I'll mail him again...
[ 24631]
Upgrade to PathTools 3.08
[ 24882]
Upgrade to PathTools 3.09
[ 25334]
Upgrade to PathTools 3.10
[ 25338]
Upgrade to PathTools 3.11
(no real changes)
Affected files ...
... //depot/maint-5.8/perl/ext/Cwd/Changes#9 integrate
... //depot/maint-5.8/perl/ext/Cwd/Cwd.xs#8 integrate
... //depot/maint-5.8/perl/ext/Cwd/t/cwd.t#15 integrate
... //depot/maint-5.8/perl/ext/Cwd/t/taint.t#7 integrate
... //depot/maint-5.8/perl/lib/Cwd.pm#18 integrate
... //depot/maint-5.8/perl/lib/File/Spec.pm#16 integrate
... //depot/maint-5.8/perl/lib/File/Spec/Cygwin.pm#9 integrate
... //depot/maint-5.8/perl/lib/File/Spec/Mac.pm#10 integrate
... //depot/maint-5.8/perl/lib/File/Spec/OS2.pm#11 integrate
... //depot/maint-5.8/perl/lib/File/Spec/Unix.pm#18 integrate
... //depot/maint-5.8/perl/lib/File/Spec/VMS.pm#13 integrate
... //depot/maint-5.8/perl/lib/File/Spec/Win32.pm#12 integrate
... //depot/maint-5.8/perl/lib/File/Spec/t/Spec.t#13 integrate
Differences ...
==== //depot/maint-5.8/perl/ext/Cwd/Changes#9 (text) ====
Index: perl/ext/Cwd/Changes
--- perl/ext/Cwd/Changes#8~24144~ Sun Apr 3 08:18:11 2005
+++ perl/ext/Cwd/Changes Sat Sep 10 12:39:28 2005
@@ -1,5 +1,66 @@
Revision history for Perl distribution PathTools.
+3.11 Sat Aug 27 20:12:55 CDT 2005
+
+ - Fixed a couple of typos in the documentation for
+ File::Spec::Mac. [Piotr Fusik]
+
+3.10 Thu Aug 25 22:24:57 CDT 2005
+
+ - eliminate_macros() and fixpath() in File::Spec::VMS are now
+ deprecated, since they are MakeMaker-specific and now live inside
+ MakeMaker. [Michael Schwern]
+
+ - canonpath() on Win32 now collapses foo/.. (or foo\..) sections
+ correctly, rather than doing the "misguided" work it was previously
+ doing. Note that canonpath() on Unix still does NOT collapse these
+ sections, as doing so would be incorrect. [Michael Schwern]
+
+3.09 Tue Jun 14 20:36:50 CDT 2005
+
+ - Added some block delimiters (brackets) in the Perl_getcwd_sv() XS
+ function, which were necessary to separate the variable
+ declarations from the statements when HAS_GETCWD is not
+ defined. [Yves]
+
+ - Apparently the _NT_cwd() routine is never defined externally like I
+ thought it was, so I simplified the code around it.
+
+ - When cwd() is implemented using the _backtick_pwd() function, it
+ sometimes could create accidental undef entries in %ENV under perl
+ 5.6, because local($hash{key}) is somewhat broken. This is now
+ fixed with an appropriate workaround. [Neil Watkiss]
+
+3.08 Sat May 28 10:10:29 CDT 2005
+
+ - Fixed a test failure with fast_abs_path() on Windows - it was
+ sensitive to the rootdir() change from version 3.07. [Steve Hay]
+
+3.07 Fri May 6 07:46:45 CDT 2005
+
+ - Fixed a bug in which the special perl variable $^O would become
+ tainted under certain versions of perl. [Michael Schwern]
+
+ - File::Spec->rootdir() was returning / on Win32. Now it returns \ .
+ [Michael Schwern]
+
+ - We now avoid modifying @_ in tmpdir() when it's not strictly
+ necessary, which reportedly provides a modest performance
+ boost. [Richard Soderberg]
+
+ - Made a couple of slight changes to the Win32 code so that it works
+ (or works better) on Symbian OS phones. [Jarkko Hietaniemi]
+
+3.06 Wed Apr 13 20:47:26 CDT 2005
+
+ (No changes in functionality)
+
+ - Added a note to the canonpath() docs about why it doesn't collapse
+ foo/../bar sections.
+
+ - The internal-only function bsd_realpath() in the XS file now uses
+ normal arg syntax instead of K&R syntax. [Nicholas Clark]
+
3.05 Mon Feb 28 07:22:58 CST 2005
- Fixed a bug in fast_abs_path() on Win32 in which forward- and
==== //depot/maint-5.8/perl/ext/Cwd/Cwd.xs#8 (text) ====
Index: perl/ext/Cwd/Cwd.xs
--- perl/ext/Cwd/Cwd.xs#7~24144~ Sun Apr 3 08:18:11 2005
+++ perl/ext/Cwd/Cwd.xs Sat Sep 10 12:39:28 2005
@@ -70,9 +70,7 @@
*/
static
char *
-bsd_realpath(path, resolved)
- const char *path;
- char *resolved;
+bsd_realpath(const char *path, char *resolved)
{
#ifdef VMS
dTHX;
@@ -270,7 +268,7 @@
}
#else
-
+ {
Stat_t statbuf;
int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
int namelen, pathlen=0;
@@ -382,6 +380,7 @@
}
return TRUE;
+ }
#endif
#else
@@ -419,7 +418,7 @@
char *path;
char buf[MAXPATHLEN];
- path = pathsv ? SvPV_nolen(pathsv) : ".";
+ path = pathsv ? SvPV_nolen(pathsv) : (char *)".";
if (bsd_realpath(path, buf)) {
sv_setpvn(TARG, buf, strlen(buf));
==== //depot/maint-5.8/perl/ext/Cwd/t/cwd.t#15 (text) ====
Index: perl/ext/Cwd/t/cwd.t
--- perl/ext/Cwd/t/cwd.t#14~24144~ Sun Apr 3 08:18:11 2005
+++ perl/ext/Cwd/t/cwd.t Sat Sep 10 12:39:28 2005
@@ -18,7 +18,7 @@
use Test::More;
require VMS::Filespec if $^O eq 'VMS';
-my $tests = 28;
+my $tests = 29;
# _perl_abs_path() currently only works when the directory separator
# is '/', so don't test it when it won't work.
my $EXTRA_ABSPATH_TESTS = ($Config{prefix} =~ m/\//) && $^O ne 'cygwin';
@@ -39,6 +39,13 @@
ok( !defined(&abs_path), ' nor abs_path()' );
ok( !defined(&fast_abs_path), ' nor fast_abs_path()');
+{
+ my @fields = qw(PATH IFS CDPATH ENV BASH_ENV);
+ my $before = grep exists $ENV{$_}, @fields;
+ cwd();
+ my $after = grep exists $ENV{$_}, @fields;
+ is($before, $after, "cwd() shouldn't create spurious entries in %ENV");
+}
# XXX force Cwd to bootsrap its XSUBs since we have set @INC = "../lib"
# XXX and subsequent chdir()s can make them impossible to find
==== //depot/maint-5.8/perl/ext/Cwd/t/taint.t#7 (text) ====
Index: perl/ext/Cwd/t/taint.t
--- perl/ext/Cwd/t/taint.t#6~24144~ Sun Apr 3 08:18:11 2005
+++ perl/ext/Cwd/t/taint.t Sat Sep 10 12:39:28 2005
@@ -14,7 +14,7 @@
use File::Spec;
use lib File::Spec->catdir('t', 'lib');
-use Test::More tests => 16;
+use Test::More tests => 17;
use Scalar::Util qw/tainted/;
@@ -30,3 +30,6 @@
is( $@, '', "$func() should not explode under taint mode" );
ok( tainted($cwd), "its return value should be tainted" );
}
+
+# Previous versions of Cwd tainted $^O
+is !tainted($^O), 1, "\$^O should not be tainted";
==== //depot/maint-5.8/perl/lib/Cwd.pm#18 (text) ====
Index: perl/lib/Cwd.pm
--- perl/lib/Cwd.pm#17~24144~ Sun Apr 3 08:18:11 2005
+++ perl/lib/Cwd.pm Sat Sep 10 12:39:28 2005
@@ -170,7 +170,7 @@
use Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
-$VERSION = '3.05';
+$VERSION = '3.11';
@ISA = qw/ Exporter /;
@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
@@ -315,7 +315,10 @@
# The 'natural and safe form' for UNIX (pwd may be setuid root)
sub _backtick_pwd {
- local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};
+ # Localize %ENV entries in a way that won't create new hash keys
+ my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV);
+ local @[EMAIL PROTECTED];
+
my $cwd = `$pwd_cmd`;
# Belt-and-suspenders in case someone said "undef $/".
local $/ = "\n";
@@ -330,8 +333,9 @@
unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
# The pwd command is not available in some chroot(2)'ed environments
my $sep = $Config::Config{path_sep} || ':';
- if( $^O eq 'MacOS' || (defined $ENV{PATH} &&
- $^O ne 'MSWin32' && # no pwd on Windows
+ my $os = $^O; # Protect $^O from tainting
+ if( $os eq 'MacOS' || (defined $ENV{PATH} &&
+ $os ne 'MSWin32' && # no pwd on Windows
grep { -x "$_/pwd" } split($sep, $ENV{PATH})) )
{
*cwd = \&_backtick_pwd;
@@ -584,9 +588,7 @@
return fast_abs_path($link_target);
}
- my $tdir = $dir;
- $tdir =~ s!\\!/!g if $^O eq 'MSWin32';
- return $tdir eq File::Spec->rootdir
+ return $dir eq File::Spec->rootdir
? File::Spec->catpath($vol, $dir, $file)
: fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
}
@@ -643,10 +645,7 @@
return $ENV{'PWD'};
}
-*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
- defined &Win32::GetCwd);
-
-*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
+*_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_os2_cwd;
sub _dos_cwd {
if (!defined &Dos::GetCwd) {
==== //depot/maint-5.8/perl/lib/File/Spec.pm#16 (text) ====
Index: perl/lib/File/Spec.pm
--- perl/lib/File/Spec.pm#15~24144~ Sun Apr 3 08:18:11 2005
+++ perl/lib/File/Spec.pm Sat Sep 10 12:39:28 2005
@@ -3,7 +3,7 @@
use strict;
use vars qw(@ISA $VERSION);
-$VERSION = '3.05';
+$VERSION = '3.11';
$VERSION = eval $VERSION;
my %module = (MacOS => 'Mac',
@@ -12,7 +12,8 @@
VMS => 'VMS',
epoc => 'Epoc',
NetWare => 'Win32', # Yes, File::Spec::Win32 works on NetWare.
- dos => 'OS2', # Yes, File::Spec::OS2 works on DJGPP.
+ symbian => 'Win32', # Yes, File::Spec::Win32 works on symbian.
+ dos => 'OS2', # Yes, File::Spec::OS2 works on DJGPP.
cygwin => 'Cygwin');
@@ -87,6 +88,13 @@
path.
$cpath = File::Spec->canonpath( $path ) ;
+
+Note that this does *not* collapse F<x/../y> sections into F<y>. This
+is by design. If F</foo> on your system is a symlink to F</bar/baz>,
+then F</foo/../quux> is actually F</bar/quux>, not F</quux> as a naive
+F<../>-removal would give you. If you want to do this kind of
+processing, you probably want C<Cwd>'s C<realpath()> function to
+actually traverse the filesystem cleaning up paths like this.
=item catdir
==== //depot/maint-5.8/perl/lib/File/Spec/Cygwin.pm#9 (text) ====
Index: perl/lib/File/Spec/Cygwin.pm
--- perl/lib/File/Spec/Cygwin.pm#8~24144~ Sun Apr 3 08:18:11 2005
+++ perl/lib/File/Spec/Cygwin.pm Sat Sep 10 12:39:28 2005
@@ -76,8 +76,7 @@
my $tmpdir;
sub tmpdir {
return $tmpdir if defined $tmpdir;
- my $self = shift;
- $tmpdir = $self->_tmpdir( $ENV{TMPDIR}, "/tmp", 'C:/temp' );
+ $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp", 'C:/temp' );
}
=back
==== //depot/maint-5.8/perl/lib/File/Spec/Mac.pm#10 (text) ====
Index: perl/lib/File/Spec/Mac.pm
--- perl/lib/File/Spec/Mac.pm#9~24144~ Sun Apr 3 08:18:11 2005
+++ perl/lib/File/Spec/Mac.pm Sat Sep 10 12:39:28 2005
@@ -53,7 +53,7 @@
directory path.
B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the resulting
-path is relative by default and I<not> absolute. This descision was made due
+path is relative by default and I<not> absolute. This decision was made due
to portability reasons. Since C<File::Spec-E<gt>catdir()> returns relative
paths
on all other operating systems, it will now also follow this convention on Mac
OS. Note that this may break some existing scripts.
@@ -272,7 +272,7 @@
B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the
resulting path is relative by default and I<not> absolute. This
-descision was made due to portability reasons. Since
+decision was made due to portability reasons. Since
C<File::Spec-E<gt>catfile()> returns relative paths on all other
operating systems, it will now also follow this convention on Mac OS.
Note that this may break some existing scripts.
@@ -373,8 +373,7 @@
my $tmpdir;
sub tmpdir {
return $tmpdir if defined $tmpdir;
- my $self = shift;
- $tmpdir = $self->_tmpdir( $ENV{TMPDIR} );
+ $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR} );
}
=item updir
==== //depot/maint-5.8/perl/lib/File/Spec/OS2.pm#11 (text) ====
Index: perl/lib/File/Spec/OS2.pm
--- perl/lib/File/Spec/OS2.pm#10~24144~ Sun Apr 3 08:18:11 2005
+++ perl/lib/File/Spec/OS2.pm Sat Sep 10 12:39:28 2005
@@ -37,8 +37,7 @@
my $tmpdir;
sub tmpdir {
return $tmpdir if defined $tmpdir;
- my $self = shift;
- $tmpdir = $self->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
+ $tmpdir = $_[0]->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
'/tmp',
'/' );
}
==== //depot/maint-5.8/perl/lib/File/Spec/Unix.pm#18 (text) ====
Index: perl/lib/File/Spec/Unix.pm
--- perl/lib/File/Spec/Unix.pm#17~24144~ Sun Apr 3 08:18:11 2005
+++ perl/lib/File/Spec/Unix.pm Sat Sep 10 12:39:28 2005
@@ -30,6 +30,13 @@
$cpath = File::Spec->canonpath( $path ) ;
+Note that this does *not* collapse F<x/../y> sections into F<y>. This
+is by design. If F</foo> on your system is a symlink to F</bar/baz>,
+then F</foo/../quux> is actually F</bar/quux>, not F</quux> as a naive
+F<../>-removal would give you. If you want to do this kind of
+processing, you probably want C<Cwd>'s C<realpath()> function to
+actually traverse the filesystem cleaning up paths like this.
+
=cut
sub canonpath {
@@ -52,7 +59,8 @@
$path =~ s|/+|/|g; # xx////xx -> xx/xx
$path =~ s@(/\.)+(/|\Z(?!\n))@/@g; # xx/././xx -> xx/xx
$path =~ s|^(\./)+||s unless $path eq "./"; # ./xx -> xx
- $path =~ s|^/(\.\./)+|/|s; # /../../xx -> xx
+ $path =~ s|^/(\.\./)+|/|; # /../../xx -> xx
+ $path =~ s|^/\.\.$|/|; # /.. -> /
$path =~ s|/\Z(?!\n)|| unless $path eq "/"; # xx/ -> xx
return "$node$path";
}
@@ -151,8 +159,7 @@
sub tmpdir {
return $tmpdir if defined $tmpdir;
- my $self = shift;
- $tmpdir = $self->_tmpdir( $ENV{TMPDIR}, "/tmp" );
+ $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" );
}
=item updir
@@ -465,5 +472,39 @@
require Cwd;
Cwd::cwd();
}
+
+
+# Internal method to reduce xx\..\yy -> yy
+sub _collapse {
+ my($fs, $path) = @_;
+
+ my $updir = $fs->updir;
+ my $curdir = $fs->curdir;
+
+ my($vol, $dirs, $file) = $fs->splitpath($path);
+ my @dirs = $fs->splitdir($dirs);
+
+ my @collapsed;
+ foreach my $dir (@dirs) {
+ if( $dir eq $updir and # if we have an updir
+ @collapsed and # and something to collapse
+ length $collapsed[-1] and # and its not the rootdir
+ $collapsed[-1] ne $updir and # nor another updir
+ $collapsed[-1] ne $curdir # nor the curdir
+ )
+ { # then
+ pop @collapsed; # collapse
+ }
+ else { # else
+ push @collapsed, $dir; # just hang onto it
+ }
+ }
+
+ return $fs->catpath($vol,
+ $fs->catdir(@collapsed),
+ $file
+ );
+}
+
1;
==== //depot/maint-5.8/perl/lib/File/Spec/VMS.pm#13 (text) ====
Index: perl/lib/File/Spec/VMS.pm
--- perl/lib/File/Spec/VMS.pm#12~24144~ Sun Apr 3 08:18:11 2005
+++ perl/lib/File/Spec/VMS.pm Sat Sep 10 12:39:28 2005
@@ -27,118 +27,6 @@
=over 4
-=item eliminate_macros
-
-Expands MM[KS]/Make macros in a text string, using the contents of
-identically named elements of C<%$self>, and returns the result
-as a file specification in Unix syntax.
-
-=cut
-
-sub eliminate_macros {
- my($self,$path) = @_;
- return '' unless $path;
- $self = {} unless ref $self;
-
- if ($path =~ /\s/) {
- return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
- }
-
- my($npath) = unixify($path);
- my($complex) = 0;
- my($head,$macro,$tail);
-
- # perform m##g in scalar context so it acts as an iterator
- while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) {
- if ($self->{$2}) {
- ($head,$macro,$tail) = ($1,$2,$3);
- if (ref $self->{$macro}) {
- if (ref $self->{$macro} eq 'ARRAY') {
- $macro = join ' ', @{$self->{$macro}};
- }
- else {
- print "Note: can't expand macro \$($macro) containing
",ref($self->{$macro}),
- "\n\t(using MMK-specific deferred substitutuon; MMS
will break)\n";
- $macro = "\cB$macro\cB";
- $complex = 1;
- }
- }
- else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
- $npath = "$head$macro$tail";
- }
- }
- if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; }
- $npath;
-}
-
-=item fixpath
-
-Catchall routine to clean up problem MM[SK]/Make macros. Expands macros
-in any directory specification, in order to avoid juxtaposing two
-VMS-syntax directories when MM[SK] is run. Also expands expressions which
-are all macro, so that we can tell how long the expansion is, and avoid
-overrunning DCL's command buffer when MM[KS] is running.
-
-If optional second argument has a TRUE value, then the return string is
-a VMS-syntax directory specification, if it is FALSE, the return string
-is a VMS-syntax file specification, and if it is not specified, fixpath()
-checks to see whether it matches the name of a directory in the current
-default directory, and returns a directory or file specification accordingly.
-
-=cut
-
-sub fixpath {
- my($self,$path,$force_path) = @_;
- return '' unless $path;
- $self = bless {} unless ref $self;
- my($fixedpath,$prefix,$name);
-
- if ($path =~ /\s/) {
- return join ' ',
- map { $self->fixpath($_,$force_path) }
- split /\s+/, $path;
- }
-
- if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) {
- if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
- $fixedpath = vmspath($self->eliminate_macros($path));
- }
- else {
- $fixedpath = vmsify($self->eliminate_macros($path));
- }
- }
- elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) &&
$self->{$prefix}) {
- my($vmspre) = $self->eliminate_macros("\$($prefix)");
- # is it a dir or just a name?
- $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ?
vmspath($vmspre) : '';
- $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
- $fixedpath = vmspath($fixedpath) if $force_path;
- }
- else {
- $fixedpath = $path;
- $fixedpath = vmspath($fixedpath) if $force_path;
- }
- # No hints, so we try to guess
- if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
- $fixedpath = vmspath($fixedpath) if -d $fixedpath;
- }
-
- # Trim off root dirname if it's had other dirs inserted in front of it.
- $fixedpath =~ s/\.000000([\]>])/$1/;
- # Special case for VMS absolute directory specs: these will have had device
- # prepended during trip through Unix syntax in eliminate_macros(), since
- # Unix syntax has no way to express "absolute from the top of this device's
- # directory tree".
- if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; }
- $fixedpath;
-}
-
-=back
-
-=head2 Methods always loaded
-
-=over 4
-
=item canonpath (override)
Removes redundant portions of file specifications according to VMS syntax.
@@ -188,7 +76,7 @@
}
}
-=item catdir
+=item catdir (override)
Concatenates a list of file specifications, and returns the result as a
VMS-syntax directory specification. No check is made for "impossible"
@@ -222,7 +110,7 @@
return $self->canonpath($rslt);
}
-=item catfile
+=item catfile (override)
Concatenates a list of file specifications, and returns the result as a
VMS-syntax file specification.
@@ -297,8 +185,7 @@
my $tmpdir;
sub tmpdir {
return $tmpdir if defined $tmpdir;
- my $self = shift;
- $tmpdir = $self->_tmpdir( 'sys$scratch:', $ENV{TMPDIR} );
+ $tmpdir = $_[0]->_tmpdir( 'sys$scratch:', $ENV{TMPDIR} );
}
=item updir (override)
@@ -517,6 +404,98 @@
}
return $self->canonpath( $path ) ;
+}
+
+
+# eliminate_macros() and fixpath() are MakeMaker-specific methods
+# which are used inside catfile() and catdir(). MakeMaker has its own
+# copies as of 6.06_03 which are the canonical ones. We leave these
+# here, in peace, so that File::Spec continues to work with MakeMakers
+# prior to 6.06_03.
+#
+# Please consider these two methods deprecated. Do not patch them,
+# patch the ones in ExtUtils::MM_VMS instead.
+sub eliminate_macros {
+ my($self,$path) = @_;
+ return '' unless $path;
+ $self = {} unless ref $self;
+
+ if ($path =~ /\s/) {
+ return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
+ }
+
+ my($npath) = unixify($path);
+ my($complex) = 0;
+ my($head,$macro,$tail);
+
+ # perform m##g in scalar context so it acts as an iterator
+ while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) {
+ if ($self->{$2}) {
+ ($head,$macro,$tail) = ($1,$2,$3);
+ if (ref $self->{$macro}) {
+ if (ref $self->{$macro} eq 'ARRAY') {
+ $macro = join ' ', @{$self->{$macro}};
+ }
+ else {
+ print "Note: can't expand macro \$($macro) containing
",ref($self->{$macro}),
+ "\n\t(using MMK-specific deferred substitutuon; MMS
will break)\n";
+ $macro = "\cB$macro\cB";
+ $complex = 1;
+ }
+ }
+ else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
+ $npath = "$head$macro$tail";
+ }
+ }
+ if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; }
+ $npath;
+}
+
+# Deprecated. See the note above for eliminate_macros().
+sub fixpath {
+ my($self,$path,$force_path) = @_;
+ return '' unless $path;
+ $self = bless {} unless ref $self;
+ my($fixedpath,$prefix,$name);
+
+ if ($path =~ /\s/) {
+ return join ' ',
+ map { $self->fixpath($_,$force_path) }
+ split /\s+/, $path;
+ }
+
+ if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) {
+ if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
+ $fixedpath = vmspath($self->eliminate_macros($path));
+ }
+ else {
+ $fixedpath = vmsify($self->eliminate_macros($path));
+ }
+ }
+ elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) &&
$self->{$prefix}) {
+ my($vmspre) = $self->eliminate_macros("\$($prefix)");
+ # is it a dir or just a name?
+ $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ?
vmspath($vmspre) : '';
+ $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
+ $fixedpath = vmspath($fixedpath) if $force_path;
+ }
+ else {
+ $fixedpath = $path;
+ $fixedpath = vmspath($fixedpath) if $force_path;
+ }
+ # No hints, so we try to guess
+ if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
+ $fixedpath = vmspath($fixedpath) if -d $fixedpath;
+ }
+
+ # Trim off root dirname if it's had other dirs inserted in front of it.
+ $fixedpath =~ s/\.000000([\]>])/$1/;
+ # Special case for VMS absolute directory specs: these will have had device
+ # prepended during trip through Unix syntax in eliminate_macros(), since
+ # Unix syntax has no way to express "absolute from the top of this device's
+ # directory tree".
+ if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; }
+ $fixedpath;
}
==== //depot/maint-5.8/perl/lib/File/Spec/Win32.pm#12 (text) ====
Index: perl/lib/File/Spec/Win32.pm
--- perl/lib/File/Spec/Win32.pm#11~24144~ Sun Apr 3 08:18:11 2005
+++ perl/lib/File/Spec/Win32.pm Sat Sep 10 12:39:28 2005
@@ -35,6 +35,9 @@
return "nul";
}
+sub rootdir () { '\\' }
+
+
=item tmpdir
Returns a string representation of the first existing directory
@@ -44,12 +47,13 @@
$ENV{TEMP}
$ENV{TMP}
SYS:/temp
+ C:\system\temp
C:/temp
/tmp
/
-The SYS:/temp is preferred in Novell NetWare (the File::Spec::Win32
-is used also for NetWare).
+The SYS:/temp is preferred in Novell NetWare and the C:\system\temp
+for Symbian (the File::Spec::Win32 is used also for those platforms).
Since Perl 5.8.0, if running under taint mode, and if the environment
variables are tainted, they are not used.
@@ -59,9 +63,9 @@
my $tmpdir;
sub tmpdir {
return $tmpdir if defined $tmpdir;
- my $self = shift;
- $tmpdir = $self->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
+ $tmpdir = $_[0]->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
'SYS:/temp',
+ 'C:\system\temp',
'C:/temp',
'/tmp',
'/' );
@@ -123,7 +127,7 @@
sub canonpath {
my ($self,$path) = @_;
- my $orig_path = $path;
+
$path =~ s/^([a-z]:)/\u$1/s;
$path =~ s|/|\\|g;
$path =~ s|([^\\])\\+|$1\\|g; # xx\\\\xx -> xx\xx
@@ -140,29 +144,7 @@
$path =~ s{^\\\.\.$}{\\}; # \.. -> \
1 while $path =~ s{^\\\.\.}{}; # \..\xx -> \xx
- my ($vol,$dirs,$file) = $self->splitpath($path);
- my @dirs = $self->splitdir($dirs);
- my (@base_dirs, @path_dirs);
- my $dest = [EMAIL PROTECTED];
- for my $dir (@dirs){
- $dest = [EMAIL PROTECTED] if $dir eq $self->updir;
- push @$dest, $dir;
- }
- # for each .. in @path_dirs pop one item from
- # @base_dirs
- while (my $dir = shift @path_dirs){
- unless ($dir eq $self->updir){
- unshift @path_dirs, $dir;
- last;
- }
- pop @base_dirs;
- }
- $path = $self->catpath(
- $vol,
- $self->catdir(@base_dirs, @path_dirs),
- $file
- );
- return $path;
+ return $self->_collapse($path);
}
=item splitpath
@@ -270,8 +252,9 @@
# If it's UNC, make sure the glue separator is there, reusing
# whatever separator is first in the $volume
- $volume .= $1
- if ( $volume =~ [EMAIL
PROTECTED]([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
+ my $v;
+ $volume .= $v
+ if ( (($v) = $volume =~ [EMAIL
PROTECTED]([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s) &&
$directory =~ [EMAIL PROTECTED]/[EMAIL PROTECTED]
) ;
==== //depot/maint-5.8/perl/lib/File/Spec/t/Spec.t#13 (text) ====
Index: perl/lib/File/Spec/t/Spec.t
--- perl/lib/File/Spec/t/Spec.t#12~24144~ Sun Apr 3 08:18:11 2005
+++ perl/lib/File/Spec/t/Spec.t Sat Sep 10 12:39:28 2005
@@ -91,12 +91,16 @@
[ "Unix->catdir('','d1','d2','d3')", '/d1/d2/d3' ],
[ "Unix->catdir('d1','d2','d3')", 'd1/d2/d3' ],
-[ "Unix->canonpath('')", '' ],
[ "Unix->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c' ],
-[ "Unix->canonpath('/.')", '/' ],
-[ "Unix->canonpath('/./')", '/' ],
-[ "Unix->canonpath('/a/./')", '/a' ],
-[ "Unix->canonpath('/a/.')", '/a' ],
+[ "Unix->canonpath('')", '' ],
+# rt.perl.org 27052
+[ "Unix->canonpath('a/../../b/c')", 'a/../../b/c' ],
+[ "Unix->canonpath('/.')", '/' ],
+[ "Unix->canonpath('/./')", '/' ],
+[ "Unix->canonpath('/a/./')", '/a' ],
+[ "Unix->canonpath('/a/.')", '/a' ],
+[ "Unix->canonpath('/../../')", '/' ],
+[ "Unix->canonpath('/../..')", '/' ],
[ "Unix->abs2rel('/t1/t2/t3','/t1/t2/t3')", '' ],
[ "Unix->abs2rel('/t1/t2/t4','/t1/t2/t3')", '../t4' ],
@@ -118,6 +122,7 @@
[ "Unix->rel2abs('/t1','/t1/t2/t3')", '/t1' ],
[ "Win32->case_tolerant()", '1' ],
+[ "Win32->rootdir()", '\\' ],
[ "Win32->splitpath('file')", ',,file'
],
[ "Win32->splitpath('\\d1/d2\\d3/')", ',\\d1/d2\\d3/,'
],
@@ -208,6 +213,8 @@
[ "Win32->canonpath('a:')", 'A:' ],
[ "Win32->canonpath('A:f')", 'A:f' ],
[ "Win32->canonpath('A:/')", 'A:\\' ],
+# rt.perl.org 27052
+[ "Win32->canonpath('a\\..\\..\\b\\c')", '..\\b\\c' ],
[ "Win32->canonpath('//a\\b//c')", '\\\\a\\b\\c' ],
[ "Win32->canonpath('/a/..../c')", '\\a\\....\\c' ],
[ "Win32->canonpath('//a/b\\c')", '\\\\a\\b\\c' ],
End of Patch.
