From bc3584c8342188f0cd26c7b1919370653fee821d Mon Sep 17 00:00:00 2001 From: Andrew Johnson Date: Tue, 1 Apr 2008 19:25:47 +0000 Subject: [PATCH] Moved Perl modules from Ctlsys to EPICS. Cleanup and corrections in expandVars@. --- src/tools/{Ctlsys => EPICS}/Getopts.pm | 6 +-- src/tools/{Ctlsys => EPICS}/Utils.pm | 66 +++++++++++++++++++------- src/tools/Makefile | 26 +++++----- src/tools/expandVars.pl@ | 54 ++++++++++----------- 4 files changed, 90 insertions(+), 62 deletions(-) rename src/tools/{Ctlsys => EPICS}/Getopts.pm (94%) rename src/tools/{Ctlsys => EPICS}/Utils.pm (62%) diff --git a/src/tools/Ctlsys/Getopts.pm b/src/tools/EPICS/Getopts.pm similarity index 94% rename from src/tools/Ctlsys/Getopts.pm rename to src/tools/EPICS/Getopts.pm index e19de05e2..c08db62aa 100644 --- a/src/tools/Ctlsys/Getopts.pm +++ b/src/tools/EPICS/Getopts.pm @@ -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; } diff --git a/src/tools/Ctlsys/Utils.pm b/src/tools/EPICS/Utils.pm similarity index 62% rename from src/tools/Ctlsys/Utils.pm rename to src/tools/EPICS/Utils.pm index 304555664..935ec6402 100644 --- a/src/tools/Ctlsys/Utils.pm +++ b/src/tools/EPICS/Utils.pm @@ -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 () { + 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 " = " 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 () { + 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 { diff --git a/src/tools/Makefile b/src/tools/Makefile index 98ee1ba88..8146808c2 100644 --- a/src/tools/Makefile +++ b/src/tools/Makefile @@ -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 diff --git a/src/tools/expandVars.pl@ b/src/tools/expandVars.pl@ index aa611aa0a..fa6073301 100644 --- a/src/tools/expandVars.pl@ +++ b/src/tools/expandVars.pl@ @@ -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. directories. If -# the TOP variable has not been expanded, we look in our own -# parent directory for ctlsysUtils.pl instead of /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 <