1N/Apackage File::Spec::Mac;
1N/A
1N/Ause strict;
1N/Ause vars qw(@ISA $VERSION);
1N/Arequire File::Spec::Unix;
1N/A
1N/A$VERSION = '1.4';
1N/A
1N/A@ISA = qw(File::Spec::Unix);
1N/A
1N/Amy $macfiles;
1N/Aif ($^O eq 'MacOS') {
1N/A $macfiles = eval { require Mac::Files };
1N/A}
1N/A
1N/Asub case_tolerant { 1 }
1N/A
1N/A
1N/A=head1 NAME
1N/A
1N/AFile::Spec::Mac - File::Spec for Mac OS (Classic)
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A require File::Spec::Mac; # Done internally by File::Spec if needed
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/AMethods for manipulating file specifications.
1N/A
1N/A=head1 METHODS
1N/A
1N/A=over 2
1N/A
1N/A=item canonpath
1N/A
1N/AOn Mac OS, there's nothing to be done. Returns what it's given.
1N/A
1N/A=cut
1N/A
1N/Asub canonpath {
1N/A my ($self,$path) = @_;
1N/A return $path;
1N/A}
1N/A
1N/A=item catdir()
1N/A
1N/AConcatenate two or more directory names to form a path separated by colons
1N/A(":") ending with a directory. Resulting paths are B<relative> by default,
1N/Abut can be forced to be absolute (but avoid this, see below). Automatically
1N/Aputs a trailing ":" on the end of the complete path, because that's what's
1N/Adone in MacPerl's environment and helps to distinguish a file path from a
1N/Adirectory path.
1N/A
1N/AB<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the resulting
1N/Apath is relative by default and I<not> absolute. This descision was made due
1N/Ato portability reasons. Since C<File::Spec-E<gt>catdir()> returns relative paths
1N/Aon all other operating systems, it will now also follow this convention on Mac
1N/AOS. Note that this may break some existing scripts.
1N/A
1N/AThe intended purpose of this routine is to concatenate I<directory names>.
1N/ABut because of the nature of Macintosh paths, some additional possibilities
1N/Aare allowed to make using this routine give reasonable results for some
1N/Acommon situations. In other words, you are also allowed to concatenate
1N/AI<paths> instead of directory names (strictly speaking, a string like ":a"
1N/Ais a path, but not a name, since it contains a punctuation character ":").
1N/A
1N/ASo, beside calls like
1N/A
1N/A catdir("a") = ":a:"
1N/A catdir("a","b") = ":a:b:"
1N/A catdir() = "" (special case)
1N/A
1N/Acalls like the following
1N/A
1N/A catdir(":a:") = ":a:"
1N/A catdir(":a","b") = ":a:b:"
1N/A catdir(":a:","b") = ":a:b:"
1N/A catdir(":a:",":b:") = ":a:b:"
1N/A catdir(":") = ":"
1N/A
1N/Aare allowed.
1N/A
1N/AHere are the rules that are used in C<catdir()>; note that we try to be as
1N/Acompatible as possible to Unix:
1N/A
1N/A=over 2
1N/A
1N/A=item 1.
1N/A
1N/AThe resulting path is relative by default, i.e. the resulting path will have a
1N/Aleading colon.
1N/A
1N/A=item 2.
1N/A
1N/AA trailing colon is added automatically to the resulting path, to denote a
1N/Adirectory.
1N/A
1N/A=item 3.
1N/A
1N/AGenerally, each argument has one leading ":" and one trailing ":"
1N/Aremoved (if any). They are then joined together by a ":". Special
1N/Atreatment applies for arguments denoting updir paths like "::lib:",
1N/Asee (4), or arguments consisting solely of colons ("colon paths"),
1N/Asee (5).
1N/A
1N/A=item 4.
1N/A
1N/AWhen an updir path like ":::lib::" is passed as argument, the number
1N/Aof directories to climb up is handled correctly, not removing leading
1N/Aor trailing colons when necessary. E.g.
1N/A
1N/A catdir(":::a","::b","c") = ":::a::b:c:"
1N/A catdir(":::a::","::b","c") = ":::a:::b:c:"
1N/A
1N/A=item 5.
1N/A
1N/AAdding a colon ":" or empty string "" to a path at I<any> position
1N/Adoesn't alter the path, i.e. these arguments are ignored. (When a ""
1N/Ais passed as the first argument, it has a special meaning, see
1N/A(6)). This way, a colon ":" is handled like a "." (curdir) on Unix,
1N/Awhile an empty string "" is generally ignored (see
1N/AC<Unix-E<gt>canonpath()> ). Likewise, a "::" is handled like a ".."
1N/A(updir), and a ":::" is handled like a "../.." etc. E.g.
1N/A
1N/A catdir("a",":",":","b") = ":a:b:"
1N/A catdir("a",":","::",":b") = ":a::b:"
1N/A
1N/A=item 6.
1N/A
1N/AIf the first argument is an empty string "" or is a volume name, i.e. matches
1N/Athe pattern /^[^:]+:/, the resulting path is B<absolute>.
1N/A
1N/A=item 7.
1N/A
1N/APassing an empty string "" as the first argument to C<catdir()> is
1N/Alike passingC<File::Spec-E<gt>rootdir()> as the first argument, i.e.
1N/A
1N/A catdir("","a","b") is the same as
1N/A
1N/A catdir(rootdir(),"a","b").
1N/A
1N/AThis is true on Unix, where C<catdir("","a","b")> yields "/a/b" and
1N/AC<rootdir()> is "/". Note that C<rootdir()> on Mac OS is the startup
1N/Avolume, which is the closest in concept to Unix' "/". This should help
1N/Ato run existing scripts originally written for Unix.
1N/A
1N/A=item 8.
1N/A
1N/AFor absolute paths, some cleanup is done, to ensure that the volume
1N/Aname isn't immediately followed by updirs. This is invalid, because
1N/Athis would go beyond "root". Generally, these cases are handled like
1N/Atheir Unix counterparts:
1N/A
1N/A Unix:
1N/A Unix->catdir("","") = "/"
1N/A Unix->catdir("",".") = "/"
1N/A Unix->catdir("","..") = "/" # can't go beyond root
1N/A Unix->catdir("",".","..","..","a") = "/a"
1N/A Mac:
1N/A Mac->catdir("","") = rootdir() # (e.g. "HD:")
1N/A Mac->catdir("",":") = rootdir()
1N/A Mac->catdir("","::") = rootdir() # can't go beyond root
1N/A Mac->catdir("",":","::","::","a") = rootdir() . "a:" # (e.g. "HD:a:")
1N/A
1N/AHowever, this approach is limited to the first arguments following
1N/A"root" (again, see C<Unix-E<gt>canonpath()> ). If there are more
1N/Aarguments that move up the directory tree, an invalid path going
1N/Abeyond root can be created.
1N/A
1N/A=back
1N/A
1N/AAs you've seen, you can force C<catdir()> to create an absolute path
1N/Aby passing either an empty string or a path that begins with a volume
1N/Aname as the first argument. However, you are strongly encouraged not
1N/Ato do so, since this is done only for backward compatibility. Newer
1N/Aversions of File::Spec come with a method called C<catpath()> (see
1N/Abelow), that is designed to offer a portable solution for the creation
1N/Aof absolute paths. It takes volume, directory and file portions and
1N/Areturns an entire path. While C<catdir()> is still suitable for the
1N/Aconcatenation of I<directory names>, you are encouraged to use
1N/AC<catpath()> to concatenate I<volume names> and I<directory
1N/Apaths>. E.g.
1N/A
1N/A $dir = File::Spec->catdir("tmp","sources");
1N/A $abs_path = File::Spec->catpath("MacintoshHD:", $dir,"");
1N/A
1N/Ayields
1N/A
1N/A "MacintoshHD:tmp:sources:" .
1N/A
1N/A=cut
1N/A
1N/Asub catdir {
1N/A my $self = shift;
1N/A return '' unless @_;
1N/A my @args = @_;
1N/A my $first_arg;
1N/A my $relative;
1N/A
1N/A # take care of the first argument
1N/A
1N/A if ($args[0] eq '') { # absolute path, rootdir
1N/A shift @args;
1N/A $relative = 0;
1N/A $first_arg = $self->rootdir;
1N/A
1N/A } elsif ($args[0] =~ /^[^:]+:/) { # absolute path, volume name
1N/A $relative = 0;
1N/A $first_arg = shift @args;
1N/A # add a trailing ':' if need be (may be it's a path like HD:dir)
1N/A $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
1N/A
1N/A } else { # relative path
1N/A $relative = 1;
1N/A if ( $args[0] =~ /^::+\Z(?!\n)/ ) {
1N/A # updir colon path ('::', ':::' etc.), don't shift
1N/A $first_arg = ':';
1N/A } elsif ($args[0] eq ':') {
1N/A $first_arg = shift @args;
1N/A } else {
1N/A # add a trailing ':' if need be
1N/A $first_arg = shift @args;
1N/A $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
1N/A }
1N/A }
1N/A
1N/A # For all other arguments,
1N/A # (a) ignore arguments that equal ':' or '',
1N/A # (b) handle updir paths specially:
1N/A # '::' -> concatenate '::'
1N/A # '::' . '::' -> concatenate ':::' etc.
1N/A # (c) add a trailing ':' if need be
1N/A
1N/A my $result = $first_arg;
1N/A while (@args) {
1N/A my $arg = shift @args;
1N/A unless (($arg eq '') || ($arg eq ':')) {
1N/A if ($arg =~ /^::+\Z(?!\n)/ ) { # updir colon path like ':::'
1N/A my $updir_count = length($arg) - 1;
1N/A while ((@args) && ($args[0] =~ /^::+\Z(?!\n)/) ) { # while updir colon path
1N/A $arg = shift @args;
1N/A $updir_count += (length($arg) - 1);
1N/A }
1N/A $arg = (':' x $updir_count);
1N/A } else {
1N/A $arg =~ s/^://s; # remove a leading ':' if any
1N/A $arg = "$arg:" unless ($arg =~ /:\Z(?!\n)/); # ensure trailing ':'
1N/A }
1N/A $result .= $arg;
1N/A }#unless
1N/A }
1N/A
1N/A if ( ($relative) && ($result !~ /^:/) ) {
1N/A # add a leading colon if need be
1N/A $result = ":$result";
1N/A }
1N/A
1N/A unless ($relative) {
1N/A # remove updirs immediately following the volume name
1N/A $result =~ s/([^:]+:)(:*)(.*)\Z(?!\n)/$1$3/;
1N/A }
1N/A
1N/A return $result;
1N/A}
1N/A
1N/A=item catfile
1N/A
1N/AConcatenate one or more directory names and a filename to form a
1N/Acomplete path ending with a filename. Resulting paths are B<relative>
1N/Aby default, but can be forced to be absolute (but avoid this).
1N/A
1N/AB<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the
1N/Aresulting path is relative by default and I<not> absolute. This
1N/Adescision was made due to portability reasons. Since
1N/AC<File::Spec-E<gt>catfile()> returns relative paths on all other
1N/Aoperating systems, it will now also follow this convention on Mac OS.
1N/ANote that this may break some existing scripts.
1N/A
1N/AThe last argument is always considered to be the file portion. Since
1N/AC<catfile()> uses C<catdir()> (see above) for the concatenation of the
1N/Adirectory portions (if any), the following with regard to relative and
1N/Aabsolute paths is true:
1N/A
1N/A catfile("") = ""
1N/A catfile("file") = "file"
1N/A
1N/Abut
1N/A
1N/A catfile("","") = rootdir() # (e.g. "HD:")
1N/A catfile("","file") = rootdir() . file # (e.g. "HD:file")
1N/A catfile("HD:","file") = "HD:file"
1N/A
1N/AThis means that C<catdir()> is called only when there are two or more
1N/Aarguments, as one might expect.
1N/A
1N/ANote that the leading ":" is removed from the filename, so that
1N/A
1N/A catfile("a","b","file") = ":a:b:file" and
1N/A
1N/A catfile("a","b",":file") = ":a:b:file"
1N/A
1N/Agive the same answer.
1N/A
1N/ATo concatenate I<volume names>, I<directory paths> and I<filenames>,
1N/Ayou are encouraged to use C<catpath()> (see below).
1N/A
1N/A=cut
1N/A
1N/Asub catfile {
1N/A my $self = shift;
1N/A return '' unless @_;
1N/A my $file = pop @_;
1N/A return $file unless @_;
1N/A my $dir = $self->catdir(@_);
1N/A $file =~ s/^://s;
1N/A return $dir.$file;
1N/A}
1N/A
1N/A=item curdir
1N/A
1N/AReturns a string representing the current directory. On Mac OS, this is ":".
1N/A
1N/A=cut
1N/A
1N/Asub curdir {
1N/A return ":";
1N/A}
1N/A
1N/A=item devnull
1N/A
1N/AReturns a string representing the null device. On Mac OS, this is "Dev:Null".
1N/A
1N/A=cut
1N/A
1N/Asub devnull {
1N/A return "Dev:Null";
1N/A}
1N/A
1N/A=item rootdir
1N/A
1N/AReturns a string representing the root directory. Under MacPerl,
1N/Areturns the name of the startup volume, since that's the closest in
1N/Aconcept, although other volumes aren't rooted there. The name has a
1N/Atrailing ":", because that's the correct specification for a volume
1N/Aname on Mac OS.
1N/A
1N/AIf Mac::Files could not be loaded, the empty string is returned.
1N/A
1N/A=cut
1N/A
1N/Asub rootdir {
1N/A#
1N/A# There's no real root directory on Mac OS. The name of the startup
1N/A# volume is returned, since that's the closest in concept.
1N/A#
1N/A return '' unless $macfiles;
1N/A my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
1N/A &Mac::Files::kSystemFolderType);
1N/A $system =~ s/:.*\Z(?!\n)/:/s;
1N/A return $system;
1N/A}
1N/A
1N/A=item tmpdir
1N/A
1N/AReturns the contents of $ENV{TMPDIR}, if that directory exits or the
1N/Acurrent working directory otherwise. Under MacPerl, $ENV{TMPDIR} will
1N/Acontain a path like "MacintoshHD:Temporary Items:", which is a hidden
1N/Adirectory on your startup volume.
1N/A
1N/A=cut
1N/A
1N/Amy $tmpdir;
1N/Asub tmpdir {
1N/A return $tmpdir if defined $tmpdir;
1N/A my $self = shift;
1N/A $tmpdir = $self->_tmpdir( $ENV{TMPDIR} );
1N/A}
1N/A
1N/A=item updir
1N/A
1N/AReturns a string representing the parent directory. On Mac OS, this is "::".
1N/A
1N/A=cut
1N/A
1N/Asub updir {
1N/A return "::";
1N/A}
1N/A
1N/A=item file_name_is_absolute
1N/A
1N/ATakes as argument a path and returns true, if it is an absolute path.
1N/AIf the path has a leading ":", it's a relative path. Otherwise, it's an
1N/Aabsolute path, unless the path doesn't contain any colons, i.e. it's a name
1N/Alike "a". In this particular case, the path is considered to be relative
1N/A(i.e. it is considered to be a filename). Use ":" in the appropriate place
1N/Ain the path if you want to distinguish unambiguously. As a special case,
1N/Athe filename '' is always considered to be absolute. Note that with version
1N/A1.2 of File::Spec::Mac, this does no longer consult the local filesystem.
1N/A
1N/AE.g.
1N/A
1N/A File::Spec->file_name_is_absolute("a"); # false (relative)
1N/A File::Spec->file_name_is_absolute(":a:b:"); # false (relative)
1N/A File::Spec->file_name_is_absolute("MacintoshHD:"); # true (absolute)
1N/A File::Spec->file_name_is_absolute(""); # true (absolute)
1N/A
1N/A
1N/A=cut
1N/A
1N/Asub file_name_is_absolute {
1N/A my ($self,$file) = @_;
1N/A if ($file =~ /:/) {
1N/A return (! ($file =~ m/^:/s) );
1N/A } elsif ( $file eq '' ) {
1N/A return 1 ;
1N/A } else {
1N/A return 0; # i.e. a file like "a"
1N/A }
1N/A}
1N/A
1N/A=item path
1N/A
1N/AReturns the null list for the MacPerl application, since the concept is
1N/Ausually meaningless under Mac OS. But if you're using the MacPerl tool under
1N/AMPW, it gives back $ENV{Commands} suitably split, as is done in
1N/A:lib:ExtUtils:MM_Mac.pm.
1N/A
1N/A=cut
1N/A
1N/Asub path {
1N/A#
1N/A# The concept is meaningless under the MacPerl application.
1N/A# Under MPW, it has a meaning.
1N/A#
1N/A return unless exists $ENV{Commands};
1N/A return split(/,/, $ENV{Commands});
1N/A}
1N/A
1N/A=item splitpath
1N/A
1N/A ($volume,$directories,$file) = File::Spec->splitpath( $path );
1N/A ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
1N/A
1N/ASplits a path into volume, directory, and filename portions.
1N/A
1N/AOn Mac OS, assumes that the last part of the path is a filename unless
1N/A$no_file is true or a trailing separator ":" is present.
1N/A
1N/AThe volume portion is always returned with a trailing ":". The directory portion
1N/Ais always returned with a leading (to denote a relative path) and a trailing ":"
1N/A(to denote a directory). The file portion is always returned I<without> a leading ":".
1N/AEmpty portions are returned as empty string ''.
1N/A
1N/AThe results can be passed to C<catpath()> to get back a path equivalent to
1N/A(usually identical to) the original path.
1N/A
1N/A
1N/A=cut
1N/A
1N/Asub splitpath {
1N/A my ($self,$path, $nofile) = @_;
1N/A my ($volume,$directory,$file);
1N/A
1N/A if ( $nofile ) {
1N/A ( $volume, $directory ) = $path =~ m|^((?:[^:]+:)?)(.*)|s;
1N/A }
1N/A else {
1N/A $path =~
1N/A m|^( (?: [^:]+: )? )
1N/A ( (?: .*: )? )
1N/A ( .* )
1N/A |xs;
1N/A $volume = $1;
1N/A $directory = $2;
1N/A $file = $3;
1N/A }
1N/A
1N/A $volume = '' unless defined($volume);
1N/A $directory = ":$directory" if ( $volume && $directory ); # take care of "HD::dir"
1N/A if ($directory) {
1N/A # Make sure non-empty directories begin and end in ':'
1N/A $directory .= ':' unless (substr($directory,-1) eq ':');
1N/A $directory = ":$directory" unless (substr($directory,0,1) eq ':');
1N/A } else {
1N/A $directory = '';
1N/A }
1N/A $file = '' unless defined($file);
1N/A
1N/A return ($volume,$directory,$file);
1N/A}
1N/A
1N/A
1N/A=item splitdir
1N/A
1N/AThe opposite of C<catdir()>.
1N/A
1N/A @dirs = File::Spec->splitdir( $directories );
1N/A
1N/A$directories should be only the directory portion of the path on systems
1N/Athat have the concept of a volume or that have path syntax that differentiates
1N/Afiles from directories. Consider using C<splitpath()> otherwise.
1N/A
1N/AUnlike just splitting the directories on the separator, empty directory names
1N/A(C<"">) can be returned. Since C<catdir()> on Mac OS always appends a trailing
1N/Acolon to distinguish a directory path from a file path, a single trailing colon
1N/Awill be ignored, i.e. there's no empty directory name after it.
1N/A
1N/AHence, on Mac OS, both
1N/A
1N/A File::Spec->splitdir( ":a:b::c:" ); and
1N/A File::Spec->splitdir( ":a:b::c" );
1N/A
1N/Ayield:
1N/A
1N/A ( "a", "b", "::", "c")
1N/A
1N/Awhile
1N/A
1N/A File::Spec->splitdir( ":a:b::c::" );
1N/A
1N/Ayields:
1N/A
1N/A ( "a", "b", "::", "c", "::")
1N/A
1N/A
1N/A=cut
1N/A
1N/Asub splitdir {
1N/A my ($self, $path) = @_;
1N/A my @result = ();
1N/A my ($head, $sep, $tail, $volume, $directories);
1N/A
1N/A return ('') if ( (!defined($path)) || ($path eq '') );
1N/A return (':') if ($path eq ':');
1N/A
1N/A ( $volume, $sep, $directories ) = $path =~ m|^((?:[^:]+:)?)(:*)(.*)|s;
1N/A
1N/A # deprecated, but handle it correctly
1N/A if ($volume) {
1N/A push (@result, $volume);
1N/A $sep .= ':';
1N/A }
1N/A
1N/A while ($sep || $directories) {
1N/A if (length($sep) > 1) {
1N/A my $updir_count = length($sep) - 1;
1N/A for (my $i=0; $i<$updir_count; $i++) {
1N/A # push '::' updir_count times;
1N/A # simulate Unix '..' updirs
1N/A push (@result, '::');
1N/A }
1N/A }
1N/A $sep = '';
1N/A if ($directories) {
1N/A ( $head, $sep, $tail ) = $directories =~ m|^((?:[^:]+)?)(:*)(.*)|s;
1N/A push (@result, $head);
1N/A $directories = $tail;
1N/A }
1N/A }
1N/A return @result;
1N/A}
1N/A
1N/A
1N/A=item catpath
1N/A
1N/A $path = File::Spec->catpath($volume,$directory,$file);
1N/A
1N/ATakes volume, directory and file portions and returns an entire path. On Mac OS,
1N/A$volume, $directory and $file are concatenated. A ':' is inserted if need be. You
1N/Amay pass an empty string for each portion. If all portions are empty, the empty
1N/Astring is returned. If $volume is empty, the result will be a relative path,
1N/Abeginning with a ':'. If $volume and $directory are empty, a leading ":" (if any)
1N/Ais removed form $file and the remainder is returned. If $file is empty, the
1N/Aresulting path will have a trailing ':'.
1N/A
1N/A
1N/A=cut
1N/A
1N/Asub catpath {
1N/A my ($self,$volume,$directory,$file) = @_;
1N/A
1N/A if ( (! $volume) && (! $directory) ) {
1N/A $file =~ s/^:// if $file;
1N/A return $file ;
1N/A }
1N/A
1N/A # We look for a volume in $volume, then in $directory, but not both
1N/A
1N/A my ($dir_volume, $dir_dirs) = $self->splitpath($directory, 1);
1N/A
1N/A $volume = $dir_volume unless length $volume;
1N/A my $path = $volume; # may be ''
1N/A $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
1N/A
1N/A if ($directory) {
1N/A $directory = $dir_dirs if $volume;
1N/A $directory =~ s/^://; # remove leading ':' if any
1N/A $path .= $directory;
1N/A $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
1N/A }
1N/A
1N/A if ($file) {
1N/A $file =~ s/^://; # remove leading ':' if any
1N/A $path .= $file;
1N/A }
1N/A
1N/A return $path;
1N/A}
1N/A
1N/A=item abs2rel
1N/A
1N/ATakes a destination path and an optional base path and returns a relative path
1N/Afrom the base path to the destination path:
1N/A
1N/A $rel_path = File::Spec->abs2rel( $path ) ;
1N/A $rel_path = File::Spec->abs2rel( $path, $base ) ;
1N/A
1N/ANote that both paths are assumed to have a notation that distinguishes a
1N/Adirectory path (with trailing ':') from a file path (without trailing ':').
1N/A
1N/AIf $base is not present or '', then the current working directory is used.
1N/AIf $base is relative, then it is converted to absolute form using C<rel2abs()>.
1N/AThis means that it is taken to be relative to the current working directory.
1N/A
1N/AIf $path and $base appear to be on two different volumes, we will not
1N/Aattempt to resolve the two paths, and we will instead simply return
1N/A$path. Note that previous versions of this module ignored the volume
1N/Aof $base, which resulted in garbage results part of the time.
1N/A
1N/AIf $base doesn't have a trailing colon, the last element of $base is
1N/Aassumed to be a filename. This filename is ignored. Otherwise all path
1N/Acomponents are assumed to be directories.
1N/A
1N/AIf $path is relative, it is converted to absolute form using C<rel2abs()>.
1N/AThis means that it is taken to be relative to the current working directory.
1N/A
1N/ABased on code written by Shigio Yamaguchi.
1N/A
1N/A
1N/A=cut
1N/A
1N/A# maybe this should be done in canonpath() ?
1N/Asub _resolve_updirs {
1N/A my $path = shift @_;
1N/A my $proceed;
1N/A
1N/A # resolve any updirs, e.g. "HD:tmp::file" -> "HD:file"
1N/A do {
1N/A $proceed = ($path =~ s/^(.*):[^:]+::(.*?)\z/$1:$2/);
1N/A } while ($proceed);
1N/A
1N/A return $path;
1N/A}
1N/A
1N/A
1N/Asub abs2rel {
1N/A my($self,$path,$base) = @_;
1N/A
1N/A # Clean up $path
1N/A if ( ! $self->file_name_is_absolute( $path ) ) {
1N/A $path = $self->rel2abs( $path ) ;
1N/A }
1N/A
1N/A # Figure out the effective $base and clean it up.
1N/A if ( !defined( $base ) || $base eq '' ) {
1N/A $base = $self->_cwd();
1N/A }
1N/A elsif ( ! $self->file_name_is_absolute( $base ) ) {
1N/A $base = $self->rel2abs( $base ) ;
1N/A $base = _resolve_updirs( $base ); # resolve updirs in $base
1N/A }
1N/A else {
1N/A $base = _resolve_updirs( $base );
1N/A }
1N/A
1N/A # Split up paths - ignore $base's file
1N/A my ( $path_vol, $path_dirs, $path_file ) = $self->splitpath( $path );
1N/A my ( $base_vol, $base_dirs ) = $self->splitpath( $base );
1N/A
1N/A return $path unless lc( $path_vol ) eq lc( $base_vol );
1N/A
1N/A # Now, remove all leading components that are the same
1N/A my @pathchunks = $self->splitdir( $path_dirs );
1N/A my @basechunks = $self->splitdir( $base_dirs );
1N/A
1N/A while ( @pathchunks &&
1N/A @basechunks &&
1N/A lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) {
1N/A shift @pathchunks ;
1N/A shift @basechunks ;
1N/A }
1N/A
1N/A # @pathchunks now has the directories to descend in to.
1N/A # ensure relative path, even if @pathchunks is empty
1N/A $path_dirs = $self->catdir( ':', @pathchunks );
1N/A
1N/A # @basechunks now contains the number of directories to climb out of.
1N/A $base_dirs = (':' x @basechunks) . ':' ;
1N/A
1N/A return $self->catpath( '', $self->catdir( $base_dirs, $path_dirs ), $path_file ) ;
1N/A}
1N/A
1N/A=item rel2abs
1N/A
1N/AConverts a relative path to an absolute path:
1N/A
1N/A $abs_path = File::Spec->rel2abs( $path ) ;
1N/A $abs_path = File::Spec->rel2abs( $path, $base ) ;
1N/A
1N/ANote that both paths are assumed to have a notation that distinguishes a
1N/Adirectory path (with trailing ':') from a file path (without trailing ':').
1N/A
1N/AIf $base is not present or '', then $base is set to the current working
1N/Adirectory. If $base is relative, then it is converted to absolute form
1N/Ausing C<rel2abs()>. This means that it is taken to be relative to the
1N/Acurrent working directory.
1N/A
1N/AIf $base doesn't have a trailing colon, the last element of $base is
1N/Aassumed to be a filename. This filename is ignored. Otherwise all path
1N/Acomponents are assumed to be directories.
1N/A
1N/AIf $path is already absolute, it is returned and $base is ignored.
1N/A
1N/ABased on code written by Shigio Yamaguchi.
1N/A
1N/A=cut
1N/A
1N/Asub rel2abs {
1N/A my ($self,$path,$base) = @_;
1N/A
1N/A if ( ! $self->file_name_is_absolute($path) ) {
1N/A # Figure out the effective $base and clean it up.
1N/A if ( !defined( $base ) || $base eq '' ) {
1N/A $base = $self->_cwd();
1N/A }
1N/A elsif ( ! $self->file_name_is_absolute($base) ) {
1N/A $base = $self->rel2abs($base) ;
1N/A }
1N/A
1N/A # Split up paths
1N/A
1N/A # igonore $path's volume
1N/A my ( $path_dirs, $path_file ) = ($self->splitpath($path))[1,2] ;
1N/A
1N/A # ignore $base's file part
1N/A my ( $base_vol, $base_dirs ) = $self->splitpath($base) ;
1N/A
1N/A # Glom them together
1N/A $path_dirs = ':' if ($path_dirs eq '');
1N/A $base_dirs =~ s/:$//; # remove trailing ':', if any
1N/A $base_dirs = $base_dirs . $path_dirs;
1N/A
1N/A $path = $self->catpath( $base_vol, $base_dirs, $path_file );
1N/A }
1N/A return $path;
1N/A}
1N/A
1N/A
1N/A=back
1N/A
1N/A=head1 AUTHORS
1N/A
1N/ASee the authors list in I<File::Spec>. Mac OS support by Paul Schinder
1N/A<schinder@pobox.com> and Thomas Wegner <wegner_thomas@yahoo.com>.
1N/A
1N/A=head1 SEE ALSO
1N/A
1N/ASee L<File::Spec> and L<File::Spec::Unix>. This package overrides the
1N/Aimplementation of these methods, not the semantics.
1N/A
1N/A=cut
1N/A
1N/A1;