Upgrade to PathTools 3.07

[p5sagit/p5-mst-13.2.git] / lib / File / Spec / Mac.pm

diff --git a/lib/File/Spec/Mac.pm b/lib/File/Spec/Mac.pm
index 83bd709..81016b3 100644 (file)
--- a/lib/File/Spec/Mac.pm
+++ b/lib/File/Spec/Mac.pm
@@ -373,8 +373,7 @@ directory on your startup volume.
 my $tmpdir;
 sub tmpdir {
     return $tmpdir if defined $tmpdir;
-    my $self = shift;
-    $tmpdir = $self->_tmpdir( $ENV{TMPDIR} );
+    $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR} );
 }
 
 =item updir
@@ -585,10 +584,16 @@ sub catpath {
        return $file ;
     }
 
+    # We look for a volume in $volume, then in $directory, but not both
+
+    my ($dir_volume, $dir_dirs) = $self->splitpath($directory, 1);
+
+    $volume = $dir_volume unless length $volume;
     my $path = $volume; # may be ''
     $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
 
     if ($directory) {
+       $directory = $dir_dirs if $volume;
        $directory =~ s/^://; # remove leading ':' if any
        $path .= $directory;
        $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
@@ -617,11 +622,13 @@ If $base is not present or '', then the current working directory is used.
 If $base is relative, then it is converted to absolute form using C<rel2abs()>.
 This means that it is taken to be relative to the current working directory.
 
-Since Mac OS has the concept of volumes, this assumes that both paths
-are on the $destination volume, and ignores the $base volume (!).
+If $path and $base appear to be on two different volumes, we will not
+attempt to resolve the two paths, and we will instead simply return
+$path.  Note that previous versions of this module ignored the volume
+of $base, which resulted in garbage results part of the time.
 
 If $base doesn't have a trailing colon, the last element of $base is
-assumed to be a filename. This filename is ignored (!). Otherwise all path
+assumed to be a filename.  This filename is ignored.  Otherwise all path
 components are assumed to be directories.
 
 If $path is relative, it is converted to absolute form using C<rel2abs()>.
@@ -656,7 +663,7 @@ sub abs2rel {
 
     # Figure out the effective $base and clean it up.
     if ( !defined( $base ) || $base eq '' ) {
-       $base = $self->cwd();
+       $base = $self->_cwd();
     }
     elsif ( ! $self->file_name_is_absolute( $base ) ) {
         $base = $self->rel2abs( $base ) ;
@@ -666,11 +673,11 @@ sub abs2rel {
        $base = _resolve_updirs( $base );
     }
 
-    # Split up paths
-    my ( $path_dirs, $path_file ) =  ($self->splitpath( $path ))[1,2] ;
+    # Split up paths - ignore $base's file
+    my ( $path_vol, $path_dirs, $path_file ) =  $self->splitpath( $path );
+    my ( $base_vol, $base_dirs )             =  $self->splitpath( $base );
 
-    # ignore $base's volume and file
-    my $base_dirs = ($self->splitpath( $base ))[1] ;
+    return $path unless lc( $path_vol ) eq lc( $base_vol );
 
     # Now, remove all leading components that are the same
     my @pathchunks = $self->splitdir( $path_dirs );
@@ -709,7 +716,7 @@ using C<rel2abs()>. This means that it is taken to be relative to the
 current working directory.
 
 If $base doesn't have a trailing colon, the last element of $base is
-assumed to be a filename. This filename is ignored (!). Otherwise all path
+assumed to be a filename.  This filename is ignored.  Otherwise all path
 components are assumed to be directories.
 
 If $path is already absolute, it is returned and $base is ignored.
@@ -724,7 +731,7 @@ sub rel2abs {
     if ( ! $self->file_name_is_absolute($path) ) {
         # Figure out the effective $base and clean it up.
         if ( !defined( $base ) || $base eq '' ) {
-           $base = $self->cwd();
+           $base = $self->_cwd();
         }
         elsif ( ! $self->file_name_is_absolute($base) ) {
             $base = $self->rel2abs($base) ;
@@ -736,7 +743,7 @@ sub rel2abs {
         my ( $path_dirs, $path_file ) = ($self->splitpath($path))[1,2] ;
 
         # ignore $base's file part
-       my ( $base_vol, $base_dirs, undef ) = $self->splitpath($base) ;
+       my ( $base_vol, $base_dirs ) = $self->splitpath($base) ;
 
        # Glom them together
        $path_dirs = ':' if ($path_dirs eq '');
@@ -756,6 +763,13 @@ sub rel2abs {
 See the authors list in I<File::Spec>. Mac OS support by Paul Schinder
 <schinder@pobox.com> and Thomas Wegner <wegner_thomas@yahoo.com>.
 
+=head1 COPYRIGHT
+
+Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
 =head1 SEE ALSO
 
 See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the