diff options
author | Nicholas Clark <nick@ccl4.org> | 2009-09-19 11:53:11 +0100 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2009-09-19 11:53:11 +0100 |
commit | 83f40c94048fdbb191199226697fba08ab108a75 (patch) | |
tree | 7274fcbb1a1797d3ba9bab4b68bea9adca7f3924 /lib | |
parent | 978463b2c6a3c34cabcf3e18bb7d2e41abf7f9ef (diff) | |
download | perl-83f40c94048fdbb191199226697fba08ab108a75.tar.gz |
Reuinte File::Spec with the rest of the PathTools distribution in ext.
It can't really be renamed from ext/Cwd to ext/PathTools, because Configure and
Makefile.SH need to know the name of the shared object produced, and they infer
this from the name of the directory.
This concludes the migration of modules from lib to ext. Exporter and version
remain in lib, but I don't think that there is any benefit in trying to move
either of them.
Diffstat (limited to 'lib')
-rw-r--r-- | lib/File/Spec.pm | 336 | ||||
-rw-r--r-- | lib/File/Spec/Cygwin.pm | 155 | ||||
-rw-r--r-- | lib/File/Spec/Epoc.pm | 79 | ||||
-rw-r--r-- | lib/File/Spec/Functions.pm | 110 | ||||
-rw-r--r-- | lib/File/Spec/Mac.pm | 781 | ||||
-rw-r--r-- | lib/File/Spec/OS2.pm | 274 | ||||
-rw-r--r-- | lib/File/Spec/Unix.pm | 521 | ||||
-rw-r--r-- | lib/File/Spec/VMS.pm | 1165 | ||||
-rw-r--r-- | lib/File/Spec/Win32.pm | 444 | ||||
-rw-r--r-- | lib/File/Spec/t/Functions.t | 10 | ||||
-rw-r--r-- | lib/File/Spec/t/Spec.t | 831 | ||||
-rw-r--r-- | lib/File/Spec/t/crossplatform.t | 173 | ||||
-rw-r--r-- | lib/File/Spec/t/rel2abs2rel.t | 73 | ||||
-rw-r--r-- | lib/File/Spec/t/tmpdir.t | 31 |
14 files changed, 0 insertions, 4983 deletions
diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm deleted file mode 100644 index 839e2aada2..0000000000 --- a/lib/File/Spec.pm +++ /dev/null @@ -1,336 +0,0 @@ -package File::Spec; - -use strict; -use vars qw(@ISA $VERSION); - -$VERSION = '3.30'; -$VERSION = eval $VERSION; - -my %module = (MacOS => 'Mac', - MSWin32 => 'Win32', - os2 => 'OS2', - VMS => 'VMS', - epoc => 'Epoc', - NetWare => 'Win32', # Yes, File::Spec::Win32 works on NetWare. - symbian => 'Win32', # Yes, File::Spec::Win32 works on symbian. - dos => 'OS2', # Yes, File::Spec::OS2 works on DJGPP. - cygwin => 'Cygwin'); - - -my $module = $module{$^O} || 'Unix'; - -require "File/Spec/$module.pm"; -@ISA = ("File::Spec::$module"); - -1; - -__END__ - -=head1 NAME - -File::Spec - portably perform operations on file names - -=head1 SYNOPSIS - - use File::Spec; - - $x=File::Spec->catfile('a', 'b', 'c'); - -which returns 'a/b/c' under Unix. Or: - - use File::Spec::Functions; - - $x = catfile('a', 'b', 'c'); - -=head1 DESCRIPTION - -This module is designed to support operations commonly performed on file -specifications (usually called "file names", but not to be confused with the -contents of a file, or Perl's file handles), such as concatenating several -directory and file names into a single path, or determining whether a path -is rooted. It is based on code directly taken from MakeMaker 5.17, code -written by Andreas KE<ouml>nig, Andy Dougherty, Charles Bailey, Ilya -Zakharevich, Paul Schinder, and others. - -Since these functions are different for most operating systems, each set of -OS specific routines is available in a separate module, including: - - File::Spec::Unix - File::Spec::Mac - File::Spec::OS2 - File::Spec::Win32 - File::Spec::VMS - -The module appropriate for the current OS is automatically loaded by -File::Spec. Since some modules (like VMS) make use of facilities available -only under that OS, it may not be possible to load all modules under all -operating systems. - -Since File::Spec is object oriented, subroutines should not be called directly, -as in: - - File::Spec::catfile('a','b'); - -but rather as class methods: - - File::Spec->catfile('a','b'); - -For simple uses, L<File::Spec::Functions> provides convenient functional -forms of these methods. - -=head1 METHODS - -=over 2 - -=item canonpath -X<canonpath> - -No physical check on the filesystem, but a logical cleanup of a -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 -X<catdir> - -Concatenate two or more directory names to form a complete path ending -with a directory. But remove the trailing slash from the resulting -string, because it doesn't look good, isn't necessary and confuses -OS/2. Of course, if this is the root directory, don't cut off the -trailing slash :-) - - $path = File::Spec->catdir( @directories ); - -=item catfile -X<catfile> - -Concatenate one or more directory names and a filename to form a -complete path ending with a filename - - $path = File::Spec->catfile( @directories, $filename ); - -=item curdir -X<curdir> - -Returns a string representation of the current directory. - - $curdir = File::Spec->curdir(); - -=item devnull -X<devnull> - -Returns a string representation of the null device. - - $devnull = File::Spec->devnull(); - -=item rootdir -X<rootdir> - -Returns a string representation of the root directory. - - $rootdir = File::Spec->rootdir(); - -=item tmpdir -X<tmpdir> - -Returns a string representation of the first writable directory from a -list of possible temporary directories. Returns the current directory -if no writable temporary directories are found. The list of directories -checked depends on the platform; e.g. File::Spec::Unix checks C<$ENV{TMPDIR}> -(unless taint is on) and F</tmp>. - - $tmpdir = File::Spec->tmpdir(); - -=item updir -X<updir> - -Returns a string representation of the parent directory. - - $updir = File::Spec->updir(); - -=item no_upwards - -Given a list of file names, strip out those that refer to a parent -directory. (Does not strip symlinks, only '.', '..', and equivalents.) - - @paths = File::Spec->no_upwards( @paths ); - -=item case_tolerant - -Returns a true or false value indicating, respectively, that alphabetic -case is not or is significant when comparing file specifications. - - $is_case_tolerant = File::Spec->case_tolerant(); - -=item file_name_is_absolute - -Takes as its argument a path, and returns true if it is an absolute path. - - $is_absolute = File::Spec->file_name_is_absolute( $path ); - -This does not consult the local filesystem on Unix, Win32, OS/2, or -Mac OS (Classic). It does consult the working environment for VMS -(see L<File::Spec::VMS/file_name_is_absolute>). - -=item path -X<path> - -Takes no argument. Returns the environment variable C<PATH> (or the local -platform's equivalent) as a list. - - @PATH = File::Spec->path(); - -=item join -X<join, path> - -join is the same as catfile. - -=item splitpath -X<splitpath> X<split, path> - -Splits a path in to volume, directory, and filename portions. On systems -with no concept of volume, returns '' for volume. - - ($volume,$directories,$file) = File::Spec->splitpath( $path ); - ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); - -For systems with no syntax differentiating filenames from directories, -assumes that the last file is a path unless C<$no_file> is true or a -trailing separator or F</.> or F</..> is present. On Unix, this means that C<$no_file> -true makes this return ( '', $path, '' ). - -The directory portion may or may not be returned with a trailing '/'. - -The results can be passed to L</catpath()> to get back a path equivalent to -(usually identical to) the original path. - -=item splitdir -X<splitdir> X<split, dir> - -The opposite of L</catdir()>. - - @dirs = File::Spec->splitdir( $directories ); - -C<$directories> must be only the directory portion of the path on systems -that have the concept of a volume or that have path syntax that differentiates -files from directories. - -Unlike just splitting the directories on the separator, empty -directory names (C<''>) can be returned, because these are significant -on some OSes. - -=item catpath() - -Takes volume, directory and file portions and returns an entire path. Under -Unix, C<$volume> is ignored, and directory and file are concatenated. A '/' is -inserted if need be. On other OSes, C<$volume> is significant. - - $full_path = File::Spec->catpath( $volume, $directory, $file ); - -=item abs2rel -X<abs2rel> X<absolute, path> X<relative, path> - -Takes a destination path and an optional base path returns a relative path -from the base path to the destination path: - - $rel_path = File::Spec->abs2rel( $path ) ; - $rel_path = File::Spec->abs2rel( $path, $base ) ; - -If C<$base> is not present or '', then L<Cwd::cwd()|Cwd> is used. If C<$base> is -relative, then it is converted to absolute form using -L</rel2abs()>. This means that it is taken to be relative to -L<Cwd::cwd()|Cwd>. - -On systems with the concept of volume, if C<$path> and C<$base> appear to be -on two different volumes, we will not attempt to resolve the two -paths, and we will instead simply return C<$path>. Note that previous -versions of this module ignored the volume of C<$base>, which resulted in -garbage results part of the time. - -On systems that have a grammar that indicates filenames, this ignores the -C<$base> filename as well. Otherwise all path components are assumed to be -directories. - -If C<$path> is relative, it is converted to absolute form using L</rel2abs()>. -This means that it is taken to be relative to L<Cwd::cwd()|Cwd>. - -No checks against the filesystem are made. On VMS, there is -interaction with the working environment, as logicals and -macros are expanded. - -Based on code written by Shigio Yamaguchi. - -=item rel2abs() -X<rel2abs> X<absolute, path> X<relative, path> - -Converts a relative path to an absolute path. - - $abs_path = File::Spec->rel2abs( $path ) ; - $abs_path = File::Spec->rel2abs( $path, $base ) ; - -If C<$base> is not present or '', then L<Cwd::cwd()|Cwd> is used. If C<$base> is relative, -then it is converted to absolute form using L</rel2abs()>. This means that it -is taken to be relative to L<Cwd::cwd()|Cwd>. - -On systems with the concept of volume, if C<$path> and C<$base> appear to be -on two different volumes, we will not attempt to resolve the two -paths, and we will instead simply return C<$path>. Note that previous -versions of this module ignored the volume of C<$base>, which resulted in -garbage results part of the time. - -On systems that have a grammar that indicates filenames, this ignores the -C<$base> filename as well. Otherwise all path components are assumed to be -directories. - -If C<$path> is absolute, it is cleaned up and returned using L</canonpath()>. - -No checks against the filesystem are made. On VMS, there is -interaction with the working environment, as logicals and -macros are expanded. - -Based on code written by Shigio Yamaguchi. - -=back - -For further information, please see L<File::Spec::Unix>, -L<File::Spec::Mac>, L<File::Spec::OS2>, L<File::Spec::Win32>, or -L<File::Spec::VMS>. - -=head1 SEE ALSO - -L<File::Spec::Unix>, L<File::Spec::Mac>, L<File::Spec::OS2>, -L<File::Spec::Win32>, L<File::Spec::VMS>, L<File::Spec::Functions>, -L<ExtUtils::MakeMaker> - -=head1 AUTHOR - -Currently maintained by Ken Williams C<< <KWILLIAMS@cpan.org> >>. - -The vast majority of the code was written by -Kenneth Albanowski C<< <kjahds@kjahds.com> >>, -Andy Dougherty C<< <doughera@lafayette.edu> >>, -Andreas KE<ouml>nig C<< <A.Koenig@franz.ww.TU-Berlin.DE> >>, -Tim Bunce C<< <Tim.Bunce@ig.co.uk> >>. -VMS support by Charles Bailey C<< <bailey@newman.upenn.edu> >>. -OS/2 support by Ilya Zakharevich C<< <ilya@math.ohio-state.edu> >>. -Mac support by Paul Schinder C<< <schinder@pobox.com> >>, and -Thomas Wegner C<< <wegner_thomas@yahoo.com> >>. -abs2rel() and rel2abs() written by Shigio Yamaguchi C<< <shigio@tamacom.com> >>, -modified by Barrie Slaymaker C<< <barries@slaysys.com> >>. -splitpath(), splitdir(), catpath() and catdir() by Barrie Slaymaker. - -=head1 COPYRIGHT - -Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. - -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut diff --git a/lib/File/Spec/Cygwin.pm b/lib/File/Spec/Cygwin.pm deleted file mode 100644 index 050a1bb2b7..0000000000 --- a/lib/File/Spec/Cygwin.pm +++ /dev/null @@ -1,155 +0,0 @@ -package File::Spec::Cygwin; - -use strict; -use vars qw(@ISA $VERSION); -require File::Spec::Unix; - -$VERSION = '3.30'; -$VERSION = eval $VERSION; - -@ISA = qw(File::Spec::Unix); - -=head1 NAME - -File::Spec::Cygwin - methods for Cygwin file specs - -=head1 SYNOPSIS - - require File::Spec::Cygwin; # Done internally by File::Spec if needed - -=head1 DESCRIPTION - -See L<File::Spec> and L<File::Spec::Unix>. This package overrides the -implementation of these methods, not the semantics. - -This module is still in beta. Cygwin-knowledgeable folks are invited -to offer patches and suggestions. - -=cut - -=pod - -=over 4 - -=item canonpath - -Any C<\> (backslashes) are converted to C</> (forward slashes), -and then File::Spec::Unix canonpath() is called on the result. - -=cut - -sub canonpath { - my($self,$path) = @_; - return unless defined $path; - - $path =~ s|\\|/|g; - - # Handle network path names beginning with double slash - my $node = ''; - if ( $path =~ s@^(//[^/]+)(?:/|\z)@/@s ) { - $node = $1; - } - return $node . $self->SUPER::canonpath($path); -} - -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 '\\')) { - shift; - return $self->SUPER::catdir('', @_); - } - - $self->SUPER::catdir(@_); -} - -=pod - -=item file_name_is_absolute - -True is returned if the file name begins with C<drive_letter:>, -and if not, File::Spec::Unix file_name_is_absolute() is called. - -=cut - - -sub file_name_is_absolute { - my ($self,$file) = @_; - return 1 if $file =~ m{^([a-z]:)?[\\/]}is; # C:/test - return $self->SUPER::file_name_is_absolute($file); -} - -=item tmpdir (override) - -Returns a string representation of the first existing directory -from the following list: - - $ENV{TMPDIR} - /tmp - $ENV{'TMP'} - $ENV{'TEMP'} - C:/temp - -Since Perl 5.8.0, if running under taint mode, and if the environment -variables are tainted, they are not used. - -=cut - -my $tmpdir; -sub tmpdir { - return $tmpdir if defined $tmpdir; - $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp", $ENV{'TMP'}, $ENV{'TEMP'}, 'C:/temp' ); -} - -=item case_tolerant - -Override Unix. Cygwin case-tolerance depends on managed mount settings and -as with MsWin32 on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE, -indicating the case significance when comparing file specifications. -Default: 1 - -=cut - -sub case_tolerant { - return 1 unless $^O eq 'cygwin' - and defined &Cygwin::mount_flags; - - my $drive = shift; - if (! $drive) { - my @flags = split(/,/, Cygwin::mount_flags('/cygwin')); - my $prefix = pop(@flags); - if (! $prefix || $prefix eq 'cygdrive') { - $drive = '/cygdrive/c'; - } elsif ($prefix eq '/') { - $drive = '/c'; - } else { - $drive = "$prefix/c"; - } - } - my $mntopts = Cygwin::mount_flags($drive); - if ($mntopts and ($mntopts =~ /,managed/)) { - return 0; - } - eval { require Win32API::File; } or return 1; - my $osFsType = "\0"x256; - my $osVolName = "\0"x256; - my $ouFsFlags = 0; - Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 ); - if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; } - else { return 1; } -} - -=back - -=head1 COPYRIGHT - -Copyright (c) 2004,2007 by the Perl 5 Porters. All rights reserved. - -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut - -1; diff --git a/lib/File/Spec/Epoc.pm b/lib/File/Spec/Epoc.pm deleted file mode 100644 index 54ff667c52..0000000000 --- a/lib/File/Spec/Epoc.pm +++ /dev/null @@ -1,79 +0,0 @@ -package File::Spec::Epoc; - -use strict; -use vars qw($VERSION @ISA); - -$VERSION = '3.30'; -$VERSION = eval $VERSION; - -require File::Spec::Unix; -@ISA = qw(File::Spec::Unix); - -=head1 NAME - -File::Spec::Epoc - methods for Epoc file specs - -=head1 SYNOPSIS - - require File::Spec::Epoc; # Done internally by File::Spec if needed - -=head1 DESCRIPTION - -See File::Spec::Unix for a documentation of the methods provided -there. This package overrides the implementation of these methods, not -the semantics. - -This package is still work in progress ;-) - -=cut - -sub case_tolerant { - return 1; -} - -=pod - -=over 4 - -=item canonpath() - -No physical check on the filesystem, but a logical cleanup of a -path. On UNIX eliminated successive slashes and successive "/.". - -=back - -=cut - -sub canonpath { - my ($self,$path) = @_; - return unless defined $path; - - $path =~ s|/+|/|g; # xx////xx -> xx/xx - $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx - $path =~ s|^(\./)+||s unless $path eq "./"; # ./xx -> xx - $path =~ s|^/(\.\./)+|/|s; # /../../xx -> xx - $path =~ s|/\Z(?!\n)|| unless $path eq "/"; # xx/ -> xx - return $path; -} - -=pod - -=head1 AUTHOR - -o.flebbe@gmx.de - -=head1 COPYRIGHT - -Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. - -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=head1 SEE ALSO - -See L<File::Spec> and L<File::Spec::Unix>. This package overrides the -implementation of these methods, not the semantics. - -=cut - -1; diff --git a/lib/File/Spec/Functions.pm b/lib/File/Spec/Functions.pm deleted file mode 100644 index e7becc7cfa..0000000000 --- a/lib/File/Spec/Functions.pm +++ /dev/null @@ -1,110 +0,0 @@ -package File::Spec::Functions; - -use File::Spec; -use strict; - -use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); - -$VERSION = '3.30'; -$VERSION = eval $VERSION; - -require Exporter; - -@ISA = qw(Exporter); - -@EXPORT = qw( - canonpath - catdir - catfile - curdir - rootdir - updir - no_upwards - file_name_is_absolute - path -); - -@EXPORT_OK = qw( - devnull - tmpdir - splitpath - splitdir - catpath - abs2rel - rel2abs - case_tolerant -); - -%EXPORT_TAGS = ( ALL => [ @EXPORT_OK, @EXPORT ] ); - -foreach my $meth (@EXPORT, @EXPORT_OK) { - my $sub = File::Spec->can($meth); - no strict 'refs'; - *{$meth} = sub {&$sub('File::Spec', @_)}; -} - - -1; -__END__ - -=head1 NAME - -File::Spec::Functions - portably perform operations on file names - -=head1 SYNOPSIS - - use File::Spec::Functions; - $x = catfile('a','b'); - -=head1 DESCRIPTION - -This module exports convenience functions for all of the class methods -provided by File::Spec. - -For a reference of available functions, please consult L<File::Spec::Unix>, -which contains the entire set, and which is inherited by the modules for -other platforms. For further information, please see L<File::Spec::Mac>, -L<File::Spec::OS2>, L<File::Spec::Win32>, or L<File::Spec::VMS>. - -=head2 Exports - -The following functions are exported by default. - - canonpath - catdir - catfile - curdir - rootdir - updir - no_upwards - file_name_is_absolute - path - - -The following functions are exported only by request. - - devnull - tmpdir - splitpath - splitdir - catpath - abs2rel - rel2abs - case_tolerant - -All the functions may be imported using the C<:ALL> tag. - -=head1 COPYRIGHT - -Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. - -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=head1 SEE ALSO - -File::Spec, File::Spec::Unix, File::Spec::Mac, File::Spec::OS2, -File::Spec::Win32, File::Spec::VMS, ExtUtils::MakeMaker - -=cut - diff --git a/lib/File/Spec/Mac.pm b/lib/File/Spec/Mac.pm deleted file mode 100644 index 8b47470d6b..0000000000 --- a/lib/File/Spec/Mac.pm +++ /dev/null @@ -1,781 +0,0 @@ -package File::Spec::Mac; - -use strict; -use vars qw(@ISA $VERSION); -require File::Spec::Unix; - -$VERSION = '3.30'; -$VERSION = eval $VERSION; - -@ISA = qw(File::Spec::Unix); - -my $macfiles; -if ($^O eq 'MacOS') { - $macfiles = eval { require Mac::Files }; -} - -sub case_tolerant { 1 } - - -=head1 NAME - -File::Spec::Mac - File::Spec for Mac OS (Classic) - -=head1 SYNOPSIS - - require File::Spec::Mac; # Done internally by File::Spec if needed - -=head1 DESCRIPTION - -Methods for manipulating file specifications. - -=head1 METHODS - -=over 2 - -=item canonpath - -On Mac OS, there's nothing to be done. Returns what it's given. - -=cut - -sub canonpath { - my ($self,$path) = @_; - return $path; -} - -=item catdir() - -Concatenate two or more directory names to form a path separated by colons -(":") ending with a directory. Resulting paths are B<relative> by default, -but can be forced to be absolute (but avoid this, see below). Automatically -puts a trailing ":" on the end of the complete path, because that's what's -done in MacPerl's environment and helps to distinguish a file path from a -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 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. - -The intended purpose of this routine is to concatenate I<directory names>. -But because of the nature of Macintosh paths, some additional possibilities -are allowed to make using this routine give reasonable results for some -common situations. In other words, you are also allowed to concatenate -I<paths> instead of directory names (strictly speaking, a string like ":a" -is a path, but not a name, since it contains a punctuation character ":"). - -So, beside calls like - - catdir("a") = ":a:" - catdir("a","b") = ":a:b:" - catdir() = "" (special case) - -calls like the following - - catdir(":a:") = ":a:" - catdir(":a","b") = ":a:b:" - catdir(":a:","b") = ":a:b:" - catdir(":a:",":b:") = ":a:b:" - catdir(":") = ":" - -are allowed. - -Here are the rules that are used in C<catdir()>; note that we try to be as -compatible as possible to Unix: - -=over 2 - -=item 1. - -The resulting path is relative by default, i.e. the resulting path will have a -leading colon. - -=item 2. - -A trailing colon is added automatically to the resulting path, to denote a -directory. - -=item 3. - -Generally, each argument has one leading ":" and one trailing ":" -removed (if any). They are then joined together by a ":". Special -treatment applies for arguments denoting updir paths like "::lib:", -see (4), or arguments consisting solely of colons ("colon paths"), -see (5). - -=item 4. - -When an updir path like ":::lib::" is passed as argument, the number -of directories to climb up is handled correctly, not removing leading -or trailing colons when necessary. E.g. - - catdir(":::a","::b","c") = ":::a::b:c:" - catdir(":::a::","::b","c") = ":::a:::b:c:" - -=item 5. - -Adding a colon ":" or empty string "" to a path at I<any> position -doesn't alter the path, i.e. these arguments are ignored. (When a "" -is passed as the first argument, it has a special meaning, see -(6)). This way, a colon ":" is handled like a "." (curdir) on Unix, -while an empty string "" is generally ignored (see -C<Unix-E<gt>canonpath()> ). Likewise, a "::" is handled like a ".." -(updir), and a ":::" is handled like a "../.." etc. E.g. - - catdir("a",":",":","b") = ":a:b:" - catdir("a",":","::",":b") = ":a::b:" - -=item 6. - -If the first argument is an empty string "" or is a volume name, i.e. matches -the pattern /^[^:]+:/, the resulting path is B<absolute>. - -=item 7. - -Passing an empty string "" as the first argument to C<catdir()> is -like passingC<File::Spec-E<gt>rootdir()> as the first argument, i.e. - - catdir("","a","b") is the same as - - catdir(rootdir(),"a","b"). - -This is true on Unix, where C<catdir("","a","b")> yields "/a/b" and -C<rootdir()> is "/". Note that C<rootdir()> on Mac OS is the startup -volume, which is the closest in concept to Unix' "/". This should help -to run existing scripts originally written for Unix. - -=item 8. - -For absolute paths, some cleanup is done, to ensure that the volume -name isn't immediately followed by updirs. This is invalid, because -this would go beyond "root". Generally, these cases are handled like -their Unix counterparts: - - Unix: - Unix->catdir("","") = "/" - Unix->catdir("",".") = "/" - Unix->catdir("","..") = "/" # can't go beyond root - Unix->catdir("",".","..","..","a") = "/a" - Mac: - Mac->catdir("","") = rootdir() # (e.g. "HD:") - Mac->catdir("",":") = rootdir() - Mac->catdir("","::") = rootdir() # can't go beyond root - Mac->catdir("",":","::","::","a") = rootdir() . "a:" # (e.g. "HD:a:") - -However, this approach is limited to the first arguments following -"root" (again, see C<Unix-E<gt>canonpath()> ). If there are more -arguments that move up the directory tree, an invalid path going -beyond root can be created. - -=back - -As you've seen, you can force C<catdir()> to create an absolute path -by passing either an empty string or a path that begins with a volume -name as the first argument. However, you are strongly encouraged not -to do so, since this is done only for backward compatibility. Newer -versions of File::Spec come with a method called C<catpath()> (see -below), that is designed to offer a portable solution for the creation -of absolute paths. It takes volume, directory and file portions and -returns an entire path. While C<catdir()> is still suitable for the -concatenation of I<directory names>, you are encouraged to use -C<catpath()> to concatenate I<volume names> and I<directory -paths>. E.g. - - $dir = File::Spec->catdir("tmp","sources"); - $abs_path = File::Spec->catpath("MacintoshHD:", $dir,""); - -yields - - "MacintoshHD:tmp:sources:" . - -=cut - -sub catdir { - my $self = shift; - return '' unless @_; - my @args = @_; - my $first_arg; - my $relative; - - # take care of the first argument - - if ($args[0] eq '') { # absolute path, rootdir - shift @args; - $relative = 0; - $first_arg = $self->rootdir; - - } elsif ($args[0] =~ /^[^:]+:/) { # absolute path, volume name - $relative = 0; - $first_arg = shift @args; - # add a trailing ':' if need be (may be it's a path like HD:dir) - $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/); - - } else { # relative path - $relative = 1; - if ( $args[0] =~ /^::+\Z(?!\n)/ ) { - # updir colon path ('::', ':::' etc.), don't shift - $first_arg = ':'; - } elsif ($args[0] eq ':') { - $first_arg = shift @args; - } else { - # add a trailing ':' if need be - $first_arg = shift @args; - $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/); - } - } - - # For all other arguments, - # (a) ignore arguments that equal ':' or '', - # (b) handle updir paths specially: - # '::' -> concatenate '::' - # '::' . '::' -> concatenate ':::' etc. - # (c) add a trailing ':' if need be - - my $result = $first_arg; - while (@args) { - my $arg = shift @args; - unless (($arg eq '') || ($arg eq ':')) { - if ($arg =~ /^::+\Z(?!\n)/ ) { # updir colon path like ':::' - my $updir_count = length($arg) - 1; - while ((@args) && ($args[0] =~ /^::+\Z(?!\n)/) ) { # while updir colon path - $arg = shift @args; - $updir_count += (length($arg) - 1); - } - $arg = (':' x $updir_count); - } else { - $arg =~ s/^://s; # remove a leading ':' if any - $arg = "$arg:" unless ($arg =~ /:\Z(?!\n)/); # ensure trailing ':' - } - $result .= $arg; - }#unless - } - - if ( ($relative) && ($result !~ /^:/) ) { - # add a leading colon if need be - $result = ":$result"; - } - - unless ($relative) { - # remove updirs immediately following the volume name - $result =~ s/([^:]+:)(:*)(.*)\Z(?!\n)/$1$3/; - } - - return $result; -} - -=item catfile - -Concatenate one or more directory names and a filename to form a -complete path ending with a filename. Resulting paths are B<relative> -by default, but can be forced to be absolute (but avoid this). - -B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the -resulting path is relative by default and I<not> absolute. This -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. - -The last argument is always considered to be the file portion. Since -C<catfile()> uses C<catdir()> (see above) for the concatenation of the -directory portions (if any), the following with regard to relative and -absolute paths is true: - - catfile("") = "" - catfile("file") = "file" - -but - - catfile("","") = rootdir() # (e.g. "HD:") - catfile("","file") = rootdir() . file # (e.g. "HD:file") - catfile("HD:","file") = "HD:file" - -This means that C<catdir()> is called only when there are two or more -arguments, as one might expect. - -Note that the leading ":" is removed from the filename, so that - - catfile("a","b","file") = ":a:b:file" and - - catfile("a","b",":file") = ":a:b:file" - -give the same answer. - -To concatenate I<volume names>, I<directory paths> and I<filenames>, -you are encouraged to use C<catpath()> (see below). - -=cut - -sub catfile { - my $self = shift; - return '' unless @_; - my $file = pop @_; - return $file unless @_; - my $dir = $self->catdir(@_); - $file =~ s/^://s; - return $dir.$file; -} - -=item curdir - -Returns a string representing the current directory. On Mac OS, this is ":". - -=cut - -sub curdir { - return ":"; -} - -=item devnull - -Returns a string representing the null device. On Mac OS, this is "Dev:Null". - -=cut - -sub devnull { - return "Dev:Null"; -} - -=item rootdir - -Returns a string representing the root directory. Under MacPerl, -returns the name of the startup volume, since that's the closest in -concept, although other volumes aren't rooted there. The name has a -trailing ":", because that's the correct specification for a volume -name on Mac OS. - -If Mac::Files could not be loaded, the empty string is returned. - -=cut - -sub rootdir { -# -# There's no real root directory on Mac OS. The name of the startup -# volume is returned, since that's the closest in concept. -# - return '' unless $macfiles; - my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk, - &Mac::Files::kSystemFolderType); - $system =~ s/:.*\Z(?!\n)/:/s; - return $system; -} - -=item tmpdir - -Returns the contents of $ENV{TMPDIR}, if that directory exits or the -current working directory otherwise. Under MacPerl, $ENV{TMPDIR} will -contain a path like "MacintoshHD:Temporary Items:", which is a hidden -directory on your startup volume. - -=cut - -my $tmpdir; -sub tmpdir { - return $tmpdir if defined $tmpdir; - $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR} ); -} - -=item updir - -Returns a string representing the parent directory. On Mac OS, this is "::". - -=cut - -sub updir { - return "::"; -} - -=item file_name_is_absolute - -Takes as argument a path and returns true, if it is an absolute path. -If the path has a leading ":", it's a relative path. Otherwise, it's an -absolute path, unless the path doesn't contain any colons, i.e. it's a name -like "a". In this particular case, the path is considered to be relative -(i.e. it is considered to be a filename). Use ":" in the appropriate place -in the path if you want to distinguish unambiguously. As a special case, -the filename '' is always considered to be absolute. Note that with version -1.2 of File::Spec::Mac, this does no longer consult the local filesystem. - -E.g. - - File::Spec->file_name_is_absolute("a"); # false (relative) - File::Spec->file_name_is_absolute(":a:b:"); # false (relative) - File::Spec->file_name_is_absolute("MacintoshHD:"); # true (absolute) - File::Spec->file_name_is_absolute(""); # true (absolute) - - -=cut - -sub file_name_is_absolute { - my ($self,$file) = @_; - if ($file =~ /:/) { - return (! ($file =~ m/^:/s) ); - } elsif ( $file eq '' ) { - return 1 ; - } else { - return 0; # i.e. a file like "a" - } -} - -=item path - -Returns the null list for the MacPerl application, since the concept is -usually meaningless under Mac OS. But if you're using the MacPerl tool under -MPW, it gives back $ENV{Commands} suitably split, as is done in -:lib:ExtUtils:MM_Mac.pm. - -=cut - -sub path { -# -# The concept is meaningless under the MacPerl application. -# Under MPW, it has a meaning. -# - return unless exists $ENV{Commands}; - return split(/,/, $ENV{Commands}); -} - -=item splitpath - - ($volume,$directories,$file) = File::Spec->splitpath( $path ); - ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); - -Splits a path into volume, directory, and filename portions. - -On Mac OS, assumes that the last part of the path is a filename unless -$no_file is true or a trailing separator ":" is present. - -The volume portion is always returned with a trailing ":". The directory portion -is always returned with a leading (to denote a relative path) and a trailing ":" -(to denote a directory). The file portion is always returned I<without> a leading ":". -Empty portions are returned as empty string ''. - -The results can be passed to C<catpath()> to get back a path equivalent to -(usually identical to) the original path. - - -=cut - -sub splitpath { - my ($self,$path, $nofile) = @_; - my ($volume,$directory,$file); - - if ( $nofile ) { - ( $volume, $directory ) = $path =~ m|^((?:[^:]+:)?)(.*)|s; - } - else { - $path =~ - m|^( (?: [^:]+: )? ) - ( (?: .*: )? ) - ( .* ) - |xs; - $volume = $1; - $directory = $2; - $file = $3; - } - - $volume = '' unless defined($volume); - $directory = ":$directory" if ( $volume && $directory ); # take care of "HD::dir" - if ($directory) { - # Make sure non-empty directories begin and end in ':' - $directory .= ':' unless (substr($directory,-1) eq ':'); - $directory = ":$directory" unless (substr($directory,0,1) eq ':'); - } else { - $directory = ''; - } - $file = '' unless defined($file); - - return ($volume,$directory,$file); -} - - -=item splitdir - -The opposite of C<catdir()>. - - @dirs = File::Spec->splitdir( $directories ); - -$directories should be only the directory portion of the path on systems -that have the concept of a volume or that have path syntax that differentiates -files from directories. Consider using C<splitpath()> otherwise. - -Unlike just splitting the directories on the separator, empty directory names -(C<"">) can be returned. Since C<catdir()> on Mac OS always appends a trailing -colon to distinguish a directory path from a file path, a single trailing colon -will be ignored, i.e. there's no empty directory name after it. - -Hence, on Mac OS, both - - File::Spec->splitdir( ":a:b::c:" ); and - File::Spec->splitdir( ":a:b::c" ); - -yield: - - ( "a", "b", "::", "c") - -while - - File::Spec->splitdir( ":a:b::c::" ); - -yields: - - ( "a", "b", "::", "c", "::") - - -=cut - -sub splitdir { - my ($self, $path) = @_; - my @result = (); - my ($head, $sep, $tail, $volume, $directories); - - return @result if ( (!defined($path)) || ($path eq '') ); - return (':') if ($path eq ':'); - - ( $volume, $sep, $directories ) = $path =~ m|^((?:[^:]+:)?)(:*)(.*)|s; - - # deprecated, but handle it correctly - if ($volume) { - push (@result, $volume); - $sep .= ':'; - } - - while ($sep || $directories) { - if (length($sep) > 1) { - my $updir_count = length($sep) - 1; - for (my $i=0; $i<$updir_count; $i++) { - # push '::' updir_count times; - # simulate Unix '..' updirs - push (@result, '::'); - } - } - $sep = ''; - if ($directories) { - ( $head, $sep, $tail ) = $directories =~ m|^((?:[^:]+)?)(:*)(.*)|s; - push (@result, $head); - $directories = $tail; - } - } - return @result; -} - - -=item catpath - - $path = File::Spec->catpath($volume,$directory,$file); - -Takes volume, directory and file portions and returns an entire path. On Mac OS, -$volume, $directory and $file are concatenated. A ':' is inserted if need be. You -may pass an empty string for each portion. If all portions are empty, the empty -string is returned. If $volume is empty, the result will be a relative path, -beginning with a ':'. If $volume and $directory are empty, a leading ":" (if any) -is removed form $file and the remainder is returned. If $file is empty, the -resulting path will have a trailing ':'. - - -=cut - -sub catpath { - my ($self,$volume,$directory,$file) = @_; - - if ( (! $volume) && (! $directory) ) { - $file =~ s/^:// if $file; - return $file ; - } - - # We look for a volume in $volume, then in $directory, but not both - - my ($dir_volume, $dir_dirs) = $self->splitpath($directory, 1); - - $volume = $dir_volume unless length $volume; - my $path = $volume; # may be '' - $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':' - - if ($directory) { - $directory = $dir_dirs if $volume; - $directory =~ s/^://; # remove leading ':' if any - $path .= $directory; - $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':' - } - - if ($file) { - $file =~ s/^://; # remove leading ':' if any - $path .= $file; - } - - return $path; -} - -=item abs2rel - -Takes a destination path and an optional base path and returns a relative path -from the base path to the destination path: - - $rel_path = File::Spec->abs2rel( $path ) ; - $rel_path = File::Spec->abs2rel( $path, $base ) ; - -Note that both paths are assumed to have a notation that distinguishes a -directory path (with trailing ':') from a file path (without trailing ':'). - -If $base is not present or '', then the current working directory is used. -If $base is relative, then it is converted to absolute form using C<rel2abs()>. -This means that it is taken to be relative to the current working directory. - -If $path and $base appear to be on two different volumes, we will not -attempt to resolve the two paths, and we will instead simply return -$path. Note that previous versions of this module ignored the volume -of $base, which resulted in garbage results part of the time. - -If $base doesn't have a trailing colon, the last element of $base is -assumed to be a filename. This filename is ignored. Otherwise all path -components are assumed to be directories. - -If $path is relative, it is converted to absolute form using C<rel2abs()>. -This means that it is taken to be relative to the current working directory. - -Based on code written by Shigio Yamaguchi. - - -=cut - -# maybe this should be done in canonpath() ? -sub _resolve_updirs { - my $path = shift @_; - my $proceed; - - # resolve any updirs, e.g. "HD:tmp::file" -> "HD:file" - do { - $proceed = ($path =~ s/^(.*):[^:]+::(.*?)\z/$1:$2/); - } while ($proceed); - - return $path; -} - - -sub abs2rel { - my($self,$path,$base) = @_; - - # Clean up $path - if ( ! $self->file_name_is_absolute( $path ) ) { - $path = $self->rel2abs( $path ) ; - } - - # Figure out the effective $base and clean it up. - if ( !defined( $base ) || $base eq '' ) { - $base = $self->_cwd(); - } - elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - $base = _resolve_updirs( $base ); # resolve updirs in $base - } - else { - $base = _resolve_updirs( $base ); - } - - # Split up paths - ignore $base's file - my ( $path_vol, $path_dirs, $path_file ) = $self->splitpath( $path ); - my ( $base_vol, $base_dirs ) = $self->splitpath( $base ); - - return $path unless lc( $path_vol ) eq lc( $base_vol ); - - # Now, remove all leading components that are the same - my @pathchunks = $self->splitdir( $path_dirs ); - my @basechunks = $self->splitdir( $base_dirs ); - - while ( @pathchunks && - @basechunks && - lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) { - shift @pathchunks ; - shift @basechunks ; - } - - # @pathchunks now has the directories to descend in to. - # ensure relative path, even if @pathchunks is empty - $path_dirs = $self->catdir( ':', @pathchunks ); - - # @basechunks now contains the number of directories to climb out of. - $base_dirs = (':' x @basechunks) . ':' ; - - return $self->catpath( '', $self->catdir( $base_dirs, $path_dirs ), $path_file ) ; -} - -=item rel2abs - -Converts a relative path to an absolute path: - - $abs_path = File::Spec->rel2abs( $path ) ; - $abs_path = File::Spec->rel2abs( $path, $base ) ; - -Note that both paths are assumed to have a notation that distinguishes a -directory path (with trailing ':') from a file path (without trailing ':'). - -If $base is not present or '', then $base is set to the current working -directory. If $base is relative, then it is converted to absolute form -using C<rel2abs()>. This means that it is taken to be relative to the -current working directory. - -If $base doesn't have a trailing colon, the last element of $base is -assumed to be a filename. This filename is ignored. Otherwise all path -components are assumed to be directories. - -If $path is already absolute, it is returned and $base is ignored. - -Based on code written by Shigio Yamaguchi. - -=cut - -sub rel2abs { - my ($self,$path,$base) = @_; - - if ( ! $self->file_name_is_absolute($path) ) { - # Figure out the effective $base and clean it up. - if ( !defined( $base ) || $base eq '' ) { - $base = $self->_cwd(); - } - elsif ( ! $self->file_name_is_absolute($base) ) { - $base = $self->rel2abs($base) ; - } - - # Split up paths - - # igonore $path's volume - my ( $path_dirs, $path_file ) = ($self->splitpath($path))[1,2] ; - - # ignore $base's file part - my ( $base_vol, $base_dirs ) = $self->splitpath($base) ; - - # Glom them together - $path_dirs = ':' if ($path_dirs eq ''); - $base_dirs =~ s/:$//; # remove trailing ':', if any - $base_dirs = $base_dirs . $path_dirs; - - $path = $self->catpath( $base_vol, $base_dirs, $path_file ); - } - return $path; -} - - -=back - -=head1 AUTHORS - -See the authors list in I<File::Spec>. Mac OS support by Paul Schinder -<schinder@pobox.com> and Thomas Wegner <wegner_thomas@yahoo.com>. - -=head1 COPYRIGHT - -Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. - -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=head1 SEE ALSO - -See L<File::Spec> and L<File::Spec::Unix>. This package overrides the -implementation of these methods, not the semantics. - -=cut - -1; diff --git a/lib/File/Spec/OS2.pm b/lib/File/Spec/OS2.pm deleted file mode 100644 index a8fa63e3c1..0000000000 --- a/lib/File/Spec/OS2.pm +++ /dev/null @@ -1,274 +0,0 @@ -package File::Spec::OS2; - -use strict; -use vars qw(@ISA $VERSION); -require File::Spec::Unix; - -$VERSION = '3.30'; -$VERSION = eval $VERSION; - -@ISA = qw(File::Spec::Unix); - -sub devnull { - return "/dev/nul"; -} - -sub case_tolerant { - return 1; -} - -sub file_name_is_absolute { - my ($self,$file) = @_; - return scalar($file =~ m{^([a-z]:)?[\\/]}is); -} - -sub path { - my $path = $ENV{PATH}; - $path =~ s:\\:/:g; - my @path = split(';',$path); - foreach (@path) { $_ = '.' if $_ eq '' } - return @path; -} - -sub _cwd { - # In OS/2 the "require Cwd" is unnecessary bloat. - return Cwd::sys_cwd(); -} - -my $tmpdir; -sub tmpdir { - return $tmpdir if defined $tmpdir; - my @d = @ENV{qw(TMPDIR TEMP TMP)}; # function call could autovivivy - $tmpdir = $_[0]->_tmpdir( @d, '/tmp', '/' ); -} - -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)); -} - -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 - $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx - $path =~ s|^(\./)+(?=[^/])||s; # ./xx -> xx - $path =~ s|/\Z(?!\n)|| - unless $path =~ m#^([a-z]:)?/\Z(?!\n)#si;# xx/ -> xx - $path =~ s{^/\.\.$}{/}; # /.. -> / - 1 while $path =~ s{^/\.\.}{}; # /../xx -> /xx - return $path; -} - - -sub splitpath { - my ($self,$path, $nofile) = @_; - my ($volume,$directory,$file) = ('','',''); - if ( $nofile ) { - $path =~ - m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) - (.*) - }xs; - $volume = $1; - $directory = $2; - } - else { - $path =~ - m{^ ( (?: [a-zA-Z]: | - (?:\\\\|//)[^\\/]+[\\/][^\\/]+ - )? - ) - ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? ) - (.*) - }xs; - $volume = $1; - $directory = $2; - $file = $3; - } - - return ($volume,$directory,$file); -} - - -sub splitdir { - my ($self,$directories) = @_ ; - split m|[\\/]|, $directories, -1; -} - - -sub catpath { - my ($self,$volume,$directory,$file) = @_; - - # If it's UNC, make sure the glue separator is there, reusing - # whatever separator is first in the $volume - $volume .= $1 - if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s && - $directory =~ m@^[^\\/]@s - ) ; - - $volume .= $directory ; - - # If the volume is not just A:, make sure the glue separator is - # there, reusing whatever separator is first in the $volume if possible. - if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s && - $volume =~ m@[^\\/]\Z(?!\n)@ && - $file =~ m@[^\\/]@ - ) { - $volume =~ m@([\\/])@ ; - my $sep = $1 ? $1 : '/' ; - $volume .= $sep ; - } - - $volume .= $file ; - - return $volume ; -} - - -sub abs2rel { - my($self,$path,$base) = @_; - - # Clean up $path - if ( ! $self->file_name_is_absolute( $path ) ) { - $path = $self->rel2abs( $path ) ; - } else { - $path = $self->canonpath( $path ) ; - } - - # Figure out the effective $base and clean it up. - if ( !defined( $base ) || $base eq '' ) { - $base = $self->_cwd(); - } elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } else { - $base = $self->canonpath( $base ) ; - } - - # Split up paths - my ( $path_volume, $path_directories, $path_file ) = $self->splitpath( $path, 1 ) ; - my ( $base_volume, $base_directories ) = $self->splitpath( $base, 1 ) ; - return $path unless $path_volume eq $base_volume; - - # Now, remove all leading components that are the same - my @pathchunks = $self->splitdir( $path_directories ); - my @basechunks = $self->splitdir( $base_directories ); - - while ( @pathchunks && - @basechunks && - lc( $pathchunks[0] ) eq lc( $basechunks[0] ) - ) { - shift @pathchunks ; - shift @basechunks ; - } - - # No need to catdir, we know these are well formed. - $path_directories = CORE::join( '/', @pathchunks ); - $base_directories = CORE::join( '/', @basechunks ); - - # $base_directories now contains the directories the resulting relative - # path must ascend out of before it can descend to $path_directory. So, - # replace all names with $parentDir - - #FA Need to replace between backslashes... - $base_directories =~ s|[^\\/]+|..|g ; - - # Glue the two together, using a separator if necessary, and preventing an - # empty result. - - #FA Must check that new directories are not empty. - if ( $path_directories ne '' && $base_directories ne '' ) { - $path_directories = "$base_directories/$path_directories" ; - } else { - $path_directories = "$base_directories$path_directories" ; - } - - return $self->canonpath( - $self->catpath( "", $path_directories, $path_file ) - ) ; -} - - -sub rel2abs { - my ($self,$path,$base ) = @_; - - if ( ! $self->file_name_is_absolute( $path ) ) { - - if ( !defined( $base ) || $base eq '' ) { - $base = $self->_cwd(); - } - elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - else { - $base = $self->canonpath( $base ) ; - } - - my ( $path_directories, $path_file ) = - ($self->splitpath( $path, 1 ))[1,2] ; - - my ( $base_volume, $base_directories ) = - $self->splitpath( $base, 1 ) ; - - $path = $self->catpath( - $base_volume, - $self->catdir( $base_directories, $path_directories ), - $path_file - ) ; - } - - return $self->canonpath( $path ) ; -} - -1; -__END__ - -=head1 NAME - -File::Spec::OS2 - methods for OS/2 file specs - -=head1 SYNOPSIS - - require File::Spec::OS2; # Done internally by File::Spec if needed - -=head1 DESCRIPTION - -See L<File::Spec> and L<File::Spec::Unix>. This package overrides the -implementation of these methods, not the semantics. - -Amongst the changes made for OS/2 are... - -=over 4 - -=item tmpdir - -Modifies the list of places temp directory information is looked for. - - $ENV{TMPDIR} - $ENV{TEMP} - $ENV{TMP} - /tmp - / - -=item splitpath - -Volumes can be drive letters or UNC sharenames (\\server\share). - -=back - -=head1 COPYRIGHT - -Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. - -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm deleted file mode 100644 index 8fd2320a39..0000000000 --- a/lib/File/Spec/Unix.pm +++ /dev/null @@ -1,521 +0,0 @@ -package File::Spec::Unix; - -use strict; -use vars qw($VERSION); - -$VERSION = '3.30'; -$VERSION = eval $VERSION; - -=head1 NAME - -File::Spec::Unix - File::Spec for Unix, base for other File::Spec modules - -=head1 SYNOPSIS - - require File::Spec::Unix; # Done automatically by File::Spec - -=head1 DESCRIPTION - -Methods for manipulating file specifications. Other File::Spec -modules, such as File::Spec::Mac, inherit from File::Spec::Unix and -override specific methods. - -=head1 METHODS - -=over 2 - -=item canonpath() - -No physical check on the filesystem, but a logical cleanup of a -path. On UNIX eliminates successive slashes and successive "/.". - - $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 { - 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 - # may be interpreted in an implementation-defined manner, although - # 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 || $path =~ s{^(//[^/]+)/}{/}s ) ) { - $node = $1; - } - # This used to be - # $path =~ s|/+|/|g unless ($^O eq 'cygwin'); - # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail - # (Mainly because trailing "" directories didn't get stripped). - # Why would cygwin avoid collapsing multiple slashes into one? --jhi - $path =~ s|/{2,}|/|g; # xx////xx -> xx/xx - $path =~ s{(?:/\.)+(?:/|\z)}{/}g; # xx/././xx -> xx/xx - $path =~ s|^(?:\./)+||s unless $path eq "./"; # ./xx -> xx - $path =~ s|^/(?:\.\./)+|/|; # /../../xx -> xx - $path =~ s|^/\.\.$|/|; # /.. -> / - $path =~ s|/\z|| unless $path eq "/"; # xx/ -> xx - return "$node$path"; -} - -=item catdir() - -Concatenate two or more directory names to form a complete path ending -with a directory. But remove the trailing slash from the resulting -string, because it doesn't look good, isn't necessary and confuses -OS2. Of course, if this is the root directory, don't cut off the -trailing slash :-) - -=cut - -sub catdir { - my $self = shift; - - $self->canonpath(join('/', @_, '')); # '' because need a trailing '/' -} - -=item catfile - -Concatenate one or more directory names and a filename to form a -complete path ending with a filename - -=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; -} - -=item curdir - -Returns a string representation of the current directory. "." on UNIX. - -=cut - -sub curdir { '.' } - -=item devnull - -Returns a string representation of the null device. "/dev/null" on UNIX. - -=cut - -sub devnull { '/dev/null' } - -=item rootdir - -Returns a string representation of the root directory. "/" on UNIX. - -=cut - -sub rootdir { '/' } - -=item tmpdir - -Returns a string representation of the first writable directory from -the following list or the current directory if none from the list are -writable: - - $ENV{TMPDIR} - /tmp - -Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR} -is tainted, it is not used. - -=cut - -my $tmpdir; -sub _tmpdir { - return $tmpdir if defined $tmpdir; - my $self = shift; - my @dirlist = @_; - { - no strict 'refs'; - if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0 - require Scalar::Util; - @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist; - } - } - foreach (@dirlist) { - next unless defined && -d && -w _; - $tmpdir = $_; - last; - } - $tmpdir = $self->curdir unless defined $tmpdir; - $tmpdir = defined $tmpdir && $self->canonpath($tmpdir); - return $tmpdir; -} - -sub tmpdir { - return $tmpdir if defined $tmpdir; - $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp" ); -} - -=item updir - -Returns a string representation of the parent directory. ".." on UNIX. - -=cut - -sub updir { '..' } - -=item no_upwards - -Given a list of file names, strip out those that refer to a parent -directory. (Does not strip symlinks, only '.', '..', and equivalents.) - -=cut - -sub no_upwards { - my $self = shift; - return grep(!/^\.{1,2}\z/s, @_); -} - -=item case_tolerant - -Returns a true or false value indicating, respectively, that alphabetic -is not or is significant when comparing file specifications. - -=cut - -sub case_tolerant { 0 } - -=item file_name_is_absolute - -Takes as argument a path and returns true if it is an absolute path. - -This does not consult the local filesystem on Unix, Win32, OS/2 or Mac -OS (Classic). It does consult the working environment for VMS (see -L<File::Spec::VMS/file_name_is_absolute>). - -=cut - -sub file_name_is_absolute { - my ($self,$file) = @_; - return scalar($file =~ m:^/:s); -} - -=item path - -Takes no argument, returns the environment variable PATH as an array. - -=cut - -sub path { - return () unless exists $ENV{PATH}; - my @path = split(':', $ENV{PATH}); - foreach (@path) { $_ = '.' if $_ eq '' } - return @path; -} - -=item join - -join is the same as catfile. - -=cut - -sub join { - my $self = shift; - return $self->catfile(@_); -} - -=item splitpath - - ($volume,$directories,$file) = File::Spec->splitpath( $path ); - ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); - -Splits a path into volume, directory, and filename portions. On systems -with no concept of volume, returns '' for volume. - -For systems with no syntax differentiating filenames from directories, -assumes that the last file is a path unless $no_file is true or a -trailing separator or /. or /.. is present. On Unix this means that $no_file -true makes this return ( '', $path, '' ). - -The directory portion may or may not be returned with a trailing '/'. - -The results can be passed to L</catpath()> to get back a path equivalent to -(usually identical to) the original path. - -=cut - -sub splitpath { - my ($self,$path, $nofile) = @_; - - my ($volume,$directory,$file) = ('','',''); - - if ( $nofile ) { - $directory = $path; - } - else { - $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs; - $directory = $1; - $file = $2; - } - - return ($volume,$directory,$file); -} - - -=item splitdir - -The opposite of L</catdir()>. - - @dirs = File::Spec->splitdir( $directories ); - -$directories must be only the directory portion of the path on systems -that have the concept of a volume or that have path syntax that differentiates -files from directories. - -Unlike just splitting the directories on the separator, empty -directory names (C<''>) can be returned, because these are significant -on some OSs. - -On Unix, - - File::Spec->splitdir( "/a/b//c/" ); - -Yields: - - ( '', 'a', 'b', '', 'c', '' ) - -=cut - -sub splitdir { - return split m|/|, $_[1], -1; # Preserve trailing fields -} - - -=item catpath() - -Takes volume, directory and file portions and returns an entire path. Under -Unix, $volume is ignored, and directory and file are concatenated. A '/' is -inserted if needed (though if the directory portion doesn't start with -'/' it is not added). On other OSs, $volume is significant. - -=cut - -sub catpath { - my ($self,$volume,$directory,$file) = @_; - - if ( $directory ne '' && - $file ne '' && - substr( $directory, -1 ) ne '/' && - substr( $file, 0, 1 ) ne '/' - ) { - $directory .= "/$file" ; - } - else { - $directory .= $file ; - } - - return $directory ; -} - -=item abs2rel - -Takes a destination path and an optional base path returns a relative path -from the base path to the destination path: - - $rel_path = File::Spec->abs2rel( $path ) ; - $rel_path = File::Spec->abs2rel( $path, $base ) ; - -If $base is not present or '', then L<cwd()|Cwd> is used. If $base is -relative, then it is converted to absolute form using -L</rel2abs()>. This means that it is taken to be relative to -L<cwd()|Cwd>. - -On systems that have a grammar that indicates filenames, this ignores the -$base filename. Otherwise all path components are assumed to be -directories. - -If $path is relative, it is converted to absolute form using L</rel2abs()>. -This means that it is taken to be relative to L<cwd()|Cwd>. - -No checks against the filesystem are made. On VMS, there is -interaction with the working environment, as logicals and -macros are expanded. - -Based on code written by Shigio Yamaguchi. - -=cut - -sub abs2rel { - my($self,$path,$base) = @_; - $base = $self->_cwd() unless defined $base and length $base; - - ($path, $base) = map $self->canonpath($_), $path, $base; - - if (grep $self->file_name_is_absolute($_), $path, $base) { - ($path, $base) = map $self->rel2abs($_), $path, $base; - } - else { - # save a couple of cwd()s if both paths are relative - ($path, $base) = map $self->catdir('/', $_), $path, $base; - } - - my ($path_volume) = $self->splitpath($path, 1); - my ($base_volume) = $self->splitpath($base, 1); - - # Can't relativize across volumes - return $path unless $path_volume eq $base_volume; - - my $path_directories = ($self->splitpath($path, 1))[1]; - my $base_directories = ($self->splitpath($base, 1))[1]; - - # For UNC paths, the user might give a volume like //foo/bar that - # strictly speaking has no directory portion. Treat it as if it - # had the root directory for that volume. - if (!length($base_directories) and $self->file_name_is_absolute($base)) { - $base_directories = $self->rootdir; - } - - # Now, remove all leading components that are the same - my @pathchunks = $self->splitdir( $path_directories ); - my @basechunks = $self->splitdir( $base_directories ); - - if ($base_directories eq $self->rootdir) { - shift @pathchunks; - return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') ); - } - - while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) { - shift @pathchunks ; - shift @basechunks ; - } - return $self->curdir unless @pathchunks || @basechunks; - - # $base now contains the directories the resulting relative path - # must ascend out of before it can descend to $path_directory. - my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks ); - return $self->canonpath( $self->catpath('', $result_dirs, '') ); -} - -sub _same { - $_[1] eq $_[2]; -} - -=item rel2abs() - -Converts a relative path to an absolute path. - - $abs_path = File::Spec->rel2abs( $path ) ; - $abs_path = File::Spec->rel2abs( $path, $base ) ; - -If $base is not present or '', then L<cwd()|Cwd> is used. If $base is -relative, then it is converted to absolute form using -L</rel2abs()>. This means that it is taken to be relative to -L<cwd()|Cwd>. - -On systems that have a grammar that indicates filenames, this ignores -the $base filename. Otherwise all path components are assumed to be -directories. - -If $path is absolute, it is cleaned up and returned using L</canonpath()>. - -No checks against the filesystem are made. On VMS, there is -interaction with the working environment, as logicals and -macros are expanded. - -Based on code written by Shigio Yamaguchi. - -=cut - -sub rel2abs { - my ($self,$path,$base ) = @_; - - # Clean up $path - if ( ! $self->file_name_is_absolute( $path ) ) { - # Figure out the effective $base and clean it up. - if ( !defined( $base ) || $base eq '' ) { - $base = $self->_cwd(); - } - elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - else { - $base = $self->canonpath( $base ) ; - } - - # Glom them together - $path = $self->catdir( $base, $path ) ; - } - - return $self->canonpath( $path ) ; -} - -=back - -=head1 COPYRIGHT - -Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. - -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=head1 SEE ALSO - -L<File::Spec> - -=cut - -# Internal routine to File::Spec, no point in making this public since -# it is the standard Cwd interface. Most of the platform-specific -# File::Spec subclasses use this. -sub _cwd { - require Cwd; - Cwd::getcwd(); -} - - -# 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); - pop @dirs if @dirs && $dirs[-1] eq ''; - - 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; diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm deleted file mode 100644 index 34b592abbf..0000000000 --- a/lib/File/Spec/VMS.pm +++ /dev/null @@ -1,1165 +0,0 @@ -package File::Spec::VMS; - -use strict; -use vars qw(@ISA $VERSION); -require File::Spec::Unix; - -$VERSION = '3.30'; -$VERSION = eval $VERSION; - -@ISA = qw(File::Spec::Unix); - -use File::Basename; -use VMS::Filespec; - -=head1 NAME - -File::Spec::VMS - methods for VMS file specs - -=head1 SYNOPSIS - - require File::Spec::VMS; # Done internally by File::Spec if needed - -=head1 DESCRIPTION - -See File::Spec::Unix for a documentation of the methods provided -there. This package overrides the implementation of these methods, not -the semantics. - -The mode of operation of these routines depend on the VMS features that -are controlled by the DECC features C<DECC$FILENAME_REPORT_UNIX> and -C<DECC$EFS_CHARSET>. - -Perl needs to be at least at 5.10 for these feature settings to work. -Use of them on older perl versions on VMS will result in unpredictable -operations. - -The default and traditional mode of these routines have been to expect VMS -syntax on input and to return VMS syntax on output, even when Unix syntax was -given on input. - -The default and traditional mode is also incompatible with the VMS -C<EFS>, Extended File system character set, and with running Perl scripts -under <GNV>, Gnu is not VMS, an optional Unix like runtime environment on VMS. - -If the C<DECC$EFS_CHARSET> feature is enabled, These routines will now accept -either VMS or UNIX syntax. If the input parameters are clearly VMS syntax, -the return value will be in VMS syntax. If the input parameters are clearly -in Unix syntax, the output will be in Unix syntax. - -This corresponds to the way that the VMS C library routines have always -handled filenames, and what a programmer who has not specifically read this -pod before would also expect. - -If the C<DECC$FILENAME_REPORT_UNIX> feature is enabled, then if the output -syntax can not be determined from the input syntax, the output syntax will be -UNIX. If the feature is not enabled, VMS output will be the default. - -=over 4 - -=cut - -# Need to look up the feature settings. The preferred way is to use the -# VMS::Feature module, but that may not be available to dual life modules. - -my $use_feature; -BEGIN { - if (eval { local $SIG{__DIE__}; require VMS::Feature; }) { - $use_feature = 1; - } -} - -# Need to look up the UNIX report mode. This may become a dynamic mode -# in the future. -sub _unix_rpt { - my $unix_rpt; - if ($use_feature) { - $unix_rpt = VMS::Feature::current("filename_unix_report"); - } else { - my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; - $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; - } - return $unix_rpt; -} - -# Need to look up the EFS character set mode. This may become a dynamic -# mode in the future. -sub _efs { - my $efs; - if ($use_feature) { - $efs = VMS::Feature::current("efs_charset"); - } else { - my $env_efs = $ENV{'DECC$EFS_CHARSET'} || ''; - $efs = $env_efs =~ /^[ET1]/i; - } - return $efs; -} - -=item canonpath (override) - -Removes redundant portions of file specifications according to the syntax -detected. - -=cut - - -sub canonpath { - my($self,$path) = @_; - - return undef unless defined $path; - - my $efs = $self->_efs; - - if ($path =~ m|/|) { # Fake Unix - my $pathify = $path =~ m|/\Z(?!\n)|; - $path = $self->SUPER::canonpath($path); - - # Do not convert to VMS when EFS character sets are in use - return $path if $efs; - - if ($pathify) { return vmspath($path); } - else { return vmsify($path); } - } - else { - -#FIXME - efs parsing has different rules. Characters in a VMS filespec -# are only delimiters if not preceded by '^'; - - $path =~ tr/<>/[]/; # < and > ==> [ and ] - $path =~ s/\]\[\./\.\]\[/g; # ][. ==> .][ - $path =~ s/\[000000\.\]\[/\[/g; # [000000.][ ==> [ - $path =~ s/\[000000\./\[/g; # [000000. ==> [ - $path =~ s/\.\]\[000000\]/\]/g; # .][000000] ==> ] - $path =~ s/\.\]\[/\./g; # foo.][bar ==> foo.bar - 1 while ($path =~ s/([\[\.])(-+)\.(-+)([\.\]])/$1$2$3$4/); - # That loop does the following - # with any amount of dashes: - # .-.-. ==> .--. - # [-.-. ==> [--. - # .-.-] ==> .--] - # [-.-] ==> [--] - 1 while ($path =~ s/([\[\.])[^\]\.]+\.-(-+)([\]\.])/$1$2$3/); - # That loop does the following - # with any amount (minimum 2) - # of dashes: - # .foo.--. ==> .-. - # .foo.--] ==> .-] - # [foo.--. ==> [-. - # [foo.--] ==> [-] - # - # And then, the remaining cases - $path =~ s/\[\.-/[-/; # [.- ==> [- - $path =~ s/\.[^\]\.]+\.-\./\./g; # .foo.-. ==> . - $path =~ s/\[[^\]\.]+\.-\./\[/g; # [foo.-. ==> [ - $path =~ s/\.[^\]\.]+\.-\]/\]/g; # .foo.-] ==> ] - $path =~ s/\[[^\]\.]+\.-\]/\[000000\]/g;# [foo.-] ==> [000000] - $path =~ s/\[\]// unless $path eq '[]'; # [] ==> - return $path; - } -} - -=item catdir (override) - -Concatenates a list of file specifications, and returns the result as a -directory specification. No check is made for "impossible" -cases (e.g. elements other than the first being absolute filespecs). - -=cut - -sub catdir { - my $self = shift; - my $dir = pop; - - my $efs = $self->_efs; - my $unix_rpt = $self->_unix_rpt; - - - my @dirs = grep {defined() && length()} @_; - if ($efs) { - # Legacy mode removes blank entries. - # But that breaks existing generic perl code that - # uses a blank path at the beginning of the array - # to indicate an absolute path. - # So put it back if found. - if (@_) { - if ($_[0] eq '') { - unshift @dirs, ''; - } - } - } - - my $rslt; - if (@dirs) { - my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs)); - my ($spath,$sdir) = ($path,$dir); - - if ($efs) { - # Extended character set in use, go into DWIM mode. - - # Now we need to identify what the directory is in - # of the specification in order to merge them. - my $path_unix = 0; - $path_unix = 1 if ($path =~ m#/#); - $path_unix = 1 if ($path =~ /^\.\.?$/); - my $path_vms = 0; - $path_vms = 1 if ($path =~ m#[\[<\]]#); - $path_vms = 1 if ($path =~ /^--?$/); - my $dir_unix = 0; - $dir_unix = 1 if ($dir =~ m#/#); - $dir_unix = 1 if ($dir =~ /^\.\.?$/); - my $dir_vms = 0; - $dir_vms = 1 if ($dir =~ m#[\[<\]]#); - $dir_vms = 1 if ($dir =~ /^--?$/); - - my $unix_mode = 0; - if (($path_unix != $dir_unix) && ($path_vms != $dir_vms)) { - # Ambiguous, so if in $unix_rpt mode then assume UNIX. - $unix_mode = 1 if $unix_rpt; - } else { - $unix_mode = 1 if (!$path_vms && !$dir_vms && $unix_rpt); - $unix_mode = 1 if ($path_unix || $dir_unix); - } - - if ($unix_mode) { - - # Fix up mixed syntax imput as good as possible - GIGO - $path = unixify($path) if $path_vms; - $dir = unixify($dir) if $dir_vms; - - $rslt = $path; - # Append a path delimiter - $rslt .= '/' unless ($rslt =~ m#/$#); - - $rslt .= $dir; - return $self->SUPER::canonpath($rslt); - } else { - - #with <> posible instead of [. - # Normalize the brackets - # Fixme - need to not switch when preceded by ^. - $path =~ s/</\[/g; - $path =~ s/>/\]/g; - $dir =~ s/</\[/g; - $dir =~ s/>/\]/g; - - # Fix up mixed syntax imput as good as possible - GIGO - $path = vmsify($path) if $path_unix; - $dir = vmsify($dir) if $dir_unix; - - #Possible path values: foo: [.foo] [foo] foo, and $(foo) - #or starting with '-', or foo.dir - #If path is foo, it needs to be converted to [.foo] - - # Fix up a bare path name. - unless ($path_vms) { - $path =~ s/\.dir\Z(?!\n)//i; - if (($path ne '') && ($path !~ /^-/)) { - # Non blank and not prefixed with '-', add a dot - $path = '[.' . $path; - } else { - # Just start a directory. - $path = '[' . $path; - } - } else { - $path =~ s/\]$//; - } - - #Possible dir values: [.dir] dir and $(foo) - - # No punctuation may have a trailing .dir - unless ($dir_vms) { - $dir =~ s/\.dir\Z(?!\n)//i; - } else { - - #strip off the brackets - $dir =~ s/^\[//; - $dir =~ s/\]$//; - } - - #strip off the leading dot if present. - $dir =~ s/^\.//; - - # Now put the specifications together. - if ($dir ne '') { - # Add a separator unless this is an absolute path - $path .= '.' if ($path ne '['); - $rslt = $path . $dir . ']'; - } else { - $rslt = $path . ']'; - } - } - - } else { - # Traditional ODS-2 mode. - $spath =~ s/\.dir\Z(?!\n)//i; $sdir =~ s/\.dir\Z(?!\n)//i; - - $sdir = $self->eliminate_macros($sdir) - unless $sdir =~ /^[\w\-]+\Z(?!\n)/s; - $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",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 ($spath =~ /^[\[<][^.\-]/s) { $rslt =~ s/^[^\[<]+//s; } - } - } else { - # Single directory, just make sure it is in directory format - # Return an empty string on null input, and pass through macros. - - if (not defined $dir or not length $dir) { $rslt = ''; } - elsif ($dir =~ /^\$\([^\)]+\)\Z(?!\n)/s) { - $rslt = $dir; - } else { - my $unix_mode = 0; - - if ($efs) { - my $dir_unix = 0; - $dir_unix = 1 if ($dir =~ m#/#); - $dir_unix = 1 if ($dir =~ /^\.\.?$/); - my $dir_vms = 0; - $dir_vms = 1 if ($dir =~ m#[\[<\]]#); - $dir_vms = 1 if ($dir =~ /^--?$/); - - if ($dir_vms == $dir_unix) { - # Ambiguous, so if in $unix_rpt mode then assume UNIX. - $unix_mode = 1 if $unix_rpt; - } else { - $unix_mode = 1 if $dir_unix; - } - } - - if ($unix_mode) { - return $dir; - } else { - # For VMS, force it to be in directory format - $rslt = vmspath($dir); - } - } - } - return $self->canonpath($rslt); -} - -=item catfile (override) - -Concatenates a list of directory specifications with a filename specification -to build a path. - -=cut - -sub catfile { - my $self = shift; - my $tfile = pop(); - my $file = $self->canonpath($tfile); - my @files = grep {defined() && length()} @_; - - my $efs = $self->_efs; - my $unix_rpt = $self->_unix_rpt; - - # Assume VMS mode - my $unix_mode = 0; - my $file_unix = 0; - my $file_vms = 0; - if ($efs) { - - # Now we need to identify format the file is in - # of the specification in order to merge them. - $file_unix = 1 if ($tfile =~ m#/#); - $file_unix = 1 if ($tfile =~ /^\.\.?$/); - $file_vms = 1 if ($tfile =~ m#[\[<\]]#); - $file_vms = 1 if ($tfile =~ /^--?$/); - - # We may know for sure what the format is. - if (($file_unix != $file_vms)) { - $unix_mode = 1 if ($file_unix && $unix_rpt); - } - } - - my $rslt; - if (@files) { - # concatenate the directories. - my $path; - if (@files == 1) { - $path = $files[0]; - } else { - if ($file_vms) { - # We need to make sure this is in VMS mode to avoid doing - # both a vmsify and unixfy on the same path, as that may - # lose significant data. - my $i = @files - 1; - my $tdir = $files[$i]; - my $tdir_vms = 0; - my $tdir_unix = 0; - $tdir_vms = 1 if ($tdir =~ m#[\[<\]]#); - $tdir_unix = 1 if ($tdir =~ m#/#); - $tdir_unix = 1 if ($tdir =~ /^\.\.?$/); - - if (!$tdir_vms) { - if ($tdir_unix) { - $tdir = vmspath($tdir); - } else { - $tdir =~ s/\.dir\Z(?!\n)//i; - $tdir = '[.' . $tdir . ']'; - } - $files[$i] = $tdir; - } - } - $path = $self->catdir(@files); - } - my $spath = $path; - - # Some thing building a VMS path in pieces may try to pass a - # directory name in filename format, so normalize it. - $spath =~ s/\.dir\Z(?!\n)//i; - - # if the spath ends with a directory delimiter and the file is bare, - # then just concat them. - # FIX-ME: In VMS format "[]<>:" are not delimiters if preceded by '^' - # Quite a bit of Perl does not know that yet. - if ($spath =~ /^[^\)\]\/:>]+\)\Z(?!\n)/s && basename($file) eq $file) { - $rslt = "$spath$file"; - } else { - if ($efs) { - - # Now we need to identify what the directory is in - # of the specification in order to merge them. - my $spath_unix = 0; - $spath_unix = 1 if ($spath =~ m#/#); - $spath_unix = 1 if ($spath =~ /^\.\.?$/); - my $spath_vms = 0; - $spath_vms = 1 if ($spath =~ m#[\[<\]]#); - $spath_vms = 1 if ($spath =~ /^--?$/); - - # Assume VMS mode - if (($spath_unix == $spath_vms) && - ($file_unix == $file_vms)) { - # Ambigous, so if in $unix_rpt mode then assume UNIX. - $unix_mode = 1 if $unix_rpt; - } else { - $unix_mode = 1 - if (($spath_unix || $file_unix) && $unix_rpt); - } - - if (!$unix_mode) { - if ($spath_vms) { - $spath = '[' . $spath . ']' if $spath =~ /^-/; - $rslt = vmspath($spath); - } else { - $rslt = '[.' . $spath . ']'; - } - $file = vmsify($file) if ($file_unix); - } else { - $spath = unixify($spath) if ($spath_vms); - $rslt = $spath; - $file = unixify($file) if ($file_vms); - - # Unix merge may need a directory delimitor. - # A null path indicates root on Unix. - $rslt .= '/' unless ($rslt =~ m#/$#); - } - - $rslt .= $file; - $rslt =~ s/\]\[//; - - } else { - # Traditional VMS Perl mode expects that this is done. - # Note for future maintainers: - # This is left here for compatibility with perl scripts - # that have come to expect this behavior, even though - # usually the Perl scripts ported to VMS have to be - # patched because of it changing Unix syntax file - # to VMS format. - - $rslt = $self->eliminate_macros($spath); - - - $rslt = vmsify($rslt.((defined $rslt) && - ($rslt ne '') ? '/' : '').unixify($file)); - } - } - } - else { - # Only passed a single file? - my $xfile = $file; - - # Traditional VMS perl expects this conversion. - $xfile = vmsify($file) unless ($efs); - - $rslt = (defined($file) && length($file)) ? $xfile : ''; - } - return $self->canonpath($rslt) unless $unix_rpt; - - # In Unix report mode, do not strip off redundent path information. - return $rslt; -} - - -=item curdir (override) - -Returns a string representation of the current directory: '[]' or '.' - -=cut - -sub curdir { - my $self = shift @_; - return '.' if ($self->_unix_rpt); - return '[]'; -} - -=item devnull (override) - -Returns a string representation of the null device: '_NLA0:' or '/dev/null' - -=cut - -sub devnull { - my $self = shift @_; - return '/dev/null' if ($self->_unix_rpt); - return "_NLA0:"; -} - -=item rootdir (override) - -Returns a string representation of the root directory: 'SYS$DISK:[000000]' -or '/' - -=cut - -sub rootdir { - my $self = shift @_; - if ($self->_unix_rpt) { - # Root may exist, try it first. - my $try = '/'; - my ($dev1, $ino1) = stat('/'); - my ($dev2, $ino2) = stat('.'); - - # Perl falls back to '.' if it can not determine '/' - if (($dev1 != $dev2) || ($ino1 != $ino2)) { - return $try; - } - # Fall back to UNIX format sys$disk. - return '/sys$disk/'; - } - return 'SYS$DISK:[000000]'; -} - -=item tmpdir (override) - -Returns a string representation of the first writable directory -from the following list or '' if none are writable: - - /tmp if C<DECC$FILENAME_REPORT_UNIX> is enabled. - sys$scratch: - $ENV{TMPDIR} - -Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR} -is tainted, it is not used. - -=cut - -my $tmpdir; -sub tmpdir { - my $self = shift @_; - return $tmpdir if defined $tmpdir; - if ($self->_unix_rpt) { - $tmpdir = $self->_tmpdir('/tmp', '/sys$scratch', $ENV{TMPDIR}); - return $tmpdir; - } - - $tmpdir = $self->_tmpdir( 'sys$scratch:', $ENV{TMPDIR} ); -} - -=item updir (override) - -Returns a string representation of the parent directory: '[-]' or '..' - -=cut - -sub updir { - my $self = shift @_; - return '..' if ($self->_unix_rpt); - return '[-]'; -} - -=item case_tolerant (override) - -VMS file specification syntax is case-tolerant. - -=cut - -sub case_tolerant { - return 1; -} - -=item path (override) - -Translate logical name DCL$PATH as a searchlist, rather than trying -to C<split> string value of C<$ENV{'PATH'}>. - -=cut - -sub path { - my (@dirs,$dir,$i); - while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); } - return @dirs; -} - -=item file_name_is_absolute (override) - -Checks for VMS directory spec as well as Unix separators. - -=cut - -sub file_name_is_absolute { - my ($self,$file) = @_; - # If it's a logical name, expand it. - $file = $ENV{$file} while $file =~ /^[\w\$\-]+\Z(?!\n)/s && $ENV{$file}; - return scalar($file =~ m!^/!s || - $file =~ m![<\[][^.\-\]>]! || - $file =~ /:[^<\[]/); -} - -=item splitpath (override) - - ($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, $nofile) = @_; - my($dev,$dir,$file) = ('','',''); - my $efs = $self->_efs; - my $vmsify_path = vmsify($path); - if ($efs) { - my $path_vms = 0; - $path_vms = 1 if ($path =~ m#[\[<\]]#); - $path_vms = 1 if ($path =~ /^--?$/); - if (!$path_vms) { - return $self->SUPER::splitpath($path, $nofile); - } - $vmsify_path = $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) - -Split a directory specification into the components. - -=cut - -sub splitdir { - my($self,$dirspec) = @_; - my @dirs = (); - return @dirs if ( (!defined $dirspec) || ('' eq $dirspec) ); - - my $efs = $self->_efs; - - my $dir_unix = 0; - $dir_unix = 1 if ($dirspec =~ m#/#); - $dir_unix = 1 if ($dirspec =~ /^\.\.?$/); - - # Unix filespecs in EFS mode handled by Unix routines. - if ($efs && $dir_unix) { - return $self->SUPER::splitdir($dirspec); - } - - # FIX ME, only split for VMS delimiters not prefixed with '^'. - - $dirspec =~ tr/<>/[]/; # < and > ==> [ and ] - $dirspec =~ s/\]\[\./\.\]\[/g; # ][. ==> .][ - $dirspec =~ s/\[000000\.\]\[/\[/g; # [000000.][ ==> [ - $dirspec =~ s/\[000000\./\[/g; # [000000. ==> [ - $dirspec =~ s/\.\]\[000000\]/\]/g; # .][000000] ==> ] - $dirspec =~ s/\.\]\[/\./g; # foo.][bar ==> foo.bar - while ($dirspec =~ s/(^|[\[\<\.])\-(\-+)($|[\]\>\.])/$1-.$2$3/g) {} - # That loop does the following - # with any amount of dashes: - # .--. ==> .-.-. - # [--. ==> [-.-. - # .--] ==> .-.-] - # [--] ==> [-.-] - $dirspec = "[$dirspec]" unless $dirspec =~ /[\[<]/; # make legal - $dirspec =~ s/^(\[|<)\./$1/; - @dirs = split /(?<!\^)\./, vmspath($dirspec); - $dirs[0] =~ s/^[\[<]//s; $dirs[-1] =~ s/[\]>]\Z(?!\n)//s; - @dirs; -} - - -=item catpath (override) - -Construct a complete filespec. - -=cut - -sub catpath { - my($self,$dev,$dir,$file) = @_; - - my $efs = $self->_efs; - my $unix_rpt = $self->_unix_rpt; - - my $unix_mode = 0; - my $dir_unix = 0; - $dir_unix = 1 if ($dir =~ m#/#); - $dir_unix = 1 if ($dir =~ /^\.\.?$/); - my $dir_vms = 0; - $dir_vms = 1 if ($dir =~ m#[\[<\]]#); - $dir_vms = 1 if ($dir =~ /^--?$/); - - if ($efs && (length($dev) == 0)) { - if ($dir_unix == $dir_vms) { - $unix_mode = $unix_rpt; - } else { - $unix_mode = $dir_unix; - } - } - - # We look for a volume in $dev, then in $dir, but not both - # but only if using VMS syntax. - if (!$unix_mode) { - $dir = vmspath($dir) if $dir_unix; - my ($dir_volume, $dir_dir, $dir_file) = $self->splitpath($dir); - $dev = $dir_volume unless length $dev; - $dir = length $dir_file ? $self->catfile($dir_dir, $dir_file) : - $dir_dir; - } - if ($dev =~ m|^/+([^/]+)|) { $dev = "$1:"; } - else { $dev .= ':' unless $dev eq '' or $dev =~ /:\Z(?!\n)/; } - if (length($dev) or length($dir)) { - if ($efs) { - if ($unix_mode) { - $dir .= '/' unless ($dir =~ m#/$#); - } else { - $dir = vmspath($dir) if (($dir =~ m#/#) || ($dir =~ /^\.\.?$/)); - $dir = "[$dir]" unless $dir =~ /^[\[<]/; - } - } else { - $dir = "[$dir]" unless $dir =~ /[\[<\/]/; - $dir = vmspath($dir); - } - } - "$dev$dir$file"; -} - -=item abs2rel (override) - -Attempt to convert a file specification to a relative specification. -On a system with volumes, like VMS, this may not be possible. - -=cut - -sub abs2rel { - my $self = shift; - my($path,$base) = @_; - - my $efs = $self->_efs; - my $unix_rpt = $self->_unix_rpt; - - if (!$efs) { - return vmspath(File::Spec::Unix::abs2rel( $self, @_ )) - if grep m{/}, @_; - } - - # We need to identify what the directory is in - # of the specification in order to process them - my $path_unix = 0; - $path_unix = 1 if ($path =~ m#/#); - $path_unix = 1 if ($path =~ /^\.\.?$/); - my $path_vms = 0; - $path_vms = 1 if ($path =~ m#[\[<\]]#); - $path_vms = 1 if ($path =~ /^--?$/); - - my $unix_mode = 0; - if ($path_vms == $path_unix) { - $unix_mode = $unix_rpt; - } else { - $unix_mode = $path_unix; - } - - my $base_unix = 0; - my $base_vms = 0; - - if (defined $base) { - $base_unix = 1 if ($base =~ m#/#); - $base_unix = 1 if ($base =~ /^\.\.?$/); - $base_vms = 1 if ($base =~ m#[\[<\]]#); - $base_vms = 1 if ($base =~ /^--?$/); - - if ($path_vms == $path_unix) { - if ($base_vms == $base_unix) { - $unix_mode = $unix_rpt; - } else { - $unix_mode = $base_unix; - } - } else { - $unix_mode = 0 if $base_vms; - } - } - - if ($efs) { - if ($unix_mode) { - # We are UNIX mode. - $base = unixpath($base) if $base_vms; - $base = unixify($path) if $path_vms; - - # Here VMS is different, and in order to do this right - # we have to take the realpath for both the path and the base - # so that we can remove the common components. - - if ($path =~ m#^/#) { - if (defined $base) { - - # For the shorterm, if the starting directories are - # common, remove them. - my $bq = qq($base); - $bq =~ s/\$/\\\$/; - $path =~ s/^$bq//i; - } - return $path; - } - - return File::Spec::Unix::abs2rel( $self, $path, $base ); - - } else { - $base = vmspath($base) if $base_unix; - $path = vmsify($path) if $path_unix; - } - } - - unless (defined $base and length $base) { - $base = $self->_cwd(); - if ($efs) { - $base_unix = 1 if ($base =~ m#/#); - $base_unix = 1 if ($base =~ /^\.\.?$/); - $base = vmspath($base) if $base_unix; - } - } - - for ($path, $base) { $_ = $self->canonpath($_) } - - # Are we even starting $path on the same (node::)device as $base? Note that - # logical paths or nodename differences may be on the "same device" - # but the comparison that ignores device differences so as to concatenate - # [---] up directory specs is not even a good idea in cases where there is - # a logical path difference between $path and $base nodename and/or device. - # Hence we fall back to returning the absolute $path spec - # if there is a case blind device (or node) difference of any sort - # and we do not even try to call $parse() or consult %ENV for $trnlnm() - # (this module needs to run on non VMS platforms after all). - - my ($path_volume, $path_directories, $path_file) = $self->splitpath($path); - my ($base_volume, $base_directories, $base_file) = $self->splitpath($base); - return $path unless lc($path_volume) eq lc($base_volume); - - for ($path, $base) { $_ = $self->rel2abs($_) } - - # Now, remove all leading components that are the same - my @pathchunks = $self->splitdir( $path_directories ); - my $pathchunks = @pathchunks; - unshift(@pathchunks,'000000') unless $pathchunks[0] eq '000000'; - my @basechunks = $self->splitdir( $base_directories ); - my $basechunks = @basechunks; - unshift(@basechunks,'000000') unless $basechunks[0] eq '000000'; - - while ( @pathchunks && - @basechunks && - lc( $pathchunks[0] ) eq lc( $basechunks[0] ) - ) { - shift @pathchunks ; - shift @basechunks ; - } - - # @basechunks now contains the directories to climb out of, - # @pathchunks now has the directories to descend in to. - if ((@basechunks > 0) || ($basechunks != $pathchunks)) { - $path_directories = join '.', ('-' x @basechunks, @pathchunks) ; - } - else { - $path_directories = join '.', @pathchunks; - } - $path_directories = '['.$path_directories.']'; - return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ; -} - - -=item rel2abs (override) - -Return an absolute file specification from a relative one. - -=cut - -sub rel2abs { - my $self = shift ; - my ($path,$base ) = @_; - return undef unless defined $path; - - my $efs = $self->_efs; - my $unix_rpt = $self->_unix_rpt; - - # We need to identify what the directory is in - # of the specification in order to process them - my $path_unix = 0; - $path_unix = 1 if ($path =~ m#/#); - $path_unix = 1 if ($path =~ /^\.\.?$/); - my $path_vms = 0; - $path_vms = 1 if ($path =~ m#[\[<\]]#); - $path_vms = 1 if ($path =~ /^--?$/); - - my $unix_mode = 0; - if ($path_vms == $path_unix) { - $unix_mode = $unix_rpt; - } else { - $unix_mode = $path_unix; - } - - my $base_unix = 0; - my $base_vms = 0; - - if (defined $base) { - $base_unix = 1 if ($base =~ m#/#); - $base_unix = 1 if ($base =~ /^\.\.?$/); - $base_vms = 1 if ($base =~ m#[\[<\]]#); - $base_vms = 1 if ($base =~ /^--?$/); - - # If we could not determine the path mode, see if we can find out - # from the base. - if ($path_vms == $path_unix) { - if ($base_vms != $base_unix) { - $unix_mode = $base_unix; - } - } - } - - if (!$efs) { - # Legacy behavior, convert to VMS syntax. - $unix_mode = 0; - if (defined $base) { - $base = vmspath($base) if $base =~ m/\//; - } - - if ($path =~ m/\//) { - $path = ( -d $path || $path =~ m/\/\z/ # educated guessing about - ? vmspath($path) # whether it's a directory - : vmsify($path) ); - } - } - - # Clean up and split up $path - if ( ! $self->file_name_is_absolute( $path ) ) { - # Figure out the effective $base and clean it up. - if ( !defined( $base ) || $base eq '' ) { - $base = $self->_cwd; - } - elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - else { - $base = $self->canonpath( $base ) ; - } - - if ($efs) { - # base may have changed, so need to look up format again. - if ($unix_mode) { - $base_vms = 1 if ($base =~ m#[\[<\]]#); - $base_vms = 1 if ($base =~ /^--?$/); - $base = unixpath($base) if $base_vms; - $base .= '/' unless ($base =~ m#/$#); - } else { - $base_unix = 1 if ($base =~ m#/#); - $base_unix = 1 if ($base =~ /^\.\.?$/); - $base = vmspath($base) if $base_unix; - } - } - - # Split up paths - my ( $path_directories, $path_file ) = - ($self->splitpath( $path ))[1,2] ; - - my ( $base_volume, $base_directories ) = - $self->splitpath( $base ) ; - - $path_directories = '' if $path_directories eq '[]' || - $path_directories eq '<>'; - my $sep = '' ; - - if ($efs) { - # Merge the paths assuming that the base is absolute. - $base_directories = $self->catdir('', - $base_directories, - $path_directories); - } else { - # Legacy behavior assumes VMS only paths - $sep = '.' - if ( $base_directories =~ m{[^.\]>]\Z(?!\n)} && - $path_directories =~ m{^[^.\[<]}s - ) ; - $base_directories = "$base_directories$sep$path_directories"; - $base_directories =~ s{\.?[\]>][\[<]\.?}{.}; - } - - $path_file = '' if ($path_file eq '.') && $unix_mode; - - $path = $self->catpath( $base_volume, $base_directories, $path_file ); - } - - 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. -# -# Update: MakeMaker 6.48 is still using these routines on VMS. -# so they need to be kept up to date with ExtUtils::MM_VMS. -# -# The traditional VMS mode using ODS-2 disks depends on these routines -# being here. These routines should not be called in when the -# C<DECC$EFS_CHARSET> or C<DECC$FILENAME_REPORT_UNIX> modes are enabled. - -sub eliminate_macros { - my($self,$path) = @_; - return '' unless (defined $path) && ($path ne ''); - $self = {} unless ref $self; - - if ($path =~ /\s/) { - return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path; - } - - my $npath = unixify($path); - # sometimes unixify will return a string with an off-by-one trailing null - $npath =~ s{\0$}{}; - - 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 (defined $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(). - -# 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. - -# fixpath() checks to see whether the result matches the name of a -# directory in the current default directory and returns a directory or -# file specification accordingly. C<$is_dir> can be set to true to -# force fixpath() to consider the path to be a directory or false to force -# it to be a file. - -sub fixpath { - my($self,$path,$force_path) = @_; - return '' unless $path; - $self = bless {}, $self 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 - -=head1 COPYRIGHT - -Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. - -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=head1 SEE ALSO - -See L<File::Spec> and L<File::Spec::Unix>. This package overrides the -implementation of these methods, not the semantics. - -An explanation of VMS file specs can be found at -L<"http://h71000.www7.hp.com/doc/731FINAL/4506/4506pro_014.html#apps_locating_naming_files">. - -=cut - -1; diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm deleted file mode 100644 index 93301ac735..0000000000 --- a/lib/File/Spec/Win32.pm +++ /dev/null @@ -1,444 +0,0 @@ -package File::Spec::Win32; - -use strict; - -use vars qw(@ISA $VERSION); -require File::Spec::Unix; - -$VERSION = '3.30'; -$VERSION = eval $VERSION; - -@ISA = qw(File::Spec::Unix); - -# Some regexes we use for path splitting -my $DRIVE_RX = '[a-zA-Z]:'; -my $UNC_RX = '(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+'; -my $VOL_RX = "(?:$DRIVE_RX|$UNC_RX)"; - - -=head1 NAME - -File::Spec::Win32 - methods for Win32 file specs - -=head1 SYNOPSIS - - require File::Spec::Win32; # Done internally by File::Spec if needed - -=head1 DESCRIPTION - -See File::Spec::Unix for a documentation of the methods provided -there. This package overrides the implementation of these methods, not -the semantics. - -=over 4 - -=item devnull - -Returns a string representation of the null device. - -=cut - -sub devnull { - return "nul"; -} - -sub rootdir { '\\' } - - -=item tmpdir - -Returns a string representation of the first existing directory -from the following list: - - $ENV{TMPDIR} - $ENV{TEMP} - $ENV{TMP} - SYS:/temp - C:\system\temp - C:/temp - /tmp - / - -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. - -=cut - -my $tmpdir; -sub tmpdir { - return $tmpdir if defined $tmpdir; - $tmpdir = $_[0]->_tmpdir( map( $ENV{$_}, qw(TMPDIR TEMP TMP) ), - 'SYS:/temp', - 'C:\system\temp', - 'C:/temp', - '/tmp', - '/' ); -} - -=item case_tolerant - -MSWin32 case-tolerance depends on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE, -indicating the case significance when comparing file specifications. -Since XP FS_CASE_SENSITIVE is effectively disabled for the NT subsubsystem. -See http://cygwin.com/ml/cygwin/2007-07/msg00891.html -Default: 1 - -=cut - -sub case_tolerant { - eval { require Win32API::File; } or return 1; - my $drive = shift || "C:"; - my $osFsType = "\0"x256; - my $osVolName = "\0"x256; - my $ouFsFlags = 0; - Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 ); - if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; } - else { return 1; } -} - -=item file_name_is_absolute - -As of right now, this returns 2 if the path is absolute with a -volume, 1 if it's absolute with no volume, 0 otherwise. - -=cut - -sub file_name_is_absolute { - - my ($self,$file) = @_; - - if ($file =~ m{^($VOL_RX)}o) { - my $vol = $1; - return ($vol =~ m{^$UNC_RX}o ? 2 - : $file =~ m{^$DRIVE_RX[\\/]}o ? 2 - : 0); - } - return $file =~ m{^[\\/]} ? 1 : 0; -} - -=item catfile - -Concatenate one or more directory names and a filename to form a -complete path ending with a filename - -=cut - -sub catfile { - shift; - - # Legacy / compatibility support - # - shift, return _canon_cat( "/", @_ ) - if $_[0] eq ""; - - # Compatibility with File::Spec <= 3.26: - # catfile('A:', 'foo') should return 'A:\foo'. - return _canon_cat( ($_[0].'\\'), @_[1..$#_] ) - if $_[0] =~ m{^$DRIVE_RX\z}o; - - return _canon_cat( @_ ); -} - -sub catdir { - shift; - - # Legacy / compatibility support - # - return "" - unless @_; - shift, return _canon_cat( "/", @_ ) - if $_[0] eq ""; - - # Compatibility with File::Spec <= 3.26: - # catdir('A:', 'foo') should return 'A:\foo'. - return _canon_cat( ($_[0].'\\'), @_[1..$#_] ) - if $_[0] =~ m{^$DRIVE_RX\z}o; - - return _canon_cat( @_ ); -} - -sub path { - my @path = split(';', $ENV{PATH}); - s/"//g for @path; - @path = grep length, @path; - unshift(@path, "."); - return @path; -} - -=item canonpath - -No physical check on the filesystem, but a logical cleanup of a -path. On UNIX eliminated successive slashes and successive "/.". -On Win32 makes - - dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even - dir1\dir2\dir3\...\dir4 -> \dir\dir4 - -=cut - -sub canonpath { - # Legacy / compatibility support - # - return $_[1] if !defined($_[1]) or $_[1] eq ''; - return _canon_cat( $_[1] ); -} - -=item splitpath - - ($volume,$directories,$file) = File::Spec->splitpath( $path ); - ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); - -Splits a path into volume, directory, and filename portions. Assumes that -the last file is a path unless the path ends in '\\', '\\.', '\\..' -or $no_file is true. On Win32 this means that $no_file true makes this return -( $volume, $path, '' ). - -Separators accepted are \ and /. - -Volumes can be drive letters or UNC sharenames (\\server\share). - -The results can be passed to L</catpath> to get back a path equivalent to -(usually identical to) the original path. - -=cut - -sub splitpath { - my ($self,$path, $nofile) = @_; - my ($volume,$directory,$file) = ('','',''); - if ( $nofile ) { - $path =~ - m{^ ( $VOL_RX ? ) (.*) }sox; - $volume = $1; - $directory = $2; - } - else { - $path =~ - m{^ ( $VOL_RX ? ) - ( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? ) - (.*) - }sox; - $volume = $1; - $directory = $2; - $file = $3; - } - - return ($volume,$directory,$file); -} - - -=item splitdir - -The opposite of L<catdir()|File::Spec/catdir()>. - - @dirs = File::Spec->splitdir( $directories ); - -$directories must be only the directory portion of the path on systems -that have the concept of a volume or that have path syntax that differentiates -files from directories. - -Unlike just splitting the directories on the separator, leading empty and -trailing directory entries can be returned, because these are significant -on some OSs. So, - - File::Spec->splitdir( "/a/b/c" ); - -Yields: - - ( '', 'a', 'b', '', 'c', '' ) - -=cut - -sub splitdir { - my ($self,$directories) = @_ ; - # - # split() likes to forget about trailing null fields, so here we - # check to be sure that there will not be any before handling the - # simple case. - # - if ( $directories !~ m|[\\/]\Z(?!\n)| ) { - return split( m|[\\/]|, $directories ); - } - else { - # - # since there was a trailing separator, add a file name to the end, - # then do the split, then replace it with ''. - # - my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ; - $directories[ $#directories ]= '' ; - return @directories ; - } -} - - -=item catpath - -Takes volume, directory and file portions and returns an entire path. Under -Unix, $volume is ignored, and this is just like catfile(). On other OSs, -the $volume become significant. - -=cut - -sub catpath { - my ($self,$volume,$directory,$file) = @_; - - # If it's UNC, make sure the glue separator is there, reusing - # whatever separator is first in the $volume - my $v; - $volume .= $v - if ( (($v) = $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s) && - $directory =~ m@^[^\\/]@s - ) ; - - $volume .= $directory ; - - # If the volume is not just A:, make sure the glue separator is - # there, reusing whatever separator is first in the $volume if possible. - if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s && - $volume =~ m@[^\\/]\Z(?!\n)@ && - $file =~ m@[^\\/]@ - ) { - $volume =~ m@([\\/])@ ; - my $sep = $1 ? $1 : '\\' ; - $volume .= $sep ; - } - - $volume .= $file ; - - return $volume ; -} - -sub _same { - lc($_[1]) eq lc($_[2]); -} - -sub rel2abs { - my ($self,$path,$base ) = @_; - - my $is_abs = $self->file_name_is_absolute($path); - - # Check for volume (should probably document the '2' thing...) - return $self->canonpath( $path ) if $is_abs == 2; - - if ($is_abs) { - # It's missing a volume, add one - my $vol = ($self->splitpath( $self->_cwd() ))[0]; - return $self->canonpath( $vol . $path ); - } - - if ( !defined( $base ) || $base eq '' ) { - require Cwd ; - $base = Cwd::getdcwd( ($self->splitpath( $path ))[0] ) if defined &Cwd::getdcwd ; - $base = $self->_cwd() unless defined $base ; - } - elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - else { - $base = $self->canonpath( $base ) ; - } - - my ( $path_directories, $path_file ) = - ($self->splitpath( $path, 1 ))[1,2] ; - - my ( $base_volume, $base_directories ) = - $self->splitpath( $base, 1 ) ; - - $path = $self->catpath( - $base_volume, - $self->catdir( $base_directories, $path_directories ), - $path_file - ) ; - - return $self->canonpath( $path ) ; -} - -=back - -=head2 Note For File::Spec::Win32 Maintainers - -Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32. - -=head1 COPYRIGHT - -Copyright (c) 2004,2007 by the Perl 5 Porters. All rights reserved. - -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=head1 SEE ALSO - -See L<File::Spec> and L<File::Spec::Unix>. This package overrides the -implementation of these methods, not the semantics. - -=cut - - -sub _canon_cat # @path -> path -{ - my ($first, @rest) = @_; - - 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, @rest; - - $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; diff --git a/lib/File/Spec/t/Functions.t b/lib/File/Spec/t/Functions.t deleted file mode 100644 index 457f53cb6f..0000000000 --- a/lib/File/Spec/t/Functions.t +++ /dev/null @@ -1,10 +0,0 @@ -#!/usr/bin/perl -w - -use Test; -use File::Spec::Functions qw/:ALL/; -plan tests => 2; - -ok catfile('a','b','c'), File::Spec->catfile('a','b','c'); - -# seems to return 0 or 1, so see if we can call it - 2003-07-07 tels -ok case_tolerant(), '/^0|1$/'; diff --git a/lib/File/Spec/t/Spec.t b/lib/File/Spec/t/Spec.t deleted file mode 100644 index 0c629bfa79..0000000000 --- a/lib/File/Spec/t/Spec.t +++ /dev/null @@ -1,831 +0,0 @@ -#!/usr/bin/perl -w - -use Test; - -# Grab all of the plain routines from File::Spec -use File::Spec @File::Spec::EXPORT_OK ; - -require File::Spec::Unix ; -require File::Spec::Win32 ; -require Cwd; - -eval { - require VMS::Filespec ; -} ; - -my $vms_unix_rpt; -my $vms_efs; - -if ($^O eq 'VMS') { - if (eval 'require VMS::Feature') { - $vms_unix_rpt = VMS::Feature::current("filename_unix_report"); - $vms_efs = VMS::Feature::current("efs_charset"); - } else { - my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; - my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || ''; - $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; - $vms_efs = $efs_charset =~ /^[ET1]/i; - } -} - - -my $skip_exception = "Install VMS::Filespec (from vms/ext)" ; - -if ( $@ ) { - # Not pretty, but it allows testing of things not implemented soley - # on VMS. It might be better to change File::Spec::VMS to do this, - # making it more usable when running on (say) Unix but working with - # VMS paths. - eval qq- - sub File::Spec::VMS::vmsify { die "$skip_exception" } - sub File::Spec::VMS::unixify { die "$skip_exception" } - sub File::Spec::VMS::vmspath { die "$skip_exception" } - - ; - $INC{"VMS/Filespec.pm"} = 1 ; -} -require File::Spec::VMS ; - -require File::Spec::OS2 ; -require File::Spec::Mac ; -require File::Spec::Epoc ; -require File::Spec::Cygwin ; - -# $root is only needed by Mac OS tests; these particular -# tests are skipped on other OSs -my $root = ''; -if ($^O eq 'MacOS') { - $root = File::Spec::Mac->rootdir(); -} - -# Each element in this array is a single test. Storing them this way makes -# maintenance easy, and should be OK since perl should be pretty functional -# before these tests are run. - -@tests = ( -# [ Function , Expected , Platform ] - -[ "Unix->case_tolerant()", '0' ], - -[ "Unix->catfile('a','b','c')", 'a/b/c' ], -[ "Unix->catfile('a','b','./c')", 'a/b/c' ], -[ "Unix->catfile('./a','b','c')", 'a/b/c' ], -[ "Unix->catfile('c')", 'c' ], -[ "Unix->catfile('./c')", 'c' ], - -[ "Unix->splitpath('file')", ',,file' ], -[ "Unix->splitpath('/d1/d2/d3/')", ',/d1/d2/d3/,' ], -[ "Unix->splitpath('d1/d2/d3/')", ',d1/d2/d3/,' ], -[ "Unix->splitpath('/d1/d2/d3/.')", ',/d1/d2/d3/.,' ], -[ "Unix->splitpath('/d1/d2/d3/..')", ',/d1/d2/d3/..,' ], -[ "Unix->splitpath('/d1/d2/d3/.file')", ',/d1/d2/d3/,.file' ], -[ "Unix->splitpath('d1/d2/d3/file')", ',d1/d2/d3/,file' ], -[ "Unix->splitpath('/../../d1/')", ',/../../d1/,' ], -[ "Unix->splitpath('/././d1/')", ',/././d1/,' ], - -[ "Unix->catpath('','','file')", 'file' ], -[ "Unix->catpath('','/d1/d2/d3/','')", '/d1/d2/d3/' ], -[ "Unix->catpath('','d1/d2/d3/','')", 'd1/d2/d3/' ], -[ "Unix->catpath('','/d1/d2/d3/.','')", '/d1/d2/d3/.' ], -[ "Unix->catpath('','/d1/d2/d3/..','')", '/d1/d2/d3/..' ], -[ "Unix->catpath('','/d1/d2/d3/','.file')", '/d1/d2/d3/.file' ], -[ "Unix->catpath('','d1/d2/d3/','file')", 'd1/d2/d3/file' ], -[ "Unix->catpath('','/../../d1/','')", '/../../d1/' ], -[ "Unix->catpath('','/././d1/','')", '/././d1/' ], -[ "Unix->catpath('d1','d2/d3/','')", 'd2/d3/' ], -[ "Unix->catpath('d1','d2','d3/')", 'd2/d3/' ], - -[ "Unix->splitdir('')", '' ], -[ "Unix->splitdir('/d1/d2/d3/')", ',d1,d2,d3,' ], -[ "Unix->splitdir('d1/d2/d3/')", 'd1,d2,d3,' ], -[ "Unix->splitdir('/d1/d2/d3')", ',d1,d2,d3' ], -[ "Unix->splitdir('d1/d2/d3')", 'd1,d2,d3' ], - -[ "Unix->catdir()", '' ], -[ "Unix->catdir('')", '/' ], -[ "Unix->catdir('/')", '/' ], -[ "Unix->catdir('','d1','d2','d3','')", '/d1/d2/d3' ], -[ "Unix->catdir('d1','d2','d3','')", 'd1/d2/d3' ], -[ "Unix->catdir('','d1','d2','d3')", '/d1/d2/d3' ], -[ "Unix->catdir('d1','d2','d3')", 'd1/d2/d3' ], -[ "Unix->catdir('/','d2/d3')", '/d2/d3' ], - -[ "Unix->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c' ], -[ "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' ], -[ "Unix->abs2rel('/t1/t2','/t1/t2/t3')", '..' ], -[ "Unix->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4' ], -[ "Unix->abs2rel('/t4/t5/t6','/t1/t2/t3')", '../../../t4/t5/t6' ], -#[ "Unix->abs2rel('../t4','/t1/t2/t3')", '../t4' ], -[ "Unix->abs2rel('/','/t1/t2/t3')", '../../..' ], -[ "Unix->abs2rel('///','/t1/t2/t3')", '../../..' ], -[ "Unix->abs2rel('/.','/t1/t2/t3')", '../../..' ], -[ "Unix->abs2rel('/./','/t1/t2/t3')", '../../..' ], -#[ "Unix->abs2rel('../t4','/t1/t2/t3')", '../t4' ], -[ "Unix->abs2rel('/t1/t2/t3', '/')", 't1/t2/t3' ], -[ "Unix->abs2rel('/t1/t2/t3', '/t1')", 't2/t3' ], -[ "Unix->abs2rel('t1/t2/t3', 't1')", 't2/t3' ], -[ "Unix->abs2rel('t1/t2/t3', 't4')", '../t1/t2/t3' ], - -[ "Unix->rel2abs('t4','/t1/t2/t3')", '/t1/t2/t3/t4' ], -[ "Unix->rel2abs('t4/t5','/t1/t2/t3')", '/t1/t2/t3/t4/t5' ], -[ "Unix->rel2abs('.','/t1/t2/t3')", '/t1/t2/t3' ], -[ "Unix->rel2abs('..','/t1/t2/t3')", '/t1/t2/t3/..' ], -[ "Unix->rel2abs('../t4','/t1/t2/t3')", '/t1/t2/t3/../t4' ], -[ "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/,' ], -[ "Win32->splitpath('d1/d2\\d3/')", ',d1/d2\\d3/,' ], -[ "Win32->splitpath('\\d1/d2\\d3/.')", ',\\d1/d2\\d3/.,' ], -[ "Win32->splitpath('\\d1/d2\\d3/..')", ',\\d1/d2\\d3/..,' ], -[ "Win32->splitpath('\\d1/d2\\d3/.file')", ',\\d1/d2\\d3/,.file' ], -[ "Win32->splitpath('\\d1/d2\\d3/file')", ',\\d1/d2\\d3/,file' ], -[ "Win32->splitpath('d1/d2\\d3/file')", ',d1/d2\\d3/,file' ], -[ "Win32->splitpath('C:\\d1/d2\\d3/')", 'C:,\\d1/d2\\d3/,' ], -[ "Win32->splitpath('C:d1/d2\\d3/')", 'C:,d1/d2\\d3/,' ], -[ "Win32->splitpath('C:\\d1/d2\\d3/file')", 'C:,\\d1/d2\\d3/,file' ], -[ "Win32->splitpath('C:d1/d2\\d3/file')", 'C:,d1/d2\\d3/,file' ], -[ "Win32->splitpath('C:\\../d2\\d3/file')", 'C:,\\../d2\\d3/,file' ], -[ "Win32->splitpath('C:../d2\\d3/file')", 'C:,../d2\\d3/,file' ], -[ "Win32->splitpath('\\../..\\d1/')", ',\\../..\\d1/,' ], -[ "Win32->splitpath('\\./.\\d1/')", ',\\./.\\d1/,' ], -[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/')", '\\\\node\\share,\\d1/d2\\d3/,' ], -[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/file')", '\\\\node\\share,\\d1/d2\\d3/,file' ], -[ "Win32->splitpath('\\\\node\\share\\d1/d2\\file')", '\\\\node\\share,\\d1/d2\\,file' ], -[ "Win32->splitpath('file',1)", ',file,' ], -[ "Win32->splitpath('\\d1/d2\\d3/',1)", ',\\d1/d2\\d3/,' ], -[ "Win32->splitpath('d1/d2\\d3/',1)", ',d1/d2\\d3/,' ], -[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/',1)", '\\\\node\\share,\\d1/d2\\d3/,' ], - -[ "Win32->catpath('','','file')", 'file' ], -[ "Win32->catpath('','\\d1/d2\\d3/','')", '\\d1/d2\\d3/' ], -[ "Win32->catpath('','d1/d2\\d3/','')", 'd1/d2\\d3/' ], -[ "Win32->catpath('','\\d1/d2\\d3/.','')", '\\d1/d2\\d3/.' ], -[ "Win32->catpath('','\\d1/d2\\d3/..','')", '\\d1/d2\\d3/..' ], -[ "Win32->catpath('','\\d1/d2\\d3/','.file')", '\\d1/d2\\d3/.file' ], -[ "Win32->catpath('','\\d1/d2\\d3/','file')", '\\d1/d2\\d3/file' ], -[ "Win32->catpath('','d1/d2\\d3/','file')", 'd1/d2\\d3/file' ], -[ "Win32->catpath('C:','\\d1/d2\\d3/','')", 'C:\\d1/d2\\d3/' ], -[ "Win32->catpath('C:','d1/d2\\d3/','')", 'C:d1/d2\\d3/' ], -[ "Win32->catpath('C:','\\d1/d2\\d3/','file')", 'C:\\d1/d2\\d3/file' ], -[ "Win32->catpath('C:','d1/d2\\d3/','file')", 'C:d1/d2\\d3/file' ], -[ "Win32->catpath('C:','\\../d2\\d3/','file')", 'C:\\../d2\\d3/file' ], -[ "Win32->catpath('C:','../d2\\d3/','file')", 'C:../d2\\d3/file' ], -[ "Win32->catpath('','\\../..\\d1/','')", '\\../..\\d1/' ], -[ "Win32->catpath('','\\./.\\d1/','')", '\\./.\\d1/' ], -[ "Win32->catpath('\\\\node\\share','\\d1/d2\\d3/','')", '\\\\node\\share\\d1/d2\\d3/' ], -[ "Win32->catpath('\\\\node\\share','\\d1/d2\\d3/','file')", '\\\\node\\share\\d1/d2\\d3/file' ], -[ "Win32->catpath('\\\\node\\share','\\d1/d2\\','file')", '\\\\node\\share\\d1/d2\\file' ], - -[ "Win32->splitdir('')", '' ], -[ "Win32->splitdir('\\d1/d2\\d3/')", ',d1,d2,d3,' ], -[ "Win32->splitdir('d1/d2\\d3/')", 'd1,d2,d3,' ], -[ "Win32->splitdir('\\d1/d2\\d3')", ',d1,d2,d3' ], -[ "Win32->splitdir('d1/d2\\d3')", 'd1,d2,d3' ], - -[ "Win32->catdir()", '' ], -[ "Win32->catdir('')", '\\' ], -[ "Win32->catdir('/')", '\\' ], -[ "Win32->catdir('/', '../')", '\\' ], -[ "Win32->catdir('/', '..\\')", '\\' ], -[ "Win32->catdir('\\', '../')", '\\' ], -[ "Win32->catdir('\\', '..\\')", '\\' ], -[ "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' ], -[ "Win32->catdir('','d1','d2','d3')", '\\d1\\d2\\d3' ], -[ "Win32->catdir('d1','d2','d3')", 'd1\\d2\\d3' ], -[ "Win32->catdir('A:/d1','d2','d3')", 'A:\\d1\\d2\\d3' ], -[ "Win32->catdir('A:/d1','d2','d3','')", 'A:\\d1\\d2\\d3' ], -#[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\d2\\d3' ], -[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\B:\\d2\\d3' ], -[ "Win32->catdir('A:/')", 'A:\\' ], -[ "Win32->catdir('\\', 'foo')", '\\foo' ], -[ "Win32->catdir('','','..')", '\\' ], -[ "Win32->catdir('A:', 'foo')", 'A:\\foo' ], - -[ "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->catfile('A:', 'foo')", 'A:\\foo' ], - - -[ "Win32->canonpath('')", '' ], -[ "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' ], -[ "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' ], -[ "Win32->canonpath('//a/b/c/.../d')", '\\\\a\\b\\d' ], -[ "Win32->canonpath('/a/b/c/../../d')", '\\a\\d' ], -[ "Win32->canonpath('/a/b/c/.../d')", '\\a\\d' ], -[ "Win32->canonpath('\\../temp\\')", '\\temp' ], -[ "Win32->canonpath('\\../')", '\\' ], -[ "Win32->canonpath('\\..\\')", '\\' ], -[ "Win32->canonpath('/../')", '\\' ], -[ "Win32->canonpath('/..\\')", '\\' ], -[ "Win32->canonpath('d1/../foo')", 'foo' ], - -[ "Win32->can('_cwd')", '/CODE/' ], - -# FakeWin32 subclass (see below) just sets CWD to C:\one\two and getdcwd('D') to D:\alpha\beta - -[ "FakeWin32->abs2rel('/t1/t2/t3','/t1/t2/t3')", '.' ], -[ "FakeWin32->abs2rel('/t1/t2/t4','/t1/t2/t3')", '..\\t4' ], -[ "FakeWin32->abs2rel('/t1/t2','/t1/t2/t3')", '..' ], -[ "FakeWin32->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4' ], -[ "FakeWin32->abs2rel('/t4/t5/t6','/t1/t2/t3')", '..\\..\\..\\t4\\t5\\t6' ], -[ "FakeWin32->abs2rel('../t4','/t1/t2/t3')", '..\\..\\..\\one\\t4' ], # Uses _cwd() -[ "FakeWin32->abs2rel('/','/t1/t2/t3')", '..\\..\\..' ], -[ "FakeWin32->abs2rel('///','/t1/t2/t3')", '..\\..\\..' ], -[ "FakeWin32->abs2rel('/.','/t1/t2/t3')", '..\\..\\..' ], -[ "FakeWin32->abs2rel('/./','/t1/t2/t3')", '..\\..\\..' ], -[ "FakeWin32->abs2rel('\\\\a/t1/t2/t4','/t2/t3')", '\\\\a\\t1\\t2\\t4' ], -[ "FakeWin32->abs2rel('//a/t1/t2/t4','/t2/t3')", '\\\\a\\t1\\t2\\t4' ], -[ "FakeWin32->abs2rel('A:/t1/t2/t3','A:/t1/t2/t3')", '.' ], -[ "FakeWin32->abs2rel('A:/t1/t2/t3/t4','A:/t1/t2/t3')", 't4' ], -[ "FakeWin32->abs2rel('A:/t1/t2/t3','A:/t1/t2/t3/t4')", '..' ], -[ "FakeWin32->abs2rel('A:/t1/t2/t3','B:/t1/t2/t3')", 'A:\\t1\\t2\\t3' ], -[ "FakeWin32->abs2rel('A:/t1/t2/t3/t4','B:/t1/t2/t3')", 'A:\\t1\\t2\\t3\\t4' ], -[ "FakeWin32->abs2rel('E:/foo/bar/baz')", 'E:\\foo\\bar\\baz' ], -[ "FakeWin32->abs2rel('C:/one/two/three')", 'three' ], -[ "FakeWin32->abs2rel('C:\\Windows\\System32', 'C:\\')", 'Windows\System32' ], -[ "FakeWin32->abs2rel('\\\\computer2\\share3\\foo.txt', '\\\\computer2\\share3')", 'foo.txt' ], -[ "FakeWin32->abs2rel('C:\\one\\two\\t\\asd1\\', 't\\asd\\')", '..\\asd1' ], -[ "FakeWin32->abs2rel('\\one\\two', 'A:\\foo')", 'C:\\one\\two' ], - -[ "FakeWin32->rel2abs('temp','C:/')", 'C:\\temp' ], -[ "FakeWin32->rel2abs('temp','C:/a')", 'C:\\a\\temp' ], -[ "FakeWin32->rel2abs('temp','C:/a/')", 'C:\\a\\temp' ], -[ "FakeWin32->rel2abs('../','C:/')", 'C:\\' ], -[ "FakeWin32->rel2abs('../','C:/a')", 'C:\\' ], -[ "FakeWin32->rel2abs('\\foo','C:/a')", 'C:\\foo' ], -[ "FakeWin32->rel2abs('temp','//prague_main/work/')", '\\\\prague_main\\work\\temp' ], -[ "FakeWin32->rel2abs('../temp','//prague_main/work/')", '\\\\prague_main\\work\\temp' ], -[ "FakeWin32->rel2abs('temp','//prague_main/work')", '\\\\prague_main\\work\\temp' ], -[ "FakeWin32->rel2abs('../','//prague_main/work')", '\\\\prague_main\\work' ], -[ "FakeWin32->rel2abs('D:foo.txt')", 'D:\\alpha\\beta\\foo.txt' ], - -[ "VMS->case_tolerant()", '1' ], - -[ "VMS->catfile('a','b','c')", $vms_unix_rpt ? 'a/b/c' : '[.a.b]c' ], -[ "VMS->catfile('a','b','[]c')", '[.a.b]c' ], -[ "VMS->catfile('[.a]','b','c')", '[.a.b]c' ], -[ "VMS->catfile('c')", 'c' ], -[ "VMS->catfile('[]c')", 'c' ], - -[ "VMS->catfile('0','b','c')", $vms_unix_rpt ? '0/b/c' : '[.0.b]c' ], -[ "VMS->catfile('a','0','c')", $vms_unix_rpt ? 'a/0/c' : '[.a.0]c' ], -[ "VMS->catfile('a','b','0')", $vms_unix_rpt ? 'a/b/0' : '[.a.b]0' ], -[ "VMS->catfile('0','0','c')", $vms_unix_rpt ? '0/0/c' : '[.0.0]c' ], -[ "VMS->catfile('a','0','0')", $vms_unix_rpt ? 'a/0/0' : '[.a.0]0' ], -[ "VMS->catfile('0','b','0')", $vms_unix_rpt ? '0/b/0' : '[.0.b]0' ], -[ "VMS->catfile('0','0','0')", $vms_unix_rpt ? '0/0/0' : '[.0.0]0' ], - - -[ "VMS->splitpath('file')", ',,file' ], -[ "VMS->splitpath('[d1.d2.d3]')", ',[d1.d2.d3],' ], -[ "VMS->splitpath('[.d1.d2.d3]')", ',[.d1.d2.d3],' ], -[ "VMS->splitpath('[d1.d2.d3]file')", ',[d1.d2.d3],file' ], -[ "VMS->splitpath('d1/d2/d3/file')", - $vms_efs ? ',d1/d2/d3/,file' : ',[.d1.d2.d3],file' ], -[ "VMS->splitpath('/d1/d2/d3/file')", - $vms_efs ? ',/d1/d2/d3/,file' : 'd1:,[d2.d3],file' ], -[ "VMS->splitpath('[.d1.d2.d3]file')", ',[.d1.d2.d3],file' ], -[ "VMS->splitpath('node::volume:[d1.d2.d3]')", 'node::volume:,[d1.d2.d3],' ], -[ "VMS->splitpath('node::volume:[d1.d2.d3]file')", 'node::volume:,[d1.d2.d3],file' ], -[ "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')", $vms_efs ? ',0/,0' : ',[.0],0' ], -[ "VMS->splitpath('0/0/0')", $vms_efs ? ',0/0/,0' : ',[.0.0],0' ], -[ "VMS->splitpath('/0/0')", $vms_efs ? ',/0/,0' : '0:,[000000],0' ], -[ "VMS->splitpath('/0/0/0')", $vms_efs ? ',/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)", $vms_efs ? ',d1/d2/d3,' : ',[.d1.d2.d3],' ], -[ "VMS->splitpath('/d1/d2/d3',1)", $vms_efs ? ',/d1/d2/d3,' : '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)", $vms_efs ? ',0/0,' : ',[.0.0],' ], -[ "VMS->splitpath('0/0/0',1)", $vms_efs ? ',0/0/0,' : ',[.0.0.0],' ], -[ "VMS->splitpath('/0/0',1)", $vms_efs ? ',/0/0,' : '0:,[000000.0],' ], -[ "VMS->splitpath('/0/0/0',1)", $vms_efs ? ',/0/0/0,' : '0:,[0.0],' ], - -[ "VMS->catpath('','','file')", 'file' ], -[ "VMS->catpath('','[d1.d2.d3]','')", '[d1.d2.d3]' ], -[ "VMS->catpath('','[.d1.d2.d3]','')", '[.d1.d2.d3]' ], -[ "VMS->catpath('','[d1.d2.d3]','file')", '[d1.d2.d3]file' ], -[ "VMS->catpath('','[.d1.d2.d3]','file')", '[.d1.d2.d3]file' ], -[ "VMS->catpath('','d1/d2/d3','file')", - $vms_efs ? 'd1/d2/d3/file' : '[.d1.d2.d3]file' ], -[ "VMS->catpath('v','d1/d2/d3','file')", 'v:[.d1.d2.d3]file' ], -[ "VMS->catpath('v','w:[d1.d2.d3]','file')", 'v:[d1.d2.d3]file' ], -[ "VMS->catpath('node::volume:','[d1.d2.d3]','')", 'node::volume:[d1.d2.d3]' ], -[ "VMS->catpath('node::volume:','[d1.d2.d3]','file')", 'node::volume:[d1.d2.d3]file' ], -[ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','')", 'node"access_spec"::volume:[d1.d2.d3]' ], -[ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','file')", 'node"access_spec"::volume:[d1.d2.d3]file' ], - -[ "VMS->canonpath('')", '' ], -[ "VMS->canonpath('volume:[d1]file')", 'volume:[d1]file' ], -[ "VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]')", 'volume:[d2.d3]' ], -[ "VMS->canonpath('volume:[000000.d1]d2.dir;1')", 'volume:[d1]d2.dir;1' ], -[ "VMS->canonpath('volume:[d1.d2.d3]file.txt')", 'volume:[d1.d2.d3]file.txt' ], -[ "VMS->canonpath('[d1.d2.d3]file.txt')", '[d1.d2.d3]file.txt' ], -[ "VMS->canonpath('volume:[-.d1.d2.d3]file.txt')", 'volume:[-.d1.d2.d3]file.txt' ], -[ "VMS->canonpath('[-.d1.d2.d3]file.txt')", '[-.d1.d2.d3]file.txt' ], -[ "VMS->canonpath('volume:[--.d1.d2.d3]file.txt')", 'volume:[--.d1.d2.d3]file.txt' ], -[ "VMS->canonpath('[--.d1.d2.d3]file.txt')", '[--.d1.d2.d3]file.txt' ], -[ "VMS->canonpath('volume:[d1.-.d2.d3]file.txt')", 'volume:[d2.d3]file.txt' ], -[ "VMS->canonpath('[d1.-.d2.d3]file.txt')", '[d2.d3]file.txt' ], -[ "VMS->canonpath('volume:[d1.--.d2.d3]file.txt')", 'volume:[-.d2.d3]file.txt' ], -[ "VMS->canonpath('[d1.--.d2.d3]file.txt')", '[-.d2.d3]file.txt' ], -[ "VMS->canonpath('volume:[d1.d2.-.d3]file.txt')", 'volume:[d1.d3]file.txt' ], -[ "VMS->canonpath('[d1.d2.-.d3]file.txt')", '[d1.d3]file.txt' ], -[ "VMS->canonpath('volume:[d1.d2.--.d3]file.txt')", 'volume:[d3]file.txt' ], -[ "VMS->canonpath('[d1.d2.--.d3]file.txt')", '[d3]file.txt' ], -[ "VMS->canonpath('volume:[d1.d2.d3.-]file.txt')", 'volume:[d1.d2]file.txt' ], -[ "VMS->canonpath('[d1.d2.d3.-]file.txt')", '[d1.d2]file.txt' ], -[ "VMS->canonpath('volume:[d1.d2.d3.--]file.txt')", 'volume:[d1]file.txt' ], -[ "VMS->canonpath('[d1.d2.d3.--]file.txt')", '[d1]file.txt' ], -[ "VMS->canonpath('volume:[d1.000000.][000000.][d3.--]file.txt')", 'volume:[d1]file.txt' ], -[ "VMS->canonpath('[d1.000000.][000000.][d3.--]file.txt')", '[d1]file.txt' ], -[ "VMS->canonpath('volume:[d1.000000.][000000.][d2.000000]file.txt')", 'volume:[d1.000000.d2.000000]file.txt' ], -[ "VMS->canonpath('[d1.000000.][000000.][d2.000000]file.txt')", '[d1.000000.d2.000000]file.txt' ], -[ "VMS->canonpath('volume:[d1.000000.][000000.][d3.--.000000]file.txt')",'volume:[d1.000000]file.txt' ], -[ "VMS->canonpath('[d1.000000.][000000.][d3.--.000000]file.txt')", '[d1.000000]file.txt' ], -[ "VMS->canonpath('volume:[d1.000000.][000000.][-.-.000000]file.txt')", 'volume:[000000]file.txt' ], -[ "VMS->canonpath('[d1.000000.][000000.][--.-.000000]file.txt')", '[-.000000]file.txt' ], -[ "VMS->canonpath('[d1.d2.--]file')", '[000000]file' ], - -[ "VMS->splitdir('')", '' ], -[ "VMS->splitdir('[]')", '' ], -[ "VMS->splitdir('d1.d2.d3')", 'd1,d2,d3' ], -[ "VMS->splitdir('[d1.d2.d3]')", 'd1,d2,d3' ], -[ "VMS->splitdir('.d1.d2.d3')", 'd1,d2,d3' ], -[ "VMS->splitdir('[.d1.d2.d3]')", 'd1,d2,d3' ], -[ "VMS->splitdir('.-.d2.d3')", '-,d2,d3' ], -[ "VMS->splitdir('[.-.d2.d3]')", '-,d2,d3' ], -[ "VMS->splitdir('[d1.d2]')", 'd1,d2' ], -[ "VMS->splitdir('[d1-.--d2]')", 'd1-,--d2' ], -[ "VMS->splitdir('[d1---.-.d2]')", 'd1---,-,d2' ], -[ "VMS->splitdir('[d1.---.d2]')", 'd1,-,-,-,d2' ], -[ "VMS->splitdir('[d1---d2]')", 'd1---d2' ], -[ "VMS->splitdir('[d1.][000000.d2]')", 'd1,d2' ], -[ "VMS->splitdir('[.d1.d2^.d3]')", 'd1,d2^.d3' ], - -[ "VMS->catdir('')", '' ], -[ "VMS->catdir('d1','d2','d3')", $vms_unix_rpt ? 'd1/d2/d3' : '[.d1.d2.d3]' ], -[ "VMS->catdir('d1','d2/','d3')", $vms_efs ? 'd1/d2/d3' : '[.d1.d2.d3]' ], -[ "VMS->catdir('','d1','d2','d3')", - $vms_unix_rpt ? '/d1/d2/d3' : - $vms_efs ? '[d1.d2.d3]' : '[.d1.d2.d3]' ], -[ "VMS->catdir('','-','d2','d3')", '[-.d2.d3]' ], -[ "VMS->catdir('','-','','d3')", '[-.d3]' ], -[ "VMS->catdir('dir.dir','d2.dir','d3.dir')", - $vms_unix_rpt ? 'dir.dir/d2.dir/d3.dir' : '[.dir.d2.d3]' ], -[ "VMS->catdir('[.name]')", '[.name]' ], -[ "VMS->catdir('[.name]','[.name]')", '[.name.name]'], - -[ "VMS->abs2rel('node::volume:[t1.t2.t3]','node::volume:[t1.t2.t3]')", '[]' ], -[ "VMS->abs2rel('node::volume:[t1.t2.t3]','[t1.t2.t3]')", 'node::volume:[t1.t2.t3]' ], -[ "VMS->abs2rel('node::volume:[t1.t2.t4]','node::volume:[t1.t2.t3]')", '[-.t4]' ], -[ "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", 'node::volume:[t1.t2.t4]' ], -[ "VMS->abs2rel('[t1.t2.t3]','[t1.t2.t3]')", '[]' ], -[ "VMS->abs2rel('[t1.t2.t3]file','[t1.t2.t3]')", 'file' ], -[ "VMS->abs2rel('[t1.t2.t3]file','[t1.t2]')", '[.t3]file' ], -[ "VMS->abs2rel('v:[t1.t2.t3]file','v:[t1.t2]')", '[.t3]file' ], -[ "VMS->abs2rel('[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]' ], -[ "VMS->abs2rel('[t1.t2]file','[t1.t2.t3]')", '[-]file' ], -[ "VMS->abs2rel('[t1.t2.t3.t4]','[t1.t2.t3]')", '[.t4]' ], -[ "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')", '[---.t4.t5.t6]' ], -[ "VMS->abs2rel('[000000]','[t1.t2.t3]')", '[---]' ], -[ "VMS->abs2rel('a:[t1.t2.t4]','a:[t1.t2.t3]')", '[-.t4]' ], -[ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')", 'a:[t1.t2.t4]' ], -[ "VMS->abs2rel('[a.-.b.c.-]','[t1.t2.t3]')", '[---.b]' ], - -[ "VMS->rel2abs('[.t4]','[t1.t2.t3]')", '[t1.t2.t3.t4]' ], -[ "VMS->rel2abs('[.t4.t5]','[t1.t2.t3]')", '[t1.t2.t3.t4.t5]' ], -[ "VMS->rel2abs('[]','[t1.t2.t3]')", '[t1.t2.t3]' ], -[ "VMS->rel2abs('[-]','[t1.t2.t3]')", '[t1.t2]' ], -[ "VMS->rel2abs('[-.t4]','[t1.t2.t3]')", '[t1.t2.t4]' ], -[ "VMS->rel2abs('[t1]','[t1.t2.t3]')", '[t1]' ], - -[ "OS2->case_tolerant()", '1' ], - -[ "OS2->catdir('A:/d1','B:/d2','d3','')", 'A:/d1/B:/d2/d3' ], - -[ "OS2->catfile('a','b','c')", 'a/b/c' ], -[ "OS2->catfile('a','b','./c')", 'a/b/c' ], -[ "OS2->catfile('./a','b','c')", 'a/b/c' ], -[ "OS2->catfile('c')", 'c' ], -[ "OS2->catfile('./c')", 'c' ], - -[ "OS2->catdir('/', '../')", '/' ], -[ "OS2->catdir('/', '..\\')", '/' ], -[ "OS2->catdir('\\', '../')", '/' ], -[ "OS2->catdir('\\', '..\\')", '/' ], - -[ "Mac->case_tolerant()", '1' ], - -[ "Mac->catpath('','','')", '' ], -[ "Mac->catpath('',':','')", ':' ], -[ "Mac->catpath('','::','')", '::' ], - -[ "Mac->catpath('hd','','')", 'hd:' ], -[ "Mac->catpath('hd:','','')", 'hd:' ], -[ "Mac->catpath('hd:',':','')", 'hd:' ], -[ "Mac->catpath('hd:','::','')", 'hd::' ], - -[ "Mac->catpath('hd','','file')", 'hd:file' ], -[ "Mac->catpath('hd',':','file')", 'hd:file' ], -[ "Mac->catpath('hd','::','file')", 'hd::file' ], -[ "Mac->catpath('hd',':::','file')", 'hd:::file' ], - -[ "Mac->catpath('hd:','',':file')", 'hd:file' ], -[ "Mac->catpath('hd:',':',':file')", 'hd:file' ], -[ "Mac->catpath('hd:','::',':file')", 'hd::file' ], -[ "Mac->catpath('hd:',':::',':file')", 'hd:::file' ], - -[ "Mac->catpath('hd:','d1','file')", 'hd:d1:file' ], -[ "Mac->catpath('hd:',':d1:',':file')", 'hd:d1:file' ], -[ "Mac->catpath('hd:','hd:d1','')", 'hd:d1:' ], - -[ "Mac->catpath('','d1','')", ':d1:' ], -[ "Mac->catpath('',':d1','')", ':d1:' ], -[ "Mac->catpath('',':d1:','')", ':d1:' ], - -[ "Mac->catpath('','d1','file')", ':d1:file' ], -[ "Mac->catpath('',':d1:',':file')", ':d1:file' ], - -[ "Mac->catpath('','','file')", 'file' ], -[ "Mac->catpath('','',':file')", 'file' ], # ! -[ "Mac->catpath('',':',':file')", ':file' ], # ! - - -[ "Mac->splitpath(':')", ',:,' ], -[ "Mac->splitpath('::')", ',::,' ], -[ "Mac->splitpath(':::')", ',:::,' ], - -[ "Mac->splitpath('file')", ',,file' ], -[ "Mac->splitpath(':file')", ',:,file' ], - -[ "Mac->splitpath('d1',1)", ',:d1:,' ], # dir, not volume -[ "Mac->splitpath(':d1',1)", ',:d1:,' ], -[ "Mac->splitpath(':d1:',1)", ',:d1:,' ], -[ "Mac->splitpath(':d1:')", ',:d1:,' ], -[ "Mac->splitpath(':d1:d2:d3:')", ',:d1:d2:d3:,' ], -[ "Mac->splitpath(':d1:d2:d3:',1)", ',:d1:d2:d3:,' ], -[ "Mac->splitpath(':d1:file')", ',:d1:,file' ], -[ "Mac->splitpath('::d1:file')", ',::d1:,file' ], - -[ "Mac->splitpath('hd:', 1)", 'hd:,,' ], -[ "Mac->splitpath('hd:')", 'hd:,,' ], -[ "Mac->splitpath('hd:d1:d2:')", 'hd:,:d1:d2:,' ], -[ "Mac->splitpath('hd:d1:d2',1)", 'hd:,:d1:d2:,' ], -[ "Mac->splitpath('hd:d1:d2:file')", 'hd:,:d1:d2:,file' ], -[ "Mac->splitpath('hd:d1:d2::file')", 'hd:,:d1:d2::,file' ], -[ "Mac->splitpath('hd::d1:d2:file')", 'hd:,::d1:d2:,file' ], # invalid path -[ "Mac->splitpath('hd:file')", 'hd:,,file' ], - -[ "Mac->splitdir()", '' ], -[ "Mac->splitdir('')", '' ], -[ "Mac->splitdir(':')", ':' ], -[ "Mac->splitdir('::')", '::' ], -[ "Mac->splitdir(':::')", '::,::' ], -[ "Mac->splitdir(':::d1:d2')", '::,::,d1,d2' ], - -[ "Mac->splitdir(':d1:d2:d3::')", 'd1,d2,d3,::'], -[ "Mac->splitdir(':d1:d2:d3:')", 'd1,d2,d3' ], -[ "Mac->splitdir(':d1:d2:d3')", 'd1,d2,d3' ], - -# absolute paths in splitdir() work, but you'd better use splitpath() -[ "Mac->splitdir('hd:')", 'hd:' ], -[ "Mac->splitdir('hd::')", 'hd:,::' ], # invalid path, but it works -[ "Mac->splitdir('hd::d1:')", 'hd:,::,d1' ], # invalid path, but it works -[ "Mac->splitdir('hd:d1:d2:::')", 'hd:,d1,d2,::,::' ], -[ "Mac->splitdir('hd:d1:d2::')", 'hd:,d1,d2,::' ], -[ "Mac->splitdir('hd:d1:d2:')", 'hd:,d1,d2' ], -[ "Mac->splitdir('hd:d1:d2')", 'hd:,d1,d2' ], -[ "Mac->splitdir('hd:d1::d2::')", 'hd:,d1,::,d2,::' ], - -[ "Mac->catdir()", '' ], -[ "Mac->catdir('')", $root, 'MacOS' ], # skipped on other OS -[ "Mac->catdir(':')", ':' ], - -[ "Mac->catdir('', '')", $root, 'MacOS' ], # skipped on other OS -[ "Mac->catdir('', ':')", $root, 'MacOS' ], # skipped on other OS -[ "Mac->catdir(':', ':')", ':' ], -[ "Mac->catdir(':', '')", ':' ], - -[ "Mac->catdir('', '::')", $root, 'MacOS' ], # skipped on other OS -[ "Mac->catdir(':', '::')", '::' ], - -[ "Mac->catdir('::', '')", '::' ], -[ "Mac->catdir('::', ':')", '::' ], - -[ "Mac->catdir('::', '::')", ':::' ], - -[ "Mac->catdir(':d1')", ':d1:' ], -[ "Mac->catdir(':d1:')", ':d1:' ], -[ "Mac->catdir(':d1','d2')", ':d1:d2:' ], -[ "Mac->catdir(':d1',':d2')", ':d1:d2:' ], -[ "Mac->catdir(':d1',':d2:')", ':d1:d2:' ], -[ "Mac->catdir(':d1',':d2::')", ':d1:d2::' ], -[ "Mac->catdir(':',':d1',':d2')", ':d1:d2:' ], -[ "Mac->catdir('::',':d1',':d2')", '::d1:d2:' ], -[ "Mac->catdir('::','::',':d1',':d2')", ':::d1:d2:' ], -[ "Mac->catdir(':',':',':d1',':d2')", ':d1:d2:' ], -[ "Mac->catdir('::',':',':d1',':d2')", '::d1:d2:' ], - -[ "Mac->catdir('d1')", ':d1:' ], -[ "Mac->catdir('d1','d2','d3')", ':d1:d2:d3:' ], -[ "Mac->catdir('d1','d2/','d3')", ':d1:d2/:d3:' ], -[ "Mac->catdir('d1','',':d2')", ':d1:d2:' ], -[ "Mac->catdir('d1',':',':d2')", ':d1:d2:' ], -[ "Mac->catdir('d1','::',':d2')", ':d1::d2:' ], -[ "Mac->catdir('d1',':::',':d2')", ':d1:::d2:' ], -[ "Mac->catdir('d1','::','::',':d2')", ':d1:::d2:' ], -[ "Mac->catdir('d1','d2')", ':d1:d2:' ], -[ "Mac->catdir('d1','d2', '')", ':d1:d2:' ], -[ "Mac->catdir('d1','d2', ':')", ':d1:d2:' ], -[ "Mac->catdir('d1','d2', '::')", ':d1:d2::' ], -[ "Mac->catdir('d1','d2','','')", ':d1:d2:' ], -[ "Mac->catdir('d1','d2',':','::')", ':d1:d2::' ], -[ "Mac->catdir('d1','d2','::','::')", ':d1:d2:::' ], -[ "Mac->catdir('d1',':d2')", ':d1:d2:' ], -[ "Mac->catdir('d1',':d2:')", ':d1:d2:' ], - -[ "Mac->catdir('','d1','d2','d3')", $root . 'd1:d2:d3:', 'MacOS' ], # skipped on other OS -[ "Mac->catdir('',':','d1','d2')", $root . 'd1:d2:' , 'MacOS' ], # skipped on other OS -[ "Mac->catdir('','::','d1','d2')", $root . 'd1:d2:' , 'MacOS' ], # skipped on other OS -[ "Mac->catdir('',':','','d1')", $root . 'd1:' , 'MacOS' ], # skipped on other OS -[ "Mac->catdir('', ':d1',':d2')", $root . 'd1:d2:' , 'MacOS' ], # skipped on other OS -[ "Mac->catdir('','',':d1',':d2')", $root . 'd1:d2:' , 'MacOS' ], # skipped on other OS - -[ "Mac->catdir('hd:',':d1')", 'hd:d1:' ], -[ "Mac->catdir('hd:d1:',':d2')", 'hd:d1:d2:' ], -[ "Mac->catdir('hd:','d1')", 'hd:d1:' ], -[ "Mac->catdir('hd:d1:',':d2')", 'hd:d1:d2:' ], -[ "Mac->catdir('hd:d1:',':d2:')", 'hd:d1:d2:' ], - -[ "Mac->catfile()", '' ], -[ "Mac->catfile('')", '' ], -[ "Mac->catfile('', '')", $root , 'MacOS' ], # skipped on other OS -[ "Mac->catfile('', 'file')", $root . 'file', 'MacOS' ], # skipped on other OS -[ "Mac->catfile(':')", ':' ], -[ "Mac->catfile(':', '')", ':' ], - -[ "Mac->catfile('d1','d2','file')", ':d1:d2:file' ], -[ "Mac->catfile('d1','d2',':file')", ':d1:d2:file' ], -[ "Mac->catfile('file')", 'file' ], -[ "Mac->catfile(':', 'file')", ':file' ], - -[ "Mac->canonpath('')", '' ], -[ "Mac->canonpath(':')", ':' ], -[ "Mac->canonpath('::')", '::' ], -[ "Mac->canonpath('a::')", 'a::' ], -[ "Mac->canonpath(':a::')", ':a::' ], - -[ "Mac->abs2rel('hd:d1:d2:','hd:d1:d2:')", ':' ], -[ "Mac->abs2rel('hd:d1:d2:','hd:d1:d2:file')", ':' ], # ignore base's file portion -[ "Mac->abs2rel('hd:d1:d2:file','hd:d1:d2:')", ':file' ], -[ "Mac->abs2rel('hd:d1:','hd:d1:d2:')", '::' ], -[ "Mac->abs2rel('hd:d3:','hd:d1:d2:')", ':::d3:' ], -[ "Mac->abs2rel('hd:d3:','hd:d1:d2::')", '::d3:' ], -[ "Mac->abs2rel('hd:d1:d4:d5:','hd:d1::d2:d3::')", '::d1:d4:d5:' ], -[ "Mac->abs2rel('hd:d1:d4:d5:','hd:d1::d2:d3:')", ':::d1:d4:d5:' ], # first, resolve updirs in base -[ "Mac->abs2rel('hd:d1:d3:','hd:d1:d2:')", '::d3:' ], -[ "Mac->abs2rel('hd:d1::d3:','hd:d1:d2:')", ':::d3:' ], -[ "Mac->abs2rel('hd:d3:','hd:d1:d2:')", ':::d3:' ], # same as above -[ "Mac->abs2rel('hd:d1:d2:d3:','hd:d1:d2:')", ':d3:' ], -[ "Mac->abs2rel('hd:d1:d2:d3::','hd:d1:d2:')", ':d3::' ], -[ "Mac->abs2rel('hd1:d3:d4:d5:','hd2:d1:d2:')", 'hd1:d3:d4:d5:'], # volume mismatch -[ "Mac->abs2rel('hd:','hd:d1:d2:')", ':::' ], - -[ "Mac->rel2abs(':d3:','hd:d1:d2:')", 'hd:d1:d2:d3:' ], -[ "Mac->rel2abs(':d3:d4:','hd:d1:d2:')", 'hd:d1:d2:d3:d4:' ], -[ "Mac->rel2abs('','hd:d1:d2:')", '' ], -[ "Mac->rel2abs('::','hd:d1:d2:')", 'hd:d1:d2::' ], -[ "Mac->rel2abs('::','hd:d1:d2:file')", 'hd:d1:d2::' ],# ignore base's file portion -[ "Mac->rel2abs(':file','hd:d1:d2:')", 'hd:d1:d2:file' ], -[ "Mac->rel2abs('::file','hd:d1:d2:')", 'hd:d1:d2::file' ], -[ "Mac->rel2abs('::d3:','hd:d1:d2:')", 'hd:d1:d2::d3:' ], -[ "Mac->rel2abs('hd:','hd:d1:d2:')", 'hd:' ], # path already absolute -[ "Mac->rel2abs('hd:d3:file','hd:d1:d2:')", 'hd:d3:file' ], -[ "Mac->rel2abs('hd:d3:','hd:d1:file')", 'hd:d3:' ], - -[ "Epoc->case_tolerant()", '1' ], - -[ "Epoc->canonpath('')", '' ], -[ "Epoc->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c' ], -[ "Epoc->canonpath('/./')", '/' ], -[ "Epoc->canonpath('/a/./')", '/a' ], - -# XXX Todo, copied from Unix, but fail. Should they? 2003-07-07 Tels -#[ "Epoc->canonpath('/a/.')", '/a' ], -#[ "Epoc->canonpath('/.')", '/' ], - -[ "Cygwin->case_tolerant()", '1' ], -[ "Cygwin->catfile('a','b','c')", 'a/b/c' ], -[ "Cygwin->catfile('a','b','./c')", 'a/b/c' ], -[ "Cygwin->catfile('./a','b','c')", 'a/b/c' ], -[ "Cygwin->catfile('c')", 'c' ], -[ "Cygwin->catfile('./c')", 'c' ], - -[ "Cygwin->splitpath('file')", ',,file' ], -[ "Cygwin->splitpath('/d1/d2/d3/')", ',/d1/d2/d3/,' ], -[ "Cygwin->splitpath('d1/d2/d3/')", ',d1/d2/d3/,' ], -[ "Cygwin->splitpath('/d1/d2/d3/.')", ',/d1/d2/d3/.,' ], -[ "Cygwin->splitpath('/d1/d2/d3/..')", ',/d1/d2/d3/..,' ], -[ "Cygwin->splitpath('/d1/d2/d3/.file')", ',/d1/d2/d3/,.file' ], -[ "Cygwin->splitpath('d1/d2/d3/file')", ',d1/d2/d3/,file' ], -[ "Cygwin->splitpath('/../../d1/')", ',/../../d1/,' ], -[ "Cygwin->splitpath('/././d1/')", ',/././d1/,' ], - -[ "Cygwin->catpath('','','file')", 'file' ], -[ "Cygwin->catpath('','/d1/d2/d3/','')", '/d1/d2/d3/' ], -[ "Cygwin->catpath('','d1/d2/d3/','')", 'd1/d2/d3/' ], -[ "Cygwin->catpath('','/d1/d2/d3/.','')", '/d1/d2/d3/.' ], -[ "Cygwin->catpath('','/d1/d2/d3/..','')", '/d1/d2/d3/..' ], -[ "Cygwin->catpath('','/d1/d2/d3/','.file')", '/d1/d2/d3/.file' ], -[ "Cygwin->catpath('','d1/d2/d3/','file')", 'd1/d2/d3/file' ], -[ "Cygwin->catpath('','/../../d1/','')", '/../../d1/' ], -[ "Cygwin->catpath('','/././d1/','')", '/././d1/' ], -[ "Cygwin->catpath('d1','d2/d3/','')", 'd2/d3/' ], -[ "Cygwin->catpath('d1','d2','d3/')", 'd2/d3/' ], - -[ "Cygwin->splitdir('')", '' ], -[ "Cygwin->splitdir('/d1/d2/d3/')", ',d1,d2,d3,' ], -[ "Cygwin->splitdir('d1/d2/d3/')", 'd1,d2,d3,' ], -[ "Cygwin->splitdir('/d1/d2/d3')", ',d1,d2,d3' ], -[ "Cygwin->splitdir('d1/d2/d3')", 'd1,d2,d3' ], - -[ "Cygwin->catdir()", '' ], -[ "Cygwin->catdir('/')", '/' ], -[ "Cygwin->catdir('','d1','d2','d3','')", '/d1/d2/d3' ], -[ "Cygwin->catdir('d1','d2','d3','')", 'd1/d2/d3' ], -[ "Cygwin->catdir('','d1','d2','d3')", '/d1/d2/d3' ], -[ "Cygwin->catdir('d1','d2','d3')", 'd1/d2/d3' ], -[ "Cygwin->catdir('/','d2/d3')", '/d2/d3' ], - -[ "Cygwin->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c' ], -[ "Cygwin->canonpath('')", '' ], -[ "Cygwin->canonpath('a/../../b/c')", 'a/../../b/c' ], -[ "Cygwin->canonpath('/.')", '/' ], -[ "Cygwin->canonpath('/./')", '/' ], -[ "Cygwin->canonpath('/a/./')", '/a' ], -[ "Cygwin->canonpath('/a/.')", '/a' ], -[ "Cygwin->canonpath('/../../')", '/' ], -[ "Cygwin->canonpath('/../..')", '/' ], - -[ "Cygwin->abs2rel('/t1/t2/t3','/t1/t2/t3')", '.' ], -[ "Cygwin->abs2rel('/t1/t2/t4','/t1/t2/t3')", '../t4' ], -[ "Cygwin->abs2rel('/t1/t2','/t1/t2/t3')", '..' ], -[ "Cygwin->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4' ], -[ "Cygwin->abs2rel('/t4/t5/t6','/t1/t2/t3')", '../../../t4/t5/t6' ], -#[ "Cygwin->abs2rel('../t4','/t1/t2/t3')", '../t4' ], -[ "Cygwin->abs2rel('/','/t1/t2/t3')", '../../..' ], -[ "Cygwin->abs2rel('///','/t1/t2/t3')", '../../..' ], -[ "Cygwin->abs2rel('/.','/t1/t2/t3')", '../../..' ], -[ "Cygwin->abs2rel('/./','/t1/t2/t3')", '../../..' ], -#[ "Cygwin->abs2rel('../t4','/t1/t2/t3')", '../t4' ], -[ "Cygwin->abs2rel('/t1/t2/t3', '/')", 't1/t2/t3' ], -[ "Cygwin->abs2rel('/t1/t2/t3', '/t1')", 't2/t3' ], -[ "Cygwin->abs2rel('t1/t2/t3', 't1')", 't2/t3' ], -[ "Cygwin->abs2rel('t1/t2/t3', 't4')", '../t1/t2/t3' ], - -[ "Cygwin->rel2abs('t4','/t1/t2/t3')", '/t1/t2/t3/t4' ], -[ "Cygwin->rel2abs('t4/t5','/t1/t2/t3')", '/t1/t2/t3/t4/t5' ], -[ "Cygwin->rel2abs('.','/t1/t2/t3')", '/t1/t2/t3' ], -[ "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' ], - -) ; - -my $test_count = scalar @tests; - -plan tests => scalar @tests; - -{ - package File::Spec::FakeWin32; - use vars qw(@ISA); - @ISA = qw(File::Spec::Win32); - - sub _cwd { 'C:\\one\\two' } - - # Some funky stuff to override Cwd::getdcwd() for testing purposes, - # in the limited scope of the rel2abs() method. - if ($Cwd::VERSION && $Cwd::VERSION gt '2.17') { # Avoid a 'used only once' warning - local $^W; - *rel2abs = sub { - my $self = shift; - local $^W; - local *Cwd::getdcwd = sub { - return 'D:\alpha\beta' if $_[0] eq 'D:'; - return 'C:\one\two' if $_[0] eq 'C:'; - return; - }; - *Cwd::getdcwd = *Cwd::getdcwd; # Avoid a 'used only once' warning - return $self->SUPER::rel2abs(@_); - }; - *rel2abs = *rel2abs; # Avoid a 'used only once' warning - } -} - - -# Test out the class methods -for ( @tests ) { - tryfunc( @$_ ) ; -} - - -# -# Tries a named function with the given args and compares the result against -# an expected result. Works with functions that return scalars or arrays. -# -sub tryfunc { - my $function = shift ; - my $expected = shift ; - my $platform = shift ; - - if ($platform && $^O ne $platform) { - skip("skip $function", 1); - return; - } - - $function =~ s#\\#\\\\#g ; - $function =~ s/^([^\$].*->)/File::Spec::$1/; - my $got = join ',', eval $function; - - if ( $@ ) { - if ( $@ =~ /^\Q$skip_exception/ ) { - skip "skip $function: $skip_exception", 1; - } - else { - ok $@, '', $function; - } - return; - } - - ok $got, $expected, $function; -} diff --git a/lib/File/Spec/t/crossplatform.t b/lib/File/Spec/t/crossplatform.t deleted file mode 100644 index b7c76fc1af..0000000000 --- a/lib/File/Spec/t/crossplatform.t +++ /dev/null @@ -1,173 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use File::Spec; -use lib File::Spec->catfile('t', 'lib'); -use Test::More; -local $|=1; - -my @platforms = qw(Cygwin Epoc Mac OS2 Unix VMS Win32); -my $tests_per_platform = 10; - -my $vms_unix_rpt = 0; -my $vms_efs = 0; -my $vms_unix_mode = 0; -my $vms_real_root = 0; - -if ($^O eq 'VMS') { - $vms_unix_mode = 0; - if (eval 'require VMS::Feature') { - $vms_unix_rpt = VMS::Feature::current("filename_unix_report"); - $vms_efs = VMS::Feature::current("efs_charset"); - } else { - my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; - my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || ''; - $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; - $vms_efs = $efs_charset =~ /^[ET1]/i; - } - - # Traditional VMS mode only if VMS is not in UNIX compatible mode. - $vms_unix_mode = ($vms_efs && $vms_unix_rpt); - - # If we are in UNIX mode, we may or may not have a real root. - if ($vms_unix_mode) { - my $rootdir = File::Spec->rootdir; - $vms_real_root = 1 if ($rootdir eq '/'); - } - -} - - -plan tests => 1 + @platforms * $tests_per_platform; - -my %volumes = ( - Mac => 'Macintosh HD', - OS2 => 'A:', - Win32 => 'A:', - VMS => 'v', - ); -my %other_vols = ( - Mac => 'Mounted Volume', - OS2 => 'B:', - Win32 => 'B:', - VMS => 'w', - ); - -ok 1, "Loaded"; - -foreach my $platform (@platforms) { - my $module = "File::Spec::$platform"; - - SKIP: - { - eval "require $module; 1"; - - skip "Can't load $module", $tests_per_platform - if $@; - - my $v = $volumes{$platform} || ''; - my $other_v = $other_vols{$platform} || ''; - - # Fake out the environment on MacOS and Win32 - no strict 'refs'; - my $save_w = $^W; - $^W = 0; - local *{"File::Spec::Mac::rootdir"} = sub { "Macintosh HD:" }; - local *{"File::Spec::Win32::_cwd"} = sub { "C:\\foo" }; - $^W = $save_w; - use strict 'refs'; - - - my ($file, $base, $result); - - $base = $module->catpath($v, $module->catdir('', 'foo'), ''); - $base = $module->catdir($module->rootdir, 'foo'); - - 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'); - $base = $module->catpath($v, $module->catdir($module->rootdir, 'foo'), ''); - $result = $module->catfile('bar', 'file'); - - if ($vms_unix_mode and $platform eq 'VMS') { - # test 56 special - # If VMS is in UNIX mode, so is the result, but having the volume - # parameter present forces the abs2rel into VMS mode. - $result = VMS::Filespec::vmsify($result); - $result =~ s/\.$//; - - # If we have a real root, then we are dealing with absolute directories - $result =~ s/\[\./\[/ if $vms_real_root; - } - - is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)"; - - - # abs2rel('A:/foo/bar', 'B:/foo') -> 'A:/foo/bar' - $base = $module->catpath($other_v, $module->catdir($module->rootdir, 'foo'), ''); - $result = volumes_differ($module, $file, $base) ? $file : $module->catfile('bar', 'file'); - is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)"; - - - # abs2rel('A:/foo/bar', '/foo') -> 'A:/foo/bar' - $base = $module->catpath('', $module->catdir($module->rootdir, 'foo'), ''); - $result = volumes_differ($module, $file, $base) ? $file : $module->catfile('bar', 'file'); - is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)"; - - - # abs2rel('/foo/bar/file', 'A:/foo') -> '/foo/bar' - $file = $module->catpath('', $module->catdir($module->rootdir, 'foo', 'bar'), 'file'); - $base = $module->catpath($v, $module->catdir($module->rootdir, 'foo'), ''); - $result = volumes_differ($module, $file, $base) ? $module->rel2abs($file) : $module->catfile('bar', 'file'); - - if ($vms_unix_mode and $platform eq 'VMS') { - # test 59 special - # If VMS is in UNIX mode, so is the result, but having the volume - # parameter present forces the abs2rel into VMS mode. - $result = VMS::Filespec::vmsify($result); - } - - is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)"; - - - # abs2rel('/foo/bar', 'B:/foo') -> '/foo/bar' - $base = $module->catpath($other_v, $module->catdir($module->rootdir, 'foo'), ''); - $result = volumes_differ($module, $file, $base) ? $module->rel2abs($file) : $module->catfile('bar', 'file'); - - if ($vms_unix_mode and $platform eq 'VMS') { - # test 60 special - # If VMS is in UNIX mode, so is the result, but having the volume - # parameter present forces the abs2rel into VMS mode. - $result = VMS::Filespec::vmsify($result); - } - - is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)"; - - - # abs2rel('/foo/bar', '/foo') -> 'bar' - $base = $module->catpath('', $module->catdir($module->rootdir, 'foo'), ''); - $result = $module->catfile('bar', 'file'); - - is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)"; - } -} - -sub volumes_differ { - my ($module, $one, $two) = @_; - my ($one_v) = $module->splitpath( $module->rel2abs($one) ); - my ($two_v) = $module->splitpath( $module->rel2abs($two) ); - return $one_v ne $two_v; -} diff --git a/lib/File/Spec/t/rel2abs2rel.t b/lib/File/Spec/t/rel2abs2rel.t deleted file mode 100644 index 0959d574b9..0000000000 --- a/lib/File/Spec/t/rel2abs2rel.t +++ /dev/null @@ -1,73 +0,0 @@ -#!/usr/bin/perl -w - -# Here we make sure File::Spec can properly deal with executables. -# VMS has some trouble with these. - -use File::Spec; -use lib File::Spec->catdir('t', 'lib'); - -use Test::More (-x $^X - ? (tests => 5) - : (skip_all => "Can't find an executable file") - ); - -BEGIN { # Set up a tiny script file - local *F; - open(F, ">rel2abs2rel$$.pl") - or die "Can't open rel2abs2rel$$.pl file for script -- $!\n"; - print F qq(print "ok\\n"\n); - close(F); -} -END { - 1 while unlink("rel2abs2rel$$.pl"); - 1 while unlink("rel2abs2rel$$.tmp"); -} - -use Config; - - -# Change 'perl' to './perl' so the shell doesn't go looking through PATH. -sub safe_rel { - my($perl) = shift; - $perl = File::Spec->catfile(File::Spec->curdir, $perl) unless - File::Spec->file_name_is_absolute($perl); - - return $perl; -} -# Make a putative perl binary say "ok\n". We have to do it this way -# because the filespec of the binary may contain characters that a -# command interpreter considers special, so we can't use the obvious -# `$perl -le "print 'ok'"`. And, for portability, we can't use fork(). -sub sayok{ - my $perl = shift; - open(STDOUTDUP, '>&STDOUT'); - open(STDOUT, ">rel2abs2rel$$.tmp") - or die "Can't open scratch file rel2abs2rel$$.tmp -- $!\n"; - system($perl, "rel2abs2rel$$.pl"); - open(STDOUT, '>&STDOUTDUP'); - close(STDOUTDUP); - - local *F; - open(F, "rel2abs2rel$$.tmp"); - local $/ = undef; - my $output = <F>; - close(F); - return $output; -} - -print "# Checking manipulations of \$^X=$^X\n"; - -my $perl = safe_rel($^X); -is( sayok($perl), "ok\n", "`$perl rel2abs2rel$$.pl` works" ); - -$perl = File::Spec->rel2abs($^X); -is( sayok($perl), "ok\n", "`$perl rel2abs2rel$$.pl` works" ); - -$perl = File::Spec->canonpath($perl); -is( sayok($perl), "ok\n", "canonpath(rel2abs($^X)) = $perl" ); - -$perl = safe_rel(File::Spec->abs2rel($perl)); -is( sayok($perl), "ok\n", "safe_rel(abs2rel(canonpath(rel2abs($^X)))) = $perl" ); - -$perl = safe_rel(File::Spec->canonpath($^X)); -is( sayok($perl), "ok\n", "safe_rel(canonpath($^X)) = $perl" ); diff --git a/lib/File/Spec/t/tmpdir.t b/lib/File/Spec/t/tmpdir.t deleted file mode 100644 index 6adad18cb9..0000000000 --- a/lib/File/Spec/t/tmpdir.t +++ /dev/null @@ -1,31 +0,0 @@ -use strict; -use Test; - -# Grab all of the plain routines from File::Spec -use File::Spec; -use File::Spec::Win32; - -plan tests => 4; - -ok 1, 1, "Loaded"; - -if ($^O eq 'VMS') { - # hack: - # Need to cause the %ENV to get populated or you only get the builtins at - # first, and then something else can cause the hash to get populated. - my %look_env = %ENV; -} -my $num_keys = keys %ENV; -File::Spec->tmpdir; -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 { - local %ENV; - File::Spec::Win32->tmpdir; - ok scalar keys %ENV, 0, "Win32->tmpdir() shouldn't change the contents of %ENV"; -} - -File::Spec::Win32->tmpdir; -ok scalar keys %ENV, $num_keys, "Win32->tmpdir() shouldn't change the contents of %ENV"; |