File Coverage

blib/lib/File/PathConvert.pm

Criterion	Covered	Total	%
statement	190	243	78.1
branch	73	116	62.9
condition	59	90	65.5
subroutine	14	15	93.3
pod	0	9	0.0
total	336	473	71.0

#
# Copyright (c) 1996, 1997, 1998 Shigio Yamaguchi. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
#       File::PathConvert.pm
#

package File::PathConvert;
require 5.002;

use strict ;

BEGIN {
   use Exporter   ();
   use vars       qw($VERSION @ISA @EXPORT_OK);
   $VERSION       = 0.9;
   @ISA           = qw(Exporter);
   @EXPORT_OK     = qw(setfstype splitpath joinpath splitdirs joindirs realpath abs2rel rel2abs $maxsymlinks $verbose $SL $resolved );
}

use vars      qw( $maxsymlinks $verbose $SL $resolved ) ;
use Cwd;

#
# Initialize @EXPORT_OK vars
#
$maxsymlinks   = 32;       # allowed symlink number in a path
$verbose       = 0;        # 1: verbose on, 0: verbose off
$SL            = '' ;      # Separator char export
$resolved      = '' ;      # realpath() intermediate value export

#############################################################################
#
#  Package Globals
#

my $fstype        ; # A name indicating the type of filesystem currently in use
my $sep           ; # separator
my $sepRE         ; # RE to match spearator
my $notsepRE      ; # RE to match anything else
my $volumeRE      ; # RE to match the volume name
my $directoryRE   ; # RE to match the directory name
my $isrootRE      ; # RE to match root path: applied to directory portion only
#my $thisDir       ; # Name of this directory
my $thisDirRE     ; # Name of this directory
my $parentDir     ; # Name of parent directory
my $parentDirRE   ; # RE to match parent dir name
my $casesensitive ; # Set to non-zero for case sensitive name comprisions.  Only
                    # affects names, not any other REs, so $isrootRE for Win32
                    # must be case insensitive
my $idempotent    ; # Set to non-zero if '//' is equivalent to '/'.  This
                    # does not affect leading '//' and '\\' under Win32,
                    # but will fold '///' and '////', etc, in to '//' on this
                    # Win32



###########
#
# The following globals are regexs used in the indicated routines.  These
# are initialized by setfstype, so they don't need to be rebuilt each time
# the routine that uses them is called.

my $basenamesplitRE ; # Used in realpath() to split filenames.


###########
#
# This RE matches (and saves) the portion of the string that is just before
# the beginning of a name
#
my $beginning_of_name ;

#
# This whopper of an RE looks for the pattern "name/.." if it occurs
# after the beginning of the string or after the root RE, or after a separator.
# We don't assume that the isrootRE has a trailing separator.
# It also makes sure that we aren't eliminating '../..' and './..' patterns
# by using the negative lookahead assertion '(?!' ... ')' construct.  It also
# ignores 'name/..name'.
#
my $name_sep_parentRE ;

#
# Matches '..$', '../' after a root
my $leading_parentRE ;

#
# Matches things like '/(./)+' and '^(./)+'
#
my $dot_sep_etcRE ;

#
# Matches trailing '/' or '/.'
#
my $trailing_sepRE ;


#############################################################################
#
#     Functions
#


