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