This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Eliminate eliminate_macros and fixpath.
[perl5.git] / dist / PathTools / lib / File / Spec / Mac.pm
CommitLineData
270d1e39
GS
1package File::Spec::Mac;
2
270d1e39 3use strict;
b4296952 4use vars qw(@ISA $VERSION);
cbc7acb0 5require File::Spec::Unix;
b4296952 6
0a660800 7$VERSION = '3.54';
3d2a0adf 8$VERSION =~ tr/_//;
b4296952 9
270d1e39 10@ISA = qw(File::Spec::Unix);
270d1e39 11
bcdb689b
JH
12my $macfiles;
13if ($^O eq 'MacOS') {
14 $macfiles = eval { require Mac::Files };
15}
be708cc0 16
e021ab8e
JH
17sub case_tolerant { 1 }
18
19
270d1e39
GS
20=head1 NAME
21
2586ba89 22File::Spec::Mac - File::Spec for Mac OS (Classic)
270d1e39
GS
23
24=head1 SYNOPSIS
25
cbc7acb0 26 require File::Spec::Mac; # Done internally by File::Spec if needed
270d1e39
GS
27
28=head1 DESCRIPTION
29
30Methods for manipulating file specifications.
31
32=head1 METHODS
33
34=over 2
35
36=item canonpath
37
2586ba89 38On Mac OS, there's nothing to be done. Returns what it's given.
270d1e39
GS
39
40=cut
41
42sub canonpath {
cbc7acb0
JD
43 my ($self,$path) = @_;
44 return $path;
270d1e39
GS
45}
46
59605c55 47=item catdir()
270d1e39 48
be708cc0 49Concatenate two or more directory names to form a path separated by colons
2586ba89 50(":") ending with a directory. Resulting paths are B<relative> by default,
45657e91
JH
51but can be forced to be absolute (but avoid this, see below). Automatically
52puts a trailing ":" on the end of the complete path, because that's what's
53done in MacPerl's environment and helps to distinguish a file path from a
2586ba89
JH
54directory path.
55
45657e91 56B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the resulting
3c4b39be 57path is relative by default and I<not> absolute. This decision was made due
45657e91
JH
58to portability reasons. Since C<File::Spec-E<gt>catdir()> returns relative paths
59on all other operating systems, it will now also follow this convention on Mac
2586ba89 60OS. Note that this may break some existing scripts.
be708cc0
JH
61
62The intended purpose of this routine is to concatenate I<directory names>.
63But because of the nature of Macintosh paths, some additional possibilities
64are allowed to make using this routine give reasonable results for some
65common situations. In other words, you are also allowed to concatenate
66I<paths> instead of directory names (strictly speaking, a string like ":a"
67is a path, but not a name, since it contains a punctuation character ":").
68
be708cc0
JH
69So, beside calls like
70
2586ba89
JH
71 catdir("a") = ":a:"
72 catdir("a","b") = ":a:b:"
73 catdir() = "" (special case)
be708cc0
JH
74
75calls like the following
270d1e39 76
2586ba89
JH
77 catdir(":a:") = ":a:"
78 catdir(":a","b") = ":a:b:"
79 catdir(":a:","b") = ":a:b:"
80 catdir(":a:",":b:") = ":a:b:"
81 catdir(":") = ":"
270d1e39 82
be708cc0 83are allowed.
270d1e39 84
5813de03
JH
85Here are the rules that are used in C<catdir()>; note that we try to be as
86compatible as possible to Unix:
2586ba89
JH
87
88=over 2
89
2586ba89 90=item 1.
2586ba89 91
5813de03
JH
92The resulting path is relative by default, i.e. the resulting path will have a
93leading colon.
2586ba89
JH
94
95=item 2.
2586ba89 96
5813de03
JH
97A trailing colon is added automatically to the resulting path, to denote a
98directory.
2586ba89
JH
99
100=item 3.
2586ba89 101
5813de03
JH
102Generally, each argument has one leading ":" and one trailing ":"
103removed (if any). They are then joined together by a ":". Special
104treatment applies for arguments denoting updir paths like "::lib:",
105see (4), or arguments consisting solely of colons ("colon paths"),
106see (5).
270d1e39 107
2586ba89 108=item 4.
5813de03
JH
109
110When an updir path like ":::lib::" is passed as argument, the number
111of directories to climb up is handled correctly, not removing leading
112or trailing colons when necessary. E.g.
270d1e39 113
2586ba89
JH
114 catdir(":::a","::b","c") = ":::a::b:c:"
115 catdir(":::a::","::b","c") = ":::a:::b:c:"
270d1e39 116
2586ba89 117=item 5.
5813de03
JH
118
119Adding a colon ":" or empty string "" to a path at I<any> position
120doesn't alter the path, i.e. these arguments are ignored. (When a ""
121is passed as the first argument, it has a special meaning, see
122(6)). This way, a colon ":" is handled like a "." (curdir) on Unix,
123while an empty string "" is generally ignored (see
124C<Unix-E<gt>canonpath()> ). Likewise, a "::" is handled like a ".."
125(updir), and a ":::" is handled like a "../.." etc. E.g.
270d1e39 126
2586ba89
JH
127 catdir("a",":",":","b") = ":a:b:"
128 catdir("a",":","::",":b") = ":a::b:"
129
2586ba89 130=item 6.
5813de03
JH
131
132If the first argument is an empty string "" or is a volume name, i.e. matches
133the pattern /^[^:]+:/, the resulting path is B<absolute>.
2586ba89
JH
134
135=item 7.
5813de03
JH
136
137Passing an empty string "" as the first argument to C<catdir()> is
138like passingC<File::Spec-E<gt>rootdir()> as the first argument, i.e.
2586ba89
JH
139
140 catdir("","a","b") is the same as
141
45657e91 142 catdir(rootdir(),"a","b").
2586ba89 143
5813de03
JH
144This is true on Unix, where C<catdir("","a","b")> yields "/a/b" and
145C<rootdir()> is "/". Note that C<rootdir()> on Mac OS is the startup
146volume, which is the closest in concept to Unix' "/". This should help
147to run existing scripts originally written for Unix.
2586ba89
JH
148
149=item 8.
5813de03
JH
150
151For absolute paths, some cleanup is done, to ensure that the volume
152name isn't immediately followed by updirs. This is invalid, because
153this would go beyond "root". Generally, these cases are handled like
154their Unix counterparts:
2586ba89
JH
155
156 Unix:
157 Unix->catdir("","") = "/"
158 Unix->catdir("",".") = "/"
7302ea77
FC
159 Unix->catdir("","..") = "/" # can't go
160 # beyond root
2586ba89
JH
161 Unix->catdir("",".","..","..","a") = "/a"
162 Mac:
7302ea77 163 Mac->catdir("","") = rootdir() # (e.g. "HD:")
2586ba89 164 Mac->catdir("",":") = rootdir()
7302ea77
FC
165 Mac->catdir("","::") = rootdir() # can't go
166 # beyond root
167 Mac->catdir("",":","::","::","a") = rootdir() . "a:"
168 # (e.g. "HD:a:")
2586ba89 169
5813de03
JH
170However, this approach is limited to the first arguments following
171"root" (again, see C<Unix-E<gt>canonpath()> ). If there are more
172arguments that move up the directory tree, an invalid path going
173beyond root can be created.
2586ba89
JH
174
175=back
176
5813de03
JH
177As you've seen, you can force C<catdir()> to create an absolute path
178by passing either an empty string or a path that begins with a volume
179name as the first argument. However, you are strongly encouraged not
180to do so, since this is done only for backward compatibility. Newer
181versions of File::Spec come with a method called C<catpath()> (see
182below), that is designed to offer a portable solution for the creation
183of absolute paths. It takes volume, directory and file portions and
184returns an entire path. While C<catdir()> is still suitable for the
185concatenation of I<directory names>, you are encouraged to use
186C<catpath()> to concatenate I<volume names> and I<directory
187paths>. E.g.
2586ba89
JH
188
189 $dir = File::Spec->catdir("tmp","sources");
190 $abs_path = File::Spec->catpath("MacintoshHD:", $dir,"");
270d1e39 191
be708cc0 192yields
270d1e39 193
2586ba89 194 "MacintoshHD:tmp:sources:" .
270d1e39 195
270d1e39
GS
196=cut
197
270d1e39 198sub catdir {
45657e91
JH
199 my $self = shift;
200 return '' unless @_;
201 my @args = @_;
202 my $first_arg;
203 my $relative;
204
2586ba89 205 # take care of the first argument
45657e91 206
2586ba89
JH
207 if ($args[0] eq '') { # absolute path, rootdir
208 shift @args;
209 $relative = 0;
210 $first_arg = $self->rootdir;
45657e91 211
2586ba89
JH
212 } elsif ($args[0] =~ /^[^:]+:/) { # absolute path, volume name
213 $relative = 0;
214 $first_arg = shift @args;
215 # add a trailing ':' if need be (may be it's a path like HD:dir)
216 $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
45657e91 217
2586ba89
JH
218 } else { # relative path
219 $relative = 1;
45657e91 220 if ( $args[0] =~ /^::+\Z(?!\n)/ ) {
2586ba89
JH
221 # updir colon path ('::', ':::' etc.), don't shift
222 $first_arg = ':';
223 } elsif ($args[0] eq ':') {
224 $first_arg = shift @args;
225 } else {
226 # add a trailing ':' if need be
227 $first_arg = shift @args;
228 $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
45657e91
JH
229 }
230 }
231
232 # For all other arguments,
2586ba89
JH
233 # (a) ignore arguments that equal ':' or '',
234 # (b) handle updir paths specially:
235 # '::' -> concatenate '::'
236 # '::' . '::' -> concatenate ':::' etc.
237 # (c) add a trailing ':' if need be
45657e91 238
2586ba89
JH
239 my $result = $first_arg;
240 while (@args) {
241 my $arg = shift @args;
242 unless (($arg eq '') || ($arg eq ':')) {
243 if ($arg =~ /^::+\Z(?!\n)/ ) { # updir colon path like ':::'
244 my $updir_count = length($arg) - 1;
245 while ((@args) && ($args[0] =~ /^::+\Z(?!\n)/) ) { # while updir colon path
45657e91 246 $arg = shift @args;
2586ba89
JH
247 $updir_count += (length($arg) - 1);
248 }
45657e91 249 $arg = (':' x $updir_count);
2586ba89
JH
250 } else {
251 $arg =~ s/^://s; # remove a leading ':' if any
252 $arg = "$arg:" unless ($arg =~ /:\Z(?!\n)/); # ensure trailing ':'
253 }
254 $result .= $arg;
255 }#unless
45657e91
JH
256 }
257
258 if ( ($relative) && ($result !~ /^:/) ) {
2586ba89
JH
259 # add a leading colon if need be
260 $result = ":$result";
261 }
45657e91
JH
262
263 unless ($relative) {
2586ba89
JH
264 # remove updirs immediately following the volume name
265 $result =~ s/([^:]+:)(:*)(.*)\Z(?!\n)/$1$3/;
266 }
45657e91
JH
267
268 return $result;
270d1e39
GS
269}
270
271=item catfile
272
273Concatenate one or more directory names and a filename to form a
45657e91
JH
274complete path ending with a filename. Resulting paths are B<relative>
275by default, but can be forced to be absolute (but avoid this).
276
277B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the
278resulting path is relative by default and I<not> absolute. This
3c4b39be 279decision was made due to portability reasons. Since
45657e91
JH
280C<File::Spec-E<gt>catfile()> returns relative paths on all other
281operating systems, it will now also follow this convention on Mac OS.
2586ba89
JH
282Note that this may break some existing scripts.
283
45657e91
JH
284The last argument is always considered to be the file portion. Since
285C<catfile()> uses C<catdir()> (see above) for the concatenation of the
286directory portions (if any), the following with regard to relative and
2586ba89
JH
287absolute paths is true:
288
289 catfile("") = ""
45657e91 290 catfile("file") = "file"
2586ba89
JH
291
292but
293
294 catfile("","") = rootdir() # (e.g. "HD:")
295 catfile("","file") = rootdir() . file # (e.g. "HD:file")
296 catfile("HD:","file") = "HD:file"
270d1e39 297
45657e91 298This means that C<catdir()> is called only when there are two or more
2586ba89 299arguments, as one might expect.
270d1e39 300
2586ba89 301Note that the leading ":" is removed from the filename, so that
270d1e39 302
2586ba89 303 catfile("a","b","file") = ":a:b:file" and
270d1e39 304
2586ba89
JH
305 catfile("a","b",":file") = ":a:b:file"
306
45657e91 307give the same answer.
2586ba89 308
45657e91 309To concatenate I<volume names>, I<directory paths> and I<filenames>,
2586ba89 310you are encouraged to use C<catpath()> (see below).
270d1e39
GS
311
312=cut
313
314sub catfile {
cbc7acb0 315 my $self = shift;
be708cc0 316 return '' unless @_;
270d1e39
GS
317 my $file = pop @_;
318 return $file unless @_;
319 my $dir = $self->catdir(@_);
1b1e14d3 320 $file =~ s/^://s;
270d1e39
GS
321 return $dir.$file;
322}
323
324=item curdir
325
be708cc0 326Returns a string representing the current directory. On Mac OS, this is ":".
270d1e39
GS
327
328=cut
329
330sub curdir {
cbc7acb0
JD
331 return ":";
332}
333
334=item devnull
335
be708cc0 336Returns a string representing the null device. On Mac OS, this is "Dev:Null".
cbc7acb0
JD
337
338=cut
339
340sub devnull {
341 return "Dev:Null";
270d1e39
GS
342}
343
344=item rootdir
345
346Returns a string representing the root directory. Under MacPerl,
347returns the name of the startup volume, since that's the closest in
be708cc0
JH
348concept, although other volumes aren't rooted there. The name has a
349trailing ":", because that's the correct specification for a volume
350name on Mac OS.
270d1e39 351
bcdb689b
JH
352If Mac::Files could not be loaded, the empty string is returned.
353
270d1e39
GS
354=cut
355
356sub rootdir {
357#
2586ba89 358# There's no real root directory on Mac OS. The name of the startup
cbc7acb0 359# volume is returned, since that's the closest in concept.
270d1e39 360#
bcdb689b
JH
361 return '' unless $macfiles;
362 my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
363 &Mac::Files::kSystemFolderType);
9c045eb2 364 $system =~ s/:.*\Z(?!\n)/:/s;
cbc7acb0
JD
365 return $system;
366}
367
368=item tmpdir
369
07824bd1
JH
370Returns the contents of $ENV{TMPDIR}, if that directory exits or the
371current working directory otherwise. Under MacPerl, $ENV{TMPDIR} will
372contain a path like "MacintoshHD:Temporary Items:", which is a hidden
373directory on your startup volume.
cbc7acb0
JD
374
375=cut
376
cbc7acb0 377sub tmpdir {
82730d4c
FC
378 my $cached = $_[0]->_cached_tmpdir('TMPDIR');
379 return $cached if defined $cached;
380 $_[0]->_cache_tmpdir($_[0]->_tmpdir( $ENV{TMPDIR} ), 'TMPDIR');
270d1e39
GS
381}
382
383=item updir
384
be708cc0 385Returns a string representing the parent directory. On Mac OS, this is "::".
270d1e39
GS
386
387=cut
388
389sub updir {
390 return "::";
391}
392
393=item file_name_is_absolute
394
be708cc0 395Takes as argument a path and returns true, if it is an absolute path.
2586ba89 396If the path has a leading ":", it's a relative path. Otherwise, it's an
be708cc0
JH
397absolute path, unless the path doesn't contain any colons, i.e. it's a name
398like "a". In this particular case, the path is considered to be relative
399(i.e. it is considered to be a filename). Use ":" in the appropriate place
400in the path if you want to distinguish unambiguously. As a special case,
45657e91
JH
401the filename '' is always considered to be absolute. Note that with version
4021.2 of File::Spec::Mac, this does no longer consult the local filesystem.
be708cc0
JH
403
404E.g.
405
7302ea77
FC
406 File::Spec->file_name_is_absolute("a"); # false (relative)
407 File::Spec->file_name_is_absolute(":a:b:"); # false (relative)
408 File::Spec->file_name_is_absolute("MacintoshHD:");
409 # true (absolute)
410 File::Spec->file_name_is_absolute(""); # true (absolute)
270d1e39 411
3c32ced9 412
270d1e39
GS
413=cut
414
415sub file_name_is_absolute {
cbc7acb0
JD
416 my ($self,$file) = @_;
417 if ($file =~ /:/) {
be708cc0 418 return (! ($file =~ m/^:/s) );
3c32ced9
BS
419 } elsif ( $file eq '' ) {
420 return 1 ;
cbc7acb0 421 } else {
be708cc0 422 return 0; # i.e. a file like "a"
270d1e39
GS
423 }
424}
425
426=item path
427
be708cc0 428Returns the null list for the MacPerl application, since the concept is
2586ba89 429usually meaningless under Mac OS. But if you're using the MacPerl tool under
be708cc0 430MPW, it gives back $ENV{Commands} suitably split, as is done in
270d1e39
GS
431:lib:ExtUtils:MM_Mac.pm.
432
433=cut
434
435sub path {
436#
437# The concept is meaningless under the MacPerl application.
438# Under MPW, it has a meaning.
439#
cbc7acb0
JD
440 return unless exists $ENV{Commands};
441 return split(/,/, $ENV{Commands});
270d1e39
GS
442}
443
0994714a
GS
444=item splitpath
445
be708cc0 446 ($volume,$directories,$file) = File::Spec->splitpath( $path );
7302ea77
FC
447 ($volume,$directories,$file) = File::Spec->splitpath( $path,
448 $no_file );
be708cc0 449
40d020d9 450Splits a path into volume, directory, and filename portions.
be708cc0
JH
451
452On Mac OS, assumes that the last part of the path is a filename unless
453$no_file is true or a trailing separator ":" is present.
454
455The volume portion is always returned with a trailing ":". The directory portion
456is always returned with a leading (to denote a relative path) and a trailing ":"
457(to denote a directory). The file portion is always returned I<without> a leading ":".
2586ba89 458Empty portions are returned as empty string ''.
be708cc0 459
2586ba89 460The results can be passed to C<catpath()> to get back a path equivalent to
be708cc0
JH
461(usually identical to) the original path.
462
463
0994714a
GS
464=cut
465
466sub splitpath {
467 my ($self,$path, $nofile) = @_;
be708cc0 468 my ($volume,$directory,$file);
0994714a
GS
469
470 if ( $nofile ) {
be708cc0 471 ( $volume, $directory ) = $path =~ m|^((?:[^:]+:)?)(.*)|s;
0994714a
GS
472 }
473 else {
be708cc0
JH
474 $path =~
475 m|^( (?: [^:]+: )? )
476 ( (?: .*: )? )
477 ( .* )
478 |xs;
0994714a
GS
479 $volume = $1;
480 $directory = $2;
481 $file = $3;
482 }
483
be708cc0
JH
484 $volume = '' unless defined($volume);
485 $directory = ":$directory" if ( $volume && $directory ); # take care of "HD::dir"
486 if ($directory) {
487 # Make sure non-empty directories begin and end in ':'
488 $directory .= ':' unless (substr($directory,-1) eq ':');
489 $directory = ":$directory" unless (substr($directory,0,1) eq ':');
490 } else {
491 $directory = '';
492 }
493 $file = '' unless defined($file);
494
0994714a
GS
495 return ($volume,$directory,$file);
496}
497
498
499=item splitdir
500
2586ba89 501The opposite of C<catdir()>.
be708cc0
JH
502
503 @dirs = File::Spec->splitdir( $directories );
504
2586ba89 505$directories should be only the directory portion of the path on systems
be708cc0 506that have the concept of a volume or that have path syntax that differentiates
2586ba89 507files from directories. Consider using C<splitpath()> otherwise.
be708cc0
JH
508
509Unlike just splitting the directories on the separator, empty directory names
510(C<"">) can be returned. Since C<catdir()> on Mac OS always appends a trailing
511colon to distinguish a directory path from a file path, a single trailing colon
512will be ignored, i.e. there's no empty directory name after it.
513
514Hence, on Mac OS, both
515
516 File::Spec->splitdir( ":a:b::c:" ); and
517 File::Spec->splitdir( ":a:b::c" );
518
519yield:
520
2586ba89 521 ( "a", "b", "::", "c")
be708cc0
JH
522
523while
524
525 File::Spec->splitdir( ":a:b::c::" );
526
527yields:
528
2586ba89 529 ( "a", "b", "::", "c", "::")
be708cc0
JH
530
531
0994714a
GS
532=cut
533
534sub splitdir {
45657e91 535 my ($self, $path) = @_;
2586ba89
JH
536 my @result = ();
537 my ($head, $sep, $tail, $volume, $directories);
45657e91 538
bf7c0a3d 539 return @result if ( (!defined($path)) || ($path eq '') );
2586ba89
JH
540 return (':') if ($path eq ':');
541
542 ( $volume, $sep, $directories ) = $path =~ m|^((?:[^:]+:)?)(:*)(.*)|s;
543
544 # deprecated, but handle it correctly
545 if ($volume) {
546 push (@result, $volume);
547 $sep .= ':';
548 }
45657e91 549
2586ba89
JH
550 while ($sep || $directories) {
551 if (length($sep) > 1) {
552 my $updir_count = length($sep) - 1;
553 for (my $i=0; $i<$updir_count; $i++) {
554 # push '::' updir_count times;
555 # simulate Unix '..' updirs
45657e91 556 push (@result, '::');
2586ba89
JH
557 }
558 }
559 $sep = '';
560 if ($directories) {
561 ( $head, $sep, $tail ) = $directories =~ m|^((?:[^:]+)?)(:*)(.*)|s;
562 push (@result, $head);
563 $directories = $tail;
564 }
45657e91 565 }
2586ba89 566 return @result;
0994714a
GS
567}
568
569
45657e91 570=item catpath
0994714a 571
be708cc0
JH
572 $path = File::Spec->catpath($volume,$directory,$file);
573
574Takes volume, directory and file portions and returns an entire path. On Mac OS,
575$volume, $directory and $file are concatenated. A ':' is inserted if need be. You
576may pass an empty string for each portion. If all portions are empty, the empty
577string is returned. If $volume is empty, the result will be a relative path,
578beginning with a ':'. If $volume and $directory are empty, a leading ":" (if any)
579is removed form $file and the remainder is returned. If $file is empty, the
580resulting path will have a trailing ':'.
581
582
0994714a
GS
583=cut
584
585sub catpath {
be708cc0 586 my ($self,$volume,$directory,$file) = @_;
0994714a 587
be708cc0
JH
588 if ( (! $volume) && (! $directory) ) {
589 $file =~ s/^:// if $file;
590 return $file ;
591 }
0994714a 592
638113eb
JH
593 # We look for a volume in $volume, then in $directory, but not both
594
595 my ($dir_volume, $dir_dirs) = $self->splitpath($directory, 1);
596
597 $volume = $dir_volume unless length $volume;
be708cc0
JH
598 my $path = $volume; # may be ''
599 $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
600
601 if ($directory) {
638113eb 602 $directory = $dir_dirs if $volume;
be708cc0
JH
603 $directory =~ s/^://; # remove leading ':' if any
604 $path .= $directory;
605 $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
0994714a
GS
606 }
607
be708cc0
JH
608 if ($file) {
609 $file =~ s/^://; # remove leading ':' if any
610 $path .= $file;
611 }
612
613 return $path;
0994714a
GS
614}
615
616=item abs2rel
617
be708cc0
JH
618Takes a destination path and an optional base path and returns a relative path
619from the base path to the destination path:
620
621 $rel_path = File::Spec->abs2rel( $path ) ;
622 $rel_path = File::Spec->abs2rel( $path, $base ) ;
623
624Note that both paths are assumed to have a notation that distinguishes a
625directory path (with trailing ':') from a file path (without trailing ':').
626
627If $base is not present or '', then the current working directory is used.
628If $base is relative, then it is converted to absolute form using C<rel2abs()>.
629This means that it is taken to be relative to the current working directory.
630
638113eb
JH
631If $path and $base appear to be on two different volumes, we will not
632attempt to resolve the two paths, and we will instead simply return
633$path. Note that previous versions of this module ignored the volume
634of $base, which resulted in garbage results part of the time.
be708cc0
JH
635
636If $base doesn't have a trailing colon, the last element of $base is
638113eb 637assumed to be a filename. This filename is ignored. Otherwise all path
be708cc0
JH
638components are assumed to be directories.
639
640If $path is relative, it is converted to absolute form using C<rel2abs()>.
641This means that it is taken to be relative to the current working directory.
642
643Based on code written by Shigio Yamaguchi.
3c32ced9 644
3c32ced9 645
0994714a
GS
646=cut
647
be708cc0
JH
648# maybe this should be done in canonpath() ?
649sub _resolve_updirs {
650 my $path = shift @_;
651 my $proceed;
652
653 # resolve any updirs, e.g. "HD:tmp::file" -> "HD:file"
654 do {
655 $proceed = ($path =~ s/^(.*):[^:]+::(.*?)\z/$1:$2/);
656 } while ($proceed);
657
658 return $path;
659}
660
661
0994714a
GS
662sub abs2rel {
663 my($self,$path,$base) = @_;
664
665 # Clean up $path
666 if ( ! $self->file_name_is_absolute( $path ) ) {
667 $path = $self->rel2abs( $path ) ;
668 }
669
670 # Figure out the effective $base and clean it up.
671 if ( !defined( $base ) || $base eq '' ) {
0fab864c 672 $base = $self->_cwd();
0994714a
GS
673 }
674 elsif ( ! $self->file_name_is_absolute( $base ) ) {
675 $base = $self->rel2abs( $base ) ;
be708cc0 676 $base = _resolve_updirs( $base ); # resolve updirs in $base
0994714a 677 }
be708cc0
JH
678 else {
679 $base = _resolve_updirs( $base );
680 }
681
638113eb
JH
682 # Split up paths - ignore $base's file
683 my ( $path_vol, $path_dirs, $path_file ) = $self->splitpath( $path );
684 my ( $base_vol, $base_dirs ) = $self->splitpath( $base );
be708cc0 685
638113eb 686 return $path unless lc( $path_vol ) eq lc( $base_vol );
0994714a
GS
687
688 # Now, remove all leading components that are the same
7c90792d
JH
689 my @pathchunks = $self->splitdir( $path_dirs );
690 my @basechunks = $self->splitdir( $base_dirs );
45657e91 691
be708cc0
JH
692 while ( @pathchunks &&
693 @basechunks &&
694 lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) {
0994714a
GS
695 shift @pathchunks ;
696 shift @basechunks ;
697 }
45657e91 698
be708cc0 699 # @pathchunks now has the directories to descend in to.
45657e91
JH
700 # ensure relative path, even if @pathchunks is empty
701 $path_dirs = $self->catdir( ':', @pathchunks );
0994714a
GS
702
703 # @basechunks now contains the number of directories to climb out of.
be708cc0 704 $base_dirs = (':' x @basechunks) . ':' ;
0994714a 705
2586ba89 706 return $self->catpath( '', $self->catdir( $base_dirs, $path_dirs ), $path_file ) ;
0994714a
GS
707}
708
709=item rel2abs
710
be708cc0
JH
711Converts a relative path to an absolute path:
712
713 $abs_path = File::Spec->rel2abs( $path ) ;
714 $abs_path = File::Spec->rel2abs( $path, $base ) ;
0994714a 715
be708cc0
JH
716Note that both paths are assumed to have a notation that distinguishes a
717directory path (with trailing ':') from a file path (without trailing ':').
718
719If $base is not present or '', then $base is set to the current working
720directory. If $base is relative, then it is converted to absolute form
721using C<rel2abs()>. This means that it is taken to be relative to the
722current working directory.
723
724If $base doesn't have a trailing colon, the last element of $base is
638113eb 725assumed to be a filename. This filename is ignored. Otherwise all path
be708cc0
JH
726components are assumed to be directories.
727
728If $path is already absolute, it is returned and $base is ignored.
729
730Based on code written by Shigio Yamaguchi.
0994714a
GS
731
732=cut
733
786b702f 734sub rel2abs {
be708cc0 735 my ($self,$path,$base) = @_;
0994714a 736
be708cc0
JH
737 if ( ! $self->file_name_is_absolute($path) ) {
738 # Figure out the effective $base and clean it up.
0994714a 739 if ( !defined( $base ) || $base eq '' ) {
0fab864c 740 $base = $self->_cwd();
0994714a 741 }
be708cc0
JH
742 elsif ( ! $self->file_name_is_absolute($base) ) {
743 $base = $self->rel2abs($base) ;
0994714a
GS
744 }
745
be708cc0
JH
746 # Split up paths
747
c4a6f826 748 # ignore $path's volume
be708cc0
JH
749 my ( $path_dirs, $path_file ) = ($self->splitpath($path))[1,2] ;
750
751 # ignore $base's file part
638113eb 752 my ( $base_vol, $base_dirs ) = $self->splitpath($base) ;
be708cc0
JH
753
754 # Glom them together
755 $path_dirs = ':' if ($path_dirs eq '');
756 $base_dirs =~ s/:$//; # remove trailing ':', if any
757 $base_dirs = $base_dirs . $path_dirs;
0994714a 758
be708cc0
JH
759 $path = $self->catpath( $base_vol, $base_dirs, $path_file );
760 }
761 return $path;
0994714a
GS
762}
763
764
270d1e39
GS
765=back
766
be708cc0
JH
767=head1 AUTHORS
768
2586ba89 769See the authors list in I<File::Spec>. Mac OS support by Paul Schinder
be708cc0
JH
770<schinder@pobox.com> and Thomas Wegner <wegner_thomas@yahoo.com>.
771
99f36a73
RGS
772=head1 COPYRIGHT
773
774Copyright (c) 2004 by the Perl 5 Porters. All rights reserved.
775
776This program is free software; you can redistribute it and/or modify
777it under the same terms as Perl itself.
778
270d1e39
GS
779=head1 SEE ALSO
780
72f15715
T
781See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
782implementation of these methods, not the semantics.
270d1e39
GS
783
784=cut
785
7861;