#!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.50 # Date: 2001, January 4 # # 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 # ...................................................................... # 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 # 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) { # 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 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: 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"; close(LU1); 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"); 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; #