=head1 NAME

CFX5::PathManip - Manipulation of paths in an non-architecture-dependent way

=head1 SYNOPSIS

Simple functions for manipulating colon-separated file paths

These functions will be easily modifiable to work with native NT paths

=cut

package CFX5::PathManip;

use strict;

use vars qw($CVSVersion);
$CVSVersion='$Id$ ';

use Exporter;
use vars qw(@ISA @EXPORT_OK);
@ISA=qw(Exporter);
@EXPORT_OK=qw(append_to_path prepend_to_path path_to_list list_to_path
	      path_list_remove_dups
	      join_file split_file split_mult_files
	      dirname basename is_absolute is_driveletter is_unc
	      abspath fullpath relative_path relative_path_fs
	      get_cwd change_cwd
              find_config_file
	      findbin_by_path
	      normalize_filename
	     );

=head2 Export tags

This module defines the following export tags:

=over

=item :manip

The L<append_to_path> and L<prepend_to_path> functions for
manipulating paths.

=item :list

The L<path_to_list> and L<list_to_path> functions for converting paths
to and from lists.

=back

=cut

use vars qw(%EXPORT_TAGS);
%EXPORT_TAGS=(
	      manip => [qw(prepend_to_path append_to_path)],
	      list  => [qw(path_to_list list_to_path)],
	      file  => [qw(split_file join_file split_mult_files abspath fullpath)],
	      all   => [@EXPORT_OK],
	     );

use CFX5::CurrentConfig qw(getconf setconf);
use CFX5::Output qw(:all);

use CFX5::PkgLoader qw(cfx5_require);

use CFX5::Config::def
  CFX5_HAVE_CYGPATH => sub {
    findbin_by_path('cygpath') eq '.' ? 0 : 1
  };

#
# Cwd uses Win32::GetCwd, which is an external (?) function, and this
# causes problems with the Perl compiler. If we define this as undef
# the compiler tries to autoload it anyway, since it doesn't
# exist. So, what to do?
#
# We cheat! Well, not really; we re-write it to shell out to cmd.exe
# and get that to tell us. There really should be a better way than
# this ...
#
#sub dummy_cwd {
#  my $d=`cd`;
#  $d =~ s/[\n\r \t]*$//;
#  $d;
#}
#BEGIN { 
#  *Win32::GetCwd = \&dummy_cwd
#    if $^O eq 'MSWin32';
#}
#use Cwd qw(fast_abs_path abs_path);

#
# rather than working these out every time we do a filename
# manipulation, do it once and cache the results.
#
use vars qw($PathSep $DirSep $DirSepQCh $DirSepRE);
sub calcseps {
  $PathSep  = getconf("path_sep");
  $DirSep   = getconf("dir_sep");
  internal_error("Cannot work out path separators")
    unless (defined $PathSep and defined $DirSep);

  # we compile $DirSepRE as a regular expression to speed up matching ...
  $DirSepQCh = quotemeta($DirSep)."/";
  $DirSepRE = qr/[$DirSepQCh]/o;
  #$DirSepRE = "[$DirSepQCh]";
}

=head2 path_to_list

Convert a native-style path into a list of directories.

=cut

sub path_to_list {
  my $path=shift;
  internal_error("Splitting undefined path")
    unless defined($path);
  calcseps() unless defined $PathSep;
  my @list=split(/$PathSep/,$path);
  return @list;
}

=head2 list_to_path

Convert a list of directories into a native-style search path.

=cut

sub list_to_path {
  calcseps() unless defined $PathSep;
  return join($PathSep,@_);
}

=head2 path_list_remove_dups

  @new = path_list_remove_dups(@old);

Given a list of directories, for example from C<path_to_list>, this
function will remove duplicates in an "intelligent" way.  This means
that we retain the ordering of the list, and keep the first occurrence
only of each directory; this is sensible because paths are searched in
a first-to-last order, so doing it this way preserves the priorities.

This function is mostly designed for use by the C<prepend_to_path> and
C<append_to_path> calls.

=cut

sub path_list_remove_dups {
  my @old=@_;
  my @new;
  my %dups;
  for my $p (@old) {
    next unless defined $p;
    push @new, $p unless $dups{$p};
    $dups{$p}++;
  }
  return @new;
}

=head2 prepend_to_path

  prepend_to_path(\$PATH, $bindir);

Prepends the named director(ies) to the referenced variable, assuming
it contains a path.  This uses the C<path_to_list> and C<list_to_path>
functions to manipulate the variable.  It will also use
C<path_list_remove_dups> to ensure that the given directory -- and,
incidentally, any others -- is only specified once in the path.  Thus,
calling this routine with a directory name which is already in the
path has the effect of moving it to the front.

=cut

