#!/usr/bin/perl

=pod
Modification history:

VERSION = 0.01 (2001) 

original distribution.

VERSION = 0.02 (2001-4-14)

Create new PSTset, and rename original PSTset to PSTcompile.  The new 
PSTset now takes three arguments: two string variables and a referenced 
hash table.  The string variables include the name of the source-code 
template and a compile flag, which is either "yes" or "no".   The 
referenced hash table contains the variables which must be substituted 
into the source-code template.  

PSTcompile (which was the old PSTset) has been modified so that it 
examines all of @_, not just the template components relevant to the
first occurance of the initial lines that begin with "in:", "out:", or 
"make:".  All of the source codes identified in the template are edited
and compiled, and a list of the edited codes is returned.  This source-
code list is also returned by PSTset.

VERSION = 0.03 (2001-7-02)

Modify PSTpreset so that it does not strip off "PST END" before checking
the argument against that for the matching "PST BEGIN(X)" statement.
Now PSTpreset checks both that "PST END" is present as well as that the
"X" argument matches that for the associated "PST BEGIN(X)" statement.

=cut

#================================================== Define PSTset module

package SET::Set;

use Exporter;
@ISA = "Exporter";
@EXPORT = qw(PSTset PSTctdRead PSTctdHash ROOT EXT HEAD TAIL);

$VERSION = "0.02";

#================================================================ PSTset

