#!/usr/bin/perl5
#
# "angen"	K. J. Turner	07/08/98
#
# This script takes ANISE filenames ("file1" to "fileN" below) from the
# command line.
# 
#   o "file1.angen" should contain the root description in the ANISE
#      language. "fileN.angen" should contain a description change in the
#      ANISE generation language. Generation files are progressively applied
#      to the root description, resulting in "serv.anise" and "serv.lotos"
#      (unless interactive).
# 
#   o "fileN.antest" should contain tests defined in the ANISE scenario
#     language. Test files are concatenated (with the base file last),
#     resulting in "serv.antest". Tests are incorporated in "serv.lotos" and
#     validated (unless interactive). Memory for testing may be set using the
#     memory option.
# 
# Command-line options are:
# 
#   -h		print help 
# 
#   -i		interactive (no LOTOS generation or test run), default batch
# 
#   -m N	memory in Mbytes for testing, default 5 Mb
# 
#   -t		trace file generation and possibly incompatible feature
#               alterations, default no trace
# 
# The following overlap checks are performed on pairs of alterations in
# "fileN.antest":
# 
#   fill		append/prefix/wrap	no check
#   append/prefix	append/prefix		ignore if duplicate context
#   otherwise		otherwise		accept if duplicate context
# 
# In the second and third cases a warning is issued. In the second case the
# requested alteration is not made.

############################### Initialisation ###############################

use English;					# get English names

use Getopt::Std;				# get options module

################################ Main Program ################################

initialise ();					# initialise program
make_anise ();					# make ANISE file
make_test ();					# make test file
make_lotos ();					# make LOTOS file
exec_test ();					# execute test file
finalise ();					# finalise program

################################ Subroutines ################################

# initialise program

sub initialise {
  $prog = $0;					# set program name
  $prog =~ s/.*\///g;				# strip off pathname
  $code = 0;					# set error result code
  $ani_ext = ".anise";				# set ANISE extension
  $ang_ext = ".angen";				# set ANISE gen. extension
  $ant_ext = ".antest";				# set ANISE test extension
  $log_ext = ".log";				# ANISE test result log
  $lot_ext = ".lot";				# set LOTOS extension
  $prl_ext = ".pl";				# set perl extension
  $home = $ENV{'HOME'};				# set home directory
  $tmp_dir = "$home/.NeXT/.NextTrash"; 		# set trash directory
  $SIG{INT} = \&prog_int;			# set interrupt handler
  $SIG{QUIT} = \&prog_int;			# set interrupt handler
  if (!getopts ('hitm:')) {			# command argument error?
    usage ();					# print usage
  }
  $parmax = $#ARGV;				# set number of parameters
  if ($opt_h || $parmax == -1) {		# help needed, no parameters?
    usage ();					# print usage
  }
  if ($opt_m) {					# memory parameter given?
    $opt_m = "-m $opt_m";			# set memory parameter
  }
  $root_infile = $ARGV[0];			# extract root input file name
  $root_outfile = "serv";			# set root output file name
  $log_outfile = $root_outfile . $log_ext;	# set ANISE test log file
  open (LOG_OUT, "> $log_outfile")		# open ANISE test log file
    || die "$prog: cannot open $log_outfile\n"; # report failure
}

# handle program interrupt

sub prog_int {
  fail ("abandoned");				# report interrupt
}

# print usage information

sub usage () {
  printf STDERR "usage: $prog [-h(elp)] [-i(nteractive)] [-m(bytes) int] ";
  printf STDERR "[-t(race)] file [file ...]\n";
  exit (1);
}

# print log dividing line

sub log_divide {
  printf LOG_OUT "++++++++++++++++++++++++++++++++++++++";
  printf LOG_OUT "++++++++++++++++++++++++++++++++++++++\n\n";
}

# combine ANISE descriptions

sub make_anise {
  $ani_outfile = "$root_outfile$ani_ext";	# set ANISE output file name
  log_divide ();				# print log divider
  trace ("Making ANISE file \"$ani_outfile\":\n"); # trace generation
  make_edit ();					# make edit file
  check_overlap ();				# check ANISE gen. overlaps
  read_anise ();				# read root ANISE description
  exec_edit ();					# execute edit file
  write_anise ();				# write combined ANISE descr.
}

# make ANISE edit file

sub make_edit {
  $ang_outfile = "$tmp_dir/$prog"."$$"."$ang_ext"; # set gen. output file name
  open (ANG_OUT, "> $ang_outfile")		# open gen. output file
    || fail ("Cannot open $ang_outfile");	# report failure
  print ANG_OUT "divert(-1)\n\n";		# lose m4 output
  print ANG_OUT "include(anise_gen.m4)\n";	# include m4 generation file
  for ($parno = 1; $parno <= $parmax; $parno++) { # run through gen. files
    $ang_infile = $ARGV[$parno] . $ang_ext;	# set gen. input file name
    open (ANG_IN, "< $ang_infile")		# open gen. input file
      || fail ("Cannot open $ang_infile");	# report failure
    $file = $ARGV[$parno];			# set current file name
    print ANG_OUT "\n# File \"$file\"\n";	# record new file name
    print ANG_OUT "define(`an_file',$file)\n";	# record file name as macro
    $instr = 0;					# note not in m4 string
    $global = 0;				# note "global" not found
    while (<ANG_IN>) {				# read gen. file line
      if (/global\(/) {				# "global" macro starts?
        $global = 1;				# note "global" found
      }
      if (/`[^']*$/) {				# m4 string starts?
        $instr = 1;				# note in string
      }
      if ($instr) {				# in string?
	if (/'[^`]*$/) {			# m4 string finishes?
	  $instr = 0;				# note not in string
	}
      }
      else {					# not in string
        s/^%.*//;				# remove leading comment
	if (/^\s*$/) {				# blank line?
	  next;					# ignore blank line
	}
      }
      s/([\/\@])/\\$1/g;			# escape special characters
      print ANG_OUT $_;				# copy input line
    }
    close (ANG_IN);				# close gen. input file
  }
  close (ANG_OUT);				# close gen. output file
  if ($global && ($parno != 1)) {		# "global" in later file?
    fail ("ANISE base file \"$file\" must be given first"); # exit program
  }
  $prl_file = "$tmp_dir/$prog"."$$"."$prl_ext";	# set edit output file name
  $cmd = "m4 $ang_outfile > $prl_file";		# set m4 command
  if (system ($cmd) != 0) {			# m4 call failed?
    fail ("M4 run not completed");		# exit program, M4 error
  }
  undef $RS;					# no end of record
  open (PRL_IN, "< $prl_file")			# open edit input file
    || fail ("cannot open $ani_infile");	# report failure
  $prl_edit = <PRL_IN>;				# read file as one string
  close (ANI_IN);				# close ANISE input file
  $RS = "\n";					# reset end of record
}

# read root ANISE description

