fb930b6b0e
Removed the -h option to convertRelease, use $ENV{EPICS_HOST_ARCH} instead.
Reworked variables associated with expandVars to make it simpler to use.
Split EPICS::Utils module into three parts.
Moved code from fullPathName.pl into the new EPICS::Path module.
Changed convertRelease.pl to use new modules.
Added some documentation to RELEASE_NOTES.html
151 lines
4.0 KiB
Perl
151 lines
4.0 KiB
Perl
#*************************************************************************
|
|
# Copyright (c) 2008 UChicago Argonne LLC, as Operator of Argonne
|
|
# National Laboratory.
|
|
# EPICS BASE is distributed subject to a Software License Agreement found
|
|
# in file LICENSE that is included with this distribution.
|
|
#*************************************************************************
|
|
|
|
# $Id$
|
|
|
|
use Carp;
|
|
use Cwd qw(getcwd abs_path);
|
|
use File::Spec;
|
|
|
|
=head1 EPICS::Path
|
|
|
|
EPICS::Path - Path-handling utilities for EPICS tools
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use lib '@EPICS_BASE@/lib/perl';
|
|
use EPICS::Path;
|
|
|
|
my $dir = UnixPath('C:\Program Files\EPICS');
|
|
print LocalPath($dir), "\n";
|
|
print AbsPath('../lib', $dir);
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
C<EPICS::Path> provides functions for processing pathnames that are
|
|
commonly needed by EPICS tools. Windows is not the only culprit, some
|
|
older automount daemons insert strange prefixes into absolute directory
|
|
paths that we have to remove before storing the result for use later.
|
|
|
|
|
|
=head1 FUNCTIONS
|
|
|
|
=over 4
|
|
|
|
=item UnixPath( I<PATH> )
|
|
|
|
C<UnixPath> should be used on any pathnames provided by external
|
|
tools to convert them into a form that Perl understands.
|
|
|
|
On cygwin we convert Windows drive specs to the equivalent cygdrive
|
|
path, and on Windows we switch directory separators from back-slash
|
|
to forward slashes.
|
|
|
|
=cut
|
|
|
|
sub UnixPath {
|
|
my ($newpath) = @_;
|
|
if ($^O eq 'cygwin') {
|
|
$newpath =~ s{\\}{/}go;
|
|
$newpath =~ s{^([a-zA-Z]):/}{/cygdrive/$1/};
|
|
} elsif ($^O eq 'MSWin32') {
|
|
$newpath =~ s{\\}{/}go;
|
|
}
|
|
return $newpath;
|
|
}
|
|
|
|
=item LocalPath( I<PATH> )
|
|
|
|
C<LocalPath> should be used when generating pathnames for external
|
|
tools or to put into a file. It converts paths from the Unix form
|
|
that Perl understands to any necessary external representation, and
|
|
also removes automounter prefixes to put the path into its canonical
|
|
form.
|
|
|
|
On cygwin we convert cygdrive paths to their equivalent Windows
|
|
drive specs. Before Leopard, the Mac OS X automounter inserted a
|
|
verbose prefix, and in case anyone is still using SunOS it adds its
|
|
own prefix as well.
|
|
|
|
=cut
|
|
|
|
sub LocalPath {
|
|
my ($newpath) = @_;
|
|
if ($^O eq 'cygwin') {
|
|
$newpath =~ s{^/cygdrive/([a-zA-Z])/}{$1:/};
|
|
} elsif ($^O eq 'darwin') {
|
|
# Darwin automounter
|
|
$newpath =~ s{^/private/var/auto\.}{/};
|
|
} elsif ($^O eq 'sunos') {
|
|
# SunOS automounter
|
|
$newpath =~ s{^/tmp_mnt/}{/};
|
|
}
|
|
return $newpath;
|
|
}
|
|
|
|
=item AbsPath( I<PATH> )
|
|
|
|
=item AbsPath( I<PATH>, I<CWD> )
|
|
|
|
The C<abs_path()> function in Perl's C<Cwd> module doesn't like
|
|
non-existent path components other than in the final position, but
|
|
EPICS tools needs to be able to handle them in paths like
|
|
F<$(TOP)/lib/$(T_A)> before the F<$(TOP)/lib> directory has been
|
|
created.
|
|
|
|
C<AbsPath> takes a path I<PATH> and optionally an absolute path to a
|
|
directory that first is relative to; if the second argument is not
|
|
provided the current working directory is used. The result returned
|
|
has been filtered through C<LocalPath()> to remove any automounter
|
|
prefixes.
|
|
|
|
=cut
|
|
|
|
sub AbsPath {
|
|
my ($path, $cwd) = @_;
|
|
|
|
$path = '.' unless defined $path;
|
|
|
|
if (defined $cwd) {
|
|
croak("'$cwd' is not an absolute path")
|
|
unless $cwd =~ m[^ / ]x;
|
|
} else {
|
|
$cwd = getcwd();
|
|
}
|
|
|
|
# Move leading ./ and ../ components from $path to $cwd
|
|
if (my ($dots, $not) = ($path =~ m[^ ( (?: \. \.? / )+ ) ( .* ) $]x)) {
|
|
$cwd .= "/$dots";
|
|
$path = $not;
|
|
}
|
|
|
|
# Handle any trailing .. part
|
|
if ($path eq '..') {
|
|
$cwd .= '/..';
|
|
$path = '.'
|
|
}
|
|
|
|
# Now calculate the absolute path
|
|
my $abs = File::Spec->rel2abs($path, abs_path($cwd));
|
|
|
|
return LocalPath($abs);
|
|
}
|
|
|
|
=back
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
Copyright (C) 2008 UChicago Argonne LLC, as Operator of Argonne National
|
|
Laboratory.
|
|
|
|
This software is distributed under the terms of the EPICS Open License.
|
|
|
|
=cut
|
|
|
|
|
|
1;
|