1package File::Spec::Mac; 2 3use strict; 4use vars qw(@ISA $VERSION); 5require File::Spec::Unix; 6 7$VERSION = '1.4'; 8 9@ISA = qw(File::Spec::Unix); 10 11my $macfiles; 12if ($^O eq 'MacOS') { 13 $macfiles = eval { require Mac::Files }; 14} 15 16sub case_tolerant { 1 } 17 18 19=head1 NAME 20 21File::Spec::Mac - File::Spec for Mac OS (Classic) 22 23=head1 SYNOPSIS 24 25 require File::Spec::Mac; # Done internally by File::Spec if needed 26 27=head1 DESCRIPTION 28 29Methods for manipulating file specifications. 30 31=head1 METHODS 32 33=over 2 34 35=item canonpath 36 37On Mac OS, there's nothing to be done. Returns what it's given. 38 39=cut 40 41sub canonpath { 42 my ($self,$path) = @_; 43 return $path; 44} 45 46=item catdir() 47 48Concatenate two or more directory names to form a path separated by colons 49(":") ending with a directory. Resulting paths are B<relative> by default, 50but can be forced to be absolute (but avoid this, see below). Automatically 51puts a trailing ":" on the end of the complete path, because that's what's 52done in MacPerl's environment and helps to distinguish a file path from a 53directory path. 54 55B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the resulting 56path is relative by default and I<not> absolute. This descision was made due 57to portability reasons. Since C<File::Spec-E<gt>catdir()> returns relative paths 58on all other operating systems, it will now also follow this convention on Mac 59OS. Note that this may break some existing scripts. 60 61The intended purpose of this routine is to concatenate I<directory names>. 62But because of the nature of Macintosh paths, some additional possibilities 63are allowed to make using this routine give reasonable results for some 64common situations. In other words, you are also allowed to concatenate 65I<paths> instead of directory names (strictly speaking, a string like ":a" 66is a path, but not a name, since it contains a punctuation character ":"). 67 68So, beside calls like 69 70 catdir("a") = ":a:" 71 catdir("a","b") = ":a:b:" 72 catdir() = "" (special case) 73 74calls like the following 75 76 catdir(":a:") = ":a:" 77 catdir(":a","b") = ":a:b:" 78 catdir(":a:","b") = ":a:b:" 79 catdir(":a:",":b:") = ":a:b:" 80 catdir(":") = ":" 81 82are allowed. 83 84Here are the rules that are used in C<catdir()>; note that we try to be as 85compatible as possible to Unix: 86 87=over 2 88 89=item 1. 90 91The resulting path is relative by default, i.e. the resulting path will have a 92leading colon. 93 94=item 2. 95 96A trailing colon is added automatically to the resulting path, to denote a 97directory. 98 99=item 3. 100 101Generally, each argument has one leading ":" and one trailing ":" 102removed (if any). They are then joined together by a ":". Special 103treatment applies for arguments denoting updir paths like "::lib:", 104see (4), or arguments consisting solely of colons ("colon paths"), 105see (5). 106 107=item 4. 108 109When an updir path like ":::lib::" is passed as argument, the number 110of directories to climb up is handled correctly, not removing leading 111or trailing colons when necessary. E.g. 112 113 catdir(":::a","::b","c") = ":::a::b:c:" 114 catdir(":::a::","::b","c") = ":::a:::b:c:" 115 116=item 5. 117 118Adding a colon ":" or empty string "" to a path at I<any> position 119doesn't alter the path, i.e. these arguments are ignored. (When a "" 120is passed as the first argument, it has a special meaning, see 121(6)). This way, a colon ":" is handled like a "." (curdir) on Unix, 122while an empty string "" is generally ignored (see 123C<Unix-E<gt>canonpath()> ). Likewise, a "::" is handled like a ".." 124(updir), and a ":::" is handled like a "../.." etc. E.g. 125 126 catdir("a",":",":","b") = ":a:b:" 127 catdir("a",":","::",":b") = ":a::b:" 128 129=item 6. 130 131If the first argument is an empty string "" or is a volume name, i.e. matches 132the pattern /^[^:]+:/, the resulting path is B<absolute>. 133 134=item 7. 135 136Passing an empty string "" as the first argument to C<catdir()> is 137like passingC<File::Spec-E<gt>rootdir()> as the first argument, i.e. 138 139 catdir("","a","b") is the same as 140 141 catdir(rootdir(),"a","b"). 142 143This is true on Unix, where C<catdir("","a","b")> yields "/a/b" and 144C<rootdir()> is "/". Note that C<rootdir()> on Mac OS is the startup 145volume, which is the closest in concept to Unix' "/". This should help 146to run existing scripts originally written for Unix. 147 148=item 8. 149 150For absolute paths, some cleanup is done, to ensure that the volume 151name isn't immediately followed by updirs. This is invalid, because 152this would go beyond "root". Generally, these cases are handled like 153their Unix counterparts: 154 155 Unix: 156 Unix->catdir("","") = "/" 157 Unix->catdir("",".") = "/" 158 Unix->catdir("","..") = "/" # can't go beyond root 159 Unix->catdir("",".","..","..","a") = "/a" 160 Mac: 161 Mac->catdir("","") = rootdir() # (e.g. "HD:") 162 Mac->catdir("",":") = rootdir() 163 Mac->catdir("","::") = rootdir() # can't go beyond root 164 Mac->catdir("",":","::","::","a") = rootdir() . "a:" # (e.g. "HD:a:") 165 166However, this approach is limited to the first arguments following 167"root" (again, see C<Unix-E<gt>canonpath()> ). If there are more 168arguments that move up the directory tree, an invalid path going 169beyond root can be created. 170 171=back 172 173As you've seen, you can force C<catdir()> to create an absolute path 174by passing either an empty string or a path that begins with a volume 175name as the first argument. However, you are strongly encouraged not 176to do so, since this is done only for backward compatibility. Newer 177versions of File::Spec come with a method called C<catpath()> (see 178below), that is designed to offer a portable solution for the creation 179of absolute paths. It takes volume, directory and file portions and 180returns an entire path. While C<catdir()> is still suitable for the 181concatenation of I<directory names>, you are encouraged to use 182C<catpath()> to concatenate I<volume names> and I<directory 183paths>. E.g. 184 185 $dir = File::Spec->catdir("tmp","sources"); 186 $abs_path = File::Spec->catpath("MacintoshHD:", $dir,""); 187 188yields 189 190 "MacintoshHD:tmp:sources:" . 191 192=cut 193 194sub catdir { 195 my $self = shift; 196 return '' unless @_; 197 my @args = @_; 198 my $first_arg; 199 my $relative; 200 201 # take care of the first argument 202 203 if ($args[0] eq '') { # absolute path, rootdir 204 shift @args; 205 $relative = 0; 206 $first_arg = $self->rootdir; 207 208 } elsif ($args[0] =~ /^[^:]+:/) { # absolute path, volume name 209 $relative = 0; 210 $first_arg = shift @args; 211 # add a trailing ':' if need be (may be it's a path like HD:dir) 212 $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/); 213 214 } else { # relative path 215 $relative = 1; 216 if ( $args[0] =~ /^::+\Z(?!\n)/ ) { 217 # updir colon path ('::', ':::' etc.), don't shift 218 $first_arg = ':'; 219 } elsif ($args[0] eq ':') { 220 $first_arg = shift @args; 221 } else { 222 # add a trailing ':' if need be 223 $first_arg = shift @args; 224 $first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/); 225 } 226 } 227 228 # For all other arguments, 229 # (a) ignore arguments that equal ':' or '', 230 # (b) handle updir paths specially: 231 # '::' -> concatenate '::' 232 # '::' . '::' -> concatenate ':::' etc. 233 # (c) add a trailing ':' if need be 234 235 my $result = $first_arg; 236 while (@args) { 237 my $arg = shift @args; 238 unless (($arg eq '') || ($arg eq ':')) { 239 if ($arg =~ /^::+\Z(?!\n)/ ) { # updir colon path like ':::' 240 my $updir_count = length($arg) - 1; 241 while ((@args) && ($args[0] =~ /^::+\Z(?!\n)/) ) { # while updir colon path 242 $arg = shift @args; 243 $updir_count += (length($arg) - 1); 244 } 245 $arg = (':' x $updir_count); 246 } else { 247 $arg =~ s/^://s; # remove a leading ':' if any 248 $arg = "$arg:" unless ($arg =~ /:\Z(?!\n)/); # ensure trailing ':' 249 } 250 $result .= $arg; 251 }#unless 252 } 253 254 if ( ($relative) && ($result !~ /^:/) ) { 255 # add a leading colon if need be 256 $result = ":$result"; 257 } 258 259 unless ($relative) { 260 # remove updirs immediately following the volume name 261 $result =~ s/([^:]+:)(:*)(.*)\Z(?!\n)/$1$3/; 262 } 263 264 return $result; 265} 266 267=item catfile 268 269Concatenate one or more directory names and a filename to form a 270complete path ending with a filename. Resulting paths are B<relative> 271by default, but can be forced to be absolute (but avoid this). 272 273B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the 274resulting path is relative by default and I<not> absolute. This 275descision was made due to portability reasons. Since 276C<File::Spec-E<gt>catfile()> returns relative paths on all other 277operating systems, it will now also follow this convention on Mac OS. 278Note that this may break some existing scripts. 279 280The last argument is always considered to be the file portion. Since 281C<catfile()> uses C<catdir()> (see above) for the concatenation of the 282directory portions (if any), the following with regard to relative and 283absolute paths is true: 284 285 catfile("") = "" 286 catfile("file") = "file" 287 288but 289 290 catfile("","") = rootdir() # (e.g. "HD:") 291 catfile("","file") = rootdir() . file # (e.g. "HD:file") 292 catfile("HD:","file") = "HD:file" 293 294This means that C<catdir()> is called only when there are two or more 295arguments, as one might expect. 296 297Note that the leading ":" is removed from the filename, so that 298 299 catfile("a","b","file") = ":a:b:file" and 300 301 catfile("a","b",":file") = ":a:b:file" 302 303give the same answer. 304 305To concatenate I<volume names>, I<directory paths> and I<filenames>, 306you are encouraged to use C<catpath()> (see below). 307 308=cut 309 310sub catfile { 311 my $self = shift; 312 return '' unless @_; 313 my $file = pop @_; 314 return $file unless @_; 315 my $dir = $self->catdir(@_); 316 $file =~ s/^://s; 317 return $dir.$file; 318} 319 320=item curdir 321 322Returns a string representing the current directory. On Mac OS, this is ":". 323 324=cut 325 326sub curdir { 327 return ":"; 328} 329 330=item devnull 331 332Returns a string representing the null device. On Mac OS, this is "Dev:Null". 333 334=cut 335 336sub devnull { 337 return "Dev:Null"; 338} 339 340=item rootdir 341 342Returns a string representing the root directory. Under MacPerl, 343returns the name of the startup volume, since that's the closest in 344concept, although other volumes aren't rooted there. The name has a 345trailing ":", because that's the correct specification for a volume 346name on Mac OS. 347 348If Mac::Files could not be loaded, the empty string is returned. 349 350=cut 351 352sub rootdir { 353# 354# There's no real root directory on Mac OS. The name of the startup 355# volume is returned, since that's the closest in concept. 356# 357 return '' unless $macfiles; 358 my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk, 359 &Mac::Files::kSystemFolderType); 360 $system =~ s/:.*\Z(?!\n)/:/s; 361 return $system; 362} 363 364=item tmpdir 365 366Returns the contents of $ENV{TMPDIR}, if that directory exits or the 367current working directory otherwise. Under MacPerl, $ENV{TMPDIR} will 368contain a path like "MacintoshHD:Temporary Items:", which is a hidden 369directory on your startup volume. 370 371=cut 372 373my $tmpdir; 374sub tmpdir { 375 return $tmpdir if defined $tmpdir; 376 my $self = shift; 377 $tmpdir = $self->_tmpdir( $ENV{TMPDIR} ); 378} 379 380=item updir 381 382Returns a string representing the parent directory. On Mac OS, this is "::". 383 384=cut 385 386sub updir { 387 return "::"; 388} 389 390=item file_name_is_absolute 391 392Takes as argument a path and returns true, if it is an absolute path. 393If the path has a leading ":", it's a relative path. Otherwise, it's an 394absolute path, unless the path doesn't contain any colons, i.e. it's a name 395like "a". In this particular case, the path is considered to be relative 396(i.e. it is considered to be a filename). Use ":" in the appropriate place 397in the path if you want to distinguish unambiguously. As a special case, 398the filename '' is always considered to be absolute. Note that with version 3991.2 of File::Spec::Mac, this does no longer consult the local filesystem. 400 401E.g. 402 403 File::Spec->file_name_is_absolute("a"); # false (relative) 404 File::Spec->file_name_is_absolute(":a:b:"); # false (relative) 405 File::Spec->file_name_is_absolute("MacintoshHD:"); # true (absolute) 406 File::Spec->file_name_is_absolute(""); # true (absolute) 407 408 409=cut 410 411sub file_name_is_absolute { 412 my ($self,$file) = @_; 413 if ($file =~ /:/) { 414 return (! ($file =~ m/^:/s) ); 415 } elsif ( $file eq '' ) { 416 return 1 ; 417 } else { 418 return 0; # i.e. a file like "a" 419 } 420} 421 422=item path 423 424Returns the null list for the MacPerl application, since the concept is 425usually meaningless under Mac OS. But if you're using the MacPerl tool under 426MPW, it gives back $ENV{Commands} suitably split, as is done in 427:lib:ExtUtils:MM_Mac.pm. 428 429=cut 430 431sub path { 432# 433# The concept is meaningless under the MacPerl application. 434# Under MPW, it has a meaning. 435# 436 return unless exists $ENV{Commands}; 437 return split(/,/, $ENV{Commands}); 438} 439 440=item splitpath 441 442 ($volume,$directories,$file) = File::Spec->splitpath( $path ); 443 ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); 444 445Splits a path into volume, directory, and filename portions. 446 447On Mac OS, assumes that the last part of the path is a filename unless 448$no_file is true or a trailing separator ":" is present. 449 450The volume portion is always returned with a trailing ":". The directory portion 451is always returned with a leading (to denote a relative path) and a trailing ":" 452(to denote a directory). The file portion is always returned I<without> a leading ":". 453Empty portions are returned as empty string ''. 454 455The results can be passed to C<catpath()> to get back a path equivalent to 456(usually identical to) the original path. 457 458 459=cut 460 461sub splitpath { 462 my ($self,$path, $nofile) = @_; 463 my ($volume,$directory,$file); 464 465 if ( $nofile ) { 466 ( $volume, $directory ) = $path =~ m|^((?:[^:]+:)?)(.*)|s; 467 } 468 else { 469 $path =~ 470 m|^( (?: [^:]+: )? ) 471 ( (?: .*: )? ) 472 ( .* ) 473 |xs; 474 $volume = $1; 475 $directory = $2; 476 $file = $3; 477 } 478 479 $volume = '' unless defined($volume); 480 $directory = ":$directory" if ( $volume && $directory ); # take care of "HD::dir" 481 if ($directory) { 482 # Make sure non-empty directories begin and end in ':' 483 $directory .= ':' unless (substr($directory,-1) eq ':'); 484 $directory = ":$directory" unless (substr($directory,0,1) eq ':'); 485 } else { 486 $directory = ''; 487 } 488 $file = '' unless defined($file); 489 490 return ($volume,$directory,$file); 491} 492 493 494=item splitdir 495 496The opposite of C<catdir()>. 497 498 @dirs = File::Spec->splitdir( $directories ); 499 500$directories should be only the directory portion of the path on systems 501that have the concept of a volume or that have path syntax that differentiates 502files from directories. Consider using C<splitpath()> otherwise. 503 504Unlike just splitting the directories on the separator, empty directory names 505(C<"">) can be returned. Since C<catdir()> on Mac OS always appends a trailing 506colon to distinguish a directory path from a file path, a single trailing colon 507will be ignored, i.e. there's no empty directory name after it. 508 509Hence, on Mac OS, both 510 511 File::Spec->splitdir( ":a:b::c:" ); and 512 File::Spec->splitdir( ":a:b::c" ); 513 514yield: 515 516 ( "a", "b", "::", "c") 517 518while 519 520 File::Spec->splitdir( ":a:b::c::" ); 521 522yields: 523 524 ( "a", "b", "::", "c", "::") 525 526 527=cut 528 529sub splitdir { 530 my ($self, $path) = @_; 531 my @result = (); 532 my ($head, $sep, $tail, $volume, $directories); 533 534 return ('') if ( (!defined($path)) || ($path eq '') ); 535 return (':') if ($path eq ':'); 536 537 ( $volume, $sep, $directories ) = $path =~ m|^((?:[^:]+:)?)(:*)(.*)|s; 538 539 # deprecated, but handle it correctly 540 if ($volume) { 541 push (@result, $volume); 542 $sep .= ':'; 543 } 544 545 while ($sep || $directories) { 546 if (length($sep) > 1) { 547 my $updir_count = length($sep) - 1; 548 for (my $i=0; $i<$updir_count; $i++) { 549 # push '::' updir_count times; 550 # simulate Unix '..' updirs 551 push (@result, '::'); 552 } 553 } 554 $sep = ''; 555 if ($directories) { 556 ( $head, $sep, $tail ) = $directories =~ m|^((?:[^:]+)?)(:*)(.*)|s; 557 push (@result, $head); 558 $directories = $tail; 559 } 560 } 561 return @result; 562} 563 564 565=item catpath 566 567 $path = File::Spec->catpath($volume,$directory,$file); 568 569Takes volume, directory and file portions and returns an entire path. On Mac OS, 570$volume, $directory and $file are concatenated. A ':' is inserted if need be. You 571may pass an empty string for each portion. If all portions are empty, the empty 572string is returned. If $volume is empty, the result will be a relative path, 573beginning with a ':'. If $volume and $directory are empty, a leading ":" (if any) 574is removed form $file and the remainder is returned. If $file is empty, the 575resulting path will have a trailing ':'. 576 577 578=cut 579 580sub catpath { 581 my ($self,$volume,$directory,$file) = @_; 582 583 if ( (! $volume) && (! $directory) ) { 584 $file =~ s/^:// if $file; 585 return $file ; 586 } 587 588 # We look for a volume in $volume, then in $directory, but not both 589 590 my ($dir_volume, $dir_dirs) = $self->splitpath($directory, 1); 591 592 $volume = $dir_volume unless length $volume; 593 my $path = $volume; # may be '' 594 $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':' 595 596 if ($directory) { 597 $directory = $dir_dirs if $volume; 598 $directory =~ s/^://; # remove leading ':' if any 599 $path .= $directory; 600 $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':' 601 } 602 603 if ($file) { 604 $file =~ s/^://; # remove leading ':' if any 605 $path .= $file; 606 } 607 608 return $path; 609} 610 611=item abs2rel 612 613Takes a destination path and an optional base path and returns a relative path 614from the base path to the destination path: 615 616 $rel_path = File::Spec->abs2rel( $path ) ; 617 $rel_path = File::Spec->abs2rel( $path, $base ) ; 618 619Note that both paths are assumed to have a notation that distinguishes a 620directory path (with trailing ':') from a file path (without trailing ':'). 621 622If $base is not present or '', then the current working directory is used. 623If $base is relative, then it is converted to absolute form using C<rel2abs()>. 624This means that it is taken to be relative to the current working directory. 625 626If $path and $base appear to be on two different volumes, we will not 627attempt to resolve the two paths, and we will instead simply return 628$path. Note that previous versions of this module ignored the volume 629of $base, which resulted in garbage results part of the time. 630 631If $base doesn't have a trailing colon, the last element of $base is 632assumed to be a filename. This filename is ignored. Otherwise all path 633components are assumed to be directories. 634 635If $path is relative, it is converted to absolute form using C<rel2abs()>. 636This means that it is taken to be relative to the current working directory. 637 638Based on code written by Shigio Yamaguchi. 639 640 641=cut 642 643# maybe this should be done in canonpath() ? 644sub _resolve_updirs { 645 my $path = shift @_; 646 my $proceed; 647 648 # resolve any updirs, e.g. "HD:tmp::file" -> "HD:file" 649 do { 650 $proceed = ($path =~ s/^(.*):[^:]+::(.*?)\z/$1:$2/); 651 } while ($proceed); 652 653 return $path; 654} 655 656 657sub abs2rel { 658 my($self,$path,$base) = @_; 659 660 # Clean up $path 661 if ( ! $self->file_name_is_absolute( $path ) ) { 662 $path = $self->rel2abs( $path ) ; 663 } 664 665 # Figure out the effective $base and clean it up. 666 if ( !defined( $base ) || $base eq '' ) { 667 $base = $self->_cwd(); 668 } 669 elsif ( ! $self->file_name_is_absolute( $base ) ) { 670 $base = $self->rel2abs( $base ) ; 671 $base = _resolve_updirs( $base ); # resolve updirs in $base 672 } 673 else { 674 $base = _resolve_updirs( $base ); 675 } 676 677 # Split up paths - ignore $base's file 678 my ( $path_vol, $path_dirs, $path_file ) = $self->splitpath( $path ); 679 my ( $base_vol, $base_dirs ) = $self->splitpath( $base ); 680 681 return $path unless lc( $path_vol ) eq lc( $base_vol ); 682 683 # Now, remove all leading components that are the same 684 my @pathchunks = $self->splitdir( $path_dirs ); 685 my @basechunks = $self->splitdir( $base_dirs ); 686 687 while ( @pathchunks && 688 @basechunks && 689 lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) { 690 shift @pathchunks ; 691 shift @basechunks ; 692 } 693 694 # @pathchunks now has the directories to descend in to. 695 # ensure relative path, even if @pathchunks is empty 696 $path_dirs = $self->catdir( ':', @pathchunks ); 697 698 # @basechunks now contains the number of directories to climb out of. 699 $base_dirs = (':' x @basechunks) . ':' ; 700 701 return $self->catpath( '', $self->catdir( $base_dirs, $path_dirs ), $path_file ) ; 702} 703 704=item rel2abs 705 706Converts a relative path to an absolute path: 707 708 $abs_path = File::Spec->rel2abs( $path ) ; 709 $abs_path = File::Spec->rel2abs( $path, $base ) ; 710 711Note that both paths are assumed to have a notation that distinguishes a 712directory path (with trailing ':') from a file path (without trailing ':'). 713 714If $base is not present or '', then $base is set to the current working 715directory. If $base is relative, then it is converted to absolute form 716using C<rel2abs()>. This means that it is taken to be relative to the 717current working directory. 718 719If $base doesn't have a trailing colon, the last element of $base is 720assumed to be a filename. This filename is ignored. Otherwise all path 721components are assumed to be directories. 722 723If $path is already absolute, it is returned and $base is ignored. 724 725Based on code written by Shigio Yamaguchi. 726 727=cut 728 729sub rel2abs { 730 my ($self,$path,$base) = @_; 731 732 if ( ! $self->file_name_is_absolute($path) ) { 733 # Figure out the effective $base and clean it up. 734 if ( !defined( $base ) || $base eq '' ) { 735 $base = $self->_cwd(); 736 } 737 elsif ( ! $self->file_name_is_absolute($base) ) { 738 $base = $self->rel2abs($base) ; 739 } 740 741 # Split up paths 742 743 # igonore $path's volume 744 my ( $path_dirs, $path_file ) = ($self->splitpath($path))[1,2] ; 745 746 # ignore $base's file part 747 my ( $base_vol, $base_dirs ) = $self->splitpath($base) ; 748 749 # Glom them together 750 $path_dirs = ':' if ($path_dirs eq ''); 751 $base_dirs =~ s/:$//; # remove trailing ':', if any 752 $base_dirs = $base_dirs . $path_dirs; 753 754 $path = $self->catpath( $base_vol, $base_dirs, $path_file ); 755 } 756 return $path; 757} 758 759 760=back 761 762=head1 AUTHORS 763 764See the authors list in I<File::Spec>. Mac OS support by Paul Schinder 765<schinder@pobox.com> and Thomas Wegner <wegner_thomas@yahoo.com>. 766 767=head1 SEE ALSO 768 769See L<File::Spec> and L<File::Spec::Unix>. This package overrides the 770implementation of these methods, not the semantics. 771 772=cut 773 7741; 775