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