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

Moved Perl modules from Ctlsys to EPICS.

Browse Source 
Cleanup and corrections in expandVars@.
This commit is contained in:
Andrew Johnson
2008-04-01 19:25:47 +00:00
parent e1d28a495a
commit bc3584c834
4 changed files with 90 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
src/tools/Ctlsys/Getopts.pm → src/tools/EPICS/Getopts.pm
View File

@@ -1,11 +1,11 @@
package Ctlsys::Getopts;
package EPICS::Getopts;
require 5.000;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(getopts);
# Ctlsys::Getopts.pm - A ctlsys version of getopts
# EPICS::Getopts.pm - An EPICS-specific version of getopts
#
# This version of getopts is modified from the Perl original in the
# following ways:
@@ -69,7 +69,7 @@ sub getopts ( $;$ ) {
}
}
local $Exporter::ExportLevel = 1;
import Ctlsys::Getopts;
import EPICS::Getopts;
$errs == 0;
}

66
src/tools/Ctlsys/Utils.pm → src/tools/EPICS/Utils.pm
View File

@@ -1,14 +1,15 @@
# Parse a configure/RELEASE file.
# 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
local *IN;
open(IN, $file) or die "Can't open $file: $!\n";
while (<IN>) {
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
@@ -22,7 +23,7 @@ sub readRelease {
# Handle "<macro> = <path>"
my ($macro, $path) = m/^\s*(\w+)\s*=\s*(.*)/;
if ($macro ne "") {
if ($macro ne '') {
$Rmacros->{$macro} = $path;
push @$Rapps, $macro;
next;
@@ -31,14 +32,14 @@ sub readRelease {
($path) = m/^\s*include\s+(.*)/;
&readRelease($path, $Rmacros, $Rapps) if (-r $path);
}
close IN;
close $IN;
}
# Expand any (possibly nested) settings that were defined after use
sub expandRelease {
my ($Rmacros) = @_;
# $Rmacros is a reference to a hash
# Expand any (possibly nested) macros that were defined after use
while (my ($macro, $path) = each %$Rmacros) {
while (my ($pre,$var,$post) = $path =~ m/(.*)\$\((\w+?)\)(.*)/) {
$path = $pre . $Rmacros->{$var} . $post;
@@ -48,16 +49,48 @@ sub expandRelease {
}
# Copy directories and files from the template
# 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 FILES, $src or die "opendir failed while copying $src: $!\n";
my @entries = readdir FILES;
closedir FILES;
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 ..
@@ -87,14 +120,15 @@ sub copyFile {
my ($src, $dst, $Rtextsubs) = @_;
return if (-e $dst);
print "Creating file '$dst'\n" if $opt_d;
open(SRC, "<$src") and open(DST, ">$dst") or die "$! copying $src to $dst\n";
while (<SRC>) {
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;
print $DST $_;
}
close DST;
close SRC;
close $DST;
close $SRC;
}
sub copyDir {

26
src/tools/Makefile
View File

@@ -19,24 +19,24 @@ EXPAND_VARS = $(PERL) ../expandVars.pl@
EXPAND += expandVars.pl@
PERL_MODULES += Ctlsys/Utils.pm
PERL_MODULES += Ctlsys/Getopts.pm
PERL_MODULES += EPICS/Utils.pm
PERL_MODULES += EPICS/Getopts.pm
PERL_SCRIPTS += convertRelease.pl*
PERL_SCRIPTS += cvsclean.pl*
PERL_SCRIPTS += convertRelease.pl
PERL_SCRIPTS += cvsclean.pl
PERL_SCRIPTS += dos2unix.pl
PERL_SCRIPTS += expandVars.pl
PERL_SCRIPTS += filterWarnings.pl*
PERL_SCRIPTS += fullPathName.pl*
PERL_SCRIPTS += installEpics.pl*
PERL_SCRIPTS += filterWarnings.pl
PERL_SCRIPTS += fullPathName.pl
PERL_SCRIPTS += installEpics.pl
PERL_SCRIPTS += makeDbDepends.pl
PERL_SCRIPTS += makeIncludeDbd.pl
PERL_SCRIPTS += makeMakefile.pl*
PERL_SCRIPTS += makeMakefileInclude.pl*
PERL_SCRIPTS += mkmf.pl*
PERL_SCRIPTS += munch.pl*
PERL_SCRIPTS += replaceVAR.pl*
PERL_SCRIPTS += useManifestTool.pl*
PERL_SCRIPTS += makeMakefile.pl
PERL_SCRIPTS += makeMakefileInclude.pl
PERL_SCRIPTS += mkmf.pl
PERL_SCRIPTS += munch.pl
PERL_SCRIPTS += replaceVAR.pl
PERL_SCRIPTS += useManifestTool.pl
include $(TOP)/configure/RULES

54
src/tools/expandVars.pl@
View File

@@ -9,52 +9,46 @@
# $Id$
#
# This BEGIN allows Perl to find the ctlsysUtils.pl module when
# the program gets run in one of its O.<arch> directories. If
# the TOP variable has not been expanded, we look in our own
# parent directory for ctlsysUtils.pl instead of <top>/lib/perl
# Do not use the code below for other perl tools that use modules,
# makeCtlsysDir.pl@ has the regular Perl code for setting @INC.
BEGIN {
# Do not copy this BEGIN code for other tools,
# it's only needed here for bootstrapping itself.
our $libperl = '@TOP@/lib/perl';
$libperl = '..' if ($libperl =~ m/^[@]TOP[@]/);
}
use lib $libperl;
use strict;
use Cwd qw(cwd abs_path);
use Ctlsys::Getopts;
use Ctlsys::Utils;
use Cwd qw(abs_path);
use EPICS::Getopts; # Needed for multiple options (-D m=v)
use EPICS::Utils; # LocalPath, readRelease, expandRelease
# Command line options processing
# Process command line options
our ($opt_d, @opt_D, $opt_h, $opt_t);
Usage() unless getopts('dD@ht:');
getopts('dD@ht:')
or &HELP_MESSAGE;
# Handle the -h command
Usage() if $opt_h;
&HELP_MESSAGE if $opt_h;
die "Path to TOP not set, use -t option\n"
unless $opt_t;
# Check filename arguments
our $infile = shift or die "No input filename argument\n";
our $outfile = shift or die "No output filename argument\n";
my $infile = shift
or die "No input filename argument\n";
my $outfile = shift
or die "No output filename argument\n";
# Where are we?
our $top = $opt_t;
my $top = LocalPath(abs_path($opt_t));
print "TOP = $top\n" if $opt_d;
# Read RELEASE file into vars
our ($base, $extensions, $ctlsys);
our %vars = (TOP => abs_path($top));
our @apps = ('TOP');
my %vars = (TOP => $top);
my @apps = ('TOP');
readRelease("$top/configure/RELEASE", \%vars, \@apps);
expandRelease(\%vars);
$ctlsys = abs_path($top);
$vars{CTLSYS} = $ctlsys;
print "CTLSYS = $ctlsys\n" if $opt_d;
die "CTLSYS directory '$ctlsys' does not exist\n"
unless -d $ctlsys;
while ($_ = shift @opt_D) {
my ($var, $val) = split /=/;
$vars{$var} = $val;
@@ -66,13 +60,13 @@ copyFile($infile, $outfile, \%vars);
##### File contains subroutines only below here
sub Usage {
print <<EOF;
sub HELP_MESSAGE {
print STDERR <<EOF;
Usage:
expandVars.pl -h
Display this Usage message
expandVars.pl -t /path/to/top -D var=value infile outfile
Expand vars in infile to generate outfile
Display this Usage message
expandVars.pl -t /path/to/top -D var=val -D var2=val2 ... infile outfile
Expand vars in infile to generate outfile
EOF
exit $opt_h ? 0 : 1;
}