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