use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '1.2';
+$VERSION = '1.4';
@ISA = qw(File::Spec::Unix);
use Cwd;
+my $macfiles;
+if ($^O eq 'MacOS') {
+ $macfiles = eval { require Mac::Files };
+}
+
+sub case_tolerant { 1 }
+
=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
return $path;
}
-=item catdir
+=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:
-Since Mac OS (Classic) uses the concept of volumes, there is an ambiguity:
-Does the first argument in
+=over 2
- File::Spec->catdir("LWP","Protocol");
+=item 1.
-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.)
+The resulting path is relative by default, i.e. the resulting path will have a
+leading colon.
-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 2.
- $dir = File::Spec->catdir("LWP","Protocol");
- $abs_path = File::Spec->catpath("MacintoshHD:", $dir, "");
+A trailing colon is added automatically to the resulting path, to denote a
+directory.
-yields
+=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.
- "MacintoshHD:LWP:Protocol:" .
+=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 $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 .= ":$_";
- }
- return "$result:";
+ 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. 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
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 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;
- my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
- &Mac::Files::kSystemFolderType);
+ 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.
+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 = $ENV{TMPDIR} if -d $ENV{TMPDIR};
- unless (defined($tmpdir)) {
- $tmpdir = cwd();
- }
- return $tmpdir;
+ my $self = shift;
+ $tmpdir = $self->_tmpdir( $ENV{TMPDIR} );
}
=item 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.
=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.
($volume,$directories,$file) = File::Spec->splitpath( $path );
($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
-Splits a path in to volume, directory, and filename portions.
+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 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;
}
# 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] ) ) {
}
# @pathchunks now has the directories to descend in to.
- $path_dirs = $self->catdir( @pathchunks );
+ # 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( '', $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>.
projects / p5sagit/p5-mst-13.2.git / blobdiff