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