This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [PATCH t/op/magic.t] missing tests 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
3c32ced9 7$VERSION = '1.2';
b4296952 8
270d1e39 9@ISA = qw(File::Spec::Unix);
270d1e39 10
be708cc0
JH
11use Cwd;
12
270d1e39
GS
13=head1 NAME
14
15File::Spec::Mac - File::Spec for MacOS
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
31On MacOS, there's nothing to be done. Returns what it's given.
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
JH
42Concatenate two or more directory names to form a path separated by colons
43(":") ending with a directory. Automatically puts a trailing ":" on the
44end of the complete path, because that's what's done in MacPerl's
45environment and helps to distinguish a file path from a directory path.
46
47The intended purpose of this routine is to concatenate I<directory names>.
48But because of the nature of Macintosh paths, some additional possibilities
49are allowed to make using this routine give reasonable results for some
50common situations. In other words, you are also allowed to concatenate
51I<paths> instead of directory names (strictly speaking, a string like ":a"
52is a path, but not a name, since it contains a punctuation character ":").
53
54Here are the rules that are used: Each argument has its trailing ":" removed.
55Each argument, except the first, has its leading ":" removed. They are then
56joined together by a ":" and a trailing ":" is added to the path.
57
58So, beside calls like
59
60 File::Spec->catdir("a") = "a:"
61 File::Spec->catdir("a","b") = "a:b:"
62 File::Spec->catdir("","a","b") = ":a:b:"
63 File::Spec->catdir("a","","b") = "a::b:"
64 File::Spec->catdir("") = ":"
65 File::Spec->catdir("a","b","") = "a:b::" (!)
66 File::Spec->catdir() = "" (special case)
67
68calls like the following
270d1e39 69
be708cc0
JH
70 File::Spec->catdir("a:",":b") = "a:b:"
71 File::Spec->catdir("a:b:",":c") = "a:b:c:"
72 File::Spec->catdir("a:","b") = "a:b:"
73 File::Spec->catdir("a",":b") = "a:b:"
74 File::Spec->catdir(":a","b") = ":a:b:"
75 File::Spec->catdir("","",":a",":b") = "::a:b:"
76 File::Spec->catdir("",":a",":b") = ":a:b:" (!)
77 File::Spec->catdir(":") = ":"
270d1e39 78
be708cc0 79are allowed.
270d1e39 80
be708cc0
JH
81To get a path beginning with a ":" (a relative path), put a "" as the first
82argument. Beginning the first argument with a ":" (e.g. ":a") will also work
83(see the examples).
270d1e39 84
be708cc0
JH
85Since Mac OS (Classic) uses the concept of volumes, there is an ambiguity:
86Does the first argument in
270d1e39 87
be708cc0 88 File::Spec->catdir("LWP","Protocol");
270d1e39 89
be708cc0
JH
90denote a volume or a directory, i.e. should the path be relative or absolute?
91There is no way of telling except by checking for the existence of "LWP:" (a
92volume) or ":LWP" (a directory), but those checks aren't made here. Thus, according
93to the above rules, the path "LWP:Protocol:" will be returned, which, considered
94alone, is an absolute path, although the volume "LWP:" may not exist. Hence, don't
95forget to put a ":" in the appropriate place in the path if you want to
96distinguish unambiguously. (Remember that a valid relative path should always begin
97with a ":", unless you are specifying a file or a directory that resides in the
98I<current> directory. In that case, the leading ":" is not mandatory.)
270d1e39 99
be708cc0
JH
100With version 1.2 of File::Spec, there's a new method called C<catpath>, that
101takes volume, directory and file portions and returns an entire path (see below).
102While C<catdir> is still suitable for the concatenation of I<directory names>,
103you should consider using C<catpath> to concatenate I<volume names> and
104I<directory paths>, because it avoids any ambiguities. E.g.
270d1e39 105
be708cc0
JH
106 $dir = File::Spec->catdir("LWP","Protocol");
107 $abs_path = File::Spec->catpath("MacintoshHD:", $dir, "");
270d1e39 108
be708cc0 109yields
270d1e39 110
be708cc0 111 "MacintoshHD:LWP:Protocol:" .
270d1e39 112
270d1e39
GS
113
114=cut
115
270d1e39 116sub catdir {
be708cc0
JH
117 my $self = shift;
118 return '' unless @_;
270d1e39 119 my @args = @_;
cbc7acb0 120 my $result = shift @args;
be708cc0
JH
121 # To match the actual end of the string,
122 # not ignoring newline, you can use \Z(?!\n).
9c045eb2 123 $result =~ s/:\Z(?!\n)//;
cbc7acb0 124 foreach (@args) {
9c045eb2 125 s/:\Z(?!\n)//;
1b1e14d3 126 s/^://s;
cbc7acb0 127 $result .= ":$_";
270d1e39 128 }
cbc7acb0 129 return "$result:";
270d1e39
GS
130}
131
132=item catfile
133
134Concatenate one or more directory names and a filename to form a
135complete path ending with a filename. Since this uses catdir, the
be708cc0
JH
136same caveats apply. Note that the leading ":" is removed from the
137filename, so that
270d1e39 138
be708cc0 139 File::Spec->catfile("a", "b", "file"); # = "a:b:file"
270d1e39
GS
140
141and
142
be708cc0 143 File::Spec->catfile("a", "b", ":file"); # = "a:b:file"
270d1e39 144
be708cc0
JH
145give the same answer, as one might expect. To concatenate I<volume names>,
146I<directory paths> and I<filenames>, you should consider using C<catpath>
147(see below).
270d1e39
GS
148
149=cut
150
151sub catfile {
cbc7acb0 152 my $self = shift;
be708cc0 153 return '' unless @_;
270d1e39
GS
154 my $file = pop @_;
155 return $file unless @_;
156 my $dir = $self->catdir(@_);
1b1e14d3 157 $file =~ s/^://s;
270d1e39
GS
158 return $dir.$file;
159}
160
161=item curdir
162
be708cc0 163Returns a string representing the current directory. On Mac OS, this is ":".
270d1e39
GS
164
165=cut
166
167sub curdir {
cbc7acb0
JD
168 return ":";
169}
170
171=item devnull
172
be708cc0 173Returns a string representing the null device. On Mac OS, this is "Dev:Null".
cbc7acb0
JD
174
175=cut
176
177sub devnull {
178 return "Dev:Null";
270d1e39
GS
179}
180
181=item rootdir
182
183Returns a string representing the root directory. Under MacPerl,
184returns the name of the startup volume, since that's the closest in
be708cc0
JH
185concept, although other volumes aren't rooted there. The name has a
186trailing ":", because that's the correct specification for a volume
187name on Mac OS.
270d1e39
GS
188
189=cut
190
191sub rootdir {
192#
cbc7acb0
JD
193# There's no real root directory on MacOS. The name of the startup
194# volume is returned, since that's the closest in concept.
270d1e39 195#
cbc7acb0
JD
196 require Mac::Files;
197 my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
198 &Mac::Files::kSystemFolderType);
9c045eb2 199 $system =~ s/:.*\Z(?!\n)/:/s;
cbc7acb0
JD
200 return $system;
201}
202
203=item tmpdir
204
be708cc0
JH
205Returns the contents of $ENV{TMPDIR}, if that directory exits or the current working
206directory otherwise. Under MacPerl, $ENV{TMPDIR} will contain a path like
207"MacintoshHD:Temporary Items:", which is a hidden directory on your startup volume.
cbc7acb0
JD
208
209=cut
210
211my $tmpdir;
212sub tmpdir {
213 return $tmpdir if defined $tmpdir;
214 $tmpdir = $ENV{TMPDIR} if -d $ENV{TMPDIR};
be708cc0
JH
215 unless (defined($tmpdir)) {
216 $tmpdir = cwd();
217 }
cbc7acb0 218 return $tmpdir;
270d1e39
GS
219}
220
221=item updir
222
be708cc0 223Returns a string representing the parent directory. On Mac OS, this is "::".
270d1e39
GS
224
225=cut
226
227sub updir {
228 return "::";
229}
230
231=item file_name_is_absolute
232
be708cc0
JH
233Takes as argument a path and returns true, if it is an absolute path.
234This does not consult the local filesystem. If
235the path has a leading ":", it's a relative path. Otherwise, it's an
236absolute path, unless the path doesn't contain any colons, i.e. it's a name
237like "a". In this particular case, the path is considered to be relative
238(i.e. it is considered to be a filename). Use ":" in the appropriate place
239in the path if you want to distinguish unambiguously. As a special case,
240the filename '' is always considered to be absolute.
241
242E.g.
243
244 File::Spec->file_name_is_absolute("a"); # false (relative)
245 File::Spec->file_name_is_absolute(":a:b:"); # false (relative)
246 File::Spec->file_name_is_absolute("MacintoshHD:"); # true (absolute)
247 File::Spec->file_name_is_absolute(""); # true (absolute)
270d1e39 248
3c32ced9 249
270d1e39
GS
250=cut
251
252sub file_name_is_absolute {
cbc7acb0
JD
253 my ($self,$file) = @_;
254 if ($file =~ /:/) {
be708cc0 255 return (! ($file =~ m/^:/s) );
3c32ced9
BS
256 } elsif ( $file eq '' ) {
257 return 1 ;
cbc7acb0 258 } else {
be708cc0 259 return 0; # i.e. a file like "a"
270d1e39
GS
260 }
261}
262
263=item path
264
be708cc0
JH
265Returns the null list for the MacPerl application, since the concept is
266usually meaningless under MacOS. But if you're using the MacPerl tool under
267MPW, it gives back $ENV{Commands} suitably split, as is done in
270d1e39
GS
268:lib:ExtUtils:MM_Mac.pm.
269
270=cut
271
272sub path {
273#
274# The concept is meaningless under the MacPerl application.
275# Under MPW, it has a meaning.
276#
cbc7acb0
JD
277 return unless exists $ENV{Commands};
278 return split(/,/, $ENV{Commands});
270d1e39
GS
279}
280
0994714a
GS
281=item splitpath
282
be708cc0
JH
283 ($volume,$directories,$file) = File::Spec->splitpath( $path );
284 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
285
286Splits a path in to volume, directory, and filename portions.
287
288On Mac OS, assumes that the last part of the path is a filename unless
289$no_file is true or a trailing separator ":" is present.
290
291The volume portion is always returned with a trailing ":". The directory portion
292is always returned with a leading (to denote a relative path) and a trailing ":"
293(to denote a directory). The file portion is always returned I<without> a leading ":".
294Empty portions are returned as "".
295
296The results can be passed to L</catpath()> to get back a path equivalent to
297(usually identical to) the original path.
298
299
0994714a
GS
300=cut
301
302sub splitpath {
303 my ($self,$path, $nofile) = @_;
be708cc0 304 my ($volume,$directory,$file);
0994714a
GS
305
306 if ( $nofile ) {
be708cc0 307 ( $volume, $directory ) = $path =~ m|^((?:[^:]+:)?)(.*)|s;
0994714a
GS
308 }
309 else {
be708cc0
JH
310 $path =~
311 m|^( (?: [^:]+: )? )
312 ( (?: .*: )? )
313 ( .* )
314 |xs;
0994714a
GS
315 $volume = $1;
316 $directory = $2;
317 $file = $3;
318 }
319
be708cc0
JH
320 $volume = '' unless defined($volume);
321 $directory = ":$directory" if ( $volume && $directory ); # take care of "HD::dir"
322 if ($directory) {
323 # Make sure non-empty directories begin and end in ':'
324 $directory .= ':' unless (substr($directory,-1) eq ':');
325 $directory = ":$directory" unless (substr($directory,0,1) eq ':');
326 } else {
327 $directory = '';
328 }
329 $file = '' unless defined($file);
330
0994714a
GS
331 return ($volume,$directory,$file);
332}
333
334
335=item splitdir
336
be708cc0
JH
337The opposite of L</catdir()>.
338
339 @dirs = File::Spec->splitdir( $directories );
340
341$directories must be only the directory portion of the path on systems
342that have the concept of a volume or that have path syntax that differentiates
343files from directories.
344
345Unlike just splitting the directories on the separator, empty directory names
346(C<"">) can be returned. Since C<catdir()> on Mac OS always appends a trailing
347colon to distinguish a directory path from a file path, a single trailing colon
348will be ignored, i.e. there's no empty directory name after it.
349
350Hence, on Mac OS, both
351
352 File::Spec->splitdir( ":a:b::c:" ); and
353 File::Spec->splitdir( ":a:b::c" );
354
355yield:
356
357 ( "", "a", "b", "", "c")
358
359while
360
361 File::Spec->splitdir( ":a:b::c::" );
362
363yields:
364
365 ( "", "a", "b", "", "c", "")
366
367
0994714a
GS
368=cut
369
370sub splitdir {
371 my ($self,$directories) = @_ ;
be708cc0
JH
372
373 if ($directories =~ /^:*\Z(?!\n)/) {
374 # dir is an empty string or a colon path like ':', i.e. the
375 # current dir, or '::', the parent dir, etc. We return that
376 # dir (as is done on Unix).
377 return $directories;
378 }
379
380 # remove a trailing colon, if any (this way, splitdir is the
381 # opposite of catdir, which automatically appends a ':')
382 $directories =~ s/:\Z(?!\n)//;
383
0994714a
GS
384 #
385 # split() likes to forget about trailing null fields, so here we
386 # check to be sure that there will not be any before handling the
387 # simple case.
388 #
9c045eb2 389 if ( $directories !~ m@:\Z(?!\n)@ ) {
0994714a
GS
390 return split( m@:@, $directories );
391 }
392 else {
393 #
be708cc0 394 # since there was a trailing separator, add a file name to the end,
0994714a
GS
395 # then do the split, then replace it with ''.
396 #
397 my( @directories )= split( m@:@, "${directories}dummy" ) ;
398 $directories[ $#directories ]= '' ;
399 return @directories ;
400 }
401}
402
403
59605c55 404=item catpath()
0994714a 405
be708cc0
JH
406 $path = File::Spec->catpath($volume,$directory,$file);
407
408Takes volume, directory and file portions and returns an entire path. On Mac OS,
409$volume, $directory and $file are concatenated. A ':' is inserted if need be. You
410may pass an empty string for each portion. If all portions are empty, the empty
411string is returned. If $volume is empty, the result will be a relative path,
412beginning with a ':'. If $volume and $directory are empty, a leading ":" (if any)
413is removed form $file and the remainder is returned. If $file is empty, the
414resulting path will have a trailing ':'.
415
416
0994714a
GS
417=cut
418
419sub catpath {
be708cc0 420 my ($self,$volume,$directory,$file) = @_;
0994714a 421
be708cc0
JH
422 if ( (! $volume) && (! $directory) ) {
423 $file =~ s/^:// if $file;
424 return $file ;
425 }
0994714a 426
be708cc0
JH
427 my $path = $volume; # may be ''
428 $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
429
430 if ($directory) {
431 $directory =~ s/^://; # remove leading ':' if any
432 $path .= $directory;
433 $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':'
0994714a
GS
434 }
435
be708cc0
JH
436 if ($file) {
437 $file =~ s/^://; # remove leading ':' if any
438 $path .= $file;
439 }
440
441 return $path;
0994714a
GS
442}
443
444=item abs2rel
445
be708cc0
JH
446Takes a destination path and an optional base path and returns a relative path
447from the base path to the destination path:
448
449 $rel_path = File::Spec->abs2rel( $path ) ;
450 $rel_path = File::Spec->abs2rel( $path, $base ) ;
451
452Note that both paths are assumed to have a notation that distinguishes a
453directory path (with trailing ':') from a file path (without trailing ':').
454
455If $base is not present or '', then the current working directory is used.
456If $base is relative, then it is converted to absolute form using C<rel2abs()>.
457This means that it is taken to be relative to the current working directory.
458
459Since Mac OS has the concept of volumes, this assumes that both paths
460are on the $destination volume, and ignores the $base volume (!).
461
462If $base doesn't have a trailing colon, the last element of $base is
463assumed to be a filename. This filename is ignored (!). Otherwise all path
464components are assumed to be directories.
465
466If $path is relative, it is converted to absolute form using C<rel2abs()>.
467This means that it is taken to be relative to the current working directory.
468
469Based on code written by Shigio Yamaguchi.
3c32ced9 470
3c32ced9 471
0994714a
GS
472=cut
473
be708cc0
JH
474# maybe this should be done in canonpath() ?
475sub _resolve_updirs {
476 my $path = shift @_;
477 my $proceed;
478
479 # resolve any updirs, e.g. "HD:tmp::file" -> "HD:file"
480 do {
481 $proceed = ($path =~ s/^(.*):[^:]+::(.*?)\z/$1:$2/);
482 } while ($proceed);
483
484 return $path;
485}
486
487
0994714a
GS
488sub abs2rel {
489 my($self,$path,$base) = @_;
490
491 # Clean up $path
492 if ( ! $self->file_name_is_absolute( $path ) ) {
493 $path = $self->rel2abs( $path ) ;
494 }
495
496 # Figure out the effective $base and clean it up.
497 if ( !defined( $base ) || $base eq '' ) {
be708cc0 498 $base = cwd();
0994714a
GS
499 }
500 elsif ( ! $self->file_name_is_absolute( $base ) ) {
501 $base = $self->rel2abs( $base ) ;
be708cc0 502 $base = _resolve_updirs( $base ); # resolve updirs in $base
0994714a 503 }
be708cc0
JH
504 else {
505 $base = _resolve_updirs( $base );
506 }
507
508 # Split up paths
509 my ( $path_dirs, $path_file ) = ($self->splitpath( $path ))[1,2] ;
510
511 # ignore $base's volume and file
512 my $base_dirs = ($self->splitpath( $base ))[1] ;
0994714a
GS
513
514 # Now, remove all leading components that are the same
be708cc0
JH
515 my @pathchunks = $self->splitdir( $path_dirs );
516 my @basechunks = $self->splitdir( $base_dirs );
0994714a 517
be708cc0
JH
518 while ( @pathchunks &&
519 @basechunks &&
520 lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) {
0994714a
GS
521 shift @pathchunks ;
522 shift @basechunks ;
523 }
524
be708cc0
JH
525 # @pathchunks now has the directories to descend in to.
526 $path_dirs = $self->catdir( @pathchunks );
0994714a
GS
527
528 # @basechunks now contains the number of directories to climb out of.
be708cc0 529 $base_dirs = (':' x @basechunks) . ':' ;
0994714a 530
be708cc0 531 return $self->catpath( '', $base_dirs . $path_dirs, $path_file ) ;
0994714a
GS
532}
533
534=item rel2abs
535
be708cc0
JH
536Converts a relative path to an absolute path:
537
538 $abs_path = File::Spec->rel2abs( $path ) ;
539 $abs_path = File::Spec->rel2abs( $path, $base ) ;
0994714a 540
be708cc0
JH
541Note that both paths are assumed to have a notation that distinguishes a
542directory path (with trailing ':') from a file path (without trailing ':').
543
544If $base is not present or '', then $base is set to the current working
545directory. If $base is relative, then it is converted to absolute form
546using C<rel2abs()>. This means that it is taken to be relative to the
547current working directory.
548
549If $base doesn't have a trailing colon, the last element of $base is
550assumed to be a filename. This filename is ignored (!). Otherwise all path
551components are assumed to be directories.
552
553If $path is already absolute, it is returned and $base is ignored.
554
555Based on code written by Shigio Yamaguchi.
0994714a
GS
556
557=cut
558
786b702f 559sub rel2abs {
be708cc0 560 my ($self,$path,$base) = @_;
0994714a 561
be708cc0
JH
562 if ( ! $self->file_name_is_absolute($path) ) {
563 # Figure out the effective $base and clean it up.
0994714a 564 if ( !defined( $base ) || $base eq '' ) {
be708cc0 565 $base = cwd();
0994714a 566 }
be708cc0
JH
567 elsif ( ! $self->file_name_is_absolute($base) ) {
568 $base = $self->rel2abs($base) ;
0994714a
GS
569 }
570
be708cc0
JH
571 # Split up paths
572
573 # igonore $path's volume
574 my ( $path_dirs, $path_file ) = ($self->splitpath($path))[1,2] ;
575
576 # ignore $base's file part
577 my ( $base_vol, $base_dirs, undef ) = $self->splitpath($base) ;
578
579 # Glom them together
580 $path_dirs = ':' if ($path_dirs eq '');
581 $base_dirs =~ s/:$//; # remove trailing ':', if any
582 $base_dirs = $base_dirs . $path_dirs;
0994714a 583
be708cc0
JH
584 $path = $self->catpath( $base_vol, $base_dirs, $path_file );
585 }
586 return $path;
0994714a
GS
587}
588
589
270d1e39
GS
590=back
591
be708cc0
JH
592=head1 AUTHORS
593
594See the authors list in L<File::Spec>. Mac OS support by Paul Schinder
595<schinder@pobox.com> and Thomas Wegner <wegner_thomas@yahoo.com>.
596
597
270d1e39
GS
598=head1 SEE ALSO
599
600L<File::Spec>
601
602=cut
603
6041;