sub prepend_to_path {
    my $vr=shift;
    internal_error("non-reference in prepend_to_path") unless ref($vr);
    my $d;
    my @l;
    if (defined $$vr) {
      push @l, path_to_list($$vr);
    }
    unshift @l, @_;
    @l = path_list_remove_dups(@l);
    $$vr=list_to_path(@l);
}

=head2 append_to_path

  append_to_path(\$PATH, $bindir);

Appends the named director(ies) to the referenced variable, assuming
it contains a path.  This uses the C<path_to_list> and C<list_to_path>
functions to manipulate the variable.  It will also use
C<path_list_remove_dups> to ensure that the given directory -- and,
incidentally, any others -- is only specified once in the path.  This
means that calling this routine with a directory name which is already
in the path has no effect (other than removing any other duplicates
which may exist).

=cut

sub append_to_path {
    my $vr=shift;

    internal_error("non-reference in append_to_path") unless ref($vr);

    my $d;
    my @l;

    if (defined $$vr) {
      @l=path_to_list($$vr);
    } else {
      @l=();
    }

    push @l, @_;

    @l = path_list_remove_dups(@l);

    $$vr=list_to_path(@l);
}

=head2 join_file

  $file=join_file('/root/path', 'subdir', 'file');

Join the arguments together with the native path separator character
to make a single filename.  In order to get a relative path, you
either need to start with an absolute path component (as in the
example above) or include an empty first component:

  $file=join_file('','root/path', 'subdir', 'file');

=cut

sub join_file {
  calcseps() unless defined $DirSep;
  # check for undef, this is a little slowdown, but this code
  # shouldn't be *too* hot. :-(

  # make sure we don't mess around with the caller's variables
  my @comps=@_;

  for my $c (@comps) {
    unless (defined $c) {
      # _debug will print enough of the call stack for this to be
      # useful.
      if (getconf('CFX5_DIE_ON_UNDEF')) {
	internal_error("Undefined value in join_file, dying at user request.  To go back to the original behaviour, unset the environment variable CFX5_DIE_ON_UNDEF (or set it to 0).");
      }
      _debug("Undefined value in join_file");
      # don't switch off perl's warning, though, unless this is a
      # release version.
      if (getconf('CFX5RELTYPE') eq 'release') {
	$c='';
      }
    }
  }
  join($DirSep,@comps);
}

=head2 split_file

  @dirs=split_file('//server/path/to/file');

Interpreting the argument as a filename, split the components of the
name using the native path separator character, I<and also the
standard "/" path separator>.  Note that for an absolute path, this
will result in a leading empty element.

Doubled separators will be treated according to the standard UNIX Way
of ignoring them, so you will never get empty path components.  The
only exception to this is on Windows NT, where a leading double slash
indicates a remote path on a server machine; in this case, the second
leading slash will be returned as part of the first component, so
C<join_file> will correctly recreate the original filename.

=cut

sub split_file {
  calcseps() unless defined $DirSepRE;
  my @rv=split($DirSepRE,$_[0]);
  my $f=shift @rv;		# keep an empty initial component if there is one
  if (scalar(@rv)>1
      and $rv[0] eq '' 
      and getconf('windows_nt')) {
    # //server/path
    $rv[1]=$DirSep.$rv[1];
    shift @rv;
  }
  ($f, grep { $_ ne '' } @rv);
}

=head2 split_mult_files

  @mult_files=split_mult_files('file1,"file No 2, with double-quotes",file3');

Interpreting the argument as a comma-separated list, split the components
of the list using the comma as a separator character. Note that
if the file name itself contains a comma, the file name must be
double quoted. 

Doubled separators (commas) will be treated according to the standard UNIX Way
of ignoring them, so you will never get empty file names. If a field contains
only white spaces, it will also be removed.


The limitation is that  you will not be able to use the double quote
as the part of the file name. From the script argument, the file list
must be single-quoted again in order for the double-quote to be preserved 
in the list.
cfx5interp -def file.def -results 'file1.res,"Sept 5, 2005's file.res"'

=cut

sub split_mult_files {
  my $files = shift;      # record containing comma-separated values
  $files =~ s/[,\s]+$//;  # remove trailing commas/white-spaces if any
  $files =~ s/,\s+,/,/;   # remove empty field if any
  my @multfiles  = ();
   push(@multfiles, $+) while $files =~ m{
      # the first part groups the phrase inside the quotes.
      # If the name contains the double quote, it must be backslashed.
      \s*"([^\"\']*(?:\\.[^\"\']*)*)",*
      # the second part groups the phrase without any quotes.
         | \s*([^,]+),*
      # the third part ignore the comma if empty field.
         | ,
     }gx;
  return @multfiles;      # list of values that were comma-separated
}

