#!perl #
#
# Perl script file 'go.pl' to run programs according to a history file
# and to assist other Perl scripts in running programs and handling the
# data
#
# Version: 6.10
# Date: 2006, October 9
#
# Coded by: Vaclav Bucha and Ludek Klimes
#     Department of Geophysics, Charles University Prague,
#     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
#     http://sw3d.cz/staff/bucha.htm
#     http://sw3d.cz/staff/klimes.htm
# ......................................................................
# Usage:
#     History file 'file.h' may be executed by command
#              perl go.pl file.h
#     generating the output history file named 'file.out'.
#     If you wish to name the output history file, e.g., 'new.out',
#     the history file may be executed by command
#              perl go.pl file.h new.out
#     For the description of history files and their interpretation
#     refer to sep.htm.
# Note:
#     You may wish to edit some definitions of global variables used
#     by subroutines of this file.  The definitions are located below,
#     between the list of subroutines and the code of the subroutines.
#     The global variables are designed to adapt this script to your
#     computer.
# ......................................................................
# This file consists of subroutines:
#     RUN($NAME,$DATA)... Subroutine to run a program with given input
#             data.
#             RUN
#     ECHO($FILE,$DATA)... Subroutine to append new data to a data file.
#             ECHO
#     COPY($FILE1,$FILE2)... Subroutine to copy files.
#             COPY
#     APPEND($FILE1,$FILE2)... Subroutine to append $FILE2 to $FILE1.
#             APPEND
#     DEL($FILE)... Subroutine to delete files.
#             DEL
#     CHK($PATH,$FILE)... Subroutine to check input data files required
#             by various perl scripts.
#             CHK
#     GO($INPUT,$OUTPUT)... Subroutine to run a history file.
#             GO
#     'go.pl'... Main program to run a history file.
#             MAIN
# ======================================================================
#                                                    
# Definition of global variables for subroutine CHK:
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# These definitions may be edited for a particular computer.
  {
    package Go;
#
# Path to the root directory of the SW3D software (for subroutine CHK):
      $SW3D='';                             # no path specified (default)
    # $SW3D='/cdrom/web/software/sw3dcd6/'; # example (Unix)
    # $SW3D='k:/web/software/sw3dcd6/';     # example (MS-DOS)
  }
# ======================================================================
# Definition of global variables for subroutine RUN:
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# These definitions may be edited for a particular computer.
# The lines which use these definitions are commented in this version.
  {
    package Go;
#
# Path to the directory with the executable SW3D programs:
    # $EXEPATH='./';            # Unix
    # $EXEPATH='';              # MS-DOS
# Note: open(LU,">./file") unlike open(LU,"|./prg.exe") works in MS-DOS
#
# Extension of the executable programs:
    # $EXTENSION='';            # Unix
    # $EXTENSION='.exe';        # MS-DOS
  }
# ======================================================================
# Subroutine RUN($NAME,$DATA)                         
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Input:
#     $NAME... String with the name of the program without an extension.
#     $DATA... String with the data for the program read from a console.
# No output.
# ----------------------------------------------------------------------
  sub RUN {
    package Go;
    $NAME =shift(@_);
#
#   Checking for a Perl script:
    $k=index($NAME,'.pl',0);
    if ($k==-1) {
#
#     Running executable program:
      # $PROGRAM=$EXEPATH.$NAME.$EXTENSION;
      # if (!-e $PROGRAM) {
      #   open (LU1,">>error.out");
      #   print LU1 "##Error go.pl-RUN-1: Executable file '$PROGRAM' not found";
      #   close(LU1);
      #   die "Executable file '$PROGRAM' not found. Error";
      # }
      open(LU,"|$NAME");
      print LU "@_\n";
      close(LU) || die "Error in program '$NAME' executed";
#     The error is not indicated under MS-DOS
#
    } else {
#
#     Running Perl script:
      open(LU,"|perl $NAME @_");
      close(LU) || die "Error in Perl script '$NAME' executed";
    }
#
#   Checking the output error file for string '##Error':
    if ($ERROR ne ' ') {
      if (-e $ERROR) {
#       Reading the error file into string array @ERRORLINES:
        open(LU,"<$ERROR");
        @ERRORLINES=;
        close(LU) || die "Error when closing file '$ERROR'";
#
#       Loop for the lines of the input SEP history file:
        foreach $ERRORLINE (@ERRORLINES) {
          $k=index($ERRORLINE,'##Error',0);
          if ($k>-1) {
            die "Error reported in file '$ERROR', execution terminated";
          }
        }
      }
    }
  }
# ======================================================================
# Subroutine ECHO($FILE,$DATA)                       
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Input:
#     $FILE... String containing output filename including redirection.
#     $DATA... String containing new data to be appended.
# No output.
# Example:
#     &ECHO(">file.tmp","First line")
#     &ECHO(">>file.tmp","Additional line")
# ----------------------------------------------------------------------
  sub ECHO {
    package Go;
    $FILE=shift(@_);
    open(LU,"$FILE");
    print LU "@_\n";
    close(LU) || die "Error when writing file '$FILE'";
  }
# ======================================================================
# Subroutine COPY($FILE1,$FILE2)                     
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Input:
#     $FILE1... String containing input filename.
#     $FILE2... String containing output filename.
# No output.
# ----------------------------------------------------------------------
  sub COPY {
    package Go;
    open(LU1,"<$_[0]");
    open(LU2,">$_[1]");
    while (){
      print LU2;
    }
    close(LU1) || die "Error when copying file '$_[0]'";
    close(LU2) || die "Error when copying file '$_[1]'";
  }
# ======================================================================
# Subroutine APPEND($FILE1,$FILE2)                 
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Input:
#     $FILE1... String containing input-output filename.
#     $FILE2... Name of the file which content will be appended to
#               file $FILE1.  File $FILE2 remains unchanged.
# No output.
# ----------------------------------------------------------------------
  sub APPEND {
    package Go;
    open(LU1,">>$_[0]");
    open(LU2,"<$_[1]");
    while (){
      print LU1;
    }
    close(LU1) || die "Error when appending '$_[1]' to '$_[0]'";
    close(LU2) || die "Error when copying file '$_[1]'";
  }
# ======================================================================
# Subroutine DEL($FILE)                               
# ~~~~~~~~~~~~~~~~~~~~~
# Subroutine to delete file
#
# Input:
#     $FILE...String containing input filename.
# No output.
# ----------------------------------------------------------------------
  sub DEL {
    package Go;
    unlink<$_[0]>;
  }
# ======================================================================
# Subroutine CHK($PATH,$FILE)                         
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Subroutine to check input data files required by various perl scripts.
# The subroutine checks the existence of the file '$FILE' in the current
# directory. If the file does not exist, the subroutine checks its
# existence in the directory '$SW3D$PATH', and, if the file exists
# there, the subroutine copies the file to the current directory.
# If the file exists neither in the current directory nor in the
# '$SW3D$PATH' directory, an error message is generated and the script
# is halted.
#
# Input:
#     $PATH...String containing the second part of the PATH to desired
#             file.
#     $FILE...String containing desired filename.
# No output.
#
# Note: the users are encouraged to change the
#       $SW3D variable
#       according to the path to their directory containing SW3D files.
# ----------------------------------------------------------------------
  sub CHK {
    package Go;
    $PATH=$_[0];
    $FILE=$_[1];
    if (!-e $FILE) {
      if ($PATH eq '') {
#       No path to the source file specified:
        open (LU1,">>error.out");
        print LU1 "##Error go.pl-CHK-1: File '$FILE' does not exist";
        close(LU1);
        die "File '$FILE' does not exist.  Error";
      } else {
        if ($SW3D eq '') {
#         No path to the root directory of the SW3D software specified:
          open (LU1,">>error.out");
          print LU1 "##Error go.pl-CHK-2: File '$FILE' not found. ".
                    "Check path \$SW3D in file go.pl.";
          close(LU1);
          die "File '$FILE' not found. Check path \$SW3D in file go.pl. ".
              "\nInterrupted";
        } else {
#         Path to the SW3D software:
          $PATHFILE=$SW3D.$PATH.$FILE;
          if (-e $PATHFILE) {
            print "Copying $PATHFILE\n";
            open (LU1,"<$PATHFILE");
            open (LU2,">$FILE");
            while (){
              print LU2;
            }
            close(LU1) || die "Error when copying file '$PATHFILE'";
            close(LU2) || die "Error when copying file '$FILE'";
          } else {
            open (LU1,">>error.out");
            print LU1 "##Error go.pl-CHK-3: File '$FILE' not available";
            close(LU1);
            print "\nFile $FILE is not available.\n";
            die "Check '$SW3D' and input data files according to Perl script\n";
          }
        }
      }
    }
  }
# ======================================================================
# Subroutine GO($INPUT,$OUTPUT)                        
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Input:
#     $INPUT..String containing the input history filename.
#     $OUTPUT... String containing the output history filename.
# No output.
# ----------------------------------------------------------------------
  sub GO {
    package Go;
    $INPUT=$_[0];
    $OUTPUT=$_[1];
#
#   Reading input SEP history file into string array @LINES:
    open(LU,"<$INPUT");
    @LINES=;
    close(LU) || die "Error when closing '$INPUT'";
#
#   Opening the output SEP history file:
    open(LU,">$OUTPUT");
#
#   Default name of the output error file:
    $ERROR='error.out';
#
#   Deleting output error file:
    if ($ERROR ne ' ') {
      if (-e $ERROR) {
        unlink($ERROR)
      }
    }
#
#   Loop over the lines of the input SEP history file:
    foreach $LINE (@LINES) {
#
#     Replacing string $INPUT by string $OUTPUT:
      $j=length($INPUT);
      $k=length($OUTPUT);
      $i=index($LINE,$INPUT,0);
      while ($i>-1) {
        substr($LINE,$i,$j)=$OUTPUT;
      } continue {
        $i=index($LINE,$INPUT,$i+$k);
      }
#
#     Copying the line into the output SEP history file:
      print LU "$LINE";
#
#     Looking for the name of the error file (for future extension):
   ## &'RSEP2($LINE);
   ## $ERROROLD=$ERROR;
   ## &'RSEP3('ERROR',$ERROR,$ERROROLD);
   ## if ($ERROR ne $ERROROLD) {
#  ##   Deleting output error file
   ##   unlink($ERROR)
   ## }
#
#     Looking for a program to execute:
      $k=index($LINE,'#',0);
      if ($k==-1) {
        $k=length($LINE);
      }
#     Line ends at position $k-1
      $j=index(substr($LINE,0,$k),':',0);
      if ($j>-1) {
#       Line contains a colon at position $j
        $i=rindex($LINE,' ',$j-1)+1;
        if ($i<$j) {
          $PROG=substr($LINE,$i,$j-$i);
          $DATA=substr($LINE,$j+1,$k-$j-1);
#
#         Default input data (the name of the history file)
          $i=length($DATA)-1;
#         Check whether the last character is Line Feed
          if ($i>-1 && substr($DATA,$i,1) eq "\n" ) {
            $i=$i-1;
          }
#         Check whether the last character is Carriage Return
          if ($i>-1 && substr($DATA,$i,1) eq "\r" ) {
            $i=$i-1;
          }
          while ($i>-1 && substr($DATA,$i,1) eq ' ') {
            $i--;
          }
          if ($i<0) {
            $DATA="'$OUTPUT' /";
          }
#
#         Executing program $PROG with data $DATA
          close(LU) || die "Error";
          &'RUN($PROG,$DATA);
          open(LU,">>$OUTPUT");
        }
      }
    }
#
#   Closing the  output history file:
    close(LU) || die "Error";
#
#   Checking the output error file for string '##Warning':
    if ($ERROR ne ' ') {
      if (-e $ERROR) {
#       Reading the error file into string array @ERRORLINES:
        open(LU,"<$ERROR");
        @ERRORLINES=;
        close(LU) || die "Error when closing file '$ERROR'";
#
#       Loop for the lines of the input SEP history file:
        foreach $ERRORLINE (@ERRORLINES) {
          $k=index($ERRORLINE,'##Warning',0);
          if ($k>-1) {
            print "Please, read the warning message(s) in file '$ERROR'!\n";
            last
          }
        }
      }
    }
  }
# ======================================================================
# Main program 'go.pl':                              
# ~~~~~~~~~~~~~~~~~~~~~
  if (scalar(@ARGV)>0) {
    $INPUT=$ARGV[0];
  } else {
    $INPUT=''
  }
  if (scalar(@ARGV)>1) {
    $OUTPUT=$ARGV[1];
  } else {
    $OUTPUT=''
  }
#
# Executing the SEP history file:
  if ($INPUT ne '') {
    if ($OUTPUT eq '') {
#     Output history file not specified, setting default based on $INPUT
      $j=length($INPUT);
      if (substr($INPUT,$j-2,2) eq '.h') {
        $OUTPUT=substr($INPUT,0,$j-2).'.out';
      } elsif (substr($INPUT,$j-2,2) eq '.H') {
        $OUTPUT=substr($INPUT,0,$j-2).'.OUT';
      } else {
        open (LU1,">>error.out");
        print LU1 "##Error go.pl-MAIN-1: No output history file";
        close(LU1);
        die "No output history file. Error";
      }
      print "Output history file: $OUTPUT\n";
    }
    &GO($INPUT,$OUTPUT);
  }
# ======================================================================
1;                                                               #