Files
pcas/src/makeBaseApp/makeBaseApp.pl
1998-05-28 19:51:50 +00:00

329 lines
8.7 KiB
Perl
Executable File

eval 'exec perl -S $0 ${1+"$@"}' # -*- Mode: perl -*-
if $running_under_some_shell; # makeBaseApp
# Authors: Ralph Lange and Marty Kraimer
use Cwd;
use Getopt::Std;
use File::Copy;
use File::Find;
use File::Path;
$user = GetUser();
$cwd = cwd();
$eAPPTYPE = $ENV{EPICS_MBA_DEF_APP_TYPE};
$eTOP = $ENV{EPICS_MBA_TEMPLATE_TOP};
&get_commandline_opts; # Read and check options
#
# Declare two default callback routines for file copy
# These may be overriden within $top/$apptypename/Replace.pl
#
# ReplaceFilename
# called with the source (template) file or directory name, returns
# the "real" name (which gets the target after $top is removed)
# Empty string: Don't copy this file
sub ReplaceFilename { # (filename)
my($file) = $_[0];
$file =~ s|.*/CVS/?.*||; # template might be kept under CVS
if($opt_i) {
$file =~ s|/$apptypename|/iocBoot|;
}
if ($ioc) { # iocBoot/ioc template has dynamic name
$file =~ s|/iocBoot/ioc|/iocBoot/$ioc|;
$file =~ s|_IOC_|$ioc|;
} else {
$file =~ s|.*/iocBoot/ioc/?.*||;
}
if ($app) { # apptypenameApp itself is dynamic, too
$file =~ s|/$apptypename|/$appdir|;
$file =~ s|/$appdir/config|/config/$apptype|;
}
$file =~ s|_APPNAME_|$appname|;
$file =~ s|_APPTYPE_|$apptype|;
# We don't want the Replace overrides
$file =~ s|.*/$app/Replace.pl$||;
return $file;
}
# ReplaceLine
# called with one line of a file, returns the line after replacing
# this and that
sub ReplaceLine { # (line)
my($line) = $_[0];
$line =~ s/_USER_/$user/;
$line =~ s/_EPICS_BASE_/$epics_base/;
$line =~ s/_ARCH_/$arch/;
$line =~ s/_APPNAME_/$appname/;
$line =~ s/_APPTYPE_/$apptype/;
$line =~ s/_TEMPLATE_TOP_/$top/;
if ($ioc) {
$line =~ s/_IOC_/$ioc/;
}
return $line;
}
# Source replace overrides for file copy
if (-r "$top/$apptypename/Replace.pl") {
require "$top/$apptypename/Replace.pl";
}
#
# Copy <top>/Makefile and config files if not present
#
CopyFile("$top/Makefile") unless (-f 'Makefile');
find(\&FCopyTree, "$top/config") unless (-d 'config');
#
# Create ioc directories
#
if ($opt_i) {
find(\&FCopyTree, "$top/$apptypename") unless (-d "iocBoot");
foreach $ioc ( @ARGV ) {
($ioc =~ /^ioc/) or $ioc = "ioc" . $ioc;
if (-d "iocBoot/$ioc") {
print "ioc iocBoot/$ioc is already there!\n";
next;
}
find(\&FCopyTree, "$top/$apptypename/ioc");
}
exit 0; # finished here for -i (no xxxApps)
}
#
# Create app directories (if any names given)
#
foreach $app ( @ARGV ) {
($appname = $app) =~ s/App$//;
$appdir = $appname . "App";
if (-d "$appdir") {
print "Application $appname is already there!\n";
next;
}
print "Creating template structure "
. "for $appname (of type $apptypename)\n" if $Debug;
find(\&FCopyTree, "$top/$apptypename");
}
exit 0; # END OF SCRIPT
#
# Get commandline options and check for validity
#
sub get_commandline_opts { #no args
($len = @ARGV) and getopts('ldit:T:b:a:') or Cleanup(1);
# Debug option
$Debug = 1 if $opt_d;
# Locate epics_base
if ($opt_b) { # first choice is -b base
$epics_base = $opt_b;
} elsif (-r "config/RELEASE") { # second choice is config/RELEASE
open(IN, "config/RELEASE") or die "Cannot open config/RELEASE";
while (<IN>) {
chomp;
s/EPICS_BASE\s*=\s*// and $epics_base = $_, break;
}
close IN;
} elsif ($0 =~ /\/bin\//) { # assume script was called with full path to base
$epics_base = $0;
$epics_base =~ s:(/.*)/bin/.*makeBaseApp.*:$1:;
}
"$epics_base" or Cleanup(1, "Cannot find EPICS base");
# Locate template top directory
if ($opt_T) { # first choice is -T templ-top
$top = $opt_T;
} elsif (-r "config/RELEASE") { # second choice is config/RELEASE
open(IN, "config/RELEASE") or die "Cannot open config/RELEASE";
while (<IN>) {
chomp;
s/TEMPLATE_TOP\s*=\s*// and $top = $_, break;
}
close IN;
}
if("$top" eq "") {
if ($eTOP) { # third choice is $ENV{EPICS_MBA_TEMPL_TOP}
$top = $eTOP;
} else { # use templates from EPICS base
$top = $epics_base . "/templates/makeBaseApp/top";
}
}
"$top" or Cleanup(1, "Cannot find template top directory");
# Print application type list?
if ($opt_l) {
&ListAppTypes;
exit 0; # finished for -l command
}
# iocBoot and architecture stuff
if ($opt_i) {
if ($opt_a) {
$arch = $opt_a;
} else {
print "What architecture do you want to use for your IOC,";
print "e.g. pc486, mv167 ? ";
$arch = <STDIN>;
chomp($arch);
}
}
# Application template type
if ($opt_t) { # first choice is -t type
$apptype = $opt_t;
} elsif ($eAPPTYPE) { # second choice is $ENV{EPICS_DEFAULT_APP_TYPE}
$apptype = $eAPPTYPE;
} elsif (-r "$top/defaultApp") {# third choice is (a link) in the $top dir
$apptype = "default";
}
$apptype =~ s/App$//;
$apptype =~ s/Boot$//;
"$apptype" or Cleanup(1, "Cannot find default application type");
if ($opt_i) { # fixed name when doing ioc dirs
$apptypename = $apptype . "Boot";
} else {
$apptypename = $apptype . "App";
}
# Valid $apptypename?
while (-l "$top/$apptypename") {
($apptypename = readlink "$top/$apptypename") =~ s/^$top//;
}
unless (-r "$top/$apptypename") {
print "Application type does not exist. ";
&ListAppTypes;
exit 1;
}
print "\nCommand line / environment options validated:\n"
. " Templ-Top: $top\n"
. "Templ-Type: $apptype\n"
. "Templ-Name: $apptypename\n"
. " opt_i: $opt_i\n"
. " arch: $arch\n"
. "EPICS-Base: $epics_base\n\n" if $Debug;
}
#
# List application types
#
sub ListAppTypes { # no args
print "Valid application types are:\n";
find(\&Fapp_types, "$top/");
for $type (keys %Types) {
printf "%-15s %-15s\n", $TypeNameA{$type}, $TypeNameE{$type};
}
}
sub Fapp_types {
! /$topn/ && ! /defaultApp$/ && /App$/ &&
($File::Find::prune = 1) && s/App$// &&
(($type = $_) =~ s/^example_//, 1) &&
($t = /^example_.*/?TypeNameE:TypeNameA,
s/^example_.*/(including example: use \'-e\' option)/, 1) &&
(eval "\$$t\{\$type\} = \$_", 1) &&
($Types{$type} = 1);
}
#
# Copy a file with replacements
#
sub CopyFile { # (source)
$source = $_[0];
$target = &ReplaceFilename($source);
if ($target) {
$target =~ s|$top/||;
open(INP, "<$source") and open(OUT, ">$target")
or die "$! Copying $source -> $target";
print "Copying file $source -> $target\n" if $Debug;
while (<INP>) {
print OUT &ReplaceLine($_);
}
close INP; close OUT;
}
}
#
# Find callback for file or structure copy
#
sub FCopyTree {
chdir $cwd; # Sigh
if (-d $File::Find::name
and ($dir = &ReplaceFilename($File::Find::name))) {
$dir =~ s|$top/||;
print "Creating directory $dir\n" if $Debug;
&mkpath($dir);
} else {
&CopyFile($File::Find::name);
}
chdir $File::Find::dir;
}
#
# Cleanup and exit
#
sub Cleanup { # (return-code [ messsage-line1, line 2, ... ])
my ($rtncode, @message) = @_;
foreach $line ( @message ) {
print "$line\n";
}
print <<EOF;
Usage:
$0 -i [options] ioc ...
create ioc boot directories
$0 [options] app ...
create application directories
where
app Application name (the created directory will have \"App\" appended to this)
ioc IOC name (note: if -i is not specified, App directories will be created)
-a arch Set the IOC architecture (e.g. mv167)
If not specified, you will be prompted
-b base Set the location of EPICS base (full path)
If not specified, base path is taken from config/RELEASE
If config does not exist, base path is taken from command
-d Verbose output (useful for debugging)
-e Create example application
-l List valid application types for this installation
-t type Set the application type (-l for a list of valid types)
If not specified, type is taken from environment
If not found in environment, \"default\" is used
-T top Set the template top directory (where the application templates are)
If not specified, top path is taken from config/RELEASE
If config does not exist, top path is taken from environment
If not found in environment, the templates from EPICS base are used
Environment:
EPICS_MBA_DEF_APP_TYPE The application type you want to use as default
EPICS_MBA_TEMPLATE_TOP The template top directory
EOF
exit $rtncode;
}
sub GetUser { # no args
my ($user);
# add to this list if new possibilities arise,
# currently it's UNIX and WIN32:
$user = $ENV{USER} || $ENV{USERNAME} || Win32::LoginName();
unless ($user) {
print "I cannot figure out your user name.\n";
print "What shall you be called ?\n";
print ">";
$user = <STDIN>;
chomp $user;
}
die "No user name" unless $user;
return $user;
}