epics/pcas
0
0
Fork 0
Code Issues Pull Requests Projects Wiki Activity

Renamed convertRelease target 'STDOUT' to 'releaseTops' and fixed build files.

Browse Source 
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
2008-04-03 21:57:16 +00:00
parent 2a9ccaf2c0
commit fb930b6b0e
15 changed files with 616 additions and 495 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
configure/CONFIG_APP_INCLUDE
View File

@@ -1,7 +1,7 @@
export TOP
export IOCAPPS
RELEASE_TOPS = $(shell $(PERL) $(TOOLS)/convertRelease.pl -T $(TOP) -h $(EPICS_HOST_ARCH) STDOUT )
RELEASE_TOPS = $(shell $(PERL) $(TOOLS)/convertRelease.pl -T $(TOP) releaseTops )
ifneq ($(RELEASE_TOPS),)

8
configure/RULES_ARCHS
View File

@@ -76,15 +76,15 @@ targetReleaseFiles = $(wildcard $(foreach arch, $(BUILD_ARCHS), \
checkReleaseTargets = $(addprefix checkRelease, $(suffix $(targetReleaseFiles)))
checkRelease: $(checkReleaseTargets)
$(CONVERTRELEASE) -h $(EPICS_HOST_ARCH) checkRelease
$(CONVERTRELEASE) checkRelease
$(checkReleaseTargets):checkRelease.%:
$(CONVERTRELEASE) -h $(EPICS_HOST_ARCH) -a $* checkRelease
$(CONVERTRELEASE) -a $* checkRelease
warnReleaseTargets = $(addprefix warnRelease, $(suffix $(targetReleaseFiles)))
warnRelease: $(warnReleaseTargets)
-$(CONVERTRELEASE) -h $(EPICS_HOST_ARCH) checkRelease
-$(CONVERTRELEASE) checkRelease
$(warnReleaseTargets):warnRelease.%:
-$(CONVERTRELEASE) -h $(EPICS_HOST_ARCH) -a $* checkRelease
-$(CONVERTRELEASE) -a $* checkRelease
#
# special clean rule

8
configure/RULES_EXPAND
View File

@@ -4,8 +4,10 @@ ifdef T_A
ifeq ($(findstring Host,$(VALID_BUILDS)),Host)
# Default settings
EXPAND_VARS ?= $(PERL) $(TOOLS)/expandVars.pl
EXPANDFLAGS += -t $(INSTALL_LOCATION) -D ARCH=$(T_A)
EXPAND_TOOL ?= $(PERL) $(TOOLS)/expandVars.pl
EXPANDFLAGS += -t $(INSTALL_LOCATION) -a $(T_A)
EXPANDFLAGS += $(addprefix -D ,$(EXPAND_VARS))
EXPANDED = $(EXPAND:%@=%)
@@ -14,7 +16,7 @@ buildInstall: $(EXPANDED)
$(EXPANDED): %: ../%@
@echo "Expanding $< to $@"
@$(RM) $@
@$(EXPAND_VARS) $(EXPANDFLAGS) $($@_EXPANDFLAGS) $< $@
@$(EXPAND_TOOL) $(EXPANDFLAGS) $($@_EXPANDFLAGS) $< $@
clean::
$(RM) $(EXPANDED)

2
configure/RULES_TOP
View File

@@ -24,7 +24,7 @@ ifneq ($(wildcard $(RULES_TOP)/cfg/RULES*),)
endif
-include $(wildcard $(CONFIG)/RULES_OCTAVE)
RELEASE_TOPS = $(shell $(CONVERTRELEASE) -T $(TOP) -h $(EPICS_HOST_ARCH) STDOUT )
RELEASE_TOPS = $(shell $(CONVERTRELEASE) -T $(TOP) releaseTops )
# Include RULES* files from tops defined in RELEASE* files
ifneq ($(RELEASE_TOPS),)

58
documentation/RELEASE_NOTES.html
View File

@@ -9,10 +9,66 @@
<body lang="en">
<h1 align="center">EPICS Base Release 3.14.x</h1>
<h2 align="center">Changes between 3.14.9 and 3.14.x</h2>
<h2 align="center">Changes between 3.14.9 and 3.14.10</h2>
<!-- Insert new items below here ... -->
<h4>Build System Reorganization</h4>
<p>Several changes have been made to the build system, although these changes
should not affect the contents of <tt>Makefile</tt>s or any applications using
Base. They do however require that the version of GNU Make used be 3.80 (3.81?)
or later. These changes are briefly:</p>
<ul>
<li>
<p>A new tool is provided that expands out <tt>@VAR@</tt> macros. By
default it knows the value of <tt>@TOP@</tt>, <tt>@ARCH@</tt> and any paths
defined in the application's <tt>configure/RELEASE</tt> file, but additional
macros can be defined in the <tt>Makefile</tt> that uses it by adding to the
<tt>EXPAND_VARS</tt> macro like the example following, which creates an
<tt>@EXE@</tt> macro that expands out to <tt>.exe</tt> on windows and to
nothing on other platforms:</p>
<pre> EXPAND_VARS += EXE=$(EXE)</pre>
<p>Files that contain <tt>@VAR@</tt> macros to be substituted must have an
at sign <tt><b>@</b></tt> as the last character of their name and be listed
in the <tt>EXPAND</tt> variable of their <tt>Makefile</tt>. The expanded
file will have the same name as the original with the <tt><b>@</b></tt>
suffix removed, and is then available for compiling or installing using any
other build mechanism.</p>
</li>
<li>
<p>Support has been added for installing Perl library modules. The
<tt>Makefile</tt> variable <tt>PERL_MODULES</tt> can be set to a list of
names of files to be installed into the <tt>$(TOP)/lib/perl</tt> directory.
The above macro expansion facility can then be used in perl programs that
use these libraries to set the perl search path to include that directory.
The syntax for this is as follows:</p>
<pre> use lib '@TOP@/lib/perl';
use MyModule;</pre>
<p>The filenames listed in <tt>PERL_MODULES</tt> can include subdirectory
path components and the build system will preserve these in the installed
result.</p>
</li>
<li>The Perl scripts that were in <tt>configure/tools</tt> are now found in
the new <tt>src/tools</tt> directory, and get installed into the appropriate
<tt>bin/<i>hostarch</i></tt> directory at build time. Some of these scripts
are no longer required and have been removed, and others are being modified
to make them more modular, extracting common routines into perl library
modules.</li>
<li>The generated files that were created by running make in the
<tt>configure</tt> directory are no longer required, having been replaced by
additional mechanisms inside the build system files. This removes a common
source of build problems.</li>
</ul>
<h4>Access security configuration files</h4>
<p>Rules and macros were added for creating an *.acf file, access security

75
src/tools/EPICS/Copy.pm Normal file
View 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
View 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
View 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;

146
src/tools/EPICS/Utils.pm
View File

@@ -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;

15
src/tools/Makefile
View File

@@ -1,10 +1,7 @@
#*************************************************************************
# Copyright (c) 2002 The University of Chicago, as Operator of Argonne
# Copyright (c) 2008 UChicago Argonne LLC, as Operator of Argonne
# National Laboratory.
# Copyright (c) 2002 The Regents of the University of California, as
# Operator of Los Alamos National Laboratory.
# EPICS BASE Versions 3.13.7
# and higher are distributed subject to a Software License Agreement found
# EPICS BASE is distributed subject to a Software License Agreement found
# in file LICENSE that is included with this distribution.
#*************************************************************************
TOP=../..
@@ -15,11 +12,15 @@ include $(TOP)/configure/CONFIG
TOOLS = $(TOP)/src/tools
# Bootstrap resolution: expandVars.pl needs to be run on itself!
EXPAND_VARS = $(PERL) ../expandVars.pl@
EXPAND_TOOL = $(PERL) $(TOOLS)/expandVars.pl@
EXPAND += convertRelease.pl@
EXPAND += expandVars.pl@
EXPAND += fullPathName.pl@
PERL_MODULES += EPICS/Utils.pm
PERL_MODULES += EPICS/Copy.pm
PERL_MODULES += EPICS/Path.pm
PERL_MODULES += EPICS/Release.pm
PERL_MODULES += EPICS/Getopts.pm
PERL_SCRIPTS += convertRelease.pl

283
src/tools/convertRelease.pl
View File

@@ -1,283 +0,0 @@
eval 'exec perl -S $0 ${1+"$@"}' # -*- Mode: perl -*-
if $running_under_some_shell; # convertRelease.pl
#*************************************************************************
# Copyright (c) 2002 The University of Chicago, as Operator of Argonne
# National Laboratory.
# Copyright (c) 2002 The Regents of the University of California, as
# Operator of Los Alamos National Laboratory.
# EPICS BASE Versions 3.13.7
# and higher are distributed subject to a Software License Agreement found
# in file LICENSE that is included with this distribution.
#*************************************************************************
#
# $Id$
#
# Parse configure/RELEASE file(s) and generate a derived output file.
# With strict patches from Nick Rees at DLS.
#
use Cwd qw(cwd abs_path);
use Getopt::Std;
use strict;
use vars qw($cwd $arch $top $hostarch $iocroot $root $outfile $relfile);
use vars qw(%macros @apps);
$cwd = UnixPath(cwd());
our ($opt_a, $opt_h, $opt_t, $opt_T);
getopt "ahtT";
if ($opt_a) {
$arch = $opt_a;
} else { # Look for O.<arch> in current path
$_ = $cwd;
($arch) = /.*\/O.([\w-]+)$/;
}
$hostarch = $arch;
$hostarch = $opt_h if ($opt_h);
if ($opt_T) {
$top = $opt_T;
} else { # Find $top from current path
# This approach is only possible under iocBoot/* and configure/*
$top = $cwd;
$top =~ s/\/iocBoot.*$//;
$top =~ s/\/configure.*$//;
}
# The IOC may need a different path to get to $top
if ($opt_t) {
$iocroot = $opt_t;
$root = $top;
while (substr($iocroot, -1, 1) eq substr($root, -1, 1)) {
chop $iocroot;
chop $root;
}
}
unless (@ARGV == 1) {
print "Usage: convertRelease.pl [-a arch] [-h hostarch] [-T top] [-t ioctop] outfile\n";
print " where outfile is be one of:\n";
print "\tcheckRelease - checks consistency with support apps\n";
print "\tcdCommands - generate cd path strings for vxWorks IOCs\n";
print "\tenvPaths - generate epicsEnvSet commands for other IOCs\n";
print "\tSTDOUT - prints modules names defined in RELEASE*s\n";
exit 2;
}
$outfile = $ARGV[0];
# TOP refers to this application
%macros = (TOP => LocalPath($top));
@apps = ('TOP'); # Records the order of definitions in RELEASE file
# Read the RELEASE file(s)
$relfile = "$top/configure/RELEASE";
die "Can't find $relfile" unless (-f $relfile);
&readReleaseFiles($relfile, \%macros, \@apps);
&expandRelease(\%macros, \@apps);
# This is a perl switch statement:
for ($outfile) {
/STDOUT/ and do { &releaseTops; last; };
/cdCommands/ and do { &cdCommands; last; };
/envPaths/ and do { &envPaths; last; };
/checkRelease/ and do { &checkRelease; last; };
die "Output file type \'$outfile\' not supported";
}
#
# Print names of the modules defined in RELEASE* files
#
sub releaseTops {
my @includes = grep !/^(TOP|TEMPLATE_TOP)$/, @apps;
foreach my $app (@includes) {
print "$app ";
}
print "\n";
}
#
# Parse all relevent configure/RELEASE* files and includes
#
sub readReleaseFiles {
my ($relfile, $Rmacros, $Rapps) = @_;
return unless (-r $relfile);
&readRelease($relfile, $Rmacros, $Rapps);
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 its includes.
#
# NB: This subroutine also appears in base/src/makeBaseApp/makeBaseApp.pl
# If you make changes here, they will be needed there as well.
#
sub readRelease {
my ($file, $Rmacros, $Rapps) = @_;
# $Rmacros is a reference to a hash, $Rapps a ref to an array
my ($pre, $var, $post, $macro, $path);
local *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
s/\s+$//; # Remove trailing whitespace
next if /^\s*$/; # Skip blank lines
# Expand all already-defined macros in the line:
while (my ($pre,$var,$post) = /(.*)\$\((\w+)\)(.*)/) {
last unless (exists $Rmacros->{$var});
$_ = $pre . $Rmacros->{$var} . $post;
}
# Handle "<macro> = <path>"
my ($macro, $path) = /^\s*(\w+)\s*=\s*(.*)/;
if ($macro ne "") {
$macro="TOP" if $macro =~ /^INSTALL_LOCATION/ ;
if (exists $Rmacros->{$macro}) {
delete $Rmacros->{$macro};
} else {
push @$Rapps, $macro;
}
$Rmacros->{$macro} = $path;
next;
}
# Handle "include <path>" and "-include <path>" syntax
($path) = /^\s*-?include\s+(.*)/;
&readRelease($path, $Rmacros, $Rapps) if (-r $path);
}
close IN;
}
sub expandRelease {
my ($Rmacros, $Rapps) = @_;
# Expand any (possibly nested) macros that were defined after use
while (my ($macro, $path) = each %$Rmacros) {
while (my ($pre,$var,$post) = $path =~ /(.*)\$\((\w+)\)(.*)/) {
$path = $pre . $Rmacros->{$var} . $post;
$Rmacros->{$macro} = $path;
}
}
}
sub cdCommands {
die "Architecture not set (use -a option)" unless ($arch);
my @includes = grep !/^TEMPLATE_TOP$/, @apps;
unlink($outfile);
open(OUT,">$outfile") or die "$! creating $outfile";
my $startup = $cwd;
$startup =~ s/^$root/$iocroot/o if ($opt_t);
print OUT "startup = \"$startup\"\n";
my $ioc = $cwd;
$ioc =~ s/^.*\///; # iocname is last component of directory name
print OUT "putenv \"ARCH=$arch\"\n";
print OUT "putenv \"IOC=$ioc\"\n";
foreach my $app (@includes) {
my $iocpath = my $path = $macros{$app};
$iocpath =~ s/^$root/$iocroot/o if ($opt_t);
my $app_lc = lc($app);
print OUT "$app_lc = \"$iocpath\"\n" if (-d $path);
print OUT "putenv \"$app=$iocpath\"\n" if (-d $path);
print OUT "${app_lc}bin = \"$iocpath/bin/$arch\"\n" if (-d "$path/bin/$arch");
}
close OUT;
}
sub envPaths {
die "Architecture not set (use -a option)" unless ($arch);
my @includes = grep !/^TEMPLATE_TOP$/, @apps;
unlink($outfile);
open(OUT,">$outfile") or die "$! creating $outfile";
my $ioc = $cwd;
$ioc =~ s/^.*\///; # iocname is last component of directory name
print OUT "epicsEnvSet(ARCH,\"$arch\")\n";
print OUT "epicsEnvSet(IOC,\"$ioc\")\n";
foreach my $app (@includes) {
my $iocpath = my $path = $macros{$app};
$iocpath =~ s/^$root/$iocroot/o if ($opt_t);
print OUT "epicsEnvSet($app,\"$iocpath\")\n" if (-d $path);
}
close OUT;
}
sub checkRelease {
my $status = 0;
delete $macros{TOP};
delete $macros{TEMPLATE_TOP};
while (my ($app, $path) = each %macros) {
my %check = (TOP => $path);
my @order = ();
my $relfile = "$path/configure/RELEASE";
&readReleaseFiles($relfile, \%check, \@order);
&expandRelease(\%check, \@order);
delete $check{TOP};
while (my ($parent, $ppath) = each %check) {
if (exists $macros{$parent} &&
abs_path($macros{$parent}) ne abs_path($ppath)) {
print "\n" unless ($status);
print "Definition of $parent conflicts with $app support.\n";
print "In this application configure/RELEASE defines\n";
print "\t$parent = $macros{$parent}\n";
print "but $app at $path has\n";
print "\t$parent = $ppath\n";
$status = 1;
}
}
}
print "\n" if ($status);
exit $status;
}
# Path rewriting rules for various OSs
# These functions are duplicated in src/makeBaseApp/makeBaseApp.pl
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;
} elsif ($^O eq 'sunos') {
$newpath =~ s{^/tmp_mnt/}{/};
}
return $newpath;
}
sub LocalPath {
my ($newpath) = @_;
if ($^O eq "cygwin") {
$newpath =~ s{^/cygdrive/([a-zA-Z])/}{$1:/};
} elsif ($^O eq "darwin") {
# These rules are likely to be site-specific
$newpath =~ s{^/private/var/auto\.home/}{/home/}; # APS
}
return $newpath;
}

