1 package File::Spec::Mac;
5 require File::Spec::Unix;
6 @ISA = qw(File::Spec::Unix);
10 File::Spec::Mac - File::Spec for MacOS
14 require File::Spec::Mac; # Done internally by File::Spec if needed
18 Methods for manipulating file specifications.
26 On MacOS, there's nothing to be done. Returns what it's given.
31 my ($self,$path) = @_;
37 Concatenate two or more directory names to form a complete path ending with
38 a directory. Put a trailing : on the end of the complete path if there
39 isn't one, because that's what's done in MacPerl's environment.
41 The fundamental requirement of this routine is that
43 File::Spec->catdir(split(":",$path)) eq $path
45 But because of the nature of Macintosh paths, some additional
46 possibilities are allowed to make using this routine give reasonable results
47 for some common situations. Here are the rules that are used. Each
48 argument has its trailing ":" removed. Each argument, except the first,
49 has its leading ":" removed. They are then joined together by a ":".
53 File::Spec->catdir("a","b") = "a:b:"
54 File::Spec->catdir("a:",":b") = "a:b:"
55 File::Spec->catdir("a:","b") = "a:b:"
56 File::Spec->catdir("a",":b") = "a:b"
57 File::Spec->catdir("a","","b") = "a::b"
61 To get a relative path (one beginning with :), begin the first argument with :
62 or put a "" as the first argument.
64 If you don't want to worry about these rules, never allow a ":" on the ends
65 of any of the arguments except at the beginning of the first.
67 Under MacPerl, there is an additional ambiguity. Does the user intend that
69 File::Spec->catfile("LWP","Protocol","http.pm")
71 be relative or absolute? There's no way of telling except by checking for the
72 existence of LWP: or :LWP, and even there he may mean a dismounted volume or
73 a relative path in a different directory (like in @INC). So those checks
74 aren't done here. This routine will treat this as absolute.
81 my $result = shift @args;
82 $result =~ s/:\Z(?!\n)//;
93 Concatenate one or more directory names and a filename to form a
94 complete path ending with a filename. Since this uses catdir, the
95 same caveats apply. Note that the leading : is removed from the filename,
98 File::Spec->catfile($ENV{HOME},"file");
102 File::Spec->catfile($ENV{HOME},":file");
104 give the same answer, as one might expect.
111 return $file unless @_;
112 my $dir = $self->catdir(@_);
119 Returns a string representing the current directory.
129 Returns a string representing the null device.
139 Returns a string representing the root directory. Under MacPerl,
140 returns the name of the startup volume, since that's the closest in
141 concept, although other volumes aren't rooted there.
147 # There's no real root directory on MacOS. The name of the startup
148 # volume is returned, since that's the closest in concept.
151 my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
152 &Mac::Files::kSystemFolderType);
153 $system =~ s/:.*\Z(?!\n)/:/s;
159 Returns a string representation of the first existing directory
160 from the following list or '' if none exist:
168 return $tmpdir if defined $tmpdir;
169 $tmpdir = $ENV{TMPDIR} if -d $ENV{TMPDIR};
170 $tmpdir = '' unless defined $tmpdir;
176 Returns a string representing the parent directory.
184 =item file_name_is_absolute
186 Takes as argument a path and returns true, if it is an absolute path. In
187 the case where a name can be either relative or absolute (for example, a
188 folder named "HD" in the current working directory on a drive named "HD"),
189 relative wins. Use ":" in the appropriate place in the path if you want to
190 distinguish unambiguously.
194 sub file_name_is_absolute {
195 my ($self,$file) = @_;
197 return ($file !~ m/^:/s);
199 return (! -e ":$file");
205 Returns the null list for the MacPerl application, since the concept is
206 usually meaningless under MacOS. But if you're using the MacPerl tool under
207 MPW, it gives back $ENV{Commands} suitably split, as is done in
208 :lib:ExtUtils:MM_Mac.pm.
214 # The concept is meaningless under the MacPerl application.
215 # Under MPW, it has a meaning.
217 return unless exists $ENV{Commands};
218 return split(/,/, $ENV{Commands});
226 my ($self,$path, $nofile) = @_;
228 my ($volume,$directory,$file) = ('','','');
231 ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|\Z(?!\n)))?)(.*)@s;
244 # Make sure non-empty volumes and directories end in ':'
245 $volume .= ':' if $volume =~ m@[^:]\Z(?!\n)@ ;
246 $directory .= ':' if $directory =~ m@[^:]\Z(?!\n)@ ;
247 return ($volume,$directory,$file);
256 my ($self,$directories) = @_ ;
258 # split() likes to forget about trailing null fields, so here we
259 # check to be sure that there will not be any before handling the
262 if ( $directories !~ m@:\Z(?!\n)@ ) {
263 return split( m@:@, $directories );
267 # since there was a trailing separator, add a file name to the end,
268 # then do the split, then replace it with ''.
270 my( @directories )= split( m@:@, "${directories}dummy" ) ;
271 $directories[ $#directories ]= '' ;
272 return @directories ;
285 $result =~ s@^([^/])@/$1@s ;
288 for $segment ( @_ ) {
289 if ( $result =~ m@[^/]\Z(?!\n)@ && $segment =~ m@^[^/]@s ) {
290 $result .= "/$segment" ;
292 elsif ( $result =~ m@/\Z(?!\n)@ && $segment =~ m@^/@s ) {
293 $result =~ s@/+\Z(?!\n)@/@;
294 $segment =~ s@^/+@@s;
295 $result .= "$segment" ;
298 $result .= $segment ;
310 my($self,$path,$base) = @_;
313 if ( ! $self->file_name_is_absolute( $path ) ) {
314 $path = $self->rel2abs( $path ) ;
317 # Figure out the effective $base and clean it up.
318 if ( !defined( $base ) || $base eq '' ) {
321 elsif ( ! $self->file_name_is_absolute( $base ) ) {
322 $base = $self->rel2abs( $base ) ;
325 # Now, remove all leading components that are the same
326 my @pathchunks = $self->splitdir( $path );
327 my @basechunks = $self->splitdir( $base );
329 while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
334 $path = join( ':', @pathchunks );
336 # @basechunks now contains the number of directories to climb out of.
337 $base = ':' x @basechunks ;
339 return "$base:$path" ;
344 Converts a relative path to an absolute path.
346 $abs_path = File::Spec->rel2abs( $destination ) ;
347 $abs_path = File::Spec->rel2abs( $destination, $base ) ;
349 If $base is not present or '', then L<cwd()> is used. If $base is relative,
350 then it is converted to absolute form using L</rel2abs()>. This means that it
351 is taken to be relative to L<cwd()>.
353 On systems with the concept of a volume, this assumes that both paths
354 are on the $base volume, and ignores the $destination volume.
356 On systems that have a grammar that indicates filenames, this ignores the
357 $base filename as well. Otherwise all path components are assumed to be
360 If $path is absolute, it is cleaned up and returned using L</canonpath()>.
362 Based on code written by Shigio Yamaguchi.
364 No checks against the filesystem are made.
369 my ($self,$path,$base ) = @_;
371 if ( ! $self->file_name_is_absolute( $path ) ) {
372 if ( !defined( $base ) || $base eq '' ) {
375 elsif ( ! $self->file_name_is_absolute( $base ) ) {
376 $base = $self->rel2abs( $base ) ;
379 $base = $self->canonpath( $base ) ;
382 $path = $self->canonpath("$base$path") ;