This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
be more optimal about clearing @_
[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
GS
6
7$VERSION = '1.1';
8
270d1e39 9@ISA = qw(File::Spec::Unix);
270d1e39
GS
10
11=head1 NAME
12
13File::Spec::Mac - File::Spec for MacOS
14
15=head1 SYNOPSIS
16
cbc7acb0 17 require File::Spec::Mac; # Done internally by File::Spec if needed
270d1e39
GS
18
19=head1 DESCRIPTION
20
21Methods for manipulating file specifications.
22
23=head1 METHODS
24
25=over 2
26
27=item canonpath
28
29On MacOS, there's nothing to be done. Returns what it's given.
30
31=cut
32
33sub canonpath {
cbc7acb0
JD
34 my ($self,$path) = @_;
35 return $path;
270d1e39
GS
36}
37
38=item catdir
39
40Concatenate two or more directory names to form a complete path ending with
41a directory. Put a trailing : on the end of the complete path if there
42isn't one, because that's what's done in MacPerl's environment.
43
44The fundamental requirement of this routine is that
45
46 File::Spec->catdir(split(":",$path)) eq $path
47
48But because of the nature of Macintosh paths, some additional
8dcee03e 49possibilities are allowed to make using this routine give reasonable results
270d1e39
GS
50for some common situations. Here are the rules that are used. Each
51argument has its trailing ":" removed. Each argument, except the first,
52has its leading ":" removed. They are then joined together by a ":".
53
54So
55
56 File::Spec->catdir("a","b") = "a:b:"
57 File::Spec->catdir("a:",":b") = "a:b:"
58 File::Spec->catdir("a:","b") = "a:b:"
59 File::Spec->catdir("a",":b") = "a:b"
60 File::Spec->catdir("a","","b") = "a::b"
61
62etc.
63
64To get a relative path (one beginning with :), begin the first argument with :
65or put a "" as the first argument.
66
67If you don't want to worry about these rules, never allow a ":" on the ends
68of any of the arguments except at the beginning of the first.
69
70Under MacPerl, there is an additional ambiguity. Does the user intend that
71
72 File::Spec->catfile("LWP","Protocol","http.pm")
73
74be relative or absolute? There's no way of telling except by checking for the
8dcee03e 75existence of LWP: or :LWP, and even there he may mean a dismounted volume or
270d1e39
GS
76a relative path in a different directory (like in @INC). So those checks
77aren't done here. This routine will treat this as absolute.
78
79=cut
80
270d1e39
GS
81sub catdir {
82 shift;
83 my @args = @_;
cbc7acb0 84 my $result = shift @args;
9c045eb2 85 $result =~ s/:\Z(?!\n)//;
cbc7acb0 86 foreach (@args) {
9c045eb2 87 s/:\Z(?!\n)//;
1b1e14d3 88 s/^://s;
cbc7acb0 89 $result .= ":$_";
270d1e39 90 }
cbc7acb0 91 return "$result:";
270d1e39
GS
92}
93
94=item catfile
95
96Concatenate one or more directory names and a filename to form a
97complete path ending with a filename. Since this uses catdir, the
98same caveats apply. Note that the leading : is removed from the filename,
99so that
100
101 File::Spec->catfile($ENV{HOME},"file");
102
103and
104
105 File::Spec->catfile($ENV{HOME},":file");
106
107give the same answer, as one might expect.
108
109=cut
110
111sub catfile {
cbc7acb0 112 my $self = shift;
270d1e39
GS
113 my $file = pop @_;
114 return $file unless @_;
115 my $dir = $self->catdir(@_);
1b1e14d3 116 $file =~ s/^://s;
270d1e39
GS
117 return $dir.$file;
118}
119
120=item curdir
121
cbc7acb0 122Returns a string representing the current directory.
270d1e39
GS
123
124=cut
125
126sub curdir {
cbc7acb0
JD
127 return ":";
128}
129
130=item devnull
131
132Returns a string representing the null device.
133
134=cut
135
136sub devnull {
137 return "Dev:Null";
270d1e39
GS
138}
139
140=item rootdir
141
142Returns a string representing the root directory. Under MacPerl,
143returns the name of the startup volume, since that's the closest in
cbc7acb0 144concept, although other volumes aren't rooted there.
270d1e39
GS
145
146=cut
147
148sub rootdir {
149#
cbc7acb0
JD
150# There's no real root directory on MacOS. The name of the startup
151# volume is returned, since that's the closest in concept.
270d1e39 152#
cbc7acb0
JD
153 require Mac::Files;
154 my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
155 &Mac::Files::kSystemFolderType);
9c045eb2 156 $system =~ s/:.*\Z(?!\n)/:/s;
cbc7acb0
JD
157 return $system;
158}
159
160=item tmpdir
161
162Returns a string representation of the first existing directory
163from the following list or '' if none exist:
164
165 $ENV{TMPDIR}
166
167=cut
168
169my $tmpdir;
170sub tmpdir {
171 return $tmpdir if defined $tmpdir;
172 $tmpdir = $ENV{TMPDIR} if -d $ENV{TMPDIR};
173 $tmpdir = '' unless defined $tmpdir;
174 return $tmpdir;
270d1e39
GS
175}
176
177=item updir
178
179Returns a string representing the parent directory.
180
181=cut
182
183sub updir {
184 return "::";
185}
186
187=item file_name_is_absolute
188
189Takes as argument a path and returns true, if it is an absolute path. In
190the case where a name can be either relative or absolute (for example, a
191folder named "HD" in the current working directory on a drive named "HD"),
192relative wins. Use ":" in the appropriate place in the path if you want to
193distinguish unambiguously.
194
195=cut
196
197sub file_name_is_absolute {
cbc7acb0
JD
198 my ($self,$file) = @_;
199 if ($file =~ /:/) {
1b1e14d3 200 return ($file !~ m/^:/s);
cbc7acb0
JD
201 } else {
202 return (! -e ":$file");
270d1e39
GS
203 }
204}
205
206=item path
207
208Returns the null list for the MacPerl application, since the concept is
209usually meaningless under MacOS. But if you're using the MacPerl tool under
210MPW, it gives back $ENV{Commands} suitably split, as is done in
211:lib:ExtUtils:MM_Mac.pm.
212
213=cut
214
215sub path {
216#
217# The concept is meaningless under the MacPerl application.
218# Under MPW, it has a meaning.
219#
cbc7acb0
JD
220 return unless exists $ENV{Commands};
221 return split(/,/, $ENV{Commands});
270d1e39
GS
222}
223
0994714a
GS
224=item splitpath
225
226=cut
227
228sub splitpath {
229 my ($self,$path, $nofile) = @_;
230
231 my ($volume,$directory,$file) = ('','','');
232
233 if ( $nofile ) {
9c045eb2 234 ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|\Z(?!\n)))?)(.*)@s;
0994714a
GS
235 }
236 else {
237 $path =~
238 m@^( (?: [^:]+: )? )
239 ( (?: .*: )? )
240 ( .* )
1b1e14d3 241 @xs;
0994714a
GS
242 $volume = $1;
243 $directory = $2;
244 $file = $3;
245 }
246
247 # Make sure non-empty volumes and directories end in ':'
9c045eb2
GS
248 $volume .= ':' if $volume =~ m@[^:]\Z(?!\n)@ ;
249 $directory .= ':' if $directory =~ m@[^:]\Z(?!\n)@ ;
0994714a
GS
250 return ($volume,$directory,$file);
251}
252
253
254=item splitdir
255
256=cut
257
258sub splitdir {
259 my ($self,$directories) = @_ ;
260 #
261 # split() likes to forget about trailing null fields, so here we
262 # check to be sure that there will not be any before handling the
263 # simple case.
264 #
9c045eb2 265 if ( $directories !~ m@:\Z(?!\n)@ ) {
0994714a
GS
266 return split( m@:@, $directories );
267 }
268 else {
269 #
270 # since there was a trailing separator, add a file name to the end,
271 # then do the split, then replace it with ''.
272 #
273 my( @directories )= split( m@:@, "${directories}dummy" ) ;
274 $directories[ $#directories ]= '' ;
275 return @directories ;
276 }
277}
278
279
280=item catpath
281
282=cut
283
284sub catpath {
285 my $self = shift ;
286
287 my $result = shift ;
1b1e14d3 288 $result =~ s@^([^/])@/$1@s ;
0994714a
GS
289
290 my $segment ;
291 for $segment ( @_ ) {
9c045eb2 292 if ( $result =~ m@[^/]\Z(?!\n)@ && $segment =~ m@^[^/]@s ) {
0994714a
GS
293 $result .= "/$segment" ;
294 }
9c045eb2
GS
295 elsif ( $result =~ m@/\Z(?!\n)@ && $segment =~ m@^/@s ) {
296 $result =~ s@/+\Z(?!\n)@/@;
1b1e14d3 297 $segment =~ s@^/+@@s;
0994714a
GS
298 $result .= "$segment" ;
299 }
300 else {
301 $result .= $segment ;
302 }
303 }
304
305 return $result ;
306}
307
308=item abs2rel
309
310=cut
311
312sub abs2rel {
313 my($self,$path,$base) = @_;
314
315 # Clean up $path
316 if ( ! $self->file_name_is_absolute( $path ) ) {
317 $path = $self->rel2abs( $path ) ;
318 }
319
320 # Figure out the effective $base and clean it up.
321 if ( !defined( $base ) || $base eq '' ) {
322 $base = cwd() ;
323 }
324 elsif ( ! $self->file_name_is_absolute( $base ) ) {
325 $base = $self->rel2abs( $base ) ;
326 }
327
328 # Now, remove all leading components that are the same
329 my @pathchunks = $self->splitdir( $path );
330 my @basechunks = $self->splitdir( $base );
331
332 while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
333 shift @pathchunks ;
334 shift @basechunks ;
335 }
336
337 $path = join( ':', @pathchunks );
338
339 # @basechunks now contains the number of directories to climb out of.
340 $base = ':' x @basechunks ;
341
342 return "$base:$path" ;
343}
344
345=item rel2abs
346
347Converts a relative path to an absolute path.
348
1d7cb664
GS
349 $abs_path = File::Spec->rel2abs( $destination ) ;
350 $abs_path = File::Spec->rel2abs( $destination, $base ) ;
0994714a
GS
351
352If $base is not present or '', then L<cwd()> is used. If $base is relative,
353then it is converted to absolute form using L</rel2abs()>. This means that it
354is taken to be relative to L<cwd()>.
355
356On systems with the concept of a volume, this assumes that both paths
357are on the $base volume, and ignores the $destination volume.
358
359On systems that have a grammar that indicates filenames, this ignores the
360$base filename as well. Otherwise all path components are assumed to be
361directories.
362
363If $path is absolute, it is cleaned up and returned using L</canonpath()>.
364
365Based on code written by Shigio Yamaguchi.
366
367No checks against the filesystem are made.
368
369=cut
370
371sub rel2abs($;$;) {
372 my ($self,$path,$base ) = @_;
373
374 if ( ! $self->file_name_is_absolute( $path ) ) {
375 if ( !defined( $base ) || $base eq '' ) {
376 $base = cwd() ;
377 }
378 elsif ( ! $self->file_name_is_absolute( $base ) ) {
379 $base = $self->rel2abs( $base ) ;
380 }
381 else {
382 $base = $self->canonpath( $base ) ;
383 }
384
385 $path = $self->canonpath("$base$path") ;
386 }
387
388 return $path ;
389}
390
391
270d1e39
GS
392=back
393
394=head1 SEE ALSO
395
396L<File::Spec>
397
398=cut
399
4001;