=head2 normalize_filename

Interpreting the argument as a filename, make sure all directory
separators are "native" and return the fixed value, stripping any
trailing separator characters, and removing ".." components. This is
especially important on Windows NT, as paths can (and will be) passed
with both forward- and back-slashes, but we want to be able to use
them consistently.

This also has the effect of compressing doubled separator characters,
except if we are on Windows NT and it is the first separator which is
doubled.  So for example, the following code:
  print normalize_filename('//server/path/to//file');
would print
  \\server\path\to\file
if called on Windows NT, but
  /server/path/to/file
if run on a UNIX platform.

=cut

sub normalize_filename {
  my $f=shift;
  calcseps() unless defined $DirSepRE;
  $f =~ s{$DirSepRE}{$DirSep}g;
  # compress doubles, skipping the first one on NT
  my $g=$f;
  $f =~ s{$DirSepRE+}{$DirSep}g;
  if (getconf('windows_nt') and substr($g,0,2) eq $DirSep.$DirSep) {
    $f=$DirSep.$f;
  }
  $f =~ s/$DirSepRE*$//;

  # now strip any "dir/.."  The repeated $DirSep in the character
  # class is to handle the case where $DirSep is '\', otherwise we get
  # an invalid RE.  It will do no harm when $DirSep is '/'.
  1 while ($f =~ s!${DirSepRE}[^$DirSep$DirSep]+${DirSepRE}\.\.(?:${DirSepRE}|$)!$DirSep!g);

  return $f;
}

=head2 basename

 $file=basename("/home/andy/file.dat");
 # $file is "file.dat"

Returns the name of the file with all directories stripped. If the
last character in the filename is the path separator character, 
returns "undef". If the native path separator character does not
occur in the filename, the return value is the argument originally
passed.

=cut

sub basename {
  my $f=shift;
  my $levels=shift;
  $levels = 1 unless defined $levels ; 

  calcseps() unless defined $DirSep;

  if ((rindex($f,$DirSep) == length($f)-1)
      or (rindex($f,"/") == length($f)-1)) {
    # we had a path sep char on the end
    return undef;
  }

  # now we can call normalize_filename, which will strip the path sep
  # char
  $f=normalize_filename($f);

  my $pos = length($f) ; 
  for (my $ii=$levels; $ii>0; $ii--) {
    my $pos1=rindex($f,$DirSep,$pos-1);
    my $pos2=rindex($f,"/",$pos-1);
    $pos = ($pos1 > $pos2 ? $pos1 : $pos2);
  }

  _debug("Last separator at $pos");

  if ($pos == -1) {
    # only a filename
    return $f;
  }

  if ($pos == length($f)-1) {
    # last char is the path separator
    return undef;
  }

  return substr($f,$pos+1);
}

=head2 dirname

 $dir=dirname("/home/andy/file.dat");
 # $dir is "/home/andy"

Removes the filename from a path, and returns the directory name,
I<without> a trailing separator character.

If the path does not
contain any path separator characters the return value is ".". If
it has a trailing separator the return value is the original directory
with the trailing separator removed. Otherwise it is all except the 
last component of the path.

Note that this algorithm will return the dirname for a file in the root
directory as being C<""> which, while consistent, may be slightly
suprising.

Because this function calls C<normalize_filename> before it starts, the
path separators used in the path may change under Windows NT.

See also C<fullpath> to get a full directory name.

=cut

sub dirname {
  my $f=shift;

  calcseps() unless defined $DirSep;

  if ((rindex($f,$DirSep) == length($f)-1)
      or (rindex($f,"/") == length($f)-1)) {
    # we had a path sep char on the end
    return normalize_filename($f);
  }

  # now we can call normalize_filename, which will strip the path sep
  # char
  $f=normalize_filename($f);

  my $pos1=rindex($f,$DirSep);
  my $pos2=rindex($f,"/");
  my $pos = ($pos1 > $pos2 ? $pos1 : $pos2);

  if ($pos == -1) {
    # only a filename
    return ".";
  }

  return substr($f,0,$pos);
}

# (defun path-to-joinfile () "Turn a pathname into a call to join_file"
#   (interactive)
#   ;; find the next occurrence of "/"
#   (if (re-search-forward "/" nil t)
#       (progn
# 	;; look for the beginning of the path contining it
# 	(re-search-backward "[= \"]")
# 	(forward-char)
# 	(let '(boa (point))
# 	  ;; insert the function call
# 	  (insert "join_file(")
# 	      (let (eoa)
# 		;; replace all "/" before EOL with commas
# 		(save-excursion
# 		  (end-of-line)
# 		  (setq eoa (point)))
# 		(while (re-search-forward "/" eoa t)
# 		  (replace-match ", " nil nil))
# 		;; add ");" to the end of the string
# 		(save-excursion
# 		  (end-of-line)
# 		  (setq eoa (point)))
# 		(if (not (re-search-forward "[= \"]" eoa t))
# 		    (goto-char eoa))
# 		(insert ");")
# 		;; now go back through this string and quote all bare
# 		;; words
# 		(setq eoa (point))
# 		(goto-char boa)
# 		(while (re-search-forward "\\b\\(\\w+\\)," eoa t)
# 		  (replace-match "\"\\1\"," nil nil)))))))


