From 638113ebabda13ba02225353c0381661c68f7168 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Tue, 16 Sep 2003 05:04:09 +0000 Subject: Upgrade to File::Spec 0.85_03. p4raw-id: //depot/perl@21239 --- lib/File/Spec/Mac.pm | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) (limited to 'lib/File/Spec/Mac.pm') diff --git a/lib/File/Spec/Mac.pm b/lib/File/Spec/Mac.pm index 1de06b83f1..34a7a015f2 100644 --- a/lib/File/Spec/Mac.pm +++ b/lib/File/Spec/Mac.pm @@ -585,10 +585,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 +623,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. 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. @@ -666,11 +674,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 +717,7 @@ using C. 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. @@ -736,7 +744,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 ''); -- cgit v1.2.1