189
src/tools/convertRelease.pl@ Executable file
View File

@@ -0,0 +1,189 @@
eval 'exec perl -S $0 ${1+"$@"}' # -*- Mode: perl -*-
if $running_under_some_shell; # convertRelease.pl
#*************************************************************************
# Copyright (c) 2008 UChicago Argonne LLC, as Operator of Argonne
# National Laboratory.
# Copyright (c) 2002 The Regents of the University of California, as
# Operator of Los Alamos National Laboratory.
# EPICS BASE is distributed subject to a Software License Agreement found
# in file LICENSE that is included with this distribution.
#*************************************************************************
#
# $Id$
#
# Convert configure/RELEASE file(s) into something else.
#
use strict;
use lib '@TOP@/lib/perl';
use Cwd qw(cwd abs_path);
use Getopt::Std;
use EPICS::Path;
use EPICS::Release;
use vars qw($arch $top $iocroot $root);
our ($opt_a, $opt_t, $opt_T);
$Getopt::Std::OUTPUT_HELP_VERSION = 1;
getopts('a:t:T:') or &HELP_MESSAGE;
my $cwd = UnixPath(cwd());
if ($opt_a) {
$arch = $opt_a;
} else { # Look for O.<arch> in current path
$cwd =~ m{ / O. ([\w-]+) $}x;
$arch = $1;
}
if ($opt_T) {
$top = $opt_T;
} else { # Find $top from current path
# This approach only works inside iocBoot/* and configure/*
$top = $cwd;
$top =~ s{ / iocBoot .* $}{}x;
$top =~ s{ / configure .* $}{}x;
}
# The IOC may need a different path to get to $top
if ($opt_t) {
$iocroot = $opt_t;
$root = $top;
while (substr($iocroot, -1, 1) eq substr($root, -1, 1)) {
chop $iocroot;
chop $root;
}
}
&HELP_MESSAGE unless @ARGV == 1;
my $outfile = $ARGV[0];
# TOP refers to this application
my %macros = (TOP => LocalPath($top));
my @apps = ('TOP'); # Records the order of definitions in RELEASE file
# Read the RELEASE file(s)
my $relfile = "$top/configure/RELEASE";
die "Can't find $relfile" unless (-f $relfile);
readReleaseFiles($relfile, \%macros, \@apps, $arch);
expandRelease(\%macros, \@apps);
# This is a perl switch statement:
for ($outfile) {
m/releaseTops/ and do { &releaseTops; last; };
m/cdCommands/ and do { &cdCommands; last; };
m/envPaths/ and do { &envPaths; last; };
m/checkRelease/ and do { &checkRelease; last; };
die "Output file type \'$outfile\' not supported";
}
############### Subroutines only below here ###############
sub HELP_MESSAGE {
print STDERR <<EOF;
Usage: convertRelease.pl [-a arch] [-T top] [-t ioctop] outfile
where outfile is one of:
releaseTops - lists the module names defined in RELEASE*s
cdCommands - generate cd path strings for vxWorks IOCs
envPaths - generate epicsEnvSet commands for other IOCs
checkRelease - checks consistency with support modules
EOF
exit 2;
}
#
# List the module names defined in RELEASE* files
#
sub releaseTops {
my @includes = grep !/^(TOP|TEMPLATE_TOP)$/, @apps;
foreach my $app (@includes) {
print "$app ";
}
print "\n";
}
sub cdCommands {
die "Architecture not set (use -a option)" unless ($arch);
my @includes = grep !/^TEMPLATE_TOP$/, @apps;
unlink($outfile);
open(OUT,">$outfile") or die "$! creating $outfile";
my $startup = $cwd;
$startup =~ s/^$root/$iocroot/o if ($opt_t);
print OUT "startup = \"$startup\"\n";
my $ioc = $cwd;
$ioc =~ s/^.*\///; # iocname is last component of directory name
print OUT "putenv \"ARCH=$arch\"\n";
print OUT "putenv \"IOC=$ioc\"\n";
foreach my $app (@includes) {
my $iocpath = my $path = $macros{$app};
$iocpath =~ s/^$root/$iocroot/o if ($opt_t);
my $app_lc = lc($app);
print OUT "$app_lc = \"$iocpath\"\n" if (-d $path);
print OUT "putenv \"$app=$iocpath\"\n" if (-d $path);
print OUT "${app_lc}bin = \"$iocpath/bin/$arch\"\n" if (-d "$path/bin/$arch");
}
close OUT;
}
sub envPaths {
die "Architecture not set (use -a option)" unless ($arch);
my @includes = grep !/^TEMPLATE_TOP$/, @apps;
unlink($outfile);
open(OUT,">$outfile") or die "$! creating $outfile";
my $ioc = $cwd;
$ioc =~ s/^.*\///; # iocname is last component of directory name
print OUT "epicsEnvSet(ARCH,\"$arch\")\n";
print OUT "epicsEnvSet(IOC,\"$ioc\")\n";
foreach my $app (@includes) {
my $iocpath = my $path = $macros{$app};
$iocpath =~ s/^$root/$iocroot/o if ($opt_t);
print OUT "epicsEnvSet($app,\"$iocpath\")\n" if (-d $path);
}
close OUT;
}
sub checkRelease {
my $status = 0;
delete $macros{TOP};
delete $macros{TEMPLATE_TOP};
while (my ($app, $path) = each %macros) {
my %check = (TOP => $path);
my @order = ();
my $relfile = "$path/configure/RELEASE";
readReleaseFiles($relfile, \%check, \@order, $arch);
expandRelease(\%check, \@order);
delete $check{TOP};
while (my ($parent, $ppath) = each %check) {
if (exists $macros{$parent} &&
abs_path($macros{$parent}) ne abs_path($ppath)) {
print "\n" unless ($status);
print "Definition of $parent conflicts with $app support.\n";
print "In this application configure/RELEASE defines\n";
print "\t$parent = $macros{$parent}\n";
print "but $app at $path has\n";
print "\t$parent = $ppath\n";
$status = 1;
}
}
}
print "\n" if ($status);
exit $status;
}