#
# setfstype: takes the name of an operating system and sets up globals that
#            allow the other functions to operate on multiple OSs.  See
#            %fsconfig for the sets of settings.
#
#            This is run once on module load to configure for the OS named
#            in $^O.
#
# Interface:
#       i)     $osname, as in $^O or plain english: "MacOS", "DOS, etc.
#              This is _not_ usually case sensitive.
#       r)     Name of recognized name on success else undef.  Note that, as
#              shipped, 'unix' is the default is nothing else matches.
#       go)    $fstype and lots of internal parameters and regexs.
#       x)     Dies if a parameter required in @fsconfig is missing.
#
#
# There are some things I couldn't figure a way to parameterize by setting
# globals. $fstype is checked for filesystem type-specific logic, like
# VMS directory syntax.
#
# Setting up for a particular OS type takes two steps: identify the OS and
# set all of the 'atomic' global variables, then take some of the atomic
# globals which are regexps and build composite values from them.
#
# The atomic regexp terms are generally used to build the larger composite
# regexps that recognize and break apart paths.  This leads to
# two important rules for the atomic regexp terms:
#
# (1) Do not use '(' ... ')' in the regex terms, since they are used to build
# regexs that use '(' ... ')' to parse paths.
#
# (2) They must be built so that a '?' or other quantifier may be appended.
# This generally means using the '(?:' ... ')' or '[' ... ']' to group
# multicharacter patterns.  Other '(?' ... ')' may also do.
#
# The routines herein strive to preserve the
# original separator and root settings, and, it turns out, never need to
# prepend root to a string (although they do need to insert separators on
# occasion).  This is good, since the Win32 root expressions can be like
# '/', '\', 'A:/', 'a:/', or even '\\' or '//' for UNC style names.
#
# Note that the default root and default notsep are not used, and so are
# undefined.
#
# For DOS, MacOS, and VMS, we assume that all paths handed in are on the same
# volume.  This is not a significant limitation except for abs2rel, since the
# absolute path is assumed to be on the same volume as the base path.
#
sub setfstype($;) {
   my( $osname ) = @_ ;

   # Find the best match for OS and set up our atomic globals accordingly
   if ( $osname =~ /^(?:(ms)?(dos|win(32|nt)?))/i )
   {
      $fstype           = 'Win32' ;
      $sep              = '/' ;
      $sepRE            = '[\\\\/]' ;
      $notsepRE         = '[^\\\\/]' ;
      $volumeRE         = '(?:^(?:[a-zA-Z]:|(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+)?)' ;
      $directoryRE      = '(?:(?:.*[\\\\/](?:\.\.?$)?)?)' ;
      $isrootRE         = '(?:^[\\\\/])' ;
#      $thisDir          = '.' ;
      $thisDirRE        = '\.' ;
      $parentDir        = '..' ;
      $parentDirRE      = '(?:\.\.)' ;
      $casesensitive    = 0 ;
      $idempotent       = 1 ;
   }
   elsif ( $osname =~ /^MacOS$/i )
   {
      $fstype           = 'MacOS' ;
      $sep              = ':' ;
      $sepRE            = '\:' ;
      $notsepRE         = '[^:]' ;
      $volumeRE         = '(?:^(?:[^:]+:)?)' ;
      $directoryRE      = '(?:(?:.*:)?)' ;
      $isrootRE         = '(?:^(?=[^:].*:)?)' ;
#      $thisDir          = '' ;
      $thisDirRE        = 'cantpossiblymatchthis' ;
      $parentDir        = '' ;
      $parentDirRE      = '(?=(?<=:):)' ;
      $casesensitive    = 0 ;
      $idempotent       = 0 ;
   }
   elsif ( $osname =~ /^VMS$/i )
   {
      $fstype           = 'VMS' ;
      $sep              = '.' ;
      $sepRE            = '[\.\]]' ;
      $notsepRE         = '[^\.\]]' ;
      # volume is node::volume:, where node:: and volume: are optional
      # and node:: cannot be present without volume.  node can include
      # an access control string in double quotes.
      # Not supported:
      #     quoted full node names
      #     embedding a double quote in a string ("" to put " in)
      #     support ':' in node names
      #     foreign file specifications
      #     task specifications
      #     UIC Directory format (use the 6 digit name for it, instead)
      $volumeRE         = '(?:^(?:(?:[\w\$-]+(?:"[^"]*")?::)?[\w\$-]+:)?)' ;
      $directoryRE      = '(?:(?:\[.*\])?)' ;

      # Root is the lack of a leading '.', unless string is empty, which
      # means 'cwd', which is relative.
      $isrootRE         = '(?:^[^\.])' ;
#      $thisDir          = '' ;
      $thisDirRE        = '\[\]' ;
      $parentDir        = '-' ;
      $parentDirRE      = '-' ;
      $casesensitive    = 0 ;
      $idempotent       = 0 ;
   }
   elsif ( $osname =~ /^URL$/i )
   {
      # URL spec based on RFC2396 (ftp://ftp.isi.edu/in-notes/rfc2396.txt)
      $fstype           = 'URL' ;
      $sep              = '/' ;
      $sepRE            = '/' ;
      $notsepRE         = '[^/]' ;
      # Volume= scheme + authority, both optional
      $volumeRE         = '(?:^(?:[a-zA-Z][a-zA-Z0-9+-.]*:)?(?://[^/?]*)?)' ;

      # Directories do _not_ include the query component: we pretend that
      # anything after a "?" is the filename or part of it.  So a '/'
      # terminates and is part of the directory spec, while a '?' or '#'
      # terminate and are not part of the directory spec.
      #
      # We pretend that ";param" syntax does not exist
      #
      $directoryRE      = '(?:(?:[^?#]*/(?:\.\.?(?:$|(?=[?#])))?)?)' ;
      $isrootRE         = '(?:^/)' ;
#      $thisDir          = '.' ;
      $thisDirRE        = '\.' ;
      $parentDir        = '..' ;
      $parentDirRE      = '(?:\.\.)' ;
      # Assume case sensitive, since many (most?) are.  The user can override
      # this if they so desire.
      $casesensitive    = 1 ;
      $idempotent       = 1 ;
   }
   else
   {
      $fstype           = 'Unix' ;
      $sep              = '/' ;
      $sepRE            = '/' ;
      $notsepRE         = '[^/]' ;
      $volumeRE         = '' ;
      $directoryRE      = '(?:(?:.*/(?:\.\.?$)?)?)' ;
      $isrootRE         = '(?:^/)' ;
#      $thisDir          = '.' ;
      $thisDirRE        = '\.' ;
      $parentDir        = '..' ;
      $parentDirRE      = '(?:\.\.)' ;
      $casesensitive    = 1 ;
      $idempotent       = 1 ;
   }

   # Now set our composite regexps.

   # Maintain old name for backward compatibility
   $SL= $sep ;

   # Build lots of REs used below, so they don't need to be built every time
   # the routines that use them are called.
   $basenamesplitRE   = '^(.*)' . $sepRE . '(' . $notsepRE . '*)$' ;

   $leading_parentRE  = '(' . $isrootRE . '?)(?:' . $parentDirRE . $sepRE . ')*(?:' . $parentDirRE . '$)?' ;
   $trailing_sepRE    = '(.)' . $sepRE . $thisDirRE . '?$' ;

   $beginning_of_name = '(?:^|' . $isrootRE . '|' . $sepRE . ')' ;

   $dot_sep_etcRE     =
      '(' . $beginning_of_name . ')(?:' . $thisDirRE . $sepRE . ')+';

   $name_sep_parentRE =
      '(' . $beginning_of_name . ')'
      . '(?!(?:' . $thisDirRE . '|' . $parentDirRE . ')' . $sepRE . ')'
      . $notsepRE . '+'
      . $sepRE . $parentDirRE
      . '(?:' . $sepRE . '|$)'
      ;

   if ( $verbose ) {
      print( <
fstype        = "$fstype"
sep           = "$sep"
sepRE         = /$sepRE/
notsepRE      = /$notsepRE/
volumeRE      = /$volumeRE/
directoryRE   = /$directoryRE/
isrootRE      = /$isrootRE/
thisDirRE     = /$thisDirRE/
parentDir     = "$parentDir"
parentDirRE   = /$parentDirRE/
casesensitive = "$casesensitive"
TOHERE
#thisDir       = "$thisDir"
   }

   return $fstype ;
}


setfstype( $^O ) ;


#
# splitpath: Splits a path into component parts: volume, dirpath, and filename.
#
#           Very much like File::Basename::fileparse(), but doesn't concern
#           itself with extensions and knows about volume names.
#
#           Returns ($volume, $directory, $filename ).
#
#           The contents of the returned list varies by operating system.
#
#           Unix:
#              $volume: always ''
#              $directory: up to, and including, final '/'
#              $filename: after final '/'
#
#           Win32:
#              $volume: drive letter and ':', if present
#              $directory and $filename are like on Unix, but '\' and '/' are
#              equivalent and the $volume is not in $directory..
#
#           VMS:
#              $volume: up to and including first ":"
#              $directory: "[...]" component
#              $filename: the rest.
#              $nofile is ignored
#
#           URL:
#              $volume: up to ':', then '//stuff/morestuff'.  No trailing '/'.
#              $directory: after $volume, up to last '/'
#              $filename: the rest.
#              $nofile is ignored
#
# Interface:
#       i)     $path
#       i)     $nofile: if true, then any trailing filename is assumed to
#              belong to the directory for non-VMS systems.
#       r)     list of ( $volume, $directory, $filename ).
#
sub splitpath {
   my( $path, $nofile )= @_ ;
   my( $volume, $directory, $file ) ;
   if ( $fstype ne 'VMS' && $fstype ne 'URL' && $nofile ) {
      $path =~ m/($volumeRE)(.*)$/ ;
      $volume   = $1 ;
      $directory= $2 ;
      $file     = '' ;
   }
   else {
      $path =~ m/($volumeRE)($directoryRE)(.*)$/ ;
      $volume   = $1 ;
      $directory= $2 ;
      $file     = $3 ;
   }

   # For Win32 UNC, force the directory portion to be non-empty. This is
   # because all UNC names are absolute, even if there's no trailing separator
   # after the sharename.
   #
   # This is a bit of a hack, necesitated by the implementation of $isrootRE,
   # which is only applied to the directory portion.
   #
   # A better long term solution might be to make the isroot test a member
   # function in the future, object-oriented version of this.
   #
   $directory = $1
     if ( $fstype eq 'Win32' && $volume =~ /^($sepRE)$sepRE/ && $directory eq '' ) ;

   return ( $volume, $directory, $file ) ;
}


#
# joinpath: joins the results of splitpath().  Not really necessary now, but
# good to have:
#
#     - API completeness
#     - Self documenting code
#     - Future handling of other filesystems
#
# For instance, if you leave the ':' or the '[' and ']' out of VMS $volume
# and $directory strings, this patches it up.  If you leave out the '['
# and provide the ']', or vice versa, it is not cleaned up.  This is
# because it's useful to automatically insert both '[' and ']', but if you
# leave off only one, it's likely that there's a bug elsewhere that needs
# looking in to.
#
# Automatically inserts a separator between directory and filename if needed
# for non-VMS OSs.
#
# Automatically inserts a separator between volume and directory or file
# if needed for Win32 UNC names.
#
sub joinpath($;$;$;) {
   my( $volume, $directory, $filename )= @_ ;

   # Fix up delimiters for $volume and $directory as needed for various OSs
   if ( $fstype eq 'VMS' ) {
      $volume .= ':'
         if ( $volume ne '' && $volume !~ m/:$/ ) ;

      $directory = join( '', ( '[', $directory, ']' ) )
         if ( $directory ne '' && $directory !~ m/^\[.*\]$/ ) ;
   }
   else {
      # Add trailing separator to directory names that require it and
      # need it.  URLs always require it if there are any directory
      # components.
      $directory .= $sep
         if (  $directory ne ''
            && ( $fstype eq 'URL' || $filename ne '' )
            && $directory !~ m/$sepRE$/
            ) ;

      # Add trailing separator to volume for UNC and HTML volume
      # names that lack it and need it.
      # Note that if a URL volume is a scheme only (ends in ':'),
      # we don't require a separator: it's a relative URL.
      $volume .= $sep
         if (  (  ( $fstype eq 'Win32' && $volume =~ m#^$sepRE{2}# )
               || ( $fstype eq 'URL'   && $volume =~ m#[^:/]$#     )
               )
            && $volume    !~ m#$sepRE$#
            && $directory !~ m#^$sepRE#
            && ( $directory ne '' || $filename ne '' )
            ) ;
   }

   return join( '', $volume, $directory, $filename ) ;
}


#
# splitdirs: Splits a string containing directory portion of a path
# in to component parts.  Preserves trailing null entries, unlike split().
#
# "a/b" should get you [ 'a', 'b' ]
#
# "a/b/" should get you [ 'a', 'b', '' ]
#
# "/a/b/" should get you [ '', 'a', 'b', '' ]
#
# "a/b" returns the same array as 'a/////b' for those OSs where
# the seperator is idempotent (Unix and DOS, at least, but not VMS).
#
# Interface:
#     i) directory path string
#
sub splitdirs($;) {
   my( $directorypath )= @_ ;

   $directorypath =~ s/^\[(.*)\]$/$1/
      if ( $fstype eq 'VMS' ) ;

   #
   # split() likes to forget about trailing null fields, so here we
   # check to be sure that there will not be any before handling the
   # simple case.
   #
   return split( $sepRE, $directorypath )
      if ( $directorypath !~ m/$sepRE$/ ) ;

   #
   # since there was a trailing separator, add a file name to the end, then
   # do the split, then replace it with ''.
   #
   $directorypath.= "file" ;
   my( @directories )= split( $sepRE, $directorypath ) ;
   $directories[ $#directories ]= '' ;

   return @directories ;
}

#
# joindirs: Joins an array of directory names in to a string, adding
# OS-specific delimiters, like '[' and ']' for VMS.
#
# Note that empty strings '' are no different then non-empty strings,
# but that undefined strings are skipped by this algorithm.
#
# This is done the hard way to preserve separators that are already
# present in any of the directory names.
#
# Could this be made faster by using a join() followed
# by s/($sepRE)$sepRE+/$1/g?
#
# Interface:
#     i) array of directory names
#     o) string representation of directory path
#
sub joindirs {
   my $directory_path ;

   $directory_path = shift
      while ( ! defined( $directory_path ) && @_ ) ;

   if ( ! defined( $directory_path ) ) {
      $directory_path = '' ;
   }
   else {
      local $_ ;

      for ( @_ ) {
        next if ( ! defined( $_ ) ) ;

        $directory_path .= $sep
           if ( $directory_path !~ /$sepRE$/ && ! /^$sepRE/ ) ;

        $directory_path .= $_ ;
      }
   }

   $directory_path = join( '', '[', $directory_path, ']' )
      if ( $fstype eq 'VMS' ) ;

   return $directory_path ;
}


#
# realpath: returns the canonicalized absolute path name
#
# Interface:
#       i)      $path   path
#       r)              resolved name on success else undef
#       go)     $resolved
#                       resolved name on success else the path name which
#                       caused the problem.
$resolved = '';
#
#       Note: this implementation is based 4.4BSD version realpath(3).
#
# TODO: Speed up by using Cwd::abs_path()?
#
sub realpath($;) {
    ($resolved) = @_;
    my($backdir) = cwd();
    my($dirname, $basename, $links, $reg);

    $resolved = regularize($resolved);
LOOP:
    {
        #
        # Find the dirname and basename.
        # Change directory to the dirname component.
        #
        if ($resolved =~ /$sepRE/) {
            ($dirname, $basename) = $resolved =~ /$basenamesplitRE/ ;
            $dirname = $sep if ( $dirname eq '' );
            $resolved = $dirname;
            unless (chdir($dirname)) {
                warn("realpath: chdir($dirname) failed: $! (in ${\cwd()}).") if $verbose;
                chdir($backdir);
                return undef;
            }
        } else {
            $dirname = '';
            $basename = $resolved;
        }
        #
        # If it is a symlink, read in the value and loop.
        # If it is a directory, then change to that directory.
        #
        if ( $basename ne '' ) {
            if (-l $basename) {
                unless ($resolved = readlink($basename)) {
                    warn("realpath: readlink($basename) failed: $! (in ${\cwd()}).") if $verbose;
                    chdir($backdir);
                    return undef;
                }
                $basename = '';
                if (++$links > $maxsymlinks) {
                    warn("realpath: too many symbolic links: $links.") if $verbose;
                    chdir($backdir);
                    return undef;
                }
                redo LOOP;
            } elsif (-d _) {
                unless (chdir($basename)) {
                    warn("realpath: chdir($basename) failed: $! (in ${\cwd()}).") if $verbose;
                    chdir($backdir);
                    return undef;
                }
                $basename = '';
            }
        }
    }
    #
    # Get the current directory name and append the basename.
    #
    $resolved = cwd();
    if ( $basename ne '' ) {
        $resolved .= $sep if ($resolved ne $sep);
        $resolved .= $basename
    }
    chdir($backdir);
    return $resolved;
} # end sub realpath


#
# abs2rel: make a relative pathname from an absolute pathname
#
# Interface:
#       i)      $path   absolute path(needed)
#       i)      $base   base directory(optional)
#       r)              relative path of $path
#
#       Note:   abs2rel doesn't check whether the specified path exist or not.
#
sub abs2rel($;$;) {
    my($path, $base) = @_;
    my($reg );

    my( $path_volume, $path_directory, $path_file )= splitpath( $path,'nofile');
    if ( $path_directory !~ /$isrootRE/ ) {
        warn("abs2rel: nothing to do: '$path' is relative.") if $verbose;
        return $path;
    }

    $base = cwd()
        if ( !defined( $base ) || $base eq '' ) ;

    my( $base_volume, $base_directory, $base_file )= splitpath( $base,'nofile');
    # check for a filename, since the nofile parameter does not work for OSs
    # like VMS that have explicit delimiters between the dir and file portions
    warn( "abs2rel: filename '$base_file' passed in \$base" )
       if ( $base_file ne '' && $verbose ) ;

    if ( $base_directory !~ /$isrootRE/ ) {
        # Make $base absolute
        my( $cw_volume, $cw_directory, $dummy ) = splitpath( cwd(), 'nofile' ) ;
        # maybe we should warn if $cw_volume ne $base_volume and both are not ''
        $base_volume= $cw_volume
           if ( $base_volume eq '' && $cw_volume ne '' ) ;
        $base_directory = join( '', $cw_directory, $sep, $base_directory ) ;
    }

    $path_directory = regularize( $path_directory );
    $base_directory = regularize( $base_directory );
    # Now, remove all leading components that are the same, so 'name/a'
    # 'name/b' become 'a' and 'b'.
    my @pathchunks = split($sepRE, $path_directory);
    my @basechunks = split($sepRE, $base_directory);

    if ( $casesensitive )
    {
        while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0])
        {
            shift @pathchunks ;
            shift @basechunks ;
        }
    }
    else {
        while (  @pathchunks
              && @basechunks
              && lc( $pathchunks[0] ) eq lc( $basechunks[0] )
              )
        {
            shift @pathchunks ;
            shift @basechunks ;
        }
    }

    # No need to use joindirs() here, since we know that the arrays
    # are well formed.
    $path_directory= join( $sep, @pathchunks );
    $base_directory= join( $sep, @basechunks );

    # Convert $base_directory from absolute to relative
    if ( $fstype eq 'VMS' ) {
        $base_directory= $sep . $base_directory
            if ( $base_directory ne '' ) ;
    }
    else {
        $base_directory=~ s/^$sepRE// ;
    }

    # $base_directory now contains the directories the resulting relative path
    # must ascend out of before it can descend to $path_directory.  So,
    # replace all names with $parentDir
    $base_directory =~ s/$notsepRE+/$parentDir/g ;

    # Glue the two together, using a separator if necessary, and preventing an
    # empty result.
    if ( $path_directory ne '' && $base_directory ne '' ) {
        $path_directory = "$base_directory$sep$path_directory" ;
    } else {
        $path_directory = "$base_directory$path_directory" ;
    }

    $path_directory = regularize( $path_directory ) ;

    # relative URLs should have no name in the volume, only a scheme.
    if ( $fstype eq 'URL' ) {
        $path_volume =~ s#/.*## ;
        # NOTE: if case insensitive URLs are ever done, this next comparison
        # needs to be tweaked.
        my $path_file_file = $path_file ;
        $path_file_file =~ s/#.*// ;
        my $base_file_file = $base_file ;
        $base_file_file =~ s/#.*// ;
        $path_file =~ s/[^#]+//
            if ( $path_file_file eq $base_file_file ) ;
    }

    # MacOS relative URLs should have no volume.
    $path_volume =''
        if ( $fstype eq 'MacOS' ) ;
    return joinpath( $path_volume, $path_directory, $path_file ) ;
}

#
# rel2abs: make an absolute pathname from a relative pathname
#
# Assumes no trailing file name on $base.  Ignores it if present on an OS
# like $VMS.
#
# Interface:
#       i)      $path   relative path (needed)
#       i)      $base   base directory  (optional)
#       r)              absolute path of $path
#
#       Note:   rel2abs doesn't check if the paths exist.
#
sub rel2abs($;$;) {
    my( $path, $base ) = @_;
    my( $reg );

    my( $path_volume, $path_directory, $path_file )= splitpath( $path, 'nofile' ) ;
    if ( $path_directory =~ /$isrootRE/ ) {
        warn( "rel2abs: nothing to do: '$path' is absolute" )
            if $verbose;
        return $path;
    }

    warn( "rel2abs: volume '$path_volume' passed in relative path: \$path" )
        if ( $path_volume ne '' && $verbose ) ;

    $base = cwd()
        if ( !defined( $base ) || $base eq '' ) ;

    my( $base_volume, $base_directory, $base_file )= splitpath( $base, 'nofile' ) ;
    # check for a filename, since the nofile parameter does not work for OSs
    # like VMS that have explicit delimiters between the dir and file portions
    warn( "rel2abs: filename '$base_file' passed in \$base" )
        if ( $base_file ne '' && $verbose ) ;

    if ( $base_directory !~ /$isrootRE/ ) {
        # Make $base absolute
        my( $cw_volume, $cw_directory, $dummy ) = splitpath( cwd(), 'nofile' ) ;
        # maybe we should warn if $cw_volume ne $base_volume and both are not ''
        $base_volume= $cw_volume
            if ( $base_volume eq '' && $cw_volume ne '' ) ;
        $base_directory = join( '', $cw_directory, $sep, $base_directory ) ;
    }

    $path_directory = regularize( $path_directory );
    $base_directory = regularize( $base_directory );

    my $result_directory ;
    # Avoid using a separator if either directory component is empty.
    if ( $base_directory ne '' && $path_directory ne '' ) {
        $result_directory= joindirs( $base_directory, $path_directory ) ;
    }
    else {
        $result_directory= "$base_directory$path_directory" ;
    }

    $result_directory = regularize( $result_directory );

    return joinpath( $base_volume, $result_directory, $path_file ) ;
}

#
# regularize a path.
#
#    Removes dubious and redundant information.
#    should only be called on directory portion on OSs
#    with volumes and with delimeters that separate dir names from file names,
#    since the separators can take on different semantics, like "\\" for UNC
#    under Win32, or '.' in filenames under VMS.
#
sub regularize {
    my( $in )= $_[ 0 ] ;

    # Combine idempotent separators.  Do this first so all other REs only
    # need to match one separator. Use the first sep found instead of
    # sepRE to preserve slashes on Win32.
    $in =~ s/($sepRE)$sepRE+/$1/g
        if ( $idempotent ) ;

    # We do this after deleting redundant separators in order to be consistent.
    # If a Win32 path ended in \/, we want to be sure that the \ is returned,
    # no the /.
    my $trailing_sep = $in =~ /($sepRE)$sepRE*$/ ? $1 : '';

    # Delete all occurences of 'name/..(/|$)'.  This is done with a while
    # loop to get rid of things like 'name1/name2/../..'. We chose the pattern
    # name/../ as the target instead of /name/.. so as to preserve 'rootness'.
    while ($in =~ s/$name_sep_parentRE/$1/g) {}

    # Get rid of ./ in '^./' and '/./'
    $in =~ s/$dot_sep_etcRE/$1/g ;

    # Get rid of trailing '/' and '/.' unless it would leave an empty string
    $in =~ s/$trailing_sepRE/$1/ ;

    # Get rid of '../' constructs from absolute paths
    $in =~ s/$leading_parentRE/$1/
      if ( $in =~ /$isrootRE/ ) ;

#    # Default to current directory if it's now empty.
#    $in = $thisDir if $_[0] eq '' ;
#
    # Restore trailing separator if it was lost. We do this to preserve
    # the 'dir-ness' of the path: paths that ended in a separator on entry
    # should leave with one in case the caller is using trailing slashes to
    # indicate paths to directories.
    $in .= $trailing_sep
        if ( $trailing_sep ne '' && $in !~ /$sepRE$/ ) ;

    return $in ;
}

1;

__END__