=head2 abspath

  $path=abspath("path");

Expands C<~> chars in the path, and makes sure it is a full pathname,
expanding symbolic links and so on.  We also include a call to cygpath
on Windows NT systems, iff

=over

=item we have F<cygpath.exe> on the PATH

=item the path as supplied contains no backslashes

=item the path as supplied is an absolute UNIX-style pathname, ie it begins with a C</>.

=back

which makes things slightly slower, but does make them more robust to
dodgy paths.

Note that this function is relatively slow; see also C<fullpath>.

=cut

sub abspath {
  my $path=shift;

  if (getconf('CFX5_HAVE_CYGPATH') 
      and $path !~ m!\\!
      and substr($path,0,1) eq '/') {
    cfx5_require('CFX5::Commands');
    my $npath=CFX5::Commands::get_cmd_output('cygpath','-w',$path);
    $npath =~ s![\n\r\s]+$!!g;
    if ($npath ne '') {
      _debug("Got Cygnified path $npath");
      $path=$npath;
    }
  }

  $path=normalize_filename($path);

  # expand ~ (see perlfaq5)
  if (substr($path,0,1) eq "~") {
    $path =~ 
      s{
	^ ~             # find a leading tilde
	(               # save this in $1
	 [^/]           # a non-slash character
	 *              # repeated 0 or more times (0 means me)
	)
       }{
	 $1
	   ? (getpwnam($1))[7]
	     : ( getconf('HOME') || $ENV{LOGDIR} )
	   }ex;
  }

  # now, we check if the full works is disabled.
  if (getconf('CFX5_DISABLE_ABSPATH')) {
    if (is_absolute($path)) {
      # it's absolute anyway, just return it
      _note "Not calculating absolute path for $path as abspath is disabled.";
      return $path;
    } elsif (defined (my $cwd=`pwd`)) {
      chomp($cwd);
      return join_file($cwd,$path);
    } elsif (defined getconf('PWD')) {
      # it's relative, but we know where we are, or at least where we
      # think we are
      _warn "Guessing current directory from PWD variable as abspath is disabled.";
      return join_file(getconf('PWD'),$path);
    } else {
      _warn "Unable to calculate absolute pathname for $path as it is disabled, leaving as relative.";
      return $path;
    }
  }

  # if $path exists, we take shortcuts; otherwise, we can use
  # _abspath_worker, which is a slower recursive way of looking for
  # something which does exist.
  calcseps unless defined $DirSep;
  cfx5_require('Cwd');
  if (-d $path) {
    _debug "$path is a directory";
    $path=Cwd::fast_abs_path($path);
    $path =~ s{/}{$DirSep}g;
    _debug "absolutely $path";
  } elsif ($path =~ m!^$DirSepRE$DirSepRE[^$DirSepQCh]+$DirSepRE[^$DirSepQCh]+$DirSepRE?$!o) {
    # we can't split up a UNC share name, and they don't count as
    # directories, so we have to catch them sooner rather than later.
    # We don't need to do anything with them, though ...
    _debug "$path is a UNC share";
  } elsif (-e $path) {
    _debug "$path is a file ...";
    my $file;
    if (index($path,$DirSep) > -1 or index($path, "/") > -1) {
      # path includes a separator
      $path=~s {
		[$DirSepQCh]	# the path separator
		(		# store in $1
		 [^$DirSepQCh]*	# the filename
		)
		$		# and the end of the string
	       } {}x;		# replace with nothing
      $file=$1;
    } else {
      # bare filename, but the directory is "."
      $file=$path;
      $path=".";
    }
    _debug "... made from $path and $file";
    $path=Cwd::fast_abs_path($path).$DirSep.$file;
    $path =~ s{/}{$DirSep}g;
  } else {
    # this is slower, but can take anything (almost ...)

    # on NT, cope with 'E:<file>'.  When I say "cope with," of course,
    # I mean "don't do something silly with" ...
    #
    # the problem is that "E:<file>" means "<file> in the current
    # working directory on the E: drive", which I don't know how to
    # get.
    _abort("Sorry, I cannot handle relative pathnames like \"$path\".\n",
	   "If you meant to put it in the root of the drive, try\n\t",
	   substr($path,0,2).'\\'.substr($path,2),"\n",
	   "otherwise please try using a different form for the path.")
      if (getconf('windows_nt') and $path =~ m{^[A-Za-z]:[^\\/]});

    # make sure we have a directory in the path, even if it's "."
    $path=".".$DirSep.$path if (index($path,$DirSep) == -1 and index($path,"/") == -1);

    _debug("$path doesn't exist, looking for it");

    # now pass all this down to the worker
    my @path=split_file($path);
    @path=_abspath_worker(@path);
    $path=join_file(@path);
    _debug("Found absolute path name $path");
  }

  return $path;
}

