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