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
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>.
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
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
"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 ':') {
# 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;
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
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
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
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;
+ my $self = shift;
+ $tmpdir = $self->_tmpdir( $ENV{TMPDIR} );
}
=item updir
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.
($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.
=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 ':');
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 = '';
push (@result, $head);
$directories = $tail;
}
- }
+ }
return @result;
}
-=item catpath()
+=item catpath
$path = File::Spec->catpath($volume,$directory,$file);
# 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) . ':' ;
projects / p5sagit/p5-mst-13.2.git / blobdiff