# a recursive function to find abs paths for other things
use vars qw(%AbsPathRecursionProtect);
sub _abspath_worker {
  my @path=@_;

  my $qpath=join_file(@path);

  if ($AbsPathRecursionProtect{$qpath}) {
    _error("Internal error in _abspath_worker: bailing out of infinite recursion on $qpath");
    return @path;
  }
  local %AbsPathRecursionProtect=%AbsPathRecursionProtect;
  $AbsPathRecursionProtect{$qpath}++;

  if (scalar(@path) < 1) {
    # we've run out of things to try, and still not found anything. So
    # rather than leaving it as-is, we take it relative to the current
    # directory.
    #
    # NB that get_cwd will (often) end up calling abspath, so there's
    # a recursion risk here.  The only way it should be triggerable is
    # if . doesn't exist, when we'll end up back in this block after
    # throwing away the '.', so we pre-test for that case here.
    if (-d '.') {
      _debug("No components exist, taking relative to cwd");
      return split_file(get_cwd());
    } else {
      # no cwd, we'll just return an explicit '.'
      _debug("No components exist and no cwd, returning '.' to fail later");
      return '.';
    }
  }

  _debug("Trying to find $qpath");
  calcseps unless defined $DirSep;
  if (-d $qpath) {
    # termination

    # the Cwd module provides this function. There is also an
    # abs_path function, which is safer but slower; this should not
    # matter in this instance, but we'll see. Note that abs_path seems
    # not to use "die" where fast_abs_path would. Note also that 
    # fast_abs_path seems to return paths with "/" separators even on
    # NT. Grrr.
    $qpath=Cwd::fast_abs_path($qpath);
    $qpath =~ s{/}{$DirSep}g;
    @path=split_file($qpath);
  } elsif (-e $qpath) {
    # not a directory, but it must be contained in a directory, so
    # this is a near-end case
    my $file=pop @path;
    @path=_abspath_worker(@path);
    push @path, $file;
  } else {
    # nope, doesn't exist at all. Strip one path from it, and have
    # another go.
    #
    # (In fact, this is the same action as the "not a directory" case
    # above, but a different cause.)
    my $part=pop @path;
    @path=_abspath_worker(@path);
    push @path, $part;
  }
  return @path;
}

=head2 is_absolute

