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