1 package File::Spec::Mac;
4 use vars qw(@ISA $VERSION);
5 require File::Spec::Unix;
9 @ISA = qw(File::Spec::Unix);
13 File::Spec::Mac - File::Spec for MacOS
17 require File::Spec::Mac; # Done internally by File::Spec if needed
21 Methods for manipulating file specifications.
29 On MacOS, there's nothing to be done. Returns what it's given.
34 my ($self,$path) = @_;
40 Concatenate two or more directory names to form a complete path ending with
41 a directory. Put a trailing : on the end of the complete path if there
42 isn't one, because that's what's done in MacPerl's environment.
44 The fundamental requirement of this routine is that
46 File::Spec->catdir(split(":",$path)) eq $path
48 But because of the nature of Macintosh paths, some additional
49 possibilities are allowed to make using this routine give reasonable results
50 for some common situations. Here are the rules that are used. Each
51 argument has its trailing ":" removed. Each argument, except the first,
52 has its leading ":" removed. They are then joined together by a ":".
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"
64 To get a relative path (one beginning with :), begin the first argument with :
65 or put a "" as the first argument.
67 If you don't want to worry about these rules, never allow a ":" on the ends
68 of any of the arguments except at the beginning of the first.
70 Under MacPerl, there is an additional ambiguity. Does the user intend that
72 File::Spec->catfile("LWP","Protocol","http.pm")
74 be relative or absolute? There's no way of telling except by checking for the
75 existence of LWP: or :LWP, and even there he may mean a dismounted volume or
76 a relative path in a different directory (like in @INC). So those checks
77 aren't done here. This routine will treat this as absolute.
84 my $result = shift @args;
85 $result =~ s/:\Z(?!\n)//;
96 Concatenate one or more directory names and a filename to form a
97 complete path ending with a filename. Since this uses catdir, the
98 same caveats apply. Note that the leading : is removed from the filename,
101 File::Spec->catfile($ENV{HOME},"file");
105 File::Spec->catfile($ENV{HOME},":file");
107 give the same answer, as one might expect.
114 return $file unless @_;
115 my $dir = $self->catdir(@_);
122 Returns a string representing the current directory.
132 Returns a string representing the null device.
142 Returns a string representing the root directory. Under MacPerl,
143 returns the name of the startup volume, since that's the closest in
144 concept, although other volumes aren't rooted there.
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.
154 my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
155 &Mac::Files::kSystemFolderType);
156 $system =~ s/:.*\Z(?!\n)/:/s;
162 Returns a string representation of the first existing directory
163 from the following list or '' if none exist:
171 return $tmpdir if defined $tmpdir;
172 $tmpdir = $ENV{TMPDIR} if -d $ENV{TMPDIR};
173 $tmpdir = '' unless defined $tmpdir;
179 Returns a string representing the parent directory.
187 =item file_name_is_absolute
189 Takes as argument a path and returns true, if it is an absolute path. In
190 the case where a name can be either relative or absolute (for example, a
191 folder named "HD" in the current working directory on a drive named "HD"),
192 relative wins. Use ":" in the appropriate place in the path if you want to
193 distinguish unambiguously.
197 sub file_name_is_absolute {
198 my ($self,$file) = @_;
200 return ($file !~ m/^:/s);
202 return (! -e ":$file");
208 Returns the null list for the MacPerl application, since the concept is
209 usually meaningless under MacOS. But if you're using the MacPerl tool under
210 MPW, it gives back $ENV{Commands} suitably split, as is done in
211 :lib:ExtUtils:MM_Mac.pm.
217 # The concept is meaningless under the MacPerl application.
218 # Under MPW, it has a meaning.
220 return unless exists $ENV{Commands};
221 return split(/,/, $ENV{Commands});
229 my ($self,$path, $nofile) = @_;
231 my ($volume,$directory,$file) = ('','','');
234 ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|\Z(?!\n)))?)(.*)@s;
247 # Make sure non-empty volumes and directories end in ':'
248 $volume .= ':' if $volume =~ m@[^:]\Z(?!\n)@ ;
249 $directory .= ':' if $directory =~ m@[^:]\Z(?!\n)@ ;
250 return ($volume,$directory,$file);
259 my ($self,$directories) = @_ ;
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
265 if ( $directories !~ m@:\Z(?!\n)@ ) {
266 return split( m@:@, $directories );
270 # since there was a trailing separator, add a file name to the end,
271 # then do the split, then replace it with ''.
273 my( @directories )= split( m@:@, "${directories}dummy" ) ;
274 $directories[ $#directories ]= '' ;
275 return @directories ;
288 $result =~ s@^([^/])@/$1@s ;
291 for $segment ( @_ ) {
292 if ( $result =~ m@[^/]\Z(?!\n)@ && $segment =~ m@^[^/]@s ) {
293 $result .= "/$segment" ;
295 elsif ( $result =~ m@/\Z(?!\n)@ && $segment =~ m@^/@s ) {
296 $result =~ s@/+\Z(?!\n)@/@;
297 $segment =~ s@^/+@@s;
298 $result .= "$segment" ;
301 $result .= $segment ;
313 my($self,$path,$base) = @_;
316 if ( ! $self->file_name_is_absolute( $path ) ) {
317 $path = $self->rel2abs( $path ) ;
320 # Figure out the effective $base and clean it up.
321 if ( !defined( $base ) || $base eq '' ) {
324 elsif ( ! $self->file_name_is_absolute( $base ) ) {
325 $base = $self->rel2abs( $base ) ;
328 # Now, remove all leading components that are the same
329 my @pathchunks = $self->splitdir( $path );
330 my @basechunks = $self->splitdir( $base );
332 while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
337 $path = join( ':', @pathchunks );
339 # @basechunks now contains the number of directories to climb out of.
340 $base = ':' x @basechunks ;
342 return "$base:$path" ;
347 Converts a relative path to an absolute path.
349 $abs_path = File::Spec->rel2abs( $destination ) ;
350 $abs_path = File::Spec->rel2abs( $destination, $base ) ;
352 If $base is not present or '', then L<cwd()> is used. If $base is relative,
353 then it is converted to absolute form using L</rel2abs()>. This means that it
354 is taken to be relative to L<cwd()>.
356 On systems with the concept of a volume, this assumes that both paths
357 are on the $base volume, and ignores the $destination volume.
359 On systems that have a grammar that indicates filenames, this ignores the
360 $base filename as well. Otherwise all path components are assumed to be
363 If $path is absolute, it is cleaned up and returned using L</canonpath()>.
365 Based on code written by Shigio Yamaguchi.
367 No checks against the filesystem are made.
372 my ($self,$path,$base ) = @_;
374 if ( ! $self->file_name_is_absolute( $path ) ) {
375 if ( !defined( $base ) || $base eq '' ) {
378 elsif ( ! $self->file_name_is_absolute( $base ) ) {
379 $base = $self->rel2abs( $base ) ;
382 $base = $self->canonpath( $base ) ;
385 $path = $self->canonpath("$base$path") ;