From: Jarkko Hietaniemi Date: Mon, 15 Oct 2001 12:58:24 +0000 (+0000) Subject: MacOS Classic catdir() rewrite from Thomas Wegner X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2586ba89304e7acdb4f9d621c694129dc14f6c8f;p=p5sagit%2Fp5-mst-13.2.git MacOS Classic catdir() rewrite from Thomas Wegner (backward incompatibility, but a deliberate one, the old version simply is broken in its logic), also documentation updates, and as suggested replicated the File::Spec::Unix documentation updates also on the File::Spec documentation. TODO: there seems to be duplication of documentation between File::Spec and File::Spec::Unix. I think the ::Unix should be left only with specific UNIXisms, and all the generic documentation should be in ::Spec. p4raw-id: //depot/perl@12440 --- diff --git a/lib/File/Find/t/find.t b/lib/File/Find/t/find.t index 5ec3dd7..682d233 100644 --- a/lib/File/Find/t/find.t +++ b/lib/File/Find/t/find.t @@ -171,28 +171,26 @@ sub my_postprocess { # $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(@_); @@ -201,21 +199,16 @@ sub dir_path { 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(@_); @@ -225,27 +218,27 @@ sub topdir { # 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(@_); @@ -254,14 +247,9 @@ sub file_path { 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 } } diff --git a/lib/File/Find/t/taint.t b/lib/File/Find/t/taint.t index 0915049..7643040 100644 --- a/lib/File/Find/t/taint.t +++ b/lib/File/Find/t/taint.t @@ -127,28 +127,26 @@ sub simple_wanted { # $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(@_); @@ -157,21 +155,16 @@ sub dir_path { 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(@_); @@ -180,28 +173,28 @@ sub topdir { } -# 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(@_); @@ -210,14 +203,9 @@ sub file_path { 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 } } diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm index e0a7391..0f90a45 100644 --- a/lib/File/Spec.pm +++ b/lib/File/Spec.pm @@ -59,7 +59,7 @@ 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 called directly, +Since File::Spec is object oriented, subroutines should not be called directly, as in: File::Spec::catfile('a','b'); @@ -153,10 +153,9 @@ Takes as 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, or OS/2. It -does sometimes on MacOS (see L). -It does consult the working environment for VMS (see -L). +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). =item path @@ -198,7 +197,7 @@ 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 (e.g. MacOS). +on some OSs. =item catpath() @@ -230,9 +229,7 @@ directories. If $path is relative, it is converted to absolute form using L. This means that it is taken to be relative to L. -No checks against the filesystem are made on most systems. On MacOS, -the filesystem may be consulted (see -L). 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. @@ -258,9 +255,7 @@ directories. If $path is absolute, it is cleaned up and returned using L. -No checks against the filesystem are made on most systems. On MacOS, -the filesystem may be consulted (see -L). 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. @@ -282,10 +277,11 @@ L Kenneth Albanowski , Andy Dougherty , Andreas KEnig -, Tim Bunce . OS/2 support by -Ilya Zakharevich . Mac support by Paul Schinder -. abs2rel() and rel2abs() written by -Shigio Yamaguchi , modified by Barrie Slaymaker -. splitpath(), splitdir(), catpath() and catdir() -by Barrie Slaymaker. +, Tim Bunce . +OS/2 support by Ilya Zakharevich . +Mac support by Paul Schinder , and Thomas Wegner +. abs2rel() and rel2abs() written by Shigio +Yamaguchi , modified by Barrie Slaymaker +. splitpath(), splitdir(), catpath() and +catdir() by Barrie Slaymaker. diff --git a/lib/File/Spec.t b/lib/File/Spec.t index 698ea01..9baa5a6 100755 --- a/lib/File/Spec.t +++ b/lib/File/Spec.t @@ -1,17 +1,52 @@ #!./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' ], @@ -313,93 +348,99 @@ BEGIN { [ "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('::')", '::' ], @@ -419,7 +460,7 @@ BEGIN { [ "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:' ], @@ -435,34 +476,6 @@ BEGIN { [ "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" ; @@ -474,7 +487,6 @@ for ( @tests ) { } - # # Tries a named function with the given args and compares the result against # an expected result. Works with functions that return scalars or arrays. diff --git a/lib/File/Spec/Mac.pm b/lib/File/Spec/Mac.pm index ebddd71..bba21ee 100644 --- a/lib/File/Spec/Mac.pm +++ b/lib/File/Spec/Mac.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '1.2'; +$VERSION = '1.3'; @ISA = qw(File::Spec::Unix); @@ -12,7 +12,7 @@ use Cwd; =head1 NAME -File::Spec::Mac - File::Spec for MacOS +File::Spec::Mac - File::Spec for Mac OS (Classic) =head1 SYNOPSIS @@ -28,7 +28,7 @@ Methods for manipulating file specifications. =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 @@ -40,9 +40,17 @@ sub canonpath { =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 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 Beginning with version 1.3 of this module, the resulting +path is relative by default and I absolute. This descision was made due +to portability reasons. Since Ccatdir()> 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. But because of the nature of Macintosh paths, some additional possibilities @@ -51,100 +59,237 @@ common situations. In other words, you are also allowed to concatenate I 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; 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 directory. In that case, the leading ":" is not mandatory.) -With version 1.2 of File::Spec, there's a new method called C, that -takes volume, directory and file portions and returns an entire path (see below). -While C is still suitable for the concatenation of I, -you should consider using C to concatenate I and -I, because it avoids any ambiguities. E.g. +=item 5. +Adding a colon ":" or empty string "" to a path at I 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 Ccanonpath()> ). 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. + +=item 7. +Passing an empty string "" as the first argument to C is like passing +Crootdir()> as the first argument, i.e. + + catdir("","a","b") is the same as + + catdir(rootdir(),"a","b"). + +This is true on Unix, where C yields "/a/b" and C is +"/". Note that C 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 +Ccanonpath()> ). 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 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 (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 is still suitable for the concatenation of I, you are +encouraged to use C to concatenate I and I. 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 +by default, but can be forced to be absolute (but avoid this). + +B Beginning with version 1.3 of this module, the +resulting path is relative by default and I absolute. This +descision was made due to portability reasons. Since +Ccatfile()> 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 uses C (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 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, -I and I, you should consider using C -(see below). + catfile("a","b",":file") = ":a:b:file" + +give the same answer. + +To concatenate I, I and I, +you are encouraged to use C (see below). =cut @@ -190,7 +335,7 @@ name on Mac OS. 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; @@ -231,13 +376,13 @@ sub updir { =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. @@ -263,7 +408,7 @@ sub file_name_is_absolute { =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. @@ -291,9 +436,9 @@ $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 a leading ":". -Empty portions are returned as "". +Empty portions are returned as empty string ''. -The results can be passed to L to get back a path equivalent to +The results can be passed to C to get back a path equivalent to (usually identical to) the original path. @@ -334,13 +479,13 @@ sub splitpath { =item splitdir -The opposite of L. +The opposite of C. @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 otherwise. Unlike just splitting the directories on the separator, empty directory names (C<"">) can be returned. Since C on Mac OS always appends a trailing @@ -354,7 +499,7 @@ Hence, on Mac OS, both yield: - ( "", "a", "b", "", "c") + ( "a", "b", "::", "c") while @@ -362,42 +507,44 @@ 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; } @@ -521,14 +668,18 @@ sub abs2rel { 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 @@ -591,7 +742,7 @@ sub rel2abs { =head1 AUTHORS -See the authors list in L. Mac OS support by Paul Schinder +See the authors list in I. Mac OS support by Paul Schinder and Thomas Wegner . diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm index 01d5f48..fcbe767 100644 --- a/lib/File/Spec/Unix.pm +++ b/lib/File/Spec/Unix.pm @@ -175,9 +175,8 @@ sub case_tolerant { 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). -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). =cut @@ -260,7 +259,7 @@ 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 (e.g. MacOS). +on some OSs. On Unix, @@ -341,9 +340,7 @@ directories. If $path is relative, it is converted to absolute form using L. This means that it is taken to be relative to L. -No checks against the filesystem are made on most systems. On MacOS, -the filesystem may be consulted (see -L). 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. @@ -421,9 +418,7 @@ directories. If $path is absolute, it is cleaned up and returned using L. -No checks against the filesystem are made on most systems. On MacOS, -the filesystem may be consulted (see -L). 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.