22
src/tools/expandVars.pl@
View File

@@ -11,20 +11,22 @@
BEGIN {
# Do not copy this BEGIN code for other tools,
# it's only needed here for bootstrapping itself.
# it's only needed so expandVars can bootstrap itself.
our $libperl = '@TOP@/lib/perl';
$libperl = '..' if ($libperl =~ m/^[@]TOP[@]/);
}
use lib $libperl;
use strict;
use Cwd qw(abs_path);
use EPICS::Getopts; # Needed for multiple options (-D m=v)
use EPICS::Utils; # LocalPath, readRelease, expandRelease
use EPICS::Getopts;
use EPICS::Path;
use EPICS::Release;
use EPICS::Copy;
# Process command line options
our ($opt_d, @opt_D, $opt_h, $opt_t);
getopts('dD@ht:')
our ($opt_a, $opt_d, @opt_D, $opt_h, $opt_t);
getopts('a:dD@ht:')
or &HELP_MESSAGE;
# Handle the -h command
@@ -40,15 +42,17 @@ my $outfile = shift
or die "No output filename argument\n";
# Where are we?
my $top = LocalPath(abs_path($opt_t));
my $top = AbsPath($opt_t);
print "TOP = $top\n" if $opt_d;
# Read RELEASE file into vars
my %vars = (TOP => $top);
my @apps = ('TOP');
readRelease("$top/configure/RELEASE", \%vars, \@apps);
readReleaseFiles("$top/configure/RELEASE", \%vars, \@apps, $opt_a);
expandRelease(\%vars);
$vars{'ARCH'} = $opt_a if $opt_a;
while ($_ = shift @opt_D) {
my ($var, $val) = split /=/;
$vars{$var} = $val;
@@ -65,7 +69,7 @@ sub HELP_MESSAGE {
Usage:
expandVars.pl -h
Display this Usage message
expandVars.pl -t /path/to/top -D var=val -D var2=val2 ... infile outfile
expandVars.pl -t /path/to/top [-a arch] -D var=val ... infile outfile
Expand vars in infile to generate outfile
EOF
exit $opt_h ? 0 : 1;

40
src/tools/fullPathName.pl
View File

@@ -1,40 +0,0 @@
eval 'exec perl -S -w $0 ${1+"$@"}' # -*- Mode: perl -*-
if 0;
# Determines an absolute pathname for its argument,
# which may be either a relative or absolute path and
# might have trailing parts that don't exist yet.
use strict;
use Cwd qw(getcwd abs_path);
use File::Spec;
# Starting values
my $cwd = getcwd();
my $rel = shift;
$rel = '.' unless defined $rel;
# Move leading ./ and ../ components from $rel to $cwd
if (my ($dot, $not) = ($rel =~ m[^ ( (?: \. \.? / )+ ) ( .* ) $]x)) {
$cwd .= "/$dot";
$rel = $not;
}
# Handle a pure ..
if ($rel eq '..') {
$cwd .= '/..';
$rel = '.'
}
# NB: abs_path() doesn't like non-existent path components other than
# in the final position, which is why we use this method.
# Calculate the absolute path
my $abs = File::Spec->rel2abs($rel, abs_path($cwd));
# Remove any automounter prefixes
$abs =~ s[^ /tmp_mnt ][]x; # SunOS, HPUX
$abs =~ s[^ /private/var/auto\. ][/]x; # MacOS
print "$abs\n";

22
src/tools/fullPathName.pl@ Executable file
View File

@@ -0,0 +1,22 @@
eval 'exec perl -S -w $0 ${1+"$@"}' # -*- Mode: perl -*-
if 0;
#*************************************************************************
# Copyright (c) 2008 The University of Chicago, 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$
# Determines an absolute pathname for its argument,
# which may be either a relative or absolute path and
# might have trailing parts that don't exist yet.
use strict;
use lib '@TOP@/lib/perl';
use EPICS::Path;
print AbsPath(shift), "\n";