File Coverage

blib/lib/File/Spec/Mac.pm
Criterion Covered Total %
statement 138 154 89.6
branch 79 92 85.8
condition 28 33 84.8
subroutine 13 19 68.4
pod 15 15 100.0
total 273 313 87.2


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