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