sub PSTset
{
=pod
PSTset uses the input string $path to locate the source-code template
identifying the code to be edited.  The input string $compile is used 
to determine if the edited code should be compiled.  The input hash
table %V identifies the variables that should be used when substituting 
values into the source-code template in $path.  PSTset returns the error 
status and the list of source codes edited.

PSTset calls PSTctdRead to read the template stored in $path.  PSTset 
then calls PSTctdSubstitute to replace variable names in the template
with values stored in %V.  If $compile eq "yes", then PSTcompile is 
called to both edit and compile the source code.  if $compile ne "yes",
any "make:" (see template discussion below) lines present in the 
template are removed before calling PSTcompile to edit, but not compile, 
the source code.

An example illustrating the format of a source-code template follows:

in:$DIR/foo.f
out:foo.f
make:$DIR/makefoo
CPST BEGIN(1)
      parameter(nx=$NX,ny=$NY,nz=$NZ)
      parameter(ibx=$IBX,iby=$IBY,ibz=$IBZ)
CPST END(1)
CPST BEGIN(2)
      file   = '$FILE'
CPST END(2)
#PST BEGIN(1)
PROGRAM = foo
#PST END(1)
      
Here $DIR/foo.f is specified as the source code that must be edited, and
foo.f is the destination for the result.  These paths are identified by 
the file-location tags "in:" and "out:" respectively.  $DIR/makefoo is 
the source for the makefile needed to compile foo.f by the tag "make:".  

Three BEGIN/END blocks follow the file-location designators.  These
blocks have counterpart blocks inside the source-code files.  $DIR/foo.f
contains the blocks CPST BEGIN(1)/CPST END(1) and CPST BEGIN(2)/CPST
END(2), and $DIR/makefoo contains #PST BEGIN(1)/#PST BEGIN(2).

Variables for which substitutions are required are identified by a $ 
symbol as their first character.  If you actually wish a $ symbol to
appear in the source code (and therefore you do not want the variable 
to be substituted by a value), then place a backslash in front of the
symbol.  for example, if $M=10, the line "set N = $M" will result in 
the substitution "set N = 10" while "set N = \$M" will result in the 
substitution "set N = $M"

Note: though it is flexible to include variable names for source code in
the "in:", "out:" and "make:" designators, the resulting template can be
difficult to understand.  For this reason, it is recommended that 
substitutions be minimized in these template lines.  It is better to 
create multiple templates rather than reuse them with variables in the
file-location tags.  Note that our example violates this rule by 
including the directory variable $DIR.  This demonstrates how to specify
a variable name in the file-location tags if you choose not to follow
our advice.
=cut
#------------------------------------ Declare and define input variables
  my ($path,$compile,$h,%V,$TMP,@src);
  $path=$_[0]; $compile=$_[1]; $h=$_[2]; %V=%$h;
#--------------------------------------------- Read source-code template
  $TMP=PSTctdRead($path);
#-------------------------------------- Substitute variables in template
  $TMP=PSTctdSubstitute($TMP,\%V);
#------------------------------------------ Edit and compile source code
  if ($compile=~/yes|y/i)      {@src=PSTcompile($TMP)}
  else {$TMP=~s/^make:.*\n//im; @src=PSTcompile($TMP)}
#------------------------------------------------------ Check for errors
  return @src
}

#============================================================ PSTcompile

sub PSTcompile
{
=pod
PSTcompile calls PSTedit to edit code based on an input source-code
template, then PSTcompile compiles the code identified by the template.  

PSTcompile begins by calling PSTpreset, which strips any initial lines 
from the template that do not begin with "in:", "out:", or "make:".  

PSTcompile then checks to make sure the source-code path is identified 
by a line beginning with "in:".  If not, PSTcompile returns with an exit 
status of 2.  

If the input and output code paths designated by "in:<input>" and 
"out:<output>" are identical, PSTcompile moves the input path <input> 
to <input>~, then proceeds.  Similarly, if the name of the Makefile 
indicated in the source-code template is identical to the name of the 
temporary makefile "makePSTtemp" used by PSTcompile, then the new name 
"makePSTtemp0" is used for the temporary Makefile.

After these few potential errors are checked, the code is edited using
the substitutions identified by the passed source-code template.  if
the template includes a "make:" line, then the Makefile identified is
edited and used to compile the code.

After editing and compiling the first source code identified by the
template, PSTcompile repeats the process to edit and compile all source
codes identified in the template.

PSTcompile returns the list of source codes edited.
=cut
#------------------------------------ Declare and define input variables
  my ($s,@srclines,$j,$fa,@a,$path,$code,$make,$mako,$e,@src);
  $s = $_[0];
  @srclines = split /\n/,$s;
#----------------------------------------------- Examine all of template
  while ($#srclines>=0) {
#-------------------------------------------------- Identify source code
    @srclines=PSTpreset($path,$code,$make,@srclines); shift(@srclines);
    $path=shift(@srclines);
    $code=shift(@srclines);
    $make=shift(@srclines);
    $mako="makePSTtemp";
#------------------------------------------------------ Check for errors
    if($path eq "") { last }
    if($code eq "") { $code=TAIL($path) }
#------------------------------------------- Avoid $path/$code collision
    if($path eq $code||$path eq "./$code"||$path eq ".//$code"){
      system "/bin/mv $path ${path}~"; $path = "${path}~";
    }
#------------------------------------------- Avoid $make/$mako collision
    if($make eq $mako||$make eq "./$mako"||$make eq ".//$mako"){
      $mako="makePSTtemp0"
    }
#-------------------------------------------------------- Offer feedback
    print "PSTset: in:$path\n"; print "PSTset: out:$code\n";
    if ($make ne "") {print "PSTset: make:$make\n"}
#----------------------------------------------------- Add $code to @src
    push @src,$code;
#------------------------------------------------------ Edit source code
    @srclines=PSTedit($path,$code,@srclines); $s=shift(@srclines);
#-------------------------------------- Edit makefile and compile source
    if ($s ne 0) { return (1,@src) }
    elsif ($make ne "") { 
      @srclines=PSTedit($make,$mako,@srclines); $s=shift(@srclines);
      system("make","-f",$mako) 
    } 
  } 
  return (0,@src)
}

#============================================================= PSTpreset

sub PSTpreset
{
=pod
PSTpreset reads a source-code template and returns a modified template.
Initial lines in the template that do not begin with "in:", "out:", or
"make:" are stripped from the template.  If a line is encountered which
contains "PST BEGIN", then all subsequent lines are stripped until a
matching "PST END" is found, at which point PSTpreset resumes searching
for lines beginning with "in:", "out:", or "make:".  Once a line 
beginning with "in:", "out:", or "make:" is found (outside of a PST 
BEGIN/END block), the next occurance of a BEGIN block triggers return of 
the modified template along with the variables $path, $code, and $make.  
The exit status of PSTpreset is prepended to the output template.
=cut
#--------------------------------------------------- Read input template
  my (@srclines,@a,$fa,$fb,$j,$SCT,$ei,$eo,$em,$path,$code,$make); 
  $ei=0; $eo=0; $em=0; $fb="";
  ($path,$code,$make,@srclines) = @_; $path=""; $code=""; $make="";
#--------------------------------------------------- Read input template
  while ($#srclines>=0) {
    $fa=$srclines[0]; @a=split(/:/,$fa,2); $a[0]=lc($a[0]);
#-------------------------------------------------- PST BEGIN is matched
    if ($fa=~/PST BEGIN/){
#--------------------------------------------------- Read BEGIN argument
      if ($ei==0 && $eo==0 && $em==0) {
        $SCT=shift(@srclines); $SCT=~s/\s+$//g; $SCT=~s/.*?PST BEGIN//;
        while ($fb ne "PST END$SCT") {
          $fb=shift(@srclines); $fb=~s/\s+$//g; $fb=~s/.*?PST END/PST END/;
        }
      }
      else { last }
    }
    elsif ($a[0]=~/^in/)   { 
      if ($ei==1) {last} else {$path=$a[1]; shift(@srclines); $ei=1}}
    elsif ($a[0]=~/^out/)  { 
      if ($eo==1) {last} else {$code=$a[1]; shift(@srclines); $eo=1}}
    elsif ($a[0]=~/^make/) { 
      if ($em==1) {last} else {$make=$a[1]; shift(@srclines); $em=1}}
    else { shift(@srclines) }
  }
  return (0,$path,$code,$make,@srclines);
}

#============================================================= PSTmkdirp

sub PSTmkdirp
{
=pod
PSTmkdirp recursively makes all the directories in $_[0], if they do not
already exist.  PSTmkdirp uses the Cwd module.
=cut
#-------------------------------------------------------- Use Cwd module
  use Cwd;
#--------------------------------------------- Identify $path, set $MODE
  my ($path,$pwd,@dirlist,$data,$MODE); 
  $path = $_[0]; $MODE=0755;
#---------------------------------------------------------- Create $path
  if (! -e $path) {
    $pwd = cwd();
    @dirlist = split /\//,$path;
    foreach $data (@dirlist) { mkdir $data,$MODE; chdir "$data" }
    chdir "$pwd";
  }
  return 0;
}

#=============================================================== PSTedit

sub PSTedit
{
#-------------------------------------------------- Read input variables
  my ($path,$fcode,@srclines) = @_; 
  my ($code,$codedir,$SCT,$SCF,$EDIT,$same);
  $code=$fcode.".PSTtemp";
#---------------------------------------------------- Open FROM/TO files
  if ($fcode=~/\//){ $codedir=HEAD($fcode); PSTmkdirp($codedir) }
  open (FROM,"<$path") or die "Could not open $path\n";
  open (TO,">$code") or die "Could not open $code\n";
#--------------------------------------------------------- Set edit flag
  $EDIT = 0;
#-------------------------------------------- Read line from source code
  while (<FROM>){
#----------------------------------------- Check for PST BEGIN directive
    if(/PST BEGIN/){
#---------------------- Read 1st line of template; strip trailing blanks
      $SCT = shift(@srclines); $SCT =~ s/\s+$//g;
      $SCF = $_              ; $SCF =~ s/\s+$//g;
#------------------------------ If 1st lines match, print template block
      if($SCT eq $SCF){
        $EDIT = 1;
        print TO "$SCT\n";
        $SCT = shift(@srclines); $SCT =~ s/\s+$//g;
        until ($SCT =~ /PST END/s){
          print TO "$SCT\n";
          $SCT = shift(@srclines); $SCT =~ s/\s+$//g;
        }
        print TO "$SCT\n";
        next }
#----------------------------------------- Exit if 1st lines don't match
      else {
        print "Template    = $SCT\n";
        print "Source code = $_\n";
        print "Template and source code do not match.\n";
        print "Make sure PST BEGIN arguments match in both.\n";
        print "Check number and order of template blocks.\n";
        print "Bailing out.\n";
        close (FROM);
        close (TO);
        return 1
      }
    }
#---------------------------------- Reset edit flag if PST END directive
    if(/PST END/){$EDIT=0; next}
    if($EDIT != 0) {next}
    print TO $_
  }
  close (FROM);
  close (TO);
#------------------------------ Compare $code with $fcode (if it exists)
  if (-e $fcode) { $same=PSTcmp($fcode,$code);
    if ($same) { unlink $code }
    else { system "/bin/mv $code $fcode" } }
  else { system "/bin/mv $code $fcode" }
  return (0,@srclines);
}

#================================================================ PSTcmp

sub PSTcmp
{
#-------------------------------------------------- Read input variables
  my ($filea,$fileb) = @_; my ($same,$lineb); $same = 1;
#------------------------------------------------------------ Open files
  open (FILEA,"<$filea") or die "Could not open $filea\n";
  open (FILEB,"<$fileb") or die "Could not open $fileb\n";
#-------------------------------------------- Read line from source code
  while (<FILEA>){
    $lineb = readline *FILEB || "EOF";
    if ($_ ne $lineb) { $same=0; last }
  }
  close (FILEA); close (FILEB);
  return $same
}

#============================================================ PSTctdRead

sub PSTctdRead
{
#-------------------------------------------------- Read input variables
  my ($file,$ctd);
  $file = $_[0]; $ctd = "";
#------------------------------------------------------------- Open file
  open (FILE,"<$file") or die "Could not open $file\n";
#---------------------------------------------------- Read file contents
  while (<FILE>){
    chomp $_; $line = "$_\n"; $ctd = $ctd.$line
  }
#------------------------------------------------------------ Close file
  close (FILE);
#----------------------------------------------- Return contents in $ctd 
  return $ctd
}

#====================================================== PSTctdSubstitute

sub PSTctdSubstitute
{
#----------------------------------------------------- Read input string
  my ($string,$h,%v);
  $string = $_[0]; $h=$_[1]; %v=%$h;
#----------------------------------------- Execute variable substitution
#      Substitute all variables in $string identified by
#      $<var> (but not \$<var>) using the data in %v.
#------------------------------------------------------ Define variables
  $string =~ s/([^\\]|^)\$(\w+)/$1$v{$2}/gm;
  $string =~ s/\\\$/\$/gm;
#-------------------------------------- Return string with substitutions
return $string
}

#============================================================ PSTctdHash

sub PSTctdHash
{
#-----------------------------------------------------------------------
#  Return a string containing
#  
#  $key = "value";\n 
#  
#  for every key/value pair of the hash variable passed.  The resulting
#  string can be executed with "eval" so that the variables are defined.
#-----------------------------------------------------------------------
  my $h=$_[0]; my %v=%$h; my $string = "";
  foreach (keys %v) { $string = $string."\$$_ = \"$v{$_}\";\n" }
  return $string
}

#==================================================== ROOT,EXT,HEAD,TAIL

sub ROOT
{
=pod
AUTHOR
  Written 4-2001 by Chris Bizon
=cut
  my (@list,@out,$item,$out);
  foreach (@_) {
    @list = (m(.*(?=\.))g);
    $item = $list[0];
    unless ($item) {$item = $_}
    push @out, $item
  }
  if ($#out == 0) { return $out[0] }
  else { return @out }
}

sub EXT
{
=pod
AUTHOR
  Written 4-2001 by Chris Bizon
=cut
  my (@list,@out,$e);
  foreach (@_) {
    @list = split /\./, $_;
    if ($#list == 0) {$e = ""} else {$e = $list[$#list]}
    push @out, $e;
  }
  if ($#out == 0) { return $out[0] }
  else { return @out }
}
 
sub HEAD
{
=pod
AUTHOR
  Written 4-2001 by Chris Bizon
=cut
  my (@list,@out,$item,$out);
  foreach (@_) {
    @list = (m(.*(?=/))g);
    $item = $list[0];
    unless ($item) {$item = $_}
    push @out, $item
  }
  if ($#out == 0) { return $out[0] }
  else { return @out }
}
 
sub TAIL
{
=pod
AUTHOR
  Written 4-2001 by Chris Bizon
=cut
  my (@list,@out);
  foreach (@_) {
    @list = split /\//, $_;
    push @out, $list[$#list];
  }
  if ($#out == 0) { return $out[0] }
  else { return @out }
}

#============================================================== Finished

1;

__END__
