diff --git a/configure/CONFIG_APP_INCLUDE b/configure/CONFIG_APP_INCLUDE index 69f1ab9e6..9b71f6bd4 100644 --- a/configure/CONFIG_APP_INCLUDE +++ b/configure/CONFIG_APP_INCLUDE @@ -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),) diff --git a/configure/RULES_ARCHS b/configure/RULES_ARCHS index 353661e69..538d7d6c7 100644 --- a/configure/RULES_ARCHS +++ b/configure/RULES_ARCHS @@ -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 diff --git a/configure/RULES_EXPAND b/configure/RULES_EXPAND index f326dbdbd..2cc239e41 100644 --- a/configure/RULES_EXPAND +++ b/configure/RULES_EXPAND @@ -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) diff --git a/configure/RULES_TOP b/configure/RULES_TOP index 33bd94e99..01fb6d41e 100644 --- a/configure/RULES_TOP +++ b/configure/RULES_TOP @@ -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),) diff --git a/documentation/RELEASE_NOTES.html b/documentation/RELEASE_NOTES.html index 55b01325f..84fecbfee 100644 --- a/documentation/RELEASE_NOTES.html +++ b/documentation/RELEASE_NOTES.html @@ -9,10 +9,66 @@

EPICS Base Release 3.14.x

-

Changes between 3.14.9 and 3.14.x

+

Changes between 3.14.9 and 3.14.10

+

Build System Reorganization

+ +

Several changes have been made to the build system, although these changes +should not affect the contents of Makefiles 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:

+ + +

Access security configuration files

Rules and macros were added for creating an *.acf file, access security diff --git a/src/tools/EPICS/Copy.pm b/src/tools/EPICS/Copy.pm new file mode 100644 index 000000000..1cc7b8e46 --- /dev/null +++ b/src/tools/EPICS/Copy.pm @@ -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; diff --git a/src/tools/EPICS/Path.pm b/src/tools/EPICS/Path.pm new file mode 100644 index 000000000..2512b880b --- /dev/null +++ b/src/tools/EPICS/Path.pm @@ -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 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 ) + + C 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 ) + + C 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 ) + +=item AbsPath( I, I ) + + The C function in Perl's C 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 takes a path I 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 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; diff --git a/src/tools/EPICS/Release.pm b/src/tools/EPICS/Release.pm new file mode 100644 index 000000000..31659e664 --- /dev/null +++ b/src/tools/EPICS/Release.pm @@ -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 " = " + 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 " and "-include " 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; diff --git a/src/tools/EPICS/Utils.pm b/src/tools/EPICS/Utils.pm deleted file mode 100644 index 935ec6402..000000000 --- a/src/tools/EPICS/Utils.pm +++ /dev/null @@ -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 " = " - my ($macro, $path) = m/^\s*(\w+)\s*=\s*(.*)/; - if ($macro ne '') { - $Rmacros->{$macro} = $path; - push @$Rapps, $macro; - next; - } - # Handle "include " 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; diff --git a/src/tools/Makefile b/src/tools/Makefile index 8146808c2..5023ddf67 100644 --- a/src/tools/Makefile +++ b/src/tools/Makefile @@ -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 diff --git a/src/tools/convertRelease.pl b/src/tools/convertRelease.pl deleted file mode 100755 index 6a23e0b05..000000000 --- a/src/tools/convertRelease.pl +++ /dev/null @@ -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. 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 () { - 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 " = " - 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 " and "-include " 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; -} diff --git a/src/tools/convertRelease.pl@ b/src/tools/convertRelease.pl@ new file mode 100755 index 000000000..09fd8fa02 --- /dev/null +++ b/src/tools/convertRelease.pl@ @@ -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. 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 <$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; +} + diff --git a/src/tools/expandVars.pl@ b/src/tools/expandVars.pl@ index fa6073301..643dcbd6e 100644 --- a/src/tools/expandVars.pl@ +++ b/src/tools/expandVars.pl@ @@ -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; diff --git a/src/tools/fullPathName.pl b/src/tools/fullPathName.pl deleted file mode 100755 index 1fad5fe2e..000000000 --- a/src/tools/fullPathName.pl +++ /dev/null @@ -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"; diff --git a/src/tools/fullPathName.pl@ b/src/tools/fullPathName.pl@ new file mode 100755 index 000000000..65adf3d1e --- /dev/null +++ b/src/tools/fullPathName.pl@ @@ -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"; +