On UNIX, a path is considered absolute if it begins with a C</>.  On
Windows NT, it is considered absolute if it begins with a drive
specification (C<D:/>) or a UNC specification (C<//HOST/>), with
backslashes or forward slashes.  

Returns TRUE if the given path is an absolute path, or FALSE if it is
relative.

=cut

sub is_absolute {
  my $path=shift;

  if (getconf("windows_nt")) {
    return (is_driveletter($path) or is_unc($path));
  } else {
    # UNIX-style; this is easy
    if (substr($path,0,1) eq "/") {
      return 1;
    } else {
      return '';
    }
  }
}

=head2 is_driveletter

Check if path is specified using a Windows drive letter (C<C:\>) or (C<C:/>)

A path is considered to be specified using a Windows drive letter
if it STARTS with the following character sequence:

a single letter, a colon, a forward slash or backslash

Returns TRUE if the given path is specified using a Windows drive letter
otherwise returns FALSE. Always returns FALSE on UNIX.

=cut

sub is_driveletter
{
  my $path=shift;
  return 1 if (getconf("windows_nt") and ($path =~ m/^[A-Za-z]:[\/\\]/));
  return '';
}


=head2 is_unc

Check if specified path is a UNC specification (C<//HOST/>)..

A path is considered to be a UNC path if it STARTS with either of the
following character sequences:

=over

=item *

two backslashes, two or more non slashes, a backslash

=item *

two forward slashes, two or more non slashes, a forward slash

=back

Note that UNC hostnames of a single letter are not allowed,
so that old Cygwin-style drive specifications are passed through.

Returns TRUE if the given path is a UNC path, otherwise returns FALSE.
Always returns FALSE on UNIX.

=cut

sub is_unc
{
  my $path=shift;
  return 1 if (getconf("windows_nt") and ($path =~ m/^\\{2}[^\\\/]{2,}\\/ or
                                          $path =~ m/^\/{2}[^\\\/]{2,}\//));
  return '';
}

=head2 fullpath

  $path=fullpath("path");

Ensures that $path is a full pathname. Unlike C<abspath>, this does
not change the path if it is already a full pathname, regardless of
whether it contains symbolic links or whatever. This makes it much
faster than C<abspath>. Also runs the file through C<normalize_path>
to make sure the path separators are what you are expecting.

Note that if the pathname is not a full pathname, and cannot be found
relative to our believed current directory, it gets the full
C<abspath> treatment, it doesn't just get the current directory added
on the beginning.  In particular, this means that most Cygwin-style
paths which are sent to fullpath, so long as they haven't been
normalised, will be converted correctly to Windows NT-style paths.

=cut

{
  my $cwd_recursion=0;
sub fullpath {
  my $path=shift;

  if (is_absolute($path)) {
    return normalize_filename($path);
  }

  unless ($cwd_recursion++) {
    # it's not absolute, so try guessing wrt our cwd and see if that
    # helps -- this can speed things up, as we can often guess the cwd
    # from the environment.
    my $cwd=get_cwd();
    --$cwd_recursion;
    if (defined $cwd and -d $cwd) {
      # use / for calculation, but remove dups etc
      (my $newpath=normalize_filename("$cwd/$path")) =~ s!\\!/!g;

      # do more tidyups, we're probably going to use this later so it
      # might as well look pretty

      # strip out /./
      while ($newpath =~ s!/\./!/!g) {
        1;
      }
      # strip out /?/../, where ? contains at least one non-dot
      # character
      while ($newpath =~ s!/[^/]*[^/.][^/]*/\.\./!/!g) {
        1;
      }

      # remove trailing "dir/.."
      $newpath =~ s!(/[^/]*[^/.][^/]*/\.\.)*$!!g;
      # remove /. from the end
      $newpath =~ s!(/\.)*$!!;

      # if the directory we're looking for doesn't exist, and neither
      # does the same when taken relative to our cwd, we'll assume it's
      # OK.
      my @pst=stat($path);
      my @nst=stat($newpath);
      if (not @pst and not @nst) {
        _debug("Neither $path or $newpath exist, assuming equivalence");
        return $newpath;
      }

      _debug("Checking for equivalence between $path and $newpath");
      # XXX warning if one exists and not the other
      if (@pst and @nst and
          $pst[0] == $nst[0] and $pst[1] == $nst[1]) {
        return $newpath;
      }
    }
  }

  _debug "calling abspath($path)";
  return abspath($path);
}
}

=head2 is_same_dir

On UNIX, compares the device and inode entries for a pair of directories
and returns true if they are the same, false if they are different, or
undef if one or both stats failed.

On Windows, stat always returns inode=0, so is a poor method of comparison.
Instead, the absolute paths are compared.

=cut

sub is_same_dir {
  my $a=shift;
  my $b=shift;

  if (getconf("windows_nt")) {
    return abspath($a) eq abspath($b);
  } else {
    my @ast=stat($a);
    my @bst=stat($b);
    return undef unless @ast and @bst;
    return ($ast[0] == $bst[0] and $ast[1] == $bst[1]);
  }
}

=head2 get_cwd

  my $cwd=get_cwd();

Returns the current working directory, if it can be calculated, or '.'.

=cut

sub get_cwd {
  # first, we try to guess, eg by looking at the PWD environment
  # variable
  if (defined $ENV{PWD} and is_same_dir('.', $ENV{PWD}) and is_absolute($ENV{PWD})) {
    _debug("got correct pwd $ENV{PWD} from ENV{PWD}");
    return normalize_filename($ENV{PWD});
  }

  # if we can't guess, we work it out
  return fullpath('.') || '.';
}

=head2 change_cwd

  change_cwd($new_dir);

Changes the cwd, using chdir, and updates any internal state.  Unless
you are going to cd back again shortly, use this in preference to
CORE::chdir.

=cut

sub change_cwd {
  my $dir=shift;

  my $fulldir=fullpath($dir);

  _debug("Changing cwd to $dir");

  # Windows: chdir fails silently if the target is a bare drive letter.
  #          Workaround: Terminate bare drive letters with a backslash.
  my $target = $fulldir;
  $target =~ s/([a-z]:)$/$1\\/i if (getconf('windows_nt'));

  unless (chdir($target)) {
    return '';
  }

  # Make sure we succeeded
  return '' unless (is_same_dir($dir,'.'));

  # and record in the PWD env var so that we can still make absolute
  # paths
  setconf(PWD => $fulldir);

  1;
}

=head2 find_config_file

I<Exportable>

  my $conf=find_config_file('hostinfo.ccl');

Looks through the standard system and user configuration directories
for the named file, and returns the first instance found.

=cut

sub find_config_file {
  my $name=shift;

  #
  # we look in first ~/.cfx/$CFXBUILDID for cfx5rc files then in ~
  # for .cfx5rc files for compatability with CFX-5.2.
  #
  my $home=getconf("HOME");

  my $release=getconf("CFXBUILDID");

  for my $prefix ( # first, the user overrides
                  (defined getconf('CFX_USER_CONFIG_DIR') 
                   ? (join_file(getconf('CFX_USER_CONFIG_DIR'),$release,''),
                      join_file(getconf('CFX_USER_CONFIG_DIR'),''))
                   : ()),
                  (defined getconf('CFX_PROFILE_DIR') 
                   ? (join_file(getconf('CFX_PROFILE_DIR'),$release,''),
                      join_file(getconf('CFX_PROFILE_DIR'),''))
                   : ()),
                  join_file($home,".cfx",$release,""),
                  join_file($home,".cfx",""),
                  join_file($home,"CFX",$release,""), 
                  join_file($home,"CFX",""), 
                  join_file($home,"."),
                  # now the system places
                  join_file(getconf('CFX_CONFIG_DIR'),''),
                  join_file(dirname(getconf('CFX_CONFIG_DIR')),''),
                 ) {
    my $file=$prefix.$name;
    return $file if -r $file;
    # maybe don't need this if we already have an extension, but it
    # does no harm!
    return "$file.txt" if -r "$file.txt";
  }

  undef;
}

=head2 findbin_by_path

  $realbin=findbin_by_path($0);

Given a filename in the style of C<$0>, work out where the actual
binary is for that command and return the I<directory> containing it.
This means:

=over

=item *

If the argument is C<-e> or C<->, which are Perl shorthand for scripts
run with the C<-e> switch and from C<stdin> respectively, return the
current directory.

=item *

If it is an absolute path, return it straight off.

=item *

If it is a relative path, run it through C<fullpath> and return it.

=item *

If it is a bare filename, look for it according to the search rules on
the current platform (assuming the default shell). On NT, this looks
first in the current directory; then on both platforms it looks along
the user's PATH (taken from the PATH variable). If this finds the
command, it is returned.

=item *

If none of these succeed, return the special string ".". This can be
used as-is, or treated as an error condition (all of the above will
return absolute pathnames).

=back

If the second argument is passed as TRUE, it will return a list of all
occurrences of the command on the PATH, if the command was passed as a
bare word; note that this list will include the command itself, unlike
the single-argument form above.

=cut '

sub findbin_by_path {
  my $bin=shift;
  my $show_all=shift || 0;
  my @all;

  if ($bin eq '-e' or $bin eq '-') {
    _debug("Special \$0 value $bin");
    return fullpath('.');
  }

  calcseps() unless defined $PathSep;

  if ($bin =~ m/$DirSepRE/) {
    # this is an absolute or relative PATH, not a bareword; send it
    # through fullpath, which knows the difference.
    _debug("$bin is a relative or absolute path");
    return fullpath(dirname($bin));
  }

  my $is_nt = getconf('windows_nt');

  # Right, it's a bare word; look along the PATH.
  my @path=(($is_nt ? (".") : ()), path_to_list(getconf('PATH')));

  $bin =~ s/\.(com|exe|bin)$//ig if $is_nt;

  _debug("looking for $bin in the PATH ...");

  for my $p (@path) {
    if ($is_nt) {
      #TODO: is this right? Specifically, check the order.
      #
      #TODO: FindBin.pm has uses -T here to make sure it's really a
      # text file, as a check for being run as "perl <file>". Should
      # we?
      for my $x (qw(.com .exe .bat), '') {
	if (-r join_file($p,$bin.$x)) {
	  _debug("Found $bin$x in $p");
	  return fullpath($p)
	    unless $show_all;
	  push @all, fullpath(join_file($p,$bin.$x));
	}
      }
    } else {
      if (-x join_file($p,$bin)) {
	_debug("Found $bin in $p");
	return fullpath($p)
	  unless $show_all;
	push @all, fullpath(join_file($p,$bin));
      }
    }
  }

  if (scalar(@all) > 0 and $show_all) {
    return @all;
  }

  _debug("Failed to find $bin in the path");

  # creative error codes rule OK
  return '.';
}

=head2 relative_path

  $link=relative_path("/home/andy/www/index.html","new-page.html");
  # $link might be "new-dir/new-page.html" if CWD is /home/andy/www/new-dir

Given two pathnames, returns the relative pathname to get to the second 
from the first. This can be used as an HTML link, to contruct the destination
for a symbolic link on a UNIX filesystem, or anything else you happen to fancy. 
Relative paths are interpreted relative to the current working directory.

This operation uses C<fullpath> to ensure both paths are in the correct form.
For consistency, you will probably want to call C<abspath> on both arguments
before you pass them (think F</tmp_mnt/home/andy> versus F</home/andy>).

Note that, on NT systems, this returns a path with backslashes in; see also
C<relative_path_fs> for a version which always uses forward-slashes.

=cut

sub relative_path {
  my $from=fullpath(shift);
  my $to=fullpath(shift);
  my $use_fs=shift;

  my @from=split_file($from);
  my @to=split_file($to);

  # remove all identical parts from the path leaders
  # the funny list below is to ensure that both lists always get
  # shifted
  my ($fs,$ts);
  while ((
          ($fs=shift @from),
          ($ts=shift @to),
          (defined $fs and defined $ts)
         ) and $fs eq $ts) {1;}

  # what have we got?
  # work out what to do, and leave the relative path in @to
  if (defined $fs and defined $ts) {
    # paths differ at this point, and both continue
    unshift @to, $ts;
    my $a;
    for $a (@from) { unshift @to, ".."; }
  } elsif (defined $fs) {
    # don't have $ts, so it's the end of the road there
    my $a;
    for $a (@from) { unshift @to, ".."; }
  } elsif (defined $ts) {
    # got to the end of the from path
    unshift @to, $ts;
  } else {
    # the paths were identical!
  }

  if ($use_fs) {
    return join("/",@to);
  } else {
    return join_file(@to);
  }
}

=head2 relative_path_fs

Just like C<relative_path>, but always returns results separated by
forward-slashes, for use on web pages etc.

=cut

sub relative_path_fs {
  return relative_path($_[0],$_[1],1);
}

=head2 CONSTRUCTORS

=head3 pathmapper

Constructor to map local paths to network (e.g. UNC) paths

=cut

sub pathmapper
{
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = {};
  bless $self, $class;
  return $self;
}

=head2 DATA ACCESS

=head3 add_mapping

Add new local -> network path mapping

=cut

sub add_mapping {
  my $self = shift;
  my $loc_path = shift;
  my $net_path = shift;

  my $a = uc(normalize_filename($loc_path));
  my $b = uc(normalize_filename($net_path));

  $self->{mappings}{$a} = $b;

  return 0;
}

=head3 map_local_path

Map a local path, returning a network path

=cut

sub map_local_path {
  my $self = shift;
  my $loc_path = shift;
  my $description = shift;

  # Unless the path exists, it's probably not a path. Return as is.
  unless (-e "$loc_path") {
    return $loc_path;
  }

  my $value = uc(normalize_filename($loc_path));
  my $mappedpath = $self->mappath_tail($value);

  # Record the mapping, if it took place
  if ($mappedpath ne $value){
    $description = 'Not specified' unless (defined $description);
    my %info = (description => $description,
                original    => $value,
                mapped      => $mappedpath);
    push @{$self->{info}}, \%info;
  }

  return $mappedpath;
}

=head3 mappath_tail

Actually carries out the mapping, recursively if necessary.
If the initial part of the path matches a mapping, treat that as
a match and append the rest of the path.

=cut

sub mappath_tail {
  my $self = shift;
  my $path = shift;

  return undef unless $path;

  # If the mapping exists, use it
  if ($self->{mappings}{$path}) {
    return $self->{mappings}{$path};
  }
  # Try reconstructing the path from the directory and base names
  elsif (dirname($path) and dirname($path) ne '.') {
    return join_file($self->mappath_tail(dirname($path)), basename($path));
  }
  # If all else fails, return the path as is
  else {
    return $path;
  }
}

=head3 map_ccl_paths

Map paths in CCL parameters

=cut

sub map_ccl_paths {
  my $self = shift;
  my $api = shift;
  my $objpath = shift;

  my @list;
  my $rv;
  
  # Process parameters
  $rv = $api->getChildParamList($objpath, \@list);
  
  for my $param (@list) {
    my $value;
    $rv = $api->getStringValue("$objpath/$param", \$value);
    my $value_mapped = $self->map_local_path($value, "CCL Parameter: $objpath/$param");
    $rv = $api->setStringValue("$objpath/$param", $value_mapped);
  }

  # Process objects (recursively)
  $rv = $api->getChildObjectList($objpath, \@list);
  
  for my $obj (@list) {
    $self->map_ccl_paths($api,"$objpath/$obj");
  }
}

=head3 mapping_info

Return an array of information about mappings carried out

=cut

sub mapping_info {
  my $self = shift;
  return () unless (exists $self->{info});
  return @{$self->{info}};
}

1;
