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