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