Renamed convertRelease target 'STDOUT' to 'releaseTops' and fixed build files.
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
This commit is contained in:
Andrew Johnson
75
src/tools/EPICS/Copy.pm
Normal file
75
src/tools/EPICS/Copy.pm
Normal file
@@ -0,0 +1,75 @@
|
||||
#*************************************************************************
|
||||
# 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$
|
||||
|
||||
# Copy directories and files from a template
|
||||
|
||||
sub copyTree {
|
||||
my ($src, $dst, $Rnamesubs, $Rtextsubs) = @_;
|
||||
# $Rnamesubs contains substitutions for file names,
|
||||
# $Rtextsubs contains substitutions for file content.
|
||||
|
||||
opendir my $FILES, $src
|
||||
or die "opendir failed while copying $src: $!\n";
|
||||
my @entries = readdir $FILES;
|
||||
closedir $FILES;
|
||||
|
||||
foreach (@entries) {
|
||||
next if m/^\.\.?$/; # ignore . and ..
|
||||
next if m/^CVS$/; # Shouldn't exist, but...
|
||||
|
||||
my $srcName = "$src/$_";
|
||||
|
||||
# Substitute any _VARS_ in the name
|
||||
s/@(\w+?)@/$Rnamesubs->{$1} || "@$1@"/eg;
|
||||
my $dstName = "$dst/$_";
|
||||
|
||||
if (-d $srcName) {
|
||||
print ":" unless $opt_d;
|
||||
copyDir($srcName, $dstName, $Rnamesubs, $Rtextsubs);
|
||||
} elsif (-f $srcName) {
|
||||
print "." unless $opt_d;
|
||||
copyFile($srcName, $dstName, $Rtextsubs);
|
||||
} elsif (-l $srcName) {
|
||||
warn "\nSoft link in template, ignored:\n\t$srcName\n";
|
||||
} else {
|
||||
warn "\nUnknown file type in template, ignored:\n\t$srcName\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub copyDir {
|
||||
my ($src, $dst, $Rnamesubs, $Rtextsubs) = @_;
|
||||
if (-e $dst && ! -d $dst) {
|
||||
warn "\nTarget exists but is not a directory, skipping:\n\t$dst\n";
|
||||
return;
|
||||
}
|
||||
print "Creating directory '$dst'\n" if $opt_d;
|
||||
mkdir $dst, 0777 or die "Can't create $dst: $!\n"
|
||||
unless -d $dst;
|
||||
copyTree($src, $dst, $Rnamesubs, $Rtextsubs);
|
||||
}
|
||||
|
||||
sub copyFile {
|
||||
my ($src, $dst, $Rtextsubs) = @_;
|
||||
return if (-e $dst);
|
||||
print "Creating file '$dst'\n" if $opt_d;
|
||||
open(my $SRC, '<', $src)
|
||||
and open(my $DST, '>', $dst)
|
||||
or die "$! copying $src to $dst\n";
|
||||
while (<$SRC>) {
|
||||
# Substitute any @VARS@ in the text
|
||||
s{@(\w+?)@}
|
||||
{exists $Rtextsubs->{$1} ? $Rtextsubs->{$1} : "\@$1\@"}eg;
|
||||
print $DST $_;
|
||||
}
|
||||
close $DST;
|
||||
close $SRC;
|
||||
}
|
||||
|
||||
1;
|
||||
150
src/tools/EPICS/Path.pm
Normal file
150
src/tools/EPICS/Path.pm
Normal file
@@ -0,0 +1,150 @@
|
||||
#*************************************************************************
|
||||
# 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;
|
||||
91
src/tools/EPICS/Release.pm
Normal file
91
src/tools/EPICS/Release.pm
Normal file
@@ -0,0 +1,91 @@
|
||||
#*************************************************************************
|
||||
# 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$
|
||||
|
||||
#
|
||||
# Parse all relevent configure/RELEASE* files and includes
|
||||
#
|
||||
sub readReleaseFiles {
|
||||
my ($relfile, $Rmacros, $Rapps, $arch) = @_;
|
||||
|
||||
return unless (-r $relfile);
|
||||
&readRelease($relfile, $Rmacros, $Rapps);
|
||||
|
||||
my $hostarch = $ENV{'EPICS_HOST_ARCH'};
|
||||
if ($hostarch) {
|
||||
my $hrelfile = "$relfile.$hostarch";
|
||||
&readRelease($hrelfile, $Rmacros, $Rapps) if (-r $hrelfile);
|
||||
}
|
||||
|
||||
if ($arch) {
|
||||
my $crelfile = "$relfile.Common.$arch";
|
||||
&readRelease($crelfile, $Rmacros, $Rapps) if (-r $crelfile);
|
||||
|
||||
if ($hostarch) {
|
||||
my $arelfile = "$relfile.$hostarch.$arch";
|
||||
&readRelease($arelfile, $Rmacros, $Rapps) if (-r $arelfile);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Parse a configure/RELEASE* file and anything it includes
|
||||
#
|
||||
sub readRelease {
|
||||
my ($file, $Rmacros, $Rapps) = @_;
|
||||
# $Rmacros is a reference to a hash, $Rapps a ref to an array
|
||||
|
||||
open(my $IN, '<', $file) or die "Can't open $file: $!\n";
|
||||
while (<$IN>) {
|
||||
chomp;
|
||||
s/ \r $//x; # Shouldn't need this, but sometimes...
|
||||
s/ # .* $//x; # Remove trailing comments
|
||||
s/ \s+ $//x; # Remove trailing whitespace
|
||||
next if m/^ \s* $/x; # Skip blank lines
|
||||
|
||||
# Expand all already-defined macros in the line:
|
||||
while (my ($pre,$var,$post) = m/ (.*) \$\( (\w+) \) (.*) /x) {
|
||||
last unless exists $Rmacros->{$var};
|
||||
$_ = $pre . $Rmacros->{$var} . $post;
|
||||
}
|
||||
|
||||
# Handle "<macro> = <path>"
|
||||
my ($macro, $path) = m/^ \s* (\w+) \s* = \s* (.*) /x;
|
||||
if ($macro ne '') {
|
||||
$macro='TOP' if $macro =~ m/^ INSTALL_LOCATION /x;
|
||||
if (exists $Rmacros->{$macro}) {
|
||||
delete $Rmacros->{$macro};
|
||||
} else {
|
||||
push @$Rapps, $macro;
|
||||
}
|
||||
$Rmacros->{$macro} = $path;
|
||||
next;
|
||||
}
|
||||
# Handle "include <path>" and "-include <path>" syntax
|
||||
($path) = m/^ \s* -? include \s+ (.*)/x;
|
||||
&readRelease($path, $Rmacros, $Rapps) if (-r $path);
|
||||
}
|
||||
close $IN;
|
||||
}
|
||||
|
||||
#
|
||||
# Expand any (possibly nested) macros that were defined after use
|
||||
#
|
||||
sub expandRelease {
|
||||
my ($Rmacros) = @_;
|
||||
# $Rmacros is a reference to a hash
|
||||
|
||||
while (my ($macro, $path) = each %$Rmacros) {
|
||||
while (my ($pre,$var,$post) = $path =~ m/(.*)\$\((\w+?)\)(.*)/) {
|
||||
$path = $pre . $Rmacros->{$var} . $post;
|
||||
$Rmacros->{$macro} = $path;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -1,146 +0,0 @@
|
||||
# Useful common utilities for EPICS tools
|
||||
#
|
||||
# This code is from base/configure/tools/convertRelease.pl
|
||||
|
||||
# Read and parse the settings from a configure/RELEASE file
|
||||
sub readRelease {
|
||||
my ($file, $Rmacros, $Rapps) = @_;
|
||||
# $Rmacros is a reference to a hash, $Rapps a ref to an array
|
||||
|
||||
my $IN;
|
||||
open($IN, '<', $file) or die "Can't open $file: $!\n";
|
||||
while (<$IN>) {
|
||||
chomp;
|
||||
s/\r$//; # Shouldn't need this, but sometimes...
|
||||
s/\s*#.*$//; # Remove trailing comments
|
||||
next if m/^\s*$/; # Skip blank lines
|
||||
|
||||
# Expand all already-defined macros in the line:
|
||||
while (my ($pre,$var,$post) = m/(.*)\$\((\w+)\)(.*)/) {
|
||||
last unless exists $Rmacros->{$var};
|
||||
$_ = $pre . $Rmacros->{$var} . $post;
|
||||
}
|
||||
|
||||
# Handle "<macro> = <path>"
|
||||
my ($macro, $path) = m/^\s*(\w+)\s*=\s*(.*)/;
|
||||
if ($macro ne '') {
|
||||
$Rmacros->{$macro} = $path;
|
||||
push @$Rapps, $macro;
|
||||
next;
|
||||
}
|
||||
# Handle "include <path>" syntax
|
||||
($path) = m/^\s*include\s+(.*)/;
|
||||
&readRelease($path, $Rmacros, $Rapps) if (-r $path);
|
||||
}
|
||||
close $IN;
|
||||
}
|
||||
|
||||
# Expand any (possibly nested) settings that were defined after use
|
||||
sub expandRelease {
|
||||
my ($Rmacros) = @_;
|
||||
# $Rmacros is a reference to a hash
|
||||
|
||||
while (my ($macro, $path) = each %$Rmacros) {
|
||||
while (my ($pre,$var,$post) = $path =~ m/(.*)\$\((\w+?)\)(.*)/) {
|
||||
$path = $pre . $Rmacros->{$var} . $post;
|
||||
$Rmacros->{$macro} = $path;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# Path rewriting rules for various OSs
|
||||
|
||||
# UnixPath should be used on any pathnames provided by external tools
|
||||
# and returns a path that Perl can use.
|
||||
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;
|
||||
}
|
||||
|
||||
# LocalPath should be used when generating pathnames for use by an
|
||||
# external tool or file.
|
||||
sub LocalPath {
|
||||
my ($newpath) = @_;
|
||||
if ($^O eq 'cygwin') {
|
||||
$newpath =~ s{^/cygdrive/([a-zA-Z])/}{$1:/};
|
||||
} elsif ($^O eq 'darwin') {
|
||||
# This rule may be site-specific to APS
|
||||
$newpath =~ s{^/private/var/auto\.home/}{/home/};
|
||||
} elsif ($^O eq 'sunos') {
|
||||
$newpath =~ s{^/tmp_mnt/}{/};
|
||||
}
|
||||
return $newpath;
|
||||
}
|
||||
|
||||
|
||||
# Copy directories and files from a template
|
||||
|
||||
sub copyTree {
|
||||
my ($src, $dst, $Rnamesubs, $Rtextsubs) = @_;
|
||||
# $Rnamesubs contains substitutions for file names,
|
||||
# $Rtextsubs contains substitutions for file content.
|
||||
|
||||
opendir my $FILES, $src
|
||||
or die "opendir failed while copying $src: $!\n";
|
||||
my @entries = readdir $FILES;
|
||||
closedir $FILES;
|
||||
|
||||
foreach (@entries) {
|
||||
next if m/^\.\.?$/; # ignore . and ..
|
||||
next if m/^CVS$/; # Shouldn't exist, but...
|
||||
|
||||
my $srcName = "$src/$_";
|
||||
|
||||
# Substitute any _VARS_ in the name
|
||||
s/@(\w+?)@/$Rnamesubs->{$1} || "@$1@"/eg;
|
||||
my $dstName = "$dst/$_";
|
||||
|
||||
if (-d $srcName) {
|
||||
print ":" unless $opt_d;
|
||||
copyDir($srcName, $dstName, $Rnamesubs, $Rtextsubs);
|
||||
} elsif (-f $srcName) {
|
||||
print "." unless $opt_d;
|
||||
copyFile($srcName, $dstName, $Rtextsubs);
|
||||
} elsif (-l $srcName) {
|
||||
warn "\nSoft link in template, ignored:\n\t$srcName\n";
|
||||
} else {
|
||||
warn "\nUnknown file type in template, ignored:\n\t$srcName\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub copyFile {
|
||||
my ($src, $dst, $Rtextsubs) = @_;
|
||||
return if (-e $dst);
|
||||
print "Creating file '$dst'\n" if $opt_d;
|
||||
open(my $SRC, '<', $src) and open(my $DST, '>', $dst)
|
||||
or die "$! copying $src to $dst\n";
|
||||
while (<$SRC>) {
|
||||
# Substitute any _VARS_ in the text
|
||||
s/@(\w+?)@/$Rtextsubs->{$1} || "@$1@"/eg;
|
||||
print $DST $_;
|
||||
}
|
||||
close $DST;
|
||||
close $SRC;
|
||||
}
|
||||
|
||||
sub copyDir {
|
||||
my ($src, $dst, $Rnamesubs, $Rtextsubs) = @_;
|
||||
if (-e $dst && ! -d $dst) {
|
||||
warn "\nTarget exists but is not a directory, skipping:\n\t$dst\n";
|
||||
return;
|
||||
}
|
||||
print "Creating directory '$dst'\n" if $opt_d;
|
||||
mkdir $dst, 0777 or die "Can't create $dst: $!\n"
|
||||
unless -d $dst;
|
||||
copyTree($src, $dst, $Rnamesubs, $Rtextsubs);
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user