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