# $root is only needed by Mac OS tests; these particular
# tests are skipped on other OSs
my $root;
-if ($^O eq 'MacOS') {
+if ($^O eq 'MacOS') {
+ push @INC, "::lib:$MacPerl::Architecture";
$root = File::Spec::Mac->rootdir();
}
[ "VMS->catdir('','-','','d3')", '[-.d3]' ],
[ "VMS->catdir('dir.dir','d2.dir','d3.dir')", '[.dir.d2.d3]' ],
[ "VMS->catdir('[.name]')", '[.name]' ],
-[ "VMS->catdir('[.name]','[.name]')", '[.name.name]'],
+[ "VMS->catdir('[.name]','[.name]')", '[.name.name]'],
[ "VMS->abs2rel('node::volume:[t1.t2.t3]','[t1.t2.t3]')", '' ],
[ "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]' ],
[ "Mac->catpath('hd','','')", 'hd:' ],
[ "Mac->catpath('hd:','','')", 'hd:' ],
-[ "Mac->catpath('hd:',':','')", 'hd:' ],
+[ "Mac->catpath('hd:',':','')", 'hd:' ],
[ "Mac->catpath('hd:','::','')", 'hd::' ],
[ "Mac->catpath('hd','','file')", 'hd:file' ],
[ "Mac->catdir(':')", ':' ],
[ "Mac->catdir('', '')", $root, 'MacOS' ], # skipped on other OS
-[ "Mac->catdir('', ':')", $root, 'MacOS' ], # skipped on other OS
-[ "Mac->catdir(':', ':')", ':' ],
-[ "Mac->catdir(':', '')", ':' ],
+[ "Mac->catdir('', ':')", $root, 'MacOS' ], # skipped on other OS
+[ "Mac->catdir(':', ':')", ':' ],
+[ "Mac->catdir(':', '')", ':' ],
[ "Mac->catdir('', '::')", $root, 'MacOS' ], # skipped on other OS
-[ "Mac->catdir(':', '::')", '::' ],
+[ "Mac->catdir(':', '::')", '::' ],
-[ "Mac->catdir('::', '')", '::' ],
-[ "Mac->catdir('::', ':')", '::' ],
+[ "Mac->catdir('::', '')", '::' ],
+[ "Mac->catdir('::', ':')", '::' ],
-[ "Mac->catdir('::', '::')", ':::' ],
+[ "Mac->catdir('::', '::')", ':::' ],
[ "Mac->catdir(':d1')", ':d1:' ],
[ "Mac->catdir(':d1:')", ':d1:' ],
[ "Mac->catdir('hd:d1:',':d2')", 'hd:d1:d2:' ],
[ "Mac->catdir('hd:d1:',':d2:')", 'hd:d1:d2:' ],
-[ "Mac->catfile()", '' ],
+[ "Mac->catfile()", '' ],
[ "Mac->catfile('')", '' ],
-[ "Mac->catfile('', '')", $root , 'MacOS' ], # skipped on other OS
+[ "Mac->catfile('', '')", $root , 'MacOS' ], # skipped on other OS
[ "Mac->catfile('', 'file')", $root . 'file', 'MacOS' ], # skipped on other OS
[ "Mac->catfile(':')", ':' ],
[ "Mac->catfile(':', '')", ':' ],
[ "Mac->catfile('d1','d2','file')", ':d1:d2:file' ],
[ "Mac->catfile('d1','d2',':file')", ':d1:d2:file' ],
-[ "Mac->catfile('file')", 'file' ],
-[ "Mac->catfile(':', 'file')", ':file' ],
-
+[ "Mac->catfile('file')", 'file' ],
+[ "Mac->catfile(':', 'file')", ':file' ],
+
[ "Mac->canonpath('')", '' ],
[ "Mac->canonpath(':')", ':' ],
[ "Mac->canonpath('::')", '::' ],
[ "Mac->abs2rel('hd:d1:d2:','hd:d1:d2:')", ':' ],
[ "Mac->abs2rel('hd:d1:d2:','hd:d1:d2:file')", ':' ], # ignore base's file portion
-[ "Mac->abs2rel('hd:d1:d2:file','hd:d1:d2:')", ':file' ],
+[ "Mac->abs2rel('hd:d1:d2:file','hd:d1:d2:')", ':file' ],
[ "Mac->abs2rel('hd:d1:','hd:d1:d2:')", '::' ],
[ "Mac->abs2rel('hd:d3:','hd:d1:d2:')", ':::d3:' ],
[ "Mac->abs2rel('hd:d3:','hd:d1:d2::')", '::d3:' ],
[ "Mac->abs2rel('hd1:d3:d4:d5:','hd2:d1:d2:')", ':::d3:d4:d5:' ], # ignore base's volume
[ "Mac->abs2rel('hd:','hd:d1:d2:')", ':::' ],
-[ "Mac->rel2abs(':d3:','hd:d1:d2:')", 'hd:d1:d2:d3:' ],
-[ "Mac->rel2abs(':d3:d4:','hd:d1:d2:')", 'hd:d1:d2:d3:d4:' ],
+[ "Mac->rel2abs(':d3:','hd:d1:d2:')", 'hd:d1:d2:d3:' ],
+[ "Mac->rel2abs(':d3:d4:','hd:d1:d2:')", 'hd:d1:d2:d3:d4:' ],
[ "Mac->rel2abs('','hd:d1:d2:')", '' ],
[ "Mac->rel2abs('::','hd:d1:d2:')", 'hd:d1:d2::' ],
[ "Mac->rel2abs('::','hd:d1:d2:file')", 'hd:d1:d2::' ],# ignore base's file portion
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
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.
=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);
my $base_dirs = ($self->splitpath( $base ))[1] ;
# Now, remove all leading components that are the same
- my @pathchunks = $self->splitdir( $path_dirs );
- my @basechunks = $self->splitdir( $base_dirs );
-
+ my @pathchunks = $self->splitdir( $path_dirs ); # expected: ('')
+ my @basechunks = $self->splitdir( $base_dirs ); # expected: (d1, d2)
+
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 / commitdiff