Upgrade to File::Spec 0.85.
[p5sagit/p5-mst-13.2.git] / lib / File / Spec / Mac.pm
index bba21ee..513e837 100644 (file)
@@ -4,11 +4,18 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '1.3';
+$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
 
@@ -41,15 +48,15 @@ sub canonpath {
 
 Concatenate two or more directory names to form a path separated by colons
 (":") ending with a directory. Resulting paths are B<relative> by default,
-but can be forced to be absolute (but avoid this, see below). Automatically 
-puts a trailing ":" on the end of the complete path, because that's what's 
-done in MacPerl's environment and helps to distinguish a file path from a 
+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 
+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>.
@@ -75,71 +82,76 @@ calls like the following
 
 are allowed.
 
-Here are the rules that are used in C<catdir()>; note that we try to be as 
-compatible as possible to Unix: 
+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.
 
+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.
 
+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).
 
+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.
+
+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.
+
+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>. 
+
+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.
+
+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"). 
+    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.
+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:
+
+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("","")                 =  "/"
@@ -152,20 +164,24 @@ immediately followed by updirs. This is invalid, because this would go beyond
     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. 
+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.
+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,"");
@@ -174,32 +190,31 @@ yields
 
     "MacintoshHD:tmp:sources:" .
 
-
 =cut
 
 sub catdir {
-    my $self = shift;  
-       return '' unless @_;    
-    my @args = @_;
-    my $first_arg;     
-       my $relative;   
-       
+       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)/ ) { 
+               if ( $args[0] =~ /^::+\Z(?!\n)/ ) {
                        # updir colon path ('::', ':::' etc.), don't shift
                        $first_arg = ':';
                } elsif ($args[0] eq ':') {
@@ -208,16 +223,16 @@ sub catdir {
                        # add a trailing ':' if need be
                        $first_arg = shift @args;
                        $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
-               } 
-       }       
-               
-       # For all other arguments,    
+               }
+       }
+
+       # 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;
@@ -225,51 +240,51 @@ sub catdir {
                        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; 
+                                       $arg = shift @args;
                                        $updir_count += (length($arg) - 1);
                                }
-                               $arg = (':' x $updir_count); 
+                               $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 !~ /^:/) ) {   
+       }
+
+       if ( ($relative) && ($result !~ /^:/) ) {
                # add a leading colon if need be
                $result = ":$result";
        }
-       
-       unless ($relative) { 
+
+       unless ($relative) {
                # remove updirs immediately following the volume name
                $result =~ s/([^:]+:)(:*)(.*)\Z(?!\n)/$1$3/;
        }
-       
-    return $result;
+
+       return $result;
 }
 
 =item catfile
 
 Concatenate one or more directory names and a filename to form a
-complete path ending with a filename. Resulting paths are B<relative> 
-by default, but can be forced to be absolute (but avoid this). 
-
-B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the 
-resulting path is relative by default and I<not> absolute. This 
-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. 
+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  
+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"    
+    catfile("file") = "file"
 
 but
 
@@ -277,7 +292,7 @@ but
     catfile("","file")    = rootdir() . file  # (e.g. "HD:file")
     catfile("HD:","file") = "HD:file"
 
-This means that C<catdir()> is called only when there are two or more 
+This means that C<catdir()> is called only when there are two or more
 arguments, as one might expect.
 
 Note that the leading ":" is removed from the filename, so that
@@ -286,9 +301,9 @@ Note that the leading ":" is removed from the filename, so that
 
     catfile("a","b",":file") = ":a:b:file"
 
-give the same answer. 
+give the same answer.
 
-To concatenate I<volume names>, I<directory paths> and I<filenames>, 
+To concatenate I<volume names>, I<directory paths> and I<filenames>,
 you are encouraged to use C<catpath()> (see below).
 
 =cut
@@ -331,6 +346,8 @@ concept, although other volumes aren't rooted there. The name has a
 trailing ":", because that's the correct specification for a volume
 name on Mac OS.
 
+If Mac::Files could not be loaded, the empty string is returned.
+
 =cut
 
 sub rootdir {
@@ -338,29 +355,27 @@ sub rootdir {
 #  There's no real root directory on Mac OS. The name of the startup
 #  volume is returned, since that's the closest in concept.
 #
-    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
@@ -381,8 +396,8 @@ absolute path, unless the path doesn't contain any colons, i.e. it's a name
 like "a". In this particular case, the path is considered to be relative
 (i.e. it is considered to be a filename). Use ":" in the appropriate place
 in the path if you want to distinguish unambiguously. As a special case,
-the filename '' is always considered to be absolute. Note that with version 
-1.2 of File::Spec::Mac, this does no longer consult the local filesystem. 
+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.
 
@@ -428,7 +443,7 @@ sub path {
     ($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.
@@ -513,10 +528,10 @@ yields:
 =cut
 
 sub splitdir {
-    my ($self, $path) = @_;
+       my ($self, $path) = @_;
        my @result = ();
        my ($head, $sep, $tail, $volume, $directories);
-    
+
        return ('') if ( (!defined($path)) || ($path eq '') );
        return (':') if ($path eq ':');
 
@@ -527,14 +542,14 @@ sub splitdir {
                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, '::'); 
+                               push (@result, '::');
                        }
                }
                $sep = '';
@@ -543,12 +558,12 @@ sub splitdir {
                        push (@result, $head);
                        $directories = $tail;
                }
-       }       
+       }
        return @result;
 }
 
 
-=item catpath()
+=item catpath
 
     $path = File::Spec->catpath($volume,$directory,$file);
 
@@ -661,20 +676,17 @@ sub abs2rel {
     # Now, remove all leading components that are the same
     my @pathchunks = $self->splitdir( $path_dirs );
     my @basechunks = $self->splitdir( $base_dirs );
-
+       
     while ( @pathchunks &&
            @basechunks &&
            lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) {
         shift @pathchunks ;
         shift @basechunks ;
     }
-       
+
     # @pathchunks now has the directories to descend in to.
-       if ( (@pathchunks) && ($pathchunks[0] ne '') ) {
-       $path_dirs = $self->catdir( @pathchunks );
-       } else {
-               $path_dirs = '';
-       }
+    # 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) . ':' ;