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
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 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;
+ $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR} );
}
=item updir
($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.
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 ':'
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()>.
# Figure out the effective $base and clean it up.
if ( !defined( $base ) || $base eq '' ) {
- $base = cwd();
+ $base = $self->_cwd();
}
elsif ( ! $self->file_name_is_absolute( $base ) ) {
$base = $self->rel2abs( $base ) ;
$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 );
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.
if ( ! $self->file_name_is_absolute($path) ) {
# Figure out the effective $base and clean it up.
if ( !defined( $base ) || $base eq '' ) {
- $base = cwd();
+ $base = $self->_cwd();
}
elsif ( ! $self->file_name_is_absolute($base) ) {
$base = $self->rel2abs($base) ;
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 '');
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
-L<File::Spec>
+See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
+implementation of these methods, not the semantics.
=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff