#!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: 5.20
# Date: 1998, November 2
#
# Coded by: Vaclav Bucha and Ludek Klimes
#     Department of Geophysics, Charles University Prague,
#     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
#     E-mails: bucha@seis.karlov.mff.cuni.cz
#              klimes@seis.karlov.mff.cuni.cz
# ......................................................................
# 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
#     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/unix/';     # example (Unix)
    # $SW3D='k:/dos/';          # 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) {
      #   die "Executable file '$PROGRAM' not found. Error";
      # }
      open(LU,"|$NAME");
      print LU @_;
      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";
    }
  }
# ======================================================================
# 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]");
    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]");
    print LU1 ;
    close(LU1) || die "Error when appending '$_[1]' to '$_[0]'";
    close(LU2) || die "Error when copying file '$_[1]'";
  }
# ======================================================================
# Subroutine CHK($PATH,$FILE)                         
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Subroutine to check input data files required by various perl scripts
#
# Input:
#     $PATH...String containing the second part of the PATH to desired
#             file.
#     $FILE...String containing desired filename.
# No output.
#
# Note: $SW3D variable may be changed according to users source
#       containing SW3D files.
# ----------------------------------------------------------------------
  sub CHK {
    package Go;
    $PATH=$_[0];
    $FILE=$_[1];
    if (!-e $FILE) {
      if ($PATH eq '') {
#       No path to the source file specified:
        die "File '$FILE' does not exist.  Error";
      } else {
        if ($SW3D eq '') {
#         No path to the root directory of the SW3D software specified:
          die "File '$FILE' not found.  Error";
        } else {
#         Path to the SW3D software:
          $PATHFILE=$SW3D.$PATH.$FILE;
          if (-e $PATHFILE) {
            print "Copying $PATHFILE\n";
            open (LU1,"<$PATHFILE");
            open (LU2,">$FILE");
            print LU2 ;
            close(LU1) || die "Error when copying file '$PATHFILE'";
            close(LU2) || die "Error when copying file '$FILE'";
          } else {
            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");
#
#   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 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);
      $m=index($LINE,':',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);
#
#         Executing program $PROG with data $DATA
          close(LU) || die "Error";
          &'RUN($PROG,$DATA);
          open(LU,">>$OUTPUT");
        }
      }
    }
    close(LU) || die "Error";
  }
# ======================================================================
# Main program 'go.pl':                              
# ~~~~~~~~~~~~~~~~~~~~~
  $INPUT=$ARGV[0];
  $OUTPUT=$ARGV[1];
#
# 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 {
        die "No output history file. Error";
      }
      print "Output history file: $OUTPUT\n";
    }
    &GO($INPUT,$OUTPUT);
  }
# ======================================================================
1;                                                               #