lib/File/Spec/Mac.pm

   1 package File::Spec::Mac;
   2
   3 use strict;
   4 use vars qw(@ISA $VERSION);
   5 require File::Spec::Unix;
   6
   7 $VERSION = '1.2';
   8
   9 @ISA = qw(File::Spec::Unix);
  10
  11 use Cwd;
  12
  13 =head1 NAME
  14
  15 File::Spec::Mac - File::Spec for MacOS
  16
  17 =head1 SYNOPSIS
  18
  19  require File::Spec::Mac; # Done internally by File::Spec if needed
  20
  21 =head1 DESCRIPTION
  22
  23 Methods for manipulating file specifications.
  24
  25 =head1 METHODS
  26
  27 =over 2
  28
  29 =item canonpath
  30
  31 On MacOS, there's nothing to be done.  Returns what it's given.
  32
  33 =cut
  34
  35 sub canonpath {
  36     my ($self,$path) = @_;
  37     return $path;
  38 }
  39
  40 =item catdir
  41
  42 Concatenate two or more directory names to form a path separated by colons
  43 (":") ending with a directory.  Automatically puts a trailing ":" on the
  44 end of the complete path, because that's what's done in MacPerl's
  45 environment and helps to distinguish a file path from a directory path.
  46
  47 The intended purpose of this routine is to concatenate I<directory names>.
  48 But because of the nature of Macintosh paths, some additional possibilities
  49 are allowed to make using this routine give reasonable results for some
  50 common situations. In other words, you are also allowed to concatenate
  51 I<paths> instead of directory names (strictly speaking, a string like ":a"
  52 is a path, but not a name, since it contains a punctuation character ":").
  53
  54 Here are the rules that are used: Each argument has its trailing ":" removed.
  55 Each argument, except the first, has its leading ":" removed.  They are then
  56 joined together by a ":" and a trailing ":" is added to the path.
  57
  58 So, 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
  68 calls like the following
  69
  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(":") = ":"
  78
  79 are allowed.
  80
  81 To get a path beginning with a ":" (a relative path), put a "" as the first
  82 argument. Beginning the first argument with a ":" (e.g. ":a") will also work
  83 (see the examples).
  84
  85 Since Mac OS (Classic) uses the concept of volumes, there is an ambiguity:
  86 Does the first argument in
  87
  88     File::Spec->catdir("LWP","Protocol");
  89
  90 denote a volume or a directory, i.e. should the path be relative or absolute?
  91 There is no way of telling except by checking for the existence of "LWP:" (a
  92 volume) or ":LWP" (a directory), but those checks aren't made here. Thus, according
  93 to the above rules, the path "LWP:Protocol:" will be returned, which, considered
  94 alone, is an absolute path, although the volume "LWP:" may not exist. Hence, don't
  95 forget to put a ":" in the appropriate place in the path if you want to
  96 distinguish unambiguously. (Remember that a valid relative path should always begin
  97 with a ":", unless you are specifying a file or a directory that resides in the
  98 I<current> directory. In that case, the leading ":" is not mandatory.)
  99
 100 With version 1.2 of File::Spec, there's a new method called C<catpath>, that
 101 takes volume, directory and file portions and returns an entire path (see below).
 102 While C<catdir> is still suitable for the concatenation of I<directory names>,
 103 you should consider using C<catpath> to concatenate I<volume names> and
 104 I<directory paths>, because it avoids any ambiguities. E.g.
 105
 106     $dir      = File::Spec->catdir("LWP","Protocol");
 107     $abs_path = File::Spec->catpath("MacintoshHD:", $dir, "");
 108
 109 yields
 110
 111     "MacintoshHD:LWP:Protocol:" .
 112
 113
 114 =cut
 115
 116 sub catdir {
 117     my $self = shift;
 118     return '' unless @_;
 119     my @args = @_;
 120     my $result = shift @args;
 121     #  To match the actual end of the string,
 122     #  not ignoring newline, you can use \Z(?!\n).
 123     $result =~ s/:\Z(?!\n)//;
 124     foreach (@args) {
 125         s/:\Z(?!\n)//;
 126         s/^://s;
 127         $result .= ":$_";
 128     }
 129     return "$result:";
 130 }
 131
 132 =item catfile
 133
 134 Concatenate one or more directory names and a filename to form a
 135 complete path ending with a filename.  Since this uses catdir, the
 136 same caveats apply.  Note that the leading ":" is removed from the
 137 filename, so that
 138
 139     File::Spec->catfile("a", "b", "file"); # = "a:b:file"
 140
 141 and
 142
 143     File::Spec->catfile("a", "b", ":file"); # = "a:b:file"
 144
 145 give the same answer, as one might expect. To concatenate I<volume names>,
 146 I<directory paths> and I<filenames>, you should consider using C<catpath>
 147 (see below).
 148
 149 =cut
 150
 151 sub catfile {
 152     my $self = shift;
 153     return '' unless @_;
 154     my $file = pop @_;
 155     return $file unless @_;
 156     my $dir = $self->catdir(@_);
 157     $file =~ s/^://s;
 158     return $dir.$file;
 159 }
 160
 161 =item curdir
 162
 163 Returns a string representing the current directory. On Mac OS, this is ":".
 164
 165 =cut
 166
 167 sub curdir {
 168     return ":";
 169 }
 170
 171 =item devnull
 172
 173 Returns a string representing the null device. On Mac OS, this is "Dev:Null".
 174
 175 =cut
 176
 177 sub devnull {
 178     return "Dev:Null";
 179 }
 180
 181 =item rootdir
 182
 183 Returns a string representing the root directory.  Under MacPerl,
 184 returns the name of the startup volume, since that's the closest in
 185 concept, although other volumes aren't rooted there. The name has a
 186 trailing ":", because that's the correct specification for a volume
 187 name on Mac OS.
 188
 189 =cut
 190
 191 sub rootdir {
 192 #
 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.
 195 #
 196     require Mac::Files;
 197     my $system =  Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
 198                                          &Mac::Files::kSystemFolderType);
 199     $system =~ s/:.*\Z(?!\n)/:/s;
 200     return $system;
 201 }
 202
 203 =item tmpdir
 204
 205 Returns the contents of $ENV{TMPDIR}, if that directory exits or the current working
 206 directory otherwise. Under MacPerl, $ENV{TMPDIR} will contain a path like
 207 "MacintoshHD:Temporary Items:", which is a hidden directory on your startup volume.
 208
 209 =cut
 210
 211 my $tmpdir;
 212 sub tmpdir {
 213     return $tmpdir if defined $tmpdir;
 214     $tmpdir = $ENV{TMPDIR} if -d $ENV{TMPDIR};
 215     unless (defined($tmpdir)) {
 216         $tmpdir = cwd();
 217     }
 218     return $tmpdir;
 219 }
 220
 221 =item updir
 222
 223 Returns a string representing the parent directory. On Mac OS, this is "::".
 224
 225 =cut
 226
 227 sub updir {
 228     return "::";
 229 }
 230
 231 =item file_name_is_absolute
 232
 233 Takes as argument a path and returns true, if it is an absolute path.
 234 This does not consult the local filesystem. If
 235 the path has a leading ":", it's a relative path. Otherwise, it's an
 236 absolute path, unless the path doesn't contain any colons, i.e. it's a name
 237 like "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
 239 in the path if you want to distinguish unambiguously. As a special case,
 240 the filename '' is always considered to be absolute.
 241
 242 E.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)
 248
 249
 250 =cut
 251
 252 sub file_name_is_absolute {
 253     my ($self,$file) = @_;
 254     if ($file =~ /:/) {
 255         return (! ($file =~ m/^:/s) );
 256     } elsif ( $file eq '' ) {
 257         return 1 ;
 258     } else {
 259         return 0; # i.e. a file like "a"
 260     }
 261 }
 262
 263 =item path
 264
 265 Returns the null list for the MacPerl application, since the concept is
 266 usually meaningless under MacOS. But if you're using the MacPerl tool under
 267 MPW, it gives back $ENV{Commands} suitably split, as is done in
 268 :lib:ExtUtils:MM_Mac.pm.
 269
 270 =cut
 271
 272 sub path {
 273 #
 274 #  The concept is meaningless under the MacPerl application.
 275 #  Under MPW, it has a meaning.
 276 #
 277     return unless exists $ENV{Commands};
 278     return split(/,/, $ENV{Commands});
 279 }
 280
 281 =item splitpath
 282
 283     ($volume,$directories,$file) = File::Spec->splitpath( $path );
 284     ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
 285
 286 Splits a path in to volume, directory, and filename portions.
 287
 288 On 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
 291 The volume portion is always returned with a trailing ":". The directory portion
 292 is 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 ":".
 294 Empty portions are returned as "".
 295
 296 The results can be passed to L</catpath()> to get back a path equivalent to
 297 (usually identical to) the original path.
 298
 299
 300 =cut
 301
 302 sub splitpath {
 303     my ($self,$path, $nofile) = @_;
 304     my ($volume,$directory,$file);
 305
 306     if ( $nofile ) {
 307         ( $volume, $directory ) = $path =~ m|^((?:[^:]+:)?)(.*)|s;
 308     }
 309     else {
 310         $path =~
 311             m|^( (?: [^:]+: )? )
 312                ( (?: .*: )? )
 313                ( .* )
 314              |xs;
 315         $volume    = $1;
 316         $directory = $2;
 317         $file      = $3;
 318     }
 319
 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
 331     return ($volume,$directory,$file);
 332 }
 333
 334
 335 =item splitdir
 336
 337 The 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
 342 that have the concept of a volume or that have path syntax that differentiates
 343 files from directories.
 344
 345 Unlike 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
 347 colon to distinguish a directory path from a file path, a single trailing colon
 348 will be ignored, i.e. there's no empty directory name after it.
 349
 350 Hence, on Mac OS, both
 351
 352     File::Spec->splitdir( ":a:b::c:" );    and
 353     File::Spec->splitdir( ":a:b::c" );
 354
 355 yield:
 356
 357     ( "", "a", "b", "", "c")
 358
 359 while
 360
 361     File::Spec->splitdir( ":a:b::c::" );
 362
 363 yields:
 364
 365     ( "", "a", "b", "", "c", "")
 366
 367
 368 =cut
 369
 370 sub splitdir {
 371     my ($self,$directories) = @_ ;
 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
 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     #
 389     if ( $directories !~ m@:\Z(?!\n)@ ) {
 390         return split( m@:@, $directories );
 391     }
 392     else {
 393         #
 394         # since there was a trailing separator, add a file name to the end,
 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
 404 =item catpath
 405
 406     $path = File::Spec->catpath($volume,$directory,$file);
 407
 408 Takes 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
 410 may pass an empty string for each portion. If all portions are empty, the empty
 411 string is returned. If $volume is empty, the result will be a relative path,
 412 beginning with a ':'. If $volume and $directory are empty, a leading ":" (if any)
 413 is removed form $file and the remainder is returned. If $file is empty, the
 414 resulting path will have a trailing ':'.
 415
 416
 417 =cut
 418
 419 sub catpath {
 420     my ($self,$volume,$directory,$file) = @_;
 421
 422     if ( (! $volume) && (! $directory) ) {
 423         $file =~ s/^:// if $file;
 424         return $file ;
 425     }
 426
 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 ':'
 434     }
 435
 436     if ($file) {
 437         $file =~ s/^://; # remove leading ':' if any
 438         $path .= $file;
 439     }
 440
 441     return $path;
 442 }
 443
 444 =item abs2rel
 445
 446 Takes a destination path and an optional base path and returns a relative path
 447 from the base path to the destination path:
 448
 449     $rel_path = File::Spec->abs2rel( $path ) ;
 450     $rel_path = File::Spec->abs2rel( $path, $base ) ;
 451
 452 Note that both paths are assumed to have a notation that distinguishes a
 453 directory path (with trailing ':') from a file path (without trailing ':').
 454
 455 If $base is not present or '', then the current working directory is used.
 456 If $base is relative, then it is converted to absolute form using C<rel2abs()>.
 457 This means that it is taken to be relative to the current working directory.
 458
 459 Since Mac OS has the concept of volumes, this assumes that both paths
 460 are on the $destination volume, and ignores the $base volume (!).
 461
 462 If $base doesn't have a trailing colon, the last element of $base is
 463 assumed to be a filename. This filename is ignored (!). Otherwise all path
 464 components are assumed to be directories.
 465
 466 If $path is relative, it is converted to absolute form using C<rel2abs()>.
 467 This means that it is taken to be relative to the current working directory.
 468
 469 Based on code written by Shigio Yamaguchi.
 470
 471
 472 =cut
 473
 474 # maybe this should be done in canonpath() ?
 475 sub _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
 488 sub 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 '' ) {
 498         $base = cwd();
 499     }
 500     elsif ( ! $self->file_name_is_absolute( $base ) ) {
 501         $base = $self->rel2abs( $base ) ;
 502         $base = _resolve_updirs( $base ); # resolve updirs in $base
 503     }
 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] ;
 513
 514     # Now, remove all leading components that are the same
 515     my @pathchunks = $self->splitdir( $path_dirs );
 516     my @basechunks = $self->splitdir( $base_dirs );
 517
 518     while ( @pathchunks &&
 519             @basechunks &&
 520             lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) {
 521         shift @pathchunks ;
 522         shift @basechunks ;
 523     }
 524
 525     # @pathchunks now has the directories to descend in to.
 526     $path_dirs = $self->catdir( @pathchunks );
 527
 528     # @basechunks now contains the number of directories to climb out of.
 529     $base_dirs = (':' x @basechunks) . ':' ;
 530
 531     return $self->catpath( '', $base_dirs . $path_dirs, $path_file ) ;
 532 }
 533
 534 =item rel2abs
 535
 536 Converts a relative path to an absolute path:
 537
 538     $abs_path = File::Spec->rel2abs( $path ) ;
 539     $abs_path = File::Spec->rel2abs( $path, $base ) ;
 540
 541 Note that both paths are assumed to have a notation that distinguishes a
 542 directory path (with trailing ':') from a file path (without trailing ':').
 543
 544 If $base is not present or '', then $base is set to the current working
 545 directory. If $base is relative, then it is converted to absolute form
 546 using C<rel2abs()>. This means that it is taken to be relative to the
 547 current working directory.
 548
 549 If $base doesn't have a trailing colon, the last element of $base is
 550 assumed to be a filename. This filename is ignored (!). Otherwise all path
 551 components are assumed to be directories.
 552
 553 If $path is already absolute, it is returned and $base is ignored.
 554
 555 Based on code written by Shigio Yamaguchi.
 556
 557 =cut
 558
 559 sub rel2abs {
 560     my ($self,$path,$base) = @_;
 561
 562     if ( ! $self->file_name_is_absolute($path) ) {
 563         # Figure out the effective $base and clean it up.
 564         if ( !defined( $base ) || $base eq '' ) {
 565             $base = cwd();
 566         }
 567         elsif ( ! $self->file_name_is_absolute($base) ) {
 568             $base = $self->rel2abs($base) ;
 569         }
 570
 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;
 583
 584         $path = $self->catpath( $base_vol, $base_dirs, $path_file );
 585     }
 586     return $path;
 587 }
 588
 589
 590 =back
 591
 592 =head1 AUTHORS
 593
 594 See 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
 598 =head1 SEE ALSO
 599
 600 L<File::Spec>
 601
 602 =cut
 603
 604 1;