home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / Mac.pm < prev    next >
Text File  |  2003-11-07  |  22KB  |  775 lines
  1. package File::Spec::Mac;
  2.  
  3. use strict;
  4. use vars qw(@ISA $VERSION);
  5. require File::Spec::Unix;
  6.  
  7. $VERSION = '1.4';
  8.  
  9. @ISA = qw(File::Spec::Unix);
  10.  
  11. my $macfiles;
  12. if ($^O eq 'MacOS') {
  13.     $macfiles = eval { require Mac::Files };
  14. }
  15.  
  16. sub case_tolerant { 1 }
  17.  
  18.  
  19. =head1 NAME
  20.  
  21. File::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.  
  29. Methods for manipulating file specifications.
  30.  
  31. =head1 METHODS
  32.  
  33. =over 2
  34.  
  35. =item canonpath
  36.  
  37. On Mac OS, there's nothing to be done. Returns what it's given.
  38.  
  39. =cut
  40.  
  41. sub canonpath {
  42.     my ($self,$path) = @_;
  43.     return $path;
  44. }
  45.  
  46. =item catdir()
  47.  
  48. Concatenate two or more directory names to form a path separated by colons
  49. (":") ending with a directory. Resulting paths are B<relative> by default,
  50. but can be forced to be absolute (but avoid this, see below). Automatically
  51. puts a trailing ":" on the end of the complete path, because that's what's
  52. done in MacPerl's environment and helps to distinguish a file path from a
  53. directory path.
  54.  
  55. B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the resulting
  56. path is relative by default and I<not> absolute. This descision was made due
  57. to portability reasons. Since C<File::Spec-E<gt>catdir()> returns relative paths
  58. on all other operating systems, it will now also follow this convention on Mac
  59. OS. Note that this may break some existing scripts.
  60.  
  61. The intended purpose of this routine is to concatenate I<directory names>.
  62. But because of the nature of Macintosh paths, some additional possibilities
  63. are allowed to make using this routine give reasonable results for some
  64. common situations. In other words, you are also allowed to concatenate
  65. I<paths> instead of directory names (strictly speaking, a string like ":a"
  66. is a path, but not a name, since it contains a punctuation character ":").
  67.  
  68. So, beside calls like
  69.  
  70.     catdir("a") = ":a:"
  71.     catdir("a","b") = ":a:b:"
  72.     catdir() = ""                    (special case)
  73.  
  74. calls 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.  
  82. are allowed.
  83.  
  84. Here are the rules that are used in C<catdir()>; note that we try to be as
  85. compatible as possible to Unix:
  86.  
  87. =over 2
  88.  
  89. =item 1.
  90.  
  91. The resulting path is relative by default, i.e. the resulting path will have a
  92. leading colon.
  93.  
  94. =item 2.
  95.  
  96. A trailing colon is added automatically to the resulting path, to denote a
  97. directory.
  98.  
  99. =item 3.
  100.  
  101. Generally, each argument has one leading ":" and one trailing ":"
  102. removed (if any). They are then joined together by a ":". Special
  103. treatment applies for arguments denoting updir paths like "::lib:",
  104. see (4), or arguments consisting solely of colons ("colon paths"),
  105. see (5).
  106.  
  107. =item 4.
  108.  
  109. When an updir path like ":::lib::" is passed as argument, the number
  110. of directories to climb up is handled correctly, not removing leading
  111. or 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.  
  118. Adding a colon ":" or empty string "" to a path at I<any> position
  119. doesn't alter the path, i.e. these arguments are ignored. (When a ""
  120. is passed as the first argument, it has a special meaning, see
  121. (6)). This way, a colon ":" is handled like a "." (curdir) on Unix,
  122. while an empty string "" is generally ignored (see
  123. C<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.  
  131. If the first argument is an empty string "" or is a volume name, i.e. matches
  132. the pattern /^[^:]+:/, the resulting path is B<absolute>.
  133.  
  134. =item 7.
  135.  
  136. Passing an empty string "" as the first argument to C<catdir()> is
  137. like 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.  
  143. This is true on Unix, where C<catdir("","a","b")> yields "/a/b" and
  144. C<rootdir()> is "/". Note that C<rootdir()> on Mac OS is the startup
  145. volume, which is the closest in concept to Unix' "/". This should help
  146. to run existing scripts originally written for Unix.
  147.  
  148. =item 8.
  149.  
  150. For absolute paths, some cleanup is done, to ensure that the volume
  151. name isn't immediately followed by updirs. This is invalid, because
  152. this would go beyond "root". Generally, these cases are handled like
  153. their 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.  
  166. However, this approach is limited to the first arguments following
  167. "root" (again, see C<Unix-E<gt>canonpath()> ). If there are more
  168. arguments that move up the directory tree, an invalid path going
  169. beyond root can be created.
  170.  
  171. =back
  172.  
  173. As you've seen, you can force C<catdir()> to create an absolute path
  174. by passing either an empty string or a path that begins with a volume
  175. name as the first argument. However, you are strongly encouraged not
  176. to do so, since this is done only for backward compatibility. Newer
  177. versions of File::Spec come with a method called C<catpath()> (see
  178. below), that is designed to offer a portable solution for the creation
  179. of absolute paths.  It takes volume, directory and file portions and
  180. returns an entire path. While C<catdir()> is still suitable for the
  181. concatenation of I<directory names>, you are encouraged to use
  182. C<catpath()> to concatenate I<volume names> and I<directory
  183. paths>. E.g.
  184.  
  185.     $dir      = File::Spec->catdir("tmp","sources");
  186.     $abs_path = File::Spec->catpath("MacintoshHD:", $dir,"");
  187.  
  188. yields
  189.  
  190.     "MacintoshHD:tmp:sources:" .
  191.  
  192. =cut
  193.  
  194. sub 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.  
  269. Concatenate one or more directory names and a filename to form a
  270. complete path ending with a filename. Resulting paths are B<relative>
  271. by default, but can be forced to be absolute (but avoid this).
  272.  
  273. B<IMPORTANT NOTE:> Beginning with version 1.3 of this module, the
  274. resulting path is relative by default and I<not> absolute. This
  275. descision was made due to portability reasons. Since
  276. C<File::Spec-E<gt>catfile()> returns relative paths on all other
  277. operating systems, it will now also follow this convention on Mac OS.
  278. Note that this may break some existing scripts.
  279.  
  280. The last argument is always considered to be the file portion. Since
  281. C<catfile()> uses C<catdir()> (see above) for the concatenation of the
  282. directory portions (if any), the following with regard to relative and
  283. absolute paths is true:
  284.  
  285.     catfile("")     = ""
  286.     catfile("file") = "file"
  287.  
  288. but
  289.  
  290.     catfile("","")        = rootdir()         # (e.g. "HD:")
  291.     catfile("","file")    = rootdir() . file  # (e.g. "HD:file")
  292.     catfile("HD:","file") = "HD:file"
  293.  
  294. This means that C<catdir()> is called only when there are two or more
  295. arguments, as one might expect.
  296.  
  297. Note 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.  
  303. give the same answer.
  304.  
  305. To concatenate I<volume names>, I<directory paths> and I<filenames>,
  306. you are encouraged to use C<catpath()> (see below).
  307.  
  308. =cut
  309.  
  310. sub 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.  
  322. Returns a string representing the current directory. On Mac OS, this is ":".
  323.  
  324. =cut
  325.  
  326. sub curdir {
  327.     return ":";
  328. }
  329.  
  330. =item devnull
  331.  
  332. Returns a string representing the null device. On Mac OS, this is "Dev:Null".
  333.  
  334. =cut
  335.  
  336. sub devnull {
  337.     return "Dev:Null";
  338. }
  339.  
  340. =item rootdir
  341.  
  342. Returns a string representing the root directory.  Under MacPerl,
  343. returns the name of the startup volume, since that's the closest in
  344. concept, although other volumes aren't rooted there. The name has a
  345. trailing ":", because that's the correct specification for a volume
  346. name on Mac OS.
  347.  
  348. If Mac::Files could not be loaded, the empty string is returned.
  349.  
  350. =cut
  351.  
  352. sub 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.  
  366. Returns the contents of $ENV{TMPDIR}, if that directory exits or the
  367. current working directory otherwise. Under MacPerl, $ENV{TMPDIR} will
  368. contain a path like "MacintoshHD:Temporary Items:", which is a hidden
  369. directory on your startup volume.
  370.  
  371. =cut
  372.  
  373. my $tmpdir;
  374. sub tmpdir {
  375.     return $tmpdir if defined $tmpdir;
  376.     my $self = shift;
  377.     $tmpdir = $self->_tmpdir( $ENV{TMPDIR} );
  378. }
  379.  
  380. =item updir
  381.  
  382. Returns a string representing the parent directory. On Mac OS, this is "::".
  383.  
  384. =cut
  385.  
  386. sub updir {
  387.     return "::";
  388. }
  389.  
  390. =item file_name_is_absolute
  391.  
  392. Takes as argument a path and returns true, if it is an absolute path.
  393. If the path has a leading ":", it's a relative path. Otherwise, it's an
  394. absolute path, unless the path doesn't contain any colons, i.e. it's a name
  395. like "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
  397. in the path if you want to distinguish unambiguously. As a special case,
  398. the filename '' is always considered to be absolute. Note that with version
  399. 1.2 of File::Spec::Mac, this does no longer consult the local filesystem.
  400.  
  401. E.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.  
  411. sub 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.  
  424. Returns the null list for the MacPerl application, since the concept is
  425. usually meaningless under Mac OS. But if you're using the MacPerl tool under
  426. MPW, it gives back $ENV{Commands} suitably split, as is done in
  427. :lib:ExtUtils:MM_Mac.pm.
  428.  
  429. =cut
  430.  
  431. sub 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.  
  445. Splits a path into volume, directory, and filename portions.
  446.  
  447. On 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.  
  450. The volume portion is always returned with a trailing ":". The directory portion
  451. is 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 ":".
  453. Empty portions are returned as empty string ''.
  454.  
  455. The 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.  
  461. sub 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.  
  496. The 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
  501. that have the concept of a volume or that have path syntax that differentiates
  502. files from directories. Consider using C<splitpath()> otherwise.
  503.  
  504. Unlike 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
  506. colon to distinguish a directory path from a file path, a single trailing colon
  507. will be ignored, i.e. there's no empty directory name after it.
  508.  
  509. Hence, on Mac OS, both
  510.  
  511.     File::Spec->splitdir( ":a:b::c:" );    and
  512.     File::Spec->splitdir( ":a:b::c" );
  513.  
  514. yield:
  515.  
  516.     ( "a", "b", "::", "c")
  517.  
  518. while
  519.  
  520.     File::Spec->splitdir( ":a:b::c::" );
  521.  
  522. yields:
  523.  
  524.     ( "a", "b", "::", "c", "::")
  525.  
  526.  
  527. =cut
  528.  
  529. sub 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.  
  569. Takes 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
  571. may pass an empty string for each portion. If all portions are empty, the empty
  572. string is returned. If $volume is empty, the result will be a relative path,
  573. beginning with a ':'. If $volume and $directory are empty, a leading ":" (if any)
  574. is removed form $file and the remainder is returned. If $file is empty, the
  575. resulting path will have a trailing ':'.
  576.  
  577.  
  578. =cut
  579.  
  580. sub 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.  
  613. Takes a destination path and an optional base path and returns a relative path
  614. from the base path to the destination path:
  615.  
  616.     $rel_path = File::Spec->abs2rel( $path ) ;
  617.     $rel_path = File::Spec->abs2rel( $path, $base ) ;
  618.  
  619. Note that both paths are assumed to have a notation that distinguishes a
  620. directory path (with trailing ':') from a file path (without trailing ':').
  621.  
  622. If $base is not present or '', then the current working directory is used.
  623. If $base is relative, then it is converted to absolute form using C<rel2abs()>.
  624. This means that it is taken to be relative to the current working directory.
  625.  
  626. If $path and $base appear to be on two different volumes, we will not
  627. attempt to resolve the two paths, and we will instead simply return
  628. $path.  Note that previous versions of this module ignored the volume
  629. of $base, which resulted in garbage results part of the time.
  630.  
  631. If $base doesn't have a trailing colon, the last element of $base is
  632. assumed to be a filename.  This filename is ignored.  Otherwise all path
  633. components are assumed to be directories.
  634.  
  635. If $path is relative, it is converted to absolute form using C<rel2abs()>.
  636. This means that it is taken to be relative to the current working directory.
  637.  
  638. Based on code written by Shigio Yamaguchi.
  639.  
  640.  
  641. =cut
  642.  
  643. # maybe this should be done in canonpath() ?
  644. sub _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.  
  657. sub 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.  
  706. Converts a relative path to an absolute path:
  707.  
  708.     $abs_path = File::Spec->rel2abs( $path ) ;
  709.     $abs_path = File::Spec->rel2abs( $path, $base ) ;
  710.  
  711. Note that both paths are assumed to have a notation that distinguishes a
  712. directory path (with trailing ':') from a file path (without trailing ':').
  713.  
  714. If $base is not present or '', then $base is set to the current working
  715. directory. If $base is relative, then it is converted to absolute form
  716. using C<rel2abs()>. This means that it is taken to be relative to the
  717. current working directory.
  718.  
  719. If $base doesn't have a trailing colon, the last element of $base is
  720. assumed to be a filename.  This filename is ignored.  Otherwise all path
  721. components are assumed to be directories.
  722.  
  723. If $path is already absolute, it is returned and $base is ignored.
  724.  
  725. Based on code written by Shigio Yamaguchi.
  726.  
  727. =cut
  728.  
  729. sub 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.  
  764. See 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.  
  769. See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
  770. implementation of these methods, not the semantics.
  771.  
  772. =cut
  773.  
  774. 1;
  775.