sub read_anise {
  $ani_infile = "$root_infile$ang_ext";		# set ANISE input root name
  undef $RS;					# no end of record
  open (ANI_IN, "< $ani_infile")		# open ANISE input file
    || fail ("Cannot open $ani_infile");	# report failure
  $_ = <ANI_IN>;				# read file as one string
  close (ANI_IN);				# close ANISE input file
  if (!/global\(/) {				# "global" macro missing?
    fail ("File \"$root_infile\" is not an ANISE base file"); # exit program
  }
  s/([%\s]*)(.*)/header($2)\n$1$2/;		# create ANISE header
  $RS = "\n";					# reset end of record
}

# execute edit file on ANISE description

sub exec_edit {
  eval ($prl_edit);				# execute edit commands
  if ($@) {					# PERL edit failed?
    fail ("Perl run not completed - ". $@);	# exit program, PERL error
  }
}

# write modifed ANISE description

sub write_anise {
  open (ANI_OUT, "> $ani_outfile")		# open ANISE output file
    || fail ("Cannot open $ani_outfile");	# report failure
  print ANI_OUT "divert(-1)\n\n";		# lose m4 output
  if ($opt_t) {					# trace LOTOS generation?
    print ANI_OUT "define(an_trace,`1')\n\n";	# turn on tracing
  }
  print ANI_OUT "include(anise.m4)\n\n";	# include anise file
  print ANI_OUT $_;				# output modified contents
  close (ANI_OUT);				# close test output file
}

# check overlap between changes from different ANISE generation files

sub check_overlap {
  $_ = $prl_edit;				# set perl string
  while (/\# (.*)/g) {				# comment found
    $pre = $`; $comm = $1; $post = $';		# extract match strings
    if ($comm =~ /File "([^"]*)"/) {		# file name?
      $file = uc ($1);				# extract file name
    }
    elsif ($comm =~ /Context "([^"]*)" (\w*) "([^"]*)"/) { # alteration?
      $context = $1; $alter = $2; $old = $3;
      if ($context && (($alter eq "Append") || ($alter eq "Prefix"))) {
        @files = keys %{$file_alter{$old}{$context}}; # get file keys
	foreach $file2 (@files) {		# go through file keys
	  $alter2 =				# get kind of alteration
	    $file_alter{$old}{$context}{$file2};
	  if (($alter2 eq "Append") ||		# append or prefix overlap?
	      ($alter2 eq "Prefix")) {
	    $pos = pos ($_);			# save current position
            $post =~ s/[^\#]*//;		# delete current edit
	    $_ = $pre . $post;			# reconstitute edit string
	    pos ($_) = $pos - length ($comm) - 2; # restore current position
	    trace ("Warning - " .		# report overlap
	      "Ignored \"$context\" $alter in $file that overlaps:");
	    trace ("  $alter2 in $file2\n");	# report file alterations
	    last;				# leave iteration over keys
	  }
	}
      }
      $file_alter{$old}{$context}{$file} = $alter; # note alteration
    }
  }
  $prl_edit = $_;				# update perl edit string
  foreach $old (keys %file_alter) {		# go through old text keys
    foreach $context (keys %{$file_alter{$old}}) { # go through context keys
      @files = keys %{$file_alter{$old}{$context}}; # get file keys
      if ($#files != 0) {			# more than one alteration?
	$clash_count = 0;			# start clash count
	$alters = "";				# start alteration list
	foreach $file (@files) {		# go through file keys
	  $alter =				# get kind of alteration
	    $file_alter{$old}{$context}{$file};
	  if (((($alter eq "Append") || ($alter eq "Prefix")) &&
	        ($alters =~ /Change|Delete|Wrap/)) ||
	      ($alter eq "Change") ||
	      ($alter eq "Delete") ||
	      (($alter eq "Fill") &&
	        ($alters =~ /Change|Delete|Fill/)) ||
	      (($alter eq "Wrap") &&
	        ($alters =~ /Append|Change|Delete|Prefix|Wrap/))) {
	    $clash_count++;			# increment alteration count
	  }
	  $alters .= "  $alter in $file\n";	# append alteration
	}
	if ($clash_count) {			# at least one clash?
	  trace ("Warning - " .			# report overlap
	    "Allowed overlapping changes of \"$old\":");
	  trace ("$alters");			# report file alterations
	}
      }
    }
  }
}

# combine ANISE test files into one

sub make_test {
  $ant_outfile = "$root_outfile$ant_ext";	# set test output file name
  trace ("Making ANISE test file \"$ant_outfile\":\n"); # trace generation
  open (TST_OUT, "> $ant_outfile")		# open test output file
    || fail ("Cannot open $ant_outfile");	# report failure
  print TST_OUT "divert(-1)\n\n";		# lose m4 output
  print TST_OUT "include(anise_test.m4)\n";	# include m4 test file
  for $parno (1..$parmax, 0) {			# run through test files
    $ant_infile = $ARGV[$parno] . $ant_ext;	# set test input file name
    open (TST_IN, "< $ant_infile")		# open test input file
      || fail ("Cannot open $ant_infile");	# report failure
    print TST_OUT "\n";				# separate output
    while (<TST_IN>) {				# read test file line
      print TST_OUT $_;				# copy input line
    }
    close (TST_IN);				# close test input file
  }
  close (TST_OUT);				# close test output file
}

# make LOTOS file from ANISE

sub make_lotos {
  if (!$opt_i) {				# not interactive?
    $lot_outfile = "$root_outfile$lot_ext";	# set LOTOS output file name
    trace ("Making LOTOS file \"$lot_outfile\":\n"); # trace generation
    $cmd = "anise $root_outfile";		# set anise command
    if (system ($cmd) != 0) {			# anise call failed?
      fail ("Anise run not completed");		# exit program, ANISE error
    }
  }
}

# execute ANISE tests

sub exec_test {
  if (!$opt_i) {				# not interactive?
    trace ("\nExecuting LOTOS tests:\n");	# trace LOTOS test execution
    close (LOG_OUT);				# close ANISE test log file
    $cmd = "antest $opt_m $root_outfile";	# set antest command
    $res = system ($cmd);			# call antest
    open (LOG_OUT, ">> $log_outfile")		# re-open ANISE test log file
      || die "$prog: cannot open $log_outfile\n"; # report failure
    if ($res != 0) {				# antest call failed?
      fail ("Antest run not completed");	# exit program, ANTEST error
    }
  }
}

# output program message if tracing

sub trace {
  printf LOG_OUT "%s\n", @_;			# log trace message
  if ($opt_t) {					# tracing?
    printf STDERR "%s\n", @_;			# print trace message
  }
}

# fail program with message

sub fail {
  printf STDERR "$prog: %s\n", @_;		# print error message
  $code = 1;					# set error code
  finalise ();					# finalise program
}

# finalise program

sub finalise {
  log_divide ();				# print log divider
  close (LOG_OUT);				# close ANISE test log file
  unlink ($prl_file, $ang_outfile);		# remove temporary files
  exit ($code);					# exit with result code
}
