# $File::Find::dir (%Expect_Dir). Also use it in file operations like
# chdir, rmdir etc.
#
-# dir_path() concatenates directory names to form a _relative_
+# dir_path() concatenates directory names to form a *relative*
# directory path, independent from the platform it's run on, although
-# there are limitations. Don't try to create an absolute path,
+# there are limitations. Don't try to create an absolute path,
# because that may fail on operating systems that have the concept of
-# volume names (e.g. Mac OS). Be careful when you want to create an
-# updir path like ../fa (Unix) or ::fa: (Mac OS). Plain directory
-# names will work best. As a special case, you can pass it a "." as
-# first argument, to create a directory path like "./fa/dir" on
+# volume names (e.g. Mac OS). As a special case, you can pass it a "."
+# as first argument, to create a directory path like "./fa/dir" on
# operating systems other than Mac OS (actually, Mac OS will ignore
# the ".", if it's the first argument). If there's no second argument,
# this function will return the empty string on Mac OS and the string
# "./" otherwise.
sub dir_path {
- my $first_item = shift @_;
+ my $first_arg = shift @_;
- if ($first_item eq '.') {
+ if ($first_arg eq '.') {
if ($^O eq 'MacOS') {
return '' unless @_;
# ignore first argument; return a relative path
# with leading ":" and with trailing ":"
- return File::Spec->catdir("", @_);
+ return File::Spec->catdir(@_);
} else { # other OS
return './' unless @_;
my $path = File::Spec->catdir(@_);
return $path;
}
- } else { # $first_item ne '.'
- return $first_item unless @_; # return plain filename
- if ($^O eq 'MacOS') {
- # relative path with leading ":" and with trailing ":"
- return File::Spec->catdir("", $first_item, @_);
- } else { # other OS
- return File::Spec->catdir($first_item, @_);
- }
+ } else { # $first_arg ne '.'
+ return $first_arg unless @_; # return plain filename
+ return File::Spec->catdir($first_arg, @_); # relative path
}
}
# Use topdir() to specify a directory path that you want to pass to
-#find/finddepth Basically, topdir() does the same as dir_path() (see
-#above), except that there's no trailing ":" on Mac OS.
+# find/finddepth. Basically, topdir() does the same as dir_path() (see
+# above), except that there's no trailing ":" on Mac OS.
sub topdir {
my $path = dir_path(@_);
# Use file_path() to specify a file path that's expected for $_
-# (%Expect_File). Also suitable for file operations like unlink etc.
+# (%Expect_File). Also suitable for file operations like unlink etc.
#
# file_path() concatenates directory names (if any) and a filename to
-# form a _relative_ file path (the last argument is assumed to be a
+# form a *relative* file path (the last argument is assumed to be a
# file). It's independent from the platform it's run on, although
-# there are limitations (see the warnings for dir_path() above). As a
-# special case, you can pass it a "." as first argument, to create a
-# file path like "./fa/file" on operating systems other than Mac OS
-# (actually, Mac OS will ignore the ".", if it's the first
-# argument). If there's no second argument, this function will return
-# the empty string on Mac OS and the string "./" otherwise.
+# there are limitations. As a special case, you can pass it a "." as
+# first argument, to create a file path like "./fa/file" on operating
+# systems other than Mac OS (actually, Mac OS will ignore the ".", if
+# it's the first argument). If there's no second argument, this
+# function will return the empty string on Mac OS and the string "./"
+# otherwise.
sub file_path {
- my $first_item = shift @_;
+ my $first_arg = shift @_;
- if ($first_item eq '.') {
+ if ($first_arg eq '.') {
if ($^O eq 'MacOS') {
return '' unless @_;
# ignore first argument; return a relative path
# with leading ":", but without trailing ":"
- return File::Spec->catfile("", @_);
+ return File::Spec->catfile(@_);
} else { # other OS
return './' unless @_;
my $path = File::Spec->catfile(@_);
return $path;
}
- } else { # $first_item ne '.'
- return $first_item unless @_; # return plain filename
- if ($^O eq 'MacOS') {
- # relative path with leading ":", but without trailing ":"
- return File::Spec->catfile("", $first_item, @_);
- } else { # other OS
- return File::Spec->catfile($first_item, @_);
- }
+ } else { # $first_arg ne '.'
+ return $first_arg unless @_; # return plain filename
+ return File::Spec->catfile($first_arg, @_); # relative path
}
}
# $File::Find::dir (%Expect_Dir). Also use it in file operations like
# chdir, rmdir etc.
#
-# dir_path() concatenates directory names to form a _relative_
-# directory path, independant from the platform it's run on, although
-# there are limitations. Don't try to create an absolute path,
+# dir_path() concatenates directory names to form a *relative*
+# directory path, independent from the platform it's run on, although
+# there are limitations. Don't try to create an absolute path,
# because that may fail on operating systems that have the concept of
-# volume names (e.g. Mac OS). Be careful when you want to create an
-# updir path like ../fa (Unix) or ::fa: (Mac OS). Plain directory
-# names will work best. As a special case, you can pass it a "." as
-# first argument, to create a directory path like "./fa/dir" on
+# volume names (e.g. Mac OS). As a special case, you can pass it a "."
+# as first argument, to create a directory path like "./fa/dir" on
# operating systems other than Mac OS (actually, Mac OS will ignore
# the ".", if it's the first argument). If there's no second argument,
# this function will return the empty string on Mac OS and the string
# "./" otherwise.
sub dir_path {
- my $first_item = shift @_;
+ my $first_arg = shift @_;
- if ($first_item eq '.') {
+ if ($first_arg eq '.') {
if ($^O eq 'MacOS') {
return '' unless @_;
# ignore first argument; return a relative path
# with leading ":" and with trailing ":"
- return File::Spec->catdir("", @_);
+ return File::Spec->catdir(@_);
} else { # other OS
return './' unless @_;
my $path = File::Spec->catdir(@_);
return $path;
}
- } else { # $first_item ne '.'
- return $first_item unless @_; # return plain filename
- if ($^O eq 'MacOS') {
- # relative path with leading ":" and with trailing ":"
- return File::Spec->catdir("", $first_item, @_);
- } else { # other OS
- return File::Spec->catdir($first_item, @_);
- }
+ } else { # $first_arg ne '.'
+ return $first_arg unless @_; # return plain filename
+ return File::Spec->catdir($first_arg, @_); # relative path
}
}
# Use topdir() to specify a directory path that you want to pass to
-#find/finddepth Basically, topdir() does the same as dir_path() (see
-#above), except that there's no trailing ":" on Mac OS.
+# find/finddepth. Basically, topdir() does the same as dir_path() (see
+# above), except that there's no trailing ":" on Mac OS.
sub topdir {
my $path = dir_path(@_);
}
-# Use file_path() to specify a file path that's expected for $_ (%Expect_File).
-# Also suitable for file operations like unlink etc.
-
+# Use file_path() to specify a file path that's expected for $_
+# (%Expect_File). Also suitable for file operations like unlink etc.
+#
# file_path() concatenates directory names (if any) and a filename to
-# form a _relative_ file path (the last argument is assumed to be a
-# file). It's independant from the platform it's run on, although
-# there are limitations (see the warnings for dir_path() above). As a
-# special case, you can pass it a "." as first argument, to create a
-# file path like "./fa/file" on operating systems other than Mac OS
-# (actually, Mac OS will ignore the ".", if it's the first
-# argument). If there's no second argument, this function will return
-# the empty string on Mac OS and the string "./" otherwise.
+# form a *relative* file path (the last argument is assumed to be a
+# file). It's independent from the platform it's run on, although
+# there are limitations. As a special case, you can pass it a "." as
+# first argument, to create a file path like "./fa/file" on operating
+# systems other than Mac OS (actually, Mac OS will ignore the ".", if
+# it's the first argument). If there's no second argument, this
+# function will return the empty string on Mac OS and the string "./"
+# otherwise.
sub file_path {
- my $first_item = shift @_;
+ my $first_arg = shift @_;
- if ($first_item eq '.') {
+ if ($first_arg eq '.') {
if ($^O eq 'MacOS') {
return '' unless @_;
# ignore first argument; return a relative path
# with leading ":", but without trailing ":"
- return File::Spec->catfile("", @_);
+ return File::Spec->catfile(@_);
} else { # other OS
return './' unless @_;
my $path = File::Spec->catfile(@_);
return $path;
}
- } else { # $first_item ne '.'
- return $first_item unless @_; # return plain filename
- if ($^O eq 'MacOS') {
- # relative path with leading ":", but without trailing ":"
- return File::Spec->catfile("", $first_item, @_);
- } else { # other OS
- return File::Spec->catfile($first_item, @_);
- }
+ } else { # $first_arg ne '.'
+ return $first_arg unless @_; # return plain filename
+ return File::Spec->catfile($first_arg, @_); # relative path
}
}
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 called directly,
+Since File::Spec is object oriented, subroutines should not be called directly,
as in:
File::Spec::catfile('a','b');
$is_absolute = File::Spec->file_name_is_absolute( $path );
-This does not consult the local filesystem on Unix, Win32, or OS/2. It
-does sometimes on MacOS (see L<File::Spec::MacOS/file_name_is_absolute>).
-It does consult the working environment for VMS (see
-L<File::Spec::VMS/file_name_is_absolute>).
+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
Unlike just splitting the directories on the separator, empty
directory names (C<''>) can be returned, because these are significant
-on some OSs (e.g. MacOS).
+on some OSs.
=item catpath()
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 most systems. On MacOS,
-the filesystem may be consulted (see
-L<File::Spec::MacOS/file_name_is_absolute>). On VMS, there is
+No checks against the filesystem are made. On VMS, there is
interaction with the working environment, as logicals and
macros are expanded.
If $path is absolute, it is cleaned up and returned using L</canonpath()>.
-No checks against the filesystem are made on most systems. On MacOS,
-the filesystem may be consulted (see
-L<File::Spec::MacOS/file_name_is_absolute>). On VMS, there is
+No checks against the filesystem are made. On VMS, there is
interaction with the working environment, as logicals and
macros are expanded.
Kenneth Albanowski <kjahds@kjahds.com>, Andy Dougherty
<doughera@lafcol.lafayette.edu>, Andreas KE<ouml>nig
-<A.Koenig@franz.ww.TU-Berlin.DE>, Tim Bunce <Tim.Bunce@ig.co.uk. VMS
-support by Charles Bailey <bailey@newman.upenn.edu>. OS/2 support by
-Ilya Zakharevich <ilya@math.ohio-state.edu>. Mac support by Paul Schinder
-<schinder@pobox.com>. abs2rel() and rel2abs() written by
-Shigio Yamaguchi <shigio@tamacom.com>, modified by Barrie Slaymaker
-<barries@slaysys.com>. splitpath(), splitdir(), catpath() and catdir()
-by Barrie Slaymaker.
+<A.Koenig@franz.ww.TU-Berlin.DE>, Tim Bunce <Tim.Bunce@ig.co.uk.
+VMS support by Charles Bailey <bailey@newman.upenn.edu>.
+OS/2 support by Ilya Zakharevich <ilya@math.ohio-state.edu>.
+Mac support by Paul Schinder <schinder@pobox.com>, and Thomas Wegner
+<wegner_thomas@yahoo.com>. abs2rel() and rel2abs() written by Shigio
+Yamaguchi <shigio@tamacom.com>, modified by Barrie Slaymaker
+<barries@slaysys.com>. splitpath(), splitdir(), catpath() and
+catdir() by Barrie Slaymaker.
#!./perl
BEGIN {
- $^O = '';
chdir 't' if -d 't';
@INC = '../lib';
}
+# Grab all of the plain routines from File::Spec
+use File::Spec @File::Spec::EXPORT_OK ;
+
+require File::Spec::Unix ;
+require File::Spec::Win32 ;
+
+eval {
+ require VMS::Filespec ;
+} ;
+
+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 ;
+
+# $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
+# [ Function , Expected , Platform ]
+
[ "Unix->catfile('a','b','c')", 'a/b/c' ],
[ "Unix->splitpath('file')", ',,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' ],
-
-[ "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('')", ':' ],
-[ "Mac->catdir(':')", ':' ],
-
-[ "Mac->catdir('', '')", '::' ], # Hmm... ":" ?
-[ "Mac->catdir('', ':')", '::' ], # Hmm... ":" ?
-[ "Mac->catdir(':', ':')", '::' ], # Hmm... ":" ?
-[ "Mac->catdir(':', '')", '::' ], # Hmm... ":" ?
-
-[ "Mac->catdir('', '::')", '::' ],
-[ "Mac->catdir(':', '::')", '::' ], # but catdir('::', ':') is ':::'
-
-[ "Mac->catdir('::', '')", ':::' ], # Hmm... "::" ?
-[ "Mac->catdir('::', ':')", ':::' ], # Hmm... "::" ?
+[ "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('::', '::')", ':::' ], # ok
-
-#
-# Unix counterparts:
-#
-
-# Unix catdir('.') = "."
-
-# Unix catdir('','') = "/"
-# Unix catdir('','.') = "/"
-# Unix catdir('.','.') = "."
-# Unix catdir('.','') = "."
-
-# Unix catdir('','..') = "/"
-# Unix catdir('.','..') = ".."
-
-# Unix catdir('..','') = ".."
-# Unix catdir('..','.') = ".."
-# Unix catdir('..','..') = "../.."
-
-[ "Mac->catdir(':d1','d2')", ':d1:d2:' ],
-[ "Mac->catdir('','d1','d2','d3')", ':d1:d2:d3:' ],
-[ "Mac->catdir('','','d2','d3')", '::d2:d3:' ],
-[ "Mac->catdir('','','','d3')", ':::d3:' ],
-[ "Mac->catdir(':d1')", ':d1:' ],
-[ "Mac->catdir(':d1',':d2')", ':d1:d2:' ],
-[ "Mac->catdir('', ':d1',':d2')", ':d1:d2:' ],
-[ "Mac->catdir('','',':d1',':d2')", '::d1:d2:' ],
-
-[ "Mac->catdir('hd')", 'hd:' ],
-[ "Mac->catdir('hd','d1','d2')", 'hd:d1:d2:' ],
-[ "Mac->catdir('hd','d1/','d2')", 'hd:d1/:d2:' ],
-[ "Mac->catdir('hd','',':d1')", 'hd::d1:' ],
-[ "Mac->catdir('hd','d1')", 'hd:d1:' ],
-[ "Mac->catdir('hd','d1', '')", 'hd:d1::' ],
-[ "Mac->catdir('hd','d1','','')", 'hd:d1:::' ],
[ "Mac->catdir('hd:',':d1')", 'hd:d1:' ],
[ "Mac->catdir('hd:d1:',':d2')", 'hd:d1:d2:' ],
[ "Mac->catdir('hd:','d1')", 'hd:d1:' ],
-[ "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()", '' ],
-[ "Mac->catfile('')", '' ],
-[ "Mac->catfile(':')", ':' ],
-[ "Mac->catfile(':', '')", ':' ],
-
-[ "Mac->catfile('hd','d1','file')", 'hd:d1:file' ],
-[ "Mac->catfile('hd','d1',':file')", 'hd:d1:file' ],
+[ "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->catfile('', 'file')", ':file' ],
-
-
+
[ "Mac->canonpath('')", '' ],
[ "Mac->canonpath(':')", ':' ],
[ "Mac->canonpath('::')", '::' ],
[ "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('v1:d3:d4:d5:','v2:d1:d2:')", ':::d3:d4:d5:' ], # ignore base's volume
+[ "Mac->abs2rel('hd1:d3:d4:d5:','hd2:d1:d2:')", ':::d3:d4:d5:' ], # ignore base's volume
[ "Mac->abs2rel('hd:','hd:d1:d2:')", ':::' ],
[ "Mac->rel2abs(':d3:','hd:d1:d2:')", 'hd:d1:d2:d3:' ],
[ "Mac->rel2abs('hd:d3:','hd:d1:file')", 'hd:d3:' ],
) ;
-# Grab all of the plain routines from File::Spec
-use File::Spec @File::Spec::EXPORT_OK ;
-
-require File::Spec::Unix ;
-require File::Spec::Win32 ;
-
-eval {
- require VMS::Filespec ;
-} ;
-
-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 ;
print "1..", scalar( @tests ), "\n" ;
}
-
#
# Tries a named function with the given args and compares the result against
# an expected result. Works with functions that return scalars or arrays.
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '1.2';
+$VERSION = '1.3';
@ISA = qw(File::Spec::Unix);
=head1 NAME
-File::Spec::Mac - File::Spec for MacOS
+File::Spec::Mac - File::Spec for Mac OS (Classic)
=head1 SYNOPSIS
=item canonpath
-On MacOS, there's nothing to be done. Returns what it's given.
+On Mac OS, there's nothing to be done. Returns what it's given.
=cut
=item catdir()
Concatenate two or more directory names to form a path separated by colons
-(":") ending with a directory. 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.
+(":") 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 descision 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
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 ":").
-Here are the rules that are used: Each argument has its trailing ":" removed.
-Each argument, except the first, has its leading ":" removed. They are then
-joined together by a ":" and a trailing ":" is added to the path.
-
So, beside calls like
- File::Spec->catdir("a") = "a:"
- File::Spec->catdir("a","b") = "a:b:"
- File::Spec->catdir("","a","b") = ":a:b:"
- File::Spec->catdir("a","","b") = "a::b:"
- File::Spec->catdir("") = ":"
- File::Spec->catdir("a","b","") = "a:b::" (!)
- File::Spec->catdir() = "" (special case)
+ catdir("a") = ":a:"
+ catdir("a","b") = ":a:b:"
+ catdir() = "" (special case)
calls like the following
- File::Spec->catdir("a:",":b") = "a:b:"
- File::Spec->catdir("a:b:",":c") = "a:b:c:"
- File::Spec->catdir("a:","b") = "a:b:"
- File::Spec->catdir("a",":b") = "a:b:"
- File::Spec->catdir(":a","b") = ":a:b:"
- File::Spec->catdir("","",":a",":b") = "::a:b:"
- File::Spec->catdir("",":a",":b") = ":a:b:" (!)
- File::Spec->catdir(":") = ":"
+ catdir(":a:") = ":a:"
+ catdir(":a","b") = ":a:b:"
+ catdir(":a:","b") = ":a:b:"
+ catdir(":a:",":b:") = ":a:b:"
+ catdir(":") = ":"
are allowed.
-To get a path beginning with a ":" (a relative path), put a "" as the first
-argument. Beginning the first argument with a ":" (e.g. ":a") will also work
-(see the examples).
+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).
+
-Since Mac OS (Classic) uses the concept of volumes, there is an ambiguity:
-Does the first argument in
+=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.
- File::Spec->catdir("LWP","Protocol");
+ catdir(":::a","::b","c") = ":::a::b:c:"
+ catdir(":::a::","::b","c") = ":::a:::b:c:"
-denote a volume or a directory, i.e. should the path be relative or absolute?
-There is no way of telling except by checking for the existence of "LWP:" (a
-volume) or ":LWP" (a directory), but those checks aren't made here. Thus, according
-to the above rules, the path "LWP:Protocol:" will be returned, which, considered
-alone, is an absolute path, although the volume "LWP:" may not exist. Hence, don't
-forget to put a ":" in the appropriate place in the path if you want to
-distinguish unambiguously. (Remember that a valid relative path should always begin
-with a ":", unless you are specifying a file or a directory that resides in the
-I<current> directory. In that case, the leading ":" is not mandatory.)
-With version 1.2 of File::Spec, there's a new method called C<catpath>, that
-takes volume, directory and file portions and returns an entire path (see below).
-While C<catdir> is still suitable for the concatenation of I<directory names>,
-you should consider using C<catpath> to concatenate I<volume names> and
-I<directory paths>, because it avoids any ambiguities. E.g.
+=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.
- $dir = File::Spec->catdir("LWP","Protocol");
- $abs_path = File::Spec->catpath("MacintoshHD:", $dir, "");
+ 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 passing
+C<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:LWP:Protocol:" .
+ "MacintoshHD:tmp:sources:" .
=cut
sub catdir {
- my $self = shift;
- return '' unless @_;
+ my $self = shift;
+ return '' unless @_;
my @args = @_;
- my $result = shift @args;
- # To match the actual end of the string,
- # not ignoring newline, you can use \Z(?!\n).
- $result =~ s/:\Z(?!\n)//;
- foreach (@args) {
- s/:\Z(?!\n)//;
- s/^://s;
- $result .= ":$_";
+ 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
}
- return "$result:";
+
+ 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. Since this uses catdir, the
-same caveats apply. Note that the leading ":" is removed from the
-filename, so that
+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
+descision 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"
- File::Spec->catfile("a", "b", "file"); # = "a:b:file"
+This means that C<catdir()> is called only when there are two or more
+arguments, as one might expect.
-and
+Note that the leading ":" is removed from the filename, so that
- File::Spec->catfile("a", "b", ":file"); # = "a:b:file"
+ catfile("a","b","file") = ":a:b:file" and
-give the same answer, as one might expect. To concatenate I<volume names>,
-I<directory paths> and I<filenames>, you should consider using C<catpath>
-(see below).
+ 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 rootdir {
#
-# There's no real root directory on MacOS. The name of the startup
+# There's no real root directory on Mac OS. The name of the startup
# volume is returned, since that's the closest in concept.
#
require Mac::Files;
=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. If
-the path has a leading ":", it's a relative path. Otherwise, it's an
+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.
+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.
=item path
Returns the null list for the MacPerl application, since the concept is
-usually meaningless under MacOS. But if you're using the MacPerl tool under
+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.
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 portions are returned as empty string ''.
-The results can be passed to L</catpath()> to get back a path equivalent to
+The results can be passed to C<catpath()> to get back a path equivalent to
(usually identical to) the original path.
=item splitdir
-The opposite of L</catdir()>.
+The opposite of C<catdir()>.
@dirs = File::Spec->splitdir( $directories );
-$directories must be only the directory portion of the path on systems
+$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.
+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
yield:
- ( "", "a", "b", "", "c")
+ ( "a", "b", "::", "c")
while
yields:
- ( "", "a", "b", "", "c", "")
+ ( "a", "b", "::", "c", "::")
=cut
sub splitdir {
- my ($self,$directories) = @_ ;
-
- if ($directories =~ /^:*\Z(?!\n)/) {
- # dir is an empty string or a colon path like ':', i.e. the
- # current dir, or '::', the parent dir, etc. We return that
- # dir (as is done on Unix).
- return $directories;
- }
-
- # remove a trailing colon, if any (this way, splitdir is the
- # opposite of catdir, which automatically appends a ':')
- $directories =~ s/:\Z(?!\n)//;
-
- #
- # 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 ;
- }
+ my ($self, $path) = @_;
+ my @result = ();
+ my ($head, $sep, $tail, $volume, $directories);
+
+ return ('') 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;
}
shift @pathchunks ;
shift @basechunks ;
}
-
+
# @pathchunks now has the directories to descend in to.
- $path_dirs = $self->catdir( @pathchunks );
+ if ( (@pathchunks) && ($pathchunks[0] ne '') ) {
+ $path_dirs = $self->catdir( @pathchunks );
+ } else {
+ $path_dirs = '';
+ }
# @basechunks now contains the number of directories to climb out of.
$base_dirs = (':' x @basechunks) . ':' ;
- return $self->catpath( '', $base_dirs . $path_dirs, $path_file ) ;
+ return $self->catpath( '', $self->catdir( $base_dirs, $path_dirs ), $path_file ) ;
}
=item rel2abs
=head1 AUTHORS
-See the authors list in L<File::Spec>. Mac OS support by Paul Schinder
+See the authors list in I<File::Spec>. Mac OS support by Paul Schinder
<schinder@pobox.com> and Thomas Wegner <wegner_thomas@yahoo.com>.
Takes as argument a path and returns true if it is an absolute path.
-This does not consult the local filesystem on Unix, Win32, or OS/2. It
-does sometimes on MacOS (see L<File::Spec::MacOS/file_name_is_absolute>).
-It does consult the working environment for VMS (see
+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
Unlike just splitting the directories on the separator, empty
directory names (C<''>) can be returned, because these are significant
-on some OSs (e.g. MacOS).
+on some OSs.
On Unix,
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 most systems. On MacOS,
-the filesystem may be consulted (see
-L<File::Spec::MacOS/file_name_is_absolute>). On VMS, there is
+No checks against the filesystem are made. On VMS, there is
interaction with the working environment, as logicals and
macros are expanded.
If $path is absolute, it is cleaned up and returned using L</canonpath()>.
-No checks against the filesystem are made on most systems. On MacOS,
-the filesystem may be consulted (see
-L<File::Spec::MacOS/file_name_is_absolute>). On VMS, there is
+No checks against the filesystem are made. On VMS, there is
interaction with the working environment, as logicals and
macros are expanded.
projects / p5sagit/p5-mst-13.2.git / commitdiff