#!/usr/local/perl561/bin/perl

=pod


=cut

package TUSC::qprep;     # Assign name of this Perl module.

use Exporter;
@ISA = "Exporter";

# Make symbols defined in this module visible to external Perl modules.
@EXPORT = qw( qprepMain );

$VERSION = "0.00";

# Establish the location of the PST library.
use constant PSTDIR => "/home/gourlay/src/PST";

use English;     # Use English names for various Perl idiomatic identifiers.
use strict;      # Use "strict" Perl rules to aid in code development.
use FileHandle ; # Use sysopen to open the script file
####use warnings;    # Tell Perl to check for more code problems.




sub qprepStateInitializeParserControls
{
=pod

  NAME
    qprepStateInitializeParserControls: set default qprep parser control values


  USAGE
    qprepStateInitializeParserControls(\%state_table);


  ARGUMENTS
    %state_table (in/out): qprep options hash table
      On output,
        each key is the name of a qprep parser control option,
        each value is the default value for the associated option.


  DESCRIPTION
    This qprep generic internal routine initializes qprep state
    variables in the "parser control" category.

    Some these values set here are essentially nonsense, and generally
    the local qprepInitCallback must change these values for qprep to
    do something useful.


  SEE ALSO
    qprep(1), qprepStateInitializeQueueProperties(in 'qprep.pm'),
    qprepInitCallback(in 'localQprep.pm').

    qprepStateInitialize(in 'qprep.pm') for an overview of qprep state
    variables.

    Practical Supercomputing Toolkit web site: http://pstoolkit.org/


  AUTHOR
    Written 2001 by Michael J. Gourlay
    in collaboration with Joe Werne, Chris Bizon and others.


=cut

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my ($state_table_ref) = @ARG ;

  # Set default values for properties.

  ####
  #### Properties associated with parsing:
  ####

  # Qprep control directives
  $state_table_ref->{erase}                 = "n" ;
  $state_table_ref->{in_script}             = ""  ;
  $state_table_ref->{out_script}            = ""  ;
  $state_table_ref->{silent}                = "n" ;
  $state_table_ref->{submit}                = "n" ;
  $state_table_ref->{operation_verbosity}   = 0   ;
  $state_table_ref->{verbose_script}        = "n" ;
  $state_table_ref->{explicit_preamble}     = "n" ;
  $state_table_ref->{first_executable_line} = ""  ;

  ####
  #### Properties associated with reading input:
  ####

  $state_table_ref->{preamble_comment}           = "#" ;
  $state_table_ref->{source_directive_prefix}    = "#PSTQ " ;

  # source_key_value_separator should be '=',
  $state_table_ref->{source_key_value_separator} = "=" ;

  ####
  #### Properties associated with writing output:
  ####
  # These values are essentially nonsense, and generally
  # the local qprepInitCallback must change these values
  # for qprep to do something useful.

  $state_table_ref->{target_comment_prefix}      = "#" ;
  $state_table_ref->{target_comment_suffix}      = "" ;
  $state_table_ref->{target_directive_prefix}    = "#PstQ " ;
  $state_table_ref->{target_key_value_separator} = " = " ;
  $state_table_ref->{target_submit_command}      = "echo Submit:" ;

  return ;
}




sub qprepStateInitializeQueueProperties
{
=pod

  NAME
    qprepStateInitializeQueueProperties: set default queue property values


  USAGE
    qprepStateInitializeQueueProperties(\%state_table);


  ARGUMENTS
    %state_table (in/out): qprep options hash table
      On output,
        each key is the name of a qprep queue properties option.
        each value is the default value for the associated option.


  DESCRIPTION
    This qprep generic internal routine initializes qprep state
    variables in the "queue properties" category.


  SEE ALSO
    qprep(1), qprepStateInitializeParserControls(in 'qprep.pm'),
    qprepInitCallback(in 'localQprep.pm'),

    qprepStateInitialize() man page for an overview of qprep
    state variables.

    Practical Supercomputing Toolkit web site: http://pstoolkit.org


  AUTHOR
    Written 2001 by Michael J. Gourlay
    in collaboration with Joe Werne, Chris Bizon and others.


=cut

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my ($state_table_ref) = @ARG ;

  # Set default values for queue properties.

  # Job environment directives
  $state_table_ref->{account}             = ""  ;
  $state_table_ref->{username}            = ""  ;
  $state_table_ref->{export_vars}         = "n" ;
  $state_table_ref->{shell}               = ""  ;

  # Reporting directives
  $state_table_ref->{stderr}              = ""              ;
  $state_table_ref->{stdout}              = ""              ;
  $state_table_ref->{keep}                = "stderr,stdout" ;
  $state_table_ref->{mail}                = "e"             ;
  $state_table_ref->{mail_to}             = ""              ;

  # Job control directives
  $state_table_ref->{queue}               = "" ;
  $state_table_ref->{job_name}            = "" ;
  $state_table_ref->{checkpoint}          = "" ;

  # Limit directives
  $state_table_ref->{nodes}               = "1" ;
  $state_table_ref->{cpus_per_node}       = "1" ;
  $state_table_ref->{wall_time}           = ""  ;
  $state_table_ref->{process_cpu_time}    = ""  ;
  $state_table_ref->{total_cpu_time}      = ""  ;
  $state_table_ref->{proc_file_size}      = ""  ;
  $state_table_ref->{total_file_size}     = ""  ;
  $state_table_ref->{tapemta}             = ""  ;
  $state_table_ref->{tapemtb}             = ""  ;
  $state_table_ref->{tapemtc}             = ""  ;
  $state_table_ref->{tapemtd}             = ""  ;
  $state_table_ref->{tapemte}             = ""  ;
  $state_table_ref->{tapemtf}             = ""  ;
  $state_table_ref->{tapemtg}             = ""  ;
  $state_table_ref->{tapemth}             = ""  ;
  $state_table_ref->{nice}                = ""  ;
  $state_table_ref->{process_memory}      = ""  ;
  $state_table_ref->{total_memory}        = ""  ;

  # Job dependence directives
  $state_table_ref->{sync_count}          = "" ;
  $state_table_ref->{sync_with}           = "" ;
  $state_table_ref->{after}               = "" ;
  $state_table_ref->{after_ok}            = "" ;
  $state_table_ref->{after_not_ok}        = "" ;
  $state_table_ref->{after_any}           = "" ;
  $state_table_ref->{depends_on}          = "" ;
  $state_table_ref->{before}              = "" ;
  $state_table_ref->{before_ok}           = "" ;
  $state_table_ref->{before_not_ok}       = "" ;
  $state_table_ref->{before_any}          = "" ;

  # Catch-all directive
  $state_table_ref->{target_cmd_line_arg}     = "" ;
  $state_table_ref->{target_script_directive} = "" ;

  return ;
}




sub qprepStateInitialize
{
=pod

  NAME
    qprepStateInitialize: set default values in table of qprep options


  USAGE
    qprepStateInitialize(\%state_table);


  DESCRIPTION
    This qprep generic internal routine performs preliminary
    initialization of the qprep state hash table.  The
    qprepInitCallback routine performs initializations specific to the
    local site.

    The qprep delineates state variables into two categories: "parser
    controls" and "queue properties".  Parser controls affect how qprep
    parses input.  Queue properties are to be translated into directives
    in the target queue system.

    Among the differences between these two categories is when they
    are evaluated.  Since parser controls affect how qprep parses
    input, parser control directives that occur on the qprep command
    line must be evaluated /before/ the input script.  In contrast,
    qprep effectively delays evaluation of queue property directives
    that occur on the qprep command line until /after/ parsing the input
    script, which allows the user to override queue properties set by
    directives in the input script.


  ARGUMENTS
    %state_table (in/out): qprep options hash table
      On output,
        each key is the name of a qprep option or state variable,
        each value is the default value for the associated option name.


  NOTES
    By separating the state initialization into two pieces, we accomplish
    these things:

      () Make it clear (to the developers anyway) which qprep state
         variables fall into which categories.

      () Allow for calling qprepStateInitializeQueueProperties a second
         time, after the initial parsing of the command-line options to
         obtain the parser control values.

         The prescribed semantics of qprep indicate that directives
         that occur on the command-line supercede directives that occur
         within a script.  In practice this happens by writing the
         command-line directives at the end of the script preamble.
         But some command-line directives only make sense if evaluated
         before the script is even opened for reading.  This poses a
         conflict.

         To resolve the conflict, qprep evaluates the command-line
         directives twice; once before the input script and once
         after.  At this time, I see no reason to effectively undo the
         evaluation of the queue properties directives, but it might
         come up that we want to explicitly undo (or perhaps even skip)
         evaluation of non-parser-control directives before evaluating
         the input script.

         This implementation mildly assumes that the target queue
         system can accept having the same options set multiple times.
         If that is not the case, then the local
         qprepPreTranslationCallback and qprepFinishPreambleCallback
         would have to implement a more sophisticated scheme that
         guarentees that all directives occur at most once within the
         script. As it happens, we imlpement that sort of scheme for
         some of the options for most queue systems anyway, so
         expanding that scheme for more directives would not pose undue
         problems for the local site administrator.


  SEE ALSO
    qprepStateInitializeParserControls(in 'qprep.pm'),
    qprepStateInitializeQueueProperties(in 'qprep.pm'),
    qprepInitCallback(in 'localQprep.pm')

    qprep(1) manual page for list of directives.

    Practical Supercomputing Toolkit web site: http://pstoolkit.org/


  AUTHOR
    Written 2001 by Michael J. Gourlay
    in collaboration with Joe Werne, Chris Bizon and others.


=cut

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my ($state_table_ref) = @ARG ;

  qprepStateInitializeParserControls($state_table_ref);
  qprepStateInitializeQueueProperties($state_table_ref);

  return ;
}




sub qprepMessageTableInitialize
{
=pod

  NAME
    qprepMessageTableInitialize: initialize table of error messages and codes


  USAGE
    qprepMessageTableInitialize(\%message_table) ;


  ARGUMENTS
    \%message_table: nested hash table of error messages and codes.

      Keys are tokens for errors.
      Values are hash table:
        Key is either MSG_TEXT or ERR_CODE.
        Value associated with MSG_TEXT is text string with error message.
        Value associated with ERR_CODE is integer error code value.


  DESCRIPTION
    The "error table" facility act similarly in spirit to the "perror"
    and "errno" operating system facilities, in that this facility
    provides a unified access point for common error messages and codes.
    This facility allows for rapid and simple internationalization, since
    only the text portion of the table need be changed, and the rest of
    the code can remain unchanged.  This facility also reduces the number
    of error messages by provoding a set of common messages, instead
    of the code author concocting a new message for each situation,
    when some situations should share one text message.


  SEE ALSO
    qprep(1),
    define_message_table(in 'archive.pm'),

    Practical Supercomputing Toolkit web site: http://pstoolkit.org


  AUTHOR
    Written 2001 by Michael J. Gourlay
    in collaboration with Joe Werne, Chris Bizon and others.

=cut

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my ($message_table_ref) = @ARG ;

  # Set error table text messages and code values

  %$message_table_ref =
  (
    WARN_OUTPUT_SCRIPT_EXISTS =>
    {
      MSG_TEXT => "qprep: WARNING: output script '%s' already exists.\n" .
                  "  You should remove that file before running qprep.\n" .
                  "  Removing old output script file...\n",
      ERR_CODE => 501
    } ,
    ERR_PARSING =>
    {
      MSG_TEXT => "qprep: ERROR: detected %i parsing errors.\n",
      ERR_CODE => 1001
    } ,
    ERR_FILE_NOT_READABLE =>
    {
      MSG_TEXT => "qprep: ERROR: could not open file named '%s' for reading.\n",
      ERR_CODE => 1002      # 1000 + ENOENT
    } ,
    ERR_TOO_FEW_CMD_LINE_ARGS =>
    {
      MSG_TEXT => "qprep: ERROR: too few (%i) command-line arguments.\n",
      ERR_CODE => 1007      # 1000 + E2BIG
    } ,
    ERR_BAD_DIRECTIVE_VALUE =>
    {
      MSG_TEXT => "qprep: ERROR: bad value '%s' for key '%s'.\n",
      ERR_CODE => 1022      # 1000 + EINVAL
    } ,
    ERR_FILE_NOT_WRITEABLE =>
    {
      MSG_TEXT => "qprep: ERROR: could not open file named '%s' for writing.\n",
      ERR_CODE => 1028      # 1000 + ENOSPC
    } ,
    ERR_NO_SUCH_DIRECTIVE_KEY =>
    {
      MSG_TEXT => "qprep: ERROR: no such directive key '%s'.\n",
      ERR_CODE => 1038      # 1000 + ENOSYS
    } ,
    ERR_BAD_DIRECTIVE_SYNTAX =>
    {
      MSG_TEXT => "qprep: ERROR: bad directive syntax in '%s'.\n",
      ERR_CODE => 1056      # 1000 + EBADRQC
    } ,

    # Errno entries
    ERR_NOENT =>
    {
      MSG_TEXT => "qprep: ERROR: no such file or entry named '%s'.\n",
      ERR_CODE => 2
    } ,
    ERR_ACCES =>
    {
      MSG_TEXT => "qprep: ERROR: Permission denied for '%s'.\n",
      ERR_CODE => 13
    } ,
    ERR_NOSPC =>
    {
      MSG_TEXT => "qprep: ERROR: No space left on device.\n",
      ERR_CODE => 28
    } ,
    ERR_DQUOT =>
    {
      MSG_TEXT => "qprep: ERROR: Quota exceeded.\n",
      ERR_CODE => 122
    }
  );

  return ;
}




sub qprepValidDirectiveTableInitialize
{
=pod

  NAME
    qprepValidDirectiveTableInitialize: assign table of valid qprep directives


  USAGE
    qprepValidDirectiveTableInitialize(\%directives_table);


  ARGUMENTS
    %directives_table (in/out): valid qprep directives

      On output,
        Each key is in the set of qprep directive names.

        Each associated value is a reference to an array of regular
        expressions that match valid directive values for the
        associated directive key.  E.g., the value pattern ".*"
        indicates that all values are considered valid for the purpose
        of preliminary semantic checking (i.e. no checks are done on
        the input directive value).  E.g., the value pattern "[0-9].*"
        matches any integer.  E.g., the value pattern "[0-9:.].*"
        matches a "time".


  DESCRIPTION
    This generic internal qprep subroutine initializes the hash table of
    valid directive keys and values.

    This directives hash table encodes the preliminary qprep parser
    rules for accepting or rejecting directive keys and values.  The
    qprepInitCallback Perl subroutine in the local configuration
    routine may edit this table to broaden or narrow the list of
    acceptable input directives.

    The local configuration modules must also augment this table if the
    qprepPreTranslationCallback ever returns directive key values other
    than those defined by qprep.  Likewise, the translation table must
    contain entries for any such directives.

    If the local configuration module adds or deletes keys from the
    directives table then it must also add or delete keys to the
    translation table.


  SEE ALSO
    qprepTranslationTableInitialize(in 'qprep.pm'),
    qprep(1), PST website at http://pstoolkit.org/


  AUTHOR
    Written 2001 by Michael J. Gourlay
    in collaboration with Joe Werne, Chris Bizon and others.

=cut

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my ($directives_table_ref) = @ARG ;

  # qprep control directives
  $directives_table_ref->{erase}                      = ['^ *[yn] *$']    ;
  $directives_table_ref->{in_script}                  = ['.*']            ;
  $directives_table_ref->{out_script}                 = ['.*']            ;
  $directives_table_ref->{silent}                     = ['^ *[yn] *$']    ;
  $directives_table_ref->{submit}                     = ['^ *[yn] *$']    ;
  $directives_table_ref->{verbose_script}             = ['^ *[ynY] *$']   ;
  $directives_table_ref->{explicit_preamble}          = ['^ *[ynY] *$']   ;
  $directives_table_ref->{operation_verbosity}        = ['^ *[0-9]* *$'] ;

  # qprep output directives
  $directives_table_ref->{target_comment_prefix}      = ['.*'] ;
  $directives_table_ref->{target_comment_suffix}      = ['.*'] ;
  $directives_table_ref->{target_directive_prefix}    = ['.*'] ;
  $directives_table_ref->{target_key_value_separator} = ['.*'] ;

  # Job environment directives
  $directives_table_ref->{account}                    = ['.*']         ;
  $directives_table_ref->{username}                   = ['.*']         ;
  $directives_table_ref->{export_vars}                = ['^ *[yn] *$'] ;
  $directives_table_ref->{shell}                      = ['.*']         ;

  # Reporting directives
  $directives_table_ref->{stdout} = ['.*']                       ;
  $directives_table_ref->{stderr} = ['.*']                       ;
  $directives_table_ref->{keep}   =
    ['^ *(neither|((stderr|stdout)(,(stderr|stdout))?)) *$'];
  $directives_table_ref->{mail}   = ['^ *(n|([abert](,[abert])*)) *$'] ;
  $directives_table_ref->{mail_to}= ['.*']                       ;

  # Job control directives
  $directives_table_ref->{queue}            = ['.*']                         ;
  $directives_table_ref->{job_name}         = ['.*']                         ;
  $directives_table_ref->{checkpoint}       = ['^ *[ns] *$', '^ *[0-9].* *$'];

  # Limit directives
  $directives_table_ref->{nodes}            = ['^ *[0-9]* *$']   ;
  $directives_table_ref->{cpus_per_node}    = ['^ *[0-9]* *$']   ;
  $directives_table_ref->{wall_time}        = ['^ *[0-9]*:[0-6][0-9] *$'] ;
  $directives_table_ref->{process_cpu_time} = ['^ *[0-9]*:[0-6][0-9] *$'] ;
  $directives_table_ref->{total_cpu_time}   = ['^ *[0-9]*:[0-6][0-9] *$'] ;
  $directives_table_ref->{proc_file_size}   = ['^ *[0-9]* *$']   ;
  $directives_table_ref->{total_file_size}  = ['^ *[0-9]* *$']   ;
  $directives_table_ref->{tapemta}          = ['^ *[0-9]* *$']   ;
  $directives_table_ref->{tapemtb}          = ['^ *[0-9]* *$']   ;
  $directives_table_ref->{tapemtc}          = ['^ *[0-9]* *$']   ;
  $directives_table_ref->{tapemtd}          = ['^ *[0-9]* *$']   ;
  $directives_table_ref->{tapemte}          = ['^ *[0-9]* *$']   ;
  $directives_table_ref->{tapemtf}          = ['^ *[0-9]* *$']   ;
  $directives_table_ref->{tapemtg}          = ['^ *[0-9]* *$']   ;
  $directives_table_ref->{tapemth}          = ['^ *[0-9]* *$']   ;
  $directives_table_ref->{nice}             = ['^ *[0-9]* *$']   ;
  $directives_table_ref->{process_memory}   = ['^ *[0-9]* *$']   ;
  $directives_table_ref->{total_memory}     = ['^ *[0-9]* *$']   ;

  # Job dependence directives
  $directives_table_ref->{sync_count}       = ['^ *[0-9]* *$'] ;
  $directives_table_ref->{sync_with}        = ['.*']           ;
  $directives_table_ref->{after}            = ['.*']           ;
  $directives_table_ref->{after_ok}         = ['.*']           ;
  $directives_table_ref->{after_not_ok}     = ['.*']           ;
  $directives_table_ref->{after_any}        = ['.*']           ;
  $directives_table_ref->{depends_on}       = ['.*']           ;
  $directives_table_ref->{before}           = ['.*']           ;
  $directives_table_ref->{before_ok}        = ['.*']           ;
  $directives_table_ref->{before_not_ok}    = ['.*']           ;
  $directives_table_ref->{before_any}       = ['.*']           ;

  # Catch-all directive
  $directives_table_ref->{target_cmd_line_arg}     = ['.*'] ;
  $directives_table_ref->{target_script_directive} = ['.*'] ;

  return ;
}




sub qprepTranslationTableInitialize
{
=pod

  NAME
    qprepTranslationTableInitialize: initialize directive translation table


  USAGE
    qprepTranslationTableInitialize(\%translation_table) ;


  ARGUMENTS
    \%translation_table: hash table translation rules

      Keys are directive keys.

      Values are arrays of translation rules.
      Each element of the array is a list of 2-tuples:

        First list element is one of KEY, VALUE or BOTH,
        indicating which part of the directive to which to apply the
        translation.

        Second element is regular expression.


  DESCRIPTION
    This routine initializes the translation table.  By default, most
    directives are translated to nothing since the target queue system
    is not obligated to implement all qprep directives, and it would be
    impossible to guess useful translations that apply generally to all
    target queue systems anyway.

    The qprepInitCallback Perl subroutine in the local configuration
    routine should edit this translation table to establish rules for
    translating from PSTQ directives to valid directives in the local
    queue system.

    The local configuration modules may also augment the table of valid
    directives, in which case that module must also augment the table
    of valid directives.

    If the local configuration module adds or deletes keys from the
    directives table then it must also add or delete keys to the
    translation table.


  SEE ALSO
    qprepValidDirectiveTableInitialize(in 'qprep.pm'),
    qprep(1),
    Practical Supercomputing Toolkit web site: http://pstoolkit.org/


  AUTHOR
    Written 2001 by Michael J. Gourlay
    in collaboration with Joe Werne, Chris Bizon and others.

=cut

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my ($translation_table_ref) = @ARG ;

  # Set translation table.
  # Most entries indicate no translation.
  # The machine-specific callback assigns most actual translation rules.

  # The ALL entry applies to all directives.
  $translation_table_ref->{ALL}                 = [] ;

  # Qprep control directives:
  # These usually have no meaning in the target system.
  $translation_table_ref->{erase}               = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{in_script}           = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{out_script}          = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{silent}              = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{submit}              = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{operation_verbosity} = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{verbose_script}      = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{explicit_preamble}   = [('BOTH', 's/.*//')] ;

  # Qprep output
  $translation_table_ref->{target_comment_prefix}      = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{target_comment_suffix}      = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{target_directive_prefix}    = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{target_key_value_separator} = [('BOTH', 's/.*//')] ;

  # Job environment directives
  $translation_table_ref->{account}             = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{username}            = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{export_vars}         = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{shell}               = [('BOTH', 's/.*//')] ;

  # Reporting directives
  $translation_table_ref->{stderr}              = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{stdout}              = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{keep}                = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{mail}                = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{mail_to}             = [('BOTH', 's/.*//')] ;

  # Job control directives
  $translation_table_ref->{queue}               = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{job_name}            = [('BOTH', 's/.*//')] ;
  $translation_table_ref->{checkpoint}          = [('BOTH', 's/.*//')] ;

  # Limit directives
  $translation_table_ref->{nodes}               = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{cpus_per_node}       = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{wall_time}           = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{process_cpu_time}    = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{total_cpu_time}      = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{proc_file_size}      = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{total_file_size}     = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{process_memory}      = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{total_memory}        = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{nice}                = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{tapemta}             = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{tapemtb}             = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{tapemtc}             = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{tapemtd}             = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{tapemte}             = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{tapemtf}             = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{tapemtg}             = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{tapemth}             = [('BOTH', "s/.*//")] ;

  # Job dependence directives
  $translation_table_ref->{sync_count}          = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{sync_with}           = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{after}               = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{after_ok}            = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{after_not_ok}        = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{after_any}           = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{depends_on}          = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{before}              = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{before_ok}           = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{before_not_ok}       = [('BOTH', "s/.*//")] ;
  $translation_table_ref->{before_any}          = [('BOTH', "s/.*//")] ;

  # Catch-all directives
  $translation_table_ref->{target_cmd_line_arg}     =
  [
    ( 'BOTH'   , "s/.*//"     )   # Remove input directive entirely
  ] ;

  $translation_table_ref->{target_script_directive} =
  [
    ( 'KEY'   , "s/.*//"     )    # Remove input directive key entirely
  ] ;

  return ;
}




sub hashTablePrint
{

=pod

  NAME
    hashTablePrint: print all key-value pairs in a Perl hash table.


  USAGE
    hashTablePrint(\%hash_table);


  ARGUMENTS
    %hash_table (in): Perl hash table


  AUTHOR
    Written 2001 by Michael J. Gourlay

=cut

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my ($hash_table_ref) = @ARG ;

  # Declare local scope for these local variables.
  my($hash_table_key);
  my($hash_table_val);

  # Iterate over each key-value pair in hash table.
  while ( ($hash_table_key, $hash_table_val) = each %$hash_table_ref )
  {
    # Print hash key name.
    print STDERR "\t$hash_table_key" ;

    # Insert tabs to align value column.
    if(length($hash_table_key) < 8)
    {
      print STDERR "\t\t" ;
    }
    elsif(length($hash_table_key) < 16)
    {
      print STDERR "\t" ;
    }

    print STDERR "\t= " ;

    # Print hash value.
    if ( ref($hash_table_val) eq "ARRAY" )
    {
      # Hash table value is an array so print all elements in array.
      my($ia);  # Declare array index variable for this inner scope.
      for( $ia=0; $ia < scalar(@$hash_table_val) - 1; $ia++)
      {
        printf(STDERR "'%s' , ", $hash_table_val->[$ia]);
      }
      printf(STDERR "'%s'\n", $hash_table_val->[$ia]);
    }
    elsif ( ref($hash_table_val) eq "HASH" )
    {
      # Hash table value is a hash table so recurse
      print STDERR "\t{\n";
      hashTablePrint($hash_table_val) ;
      print STDERR "\t}\n";
    }
    else
    {
      # Has table value is scalar so just print it.
      print STDERR "'$hash_table_val'\n";
    }
  }

}




sub arrayPrint
{

=pod

  NAME
    arrayPrint: print all elements in a Perl array


  USAGE
    arrayPrint(\@array);


  ARGUMENTS
    \@array (in): reference to Perl array


  AUTHOR
    Written 2001 by Michael J. Gourlay

=cut

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my ($array_ref) = @ARG ;

  # Declare local scope for these local variables.
  my($array_element);

  # Iterate through each element in array
  for( my($ia)=0; $ia < scalar(@$array_ref); $ia++)
  {
    printf(STDERR "    [%3i] = '%s'\n", $ia, $array_ref->[$ia]);
  }
}




sub qprepDirectiveCheck
{
=pod
  NAME
    qprepDirectiveCheck: verify syntax and validity of directive string


  USAGE
    my($status_code) = qprepDirectiveCheck(\%state_table,
                                           \%message_table,
                                           \%directives_table,
                                            $string_to_parse,
                                           \$directive_key,
                                           \$directive_value);


 ARGUMENTS
   \%state_table (in): reference to hash table of qprep options.
      (reads operation_verbosity member for verbose mode.)

   \%message_table (in): nested hash table of error messages and codes.
      (See qprepMessageTableInitialize(in 'qprep.pm'))

   \%directives_table (in): table of valid directives
      (See qprepValidDirectiveTableInitialize(in 'qprep.pm'))

   $string_to_pares (in): string containing candidate directive

   \$directive_key (out): directive key, parsed from string_to_parse

   \$directive_value (out): directive value, parsed from string_to_parse


  DESCRIPTION
    This generic internal qprep Perl subroutine parses an input string
    into a qprep directive (which is a key-value pair with a specific
    format) and compares the directive key and value to an entry in the
    table of valid directives (directives_table) to verify that the
    directive is valid.

    This grammar entry describes the syntax for a valid qprep
    directive:

      qprep-directive:
        qprep-key = qprep-value

      qprep-key:
        {one of the options described in the qprep(1) man page}

      qprep-value:
        string_constant (terminal symbol)

    Leading white space and white space between qprep-key and the
    literal '=' are ignored.  White space after the '=' is
    significant, except for a termining newline character, which is
    ignored if present.

    This routine rejects input strings not in that form.

    The string preceding the '=' is stored into directive_key,
    except for leading and trailing white space.

    The string following the '=' is stored into directive_value.

    If the input string fits the prescribed syntax, then this routine
    uses the value of directive_key as the key in the
    directives_table.  The associated value is an array of strings
    which this routine interprets as regular expressions (regex).  The
    contents of directive_value are compared with each regex from the
    table entry.  If none of the regexes match the contents of
    directive_value then the directive is rejected.


  RETURN VALUES
    Returns zero if the input string is accepted.

    Returns an error code from message_table if the input string is
    rejected.


  SEE ALSO
    qprepStateInitialize(in 'qprep.pm'),
    qprepMessageTableInitialize(in 'qprep.pm'),
    qprepValidDirectiveTableInitialize(in 'qprep.pm'),


=cut

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my($state_table_ref,
     $message_table_ref,
     $directives_table_ref,
     $string_to_parse,
     $directive_key_ref,
     $directive_value_ref
    ) = @ARG;

  if ( $state_table_ref->{operation_verbosity} >= 2 )
  {
    print STDERR "qprepDirectiveCheck: ",
                 "$state_table_ref $message_table_ref ",
                 "$directives_table_ref $string_to_parse ",
                 "$directive_key_ref $directive_value_ref\n" ;
  }

  # Substring before assignment delimiter is directive key.
  # Substring after  assignment delimiter is directive value.
  # Note that directive key can not contain delimiter characters.
  # This pattern matches
  #  any string not containing a delimeter, which is group 1,
  #  followed by any amount of white space,
  #  followed by a delimiter (=)
  #  followed by any string, which is group 2.
  #
  # NOTE
  #  The literal '=' in this pattern match should instead use
  #  the value of
  #  $state_table_ref->{source_key_value_separator},
  #  but it seems highly unlikely that we would want to
  #  change that value from anything other than '='.
  if( $string_to_parse =~ m/([^=]*)[ \t]*=(.*)/ )
  {
    # Extract groups from pattern match
    $$directive_key_ref   = $1;
    $$directive_value_ref = $2;

    # Remove leading and trailing white space from directive key.
    $$directive_key_ref =~ s/^ *//;
    $$directive_key_ref =~ s/ *$//;
    if ( $state_table_ref->{operation_verbosity} >= 3 )
    {
      print STDERR "qprepDirectiveCheck: key='$$directive_key_ref'\n";
      print STDERR "qprepDirectiveCheck: value='$$directive_value_ref'\n";
    }
  }
  else
  {
    # Remove trailing newline from input line string, to tidy error message.
    chomp($string_to_parse);

    printf(STDERR
      $message_table_ref->{ERR_BAD_DIRECTIVE_SYNTAX}{MSG_TEXT},
      $string_to_parse);
    return $message_table_ref->{ERR_BAD_DIRECTIVE_SYNTAX}{ERR_CODE};
  }

  # Verify that input directive key is valid
  if( ! exists $directives_table_ref->{$$directive_key_ref} )
  {
    printf(STDERR
      $message_table_ref->{ERR_NO_SUCH_DIRECTIVE_KEY}{MSG_TEXT},
      $$directive_key_ref);
    return $message_table_ref->{ERR_NO_SUCH_DIRECTIVE_KEY}{ERR_CODE};

  }

  # Assign directive value pattern array to another variable,
  # for typographical convenience.
  # Also, Perl does not evaluate
  #   scalar(@$directives_table_ref->{$$directive_key_ref})
  # even though it evaluates
  #   scalar(@$dv_array_ref)
  # but I do not know why.
  my($dv_array_ref) = $directives_table_ref->{$$directive_key_ref};

  # Verify that input directive value is valid for associated key
  my($found_dir_val_match)=0;

  for(my($ipattern)=0;
      $ipattern < scalar(@$dv_array_ref);
      $ipattern ++ )
  {
    my($val_pattern)=$dv_array_ref->[$ipattern];

    if( ( $$directive_value_ref =~ m/$val_pattern/ ) )
    {
      $found_dir_val_match=1;
    }
  }

  if(!$found_dir_val_match)
  {
    # Input directive value failed to match any patterns for valid values.
    printf(STDERR
      $message_table_ref->{ERR_BAD_DIRECTIVE_VALUE}{MSG_TEXT},
      $$directive_value_ref, $$directive_key_ref);
    return $message_table_ref->{ERR_BAD_DIRECTIVE_VALUE}{ERR_CODE};
  }

  # Return status code meaning "no errors detected."
  return 0;
}




sub qprepDirectiveAssign
{
=pod
  NAME
    qprepDirectiveAssign: assign directive value to directive key


  USAGE
    qprepDirectiveAssign(\%state_table, \%message_table,
                         $directive_key, $directive_value);


  ARGUMENTS
   \%state_table (in/out): reference to hash table of qprep properties

   \%message_table (in): nested hash table of error messages and codes.
     (See qprepMessageTableInitialize(3))

   $directive_key (in): string containing directive key

   $directive_value (in): string containing directive key


  DESCRIPTION
    This routine assigns the given directive value to the given directive
    key in the qprep state table.  This routine also performs a simple
    check to verify that the table already has an entry for the given
    key, to make sure that the key is valid.  If the state table does
    not already have the key then this routine prints a warning message
    but makes the assignment anyway.

    qprepDirectiveParse calls this routine before any translations.


  RETURN VALUE
    This routine always returns 0.


  SEE ALSO
    qprepStateInitialize(in 'qprep.pm'),
    qprepDirectiveParse(in 'qprep.pm')


  NOTES
    To clarify:  this routine modifies an entry in state_table only.
    This routine does not modify the contents of directive_key nor
    directive_value, nor could it since those arguments are scalars,
    not references to scalars.



=cut

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my($state_table_ref,
     $message_table_ref,
     $directive_key,
     $directive_value) = @ARG;

  if ( $state_table_ref->{operation_verbosity} >= 2 )
  {
    print STDERR "qprepDirectiveAssign: ",
           "$state_table_ref $message_table_ref ",
           "$directive_key $directive_value\n" ;
  }

  if( ! exists $state_table_ref->{$directive_key} )
  {
    printf(STDERR
      $message_table_ref->{ERR_NO_SUCH_DIRECTIVE_KEY}{MSG_TEXT},
      $directive_key);
    printf(STDERR
      "qprepDirectiveAssign: WARNING: continuing anyway.\n");
  }

  $state_table_ref->{$directive_key} = $directive_value;

  return 0;
}




sub qprepTranslationTableApply
{
=pod
  NAME
    qprepTranslationTableApply: apply table-based translation to qprep directive

  USAGE
   $status_code = qprepTranslationTableApply(\%state_table,
                                             \%message_table,
                                             \%translation_table,
                                              $directive_key_ref,
UNDER CONSTRUCTION                            $directive_value_ref,
                                              $output_stream);

  ARGUMENTS
   \%state_table (in/out): reference to hash table of qprep properties

   \%message_table (in): nested hash table of error messages and codes.
     (See qprepMessageTableInitialize(3))

   \%translation_table (in): table of directive translation rules

   $directive_key_ref (in): reference to string containing input directive key

   $directive_value_ref (in): reference to string containing input directive key

   $output_stream (in/out): file handle to output script


  DESCRIPTION
    This routine applies the appropriate translation to the given
    directive key and value.

    Note that directive_key_ref and directive_value_ref should refer to
    values already processed by qprepPreTranslationCallback.


  RETURN VALUE
    This routine returns zero if no errors are detected.

    This routine reports an error message and returns non-zero if
    translation_table has no entry for the given directive_key.
    The most likely cause of that condition is that
    qprepPreTranslationCallback alters directive_key to a value that
    does not exist in translation_table.  The solution to that problem
    is for qprepInitCallback to add an entry in translation_table for
    the directive key.

    Another possible cause for an error condition is that the value in
    the translation_table entry contains an entry which has an invalid
    target (i.e. a target other than 'KEY', 'VALUE' or 'BOTH').  The
    solution is to fix the entry.


  SEE ALSO
    qprepTranslationTableInitialize(in 'qprep.pm'),
    qprepPreTranslationCallback(in 'localQprep.pm')


=cut
  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my($state_table_ref,
     $message_table_ref,
     $translation_table_ref,
     $directive_key_ref,
     $directive_value_ref,
     $output_stream)         = @ARG;

  # Declare local variables
  my($target_key)    = $$directive_key_ref;   # translated directive key
  my($target_value)  = $$directive_value_ref; # translated directive value
  my($sub_target) ;                           # target of substitution rule
  my($sub_pattern);                           # substitution regular expression
  my($substitution_array_ref);                # array of substitution patterns

  if ( $state_table_ref->{operation_verbosity} >= 2 )
  {
    print STDERR "qprepTranslationTableApply: ",
     "$state_table_ref $message_table_ref $translation_table_ref ",
     "$$directive_key_ref $$directive_value_ref $output_stream\n";
  }

  if( ! exists $translation_table_ref->{$$directive_key_ref} )
  {
    printf(STDERR
      $message_table_ref->{ERR_NO_SUCH_DIRECTIVE_KEY}{MSG_TEXT},
      $$directive_key_ref);
    printf(STDERR
      "qprepTranslationTableApply: WARNING: continuing anyway.\n");
  }

  # Assign array of substitutions for typographical convenience.

  my($dir_key);
  foreach $dir_key ('ALL', $$directive_key_ref)
  {
    if( exists $translation_table_ref->{$dir_key} )
    {
      # Assign subst array to scalar ref var for typographical convenience,
      # and because Perl can not use scalar(@...) on RHS of next line.
      $substitution_array_ref = $translation_table_ref->{$dir_key};

      # Iterate through all substitutions in translation table for this key.
      for(my($isub)=0; $isub < scalar(@$substitution_array_ref); $isub += 2)
      {
        # ith element has target of pattern (KEY, VALUE or BOTH).
        $sub_target  = $substitution_array_ref->[$isub  ];

        # ith+1 element has regex pattern.
        $sub_pattern = $substitution_array_ref->[$isub+1];

        # Apply the regex to the appropriate string.
        # "eval" might not be the best way to do this,
        # so if you know a better way, let me (MJG) know,
        # or just change this code.
        if( $sub_target eq "KEY" )
        {
          eval "\$target_key =~ $sub_pattern";
        }
        elsif ( $sub_target eq "VALUE" )
        {
          eval  "\$target_value =~ $sub_pattern"  ;
        }
        elsif ( $sub_target eq "BOTH" )
        {
          eval "\$target_key   =~ $sub_pattern" ;
          eval "\$target_value =~ $sub_pattern" ;
        }
        else
        {
          printf STDERR "qprepTranslationTableApply: PANIC: No such target.\n";
          return 9999;
        }
      }
    }
    else
    {
      # This should never execute,
      # since an earlier if-block checked for this condition.
      # It could happen, though, if a Callback removed the
      # translation_table entry for 'ALL'.
      print STDERR
        "qprepTranslationTableApply: WARNING: no translation table entry for '",
        $dir_key,
        "'.\n",
        "  Report this to your system administrator,\n",
        "  or send a bug report to 'http://pstoolkit.org'.\n";
    }
  }

  if ( $state_table_ref->{operation_verbosity} >= 3 )
  {
    print STDERR "qprepTranslationTableApply: tgt_key='$target_key'\n";
    print STDERR "qprepTranslationTableApply: tgt_val='$target_value'\n";
  }

  if($output_stream eq "no_output_yet")
  {
    # Apparently this is a command-line argument.
    return 0;
  }

  # If verbose_script is capital Y (very verbose)...
  if( $state_table_ref->{verbose_script} eq "Y" )
  {
    # Write the pre-translated directive to output stream, as a comment,
    # to aid the user in understanding how the original input produces
    # the translated output.
    #
    # NOTE
    #  The value of $state_table_ref->{source_key_value_separator}
    #  should be a literal '='.  If that is not the case then
    #  the code inside qprepDirectiveCheck.
    print $output_stream
      "$state_table_ref->{target_comment_prefix} (post-pre-translate): ",
      "$state_table_ref->{source_directive_prefix}",
      "$$directive_key_ref ",
      "$state_table_ref->{source_key_value_separator}",
      "$$directive_value_ref ",
      "$state_table_ref->{target_comment_suffix}\n";
  }

  # Assign the target values back into the subroutine arguments.
  $$directive_key_ref   = $target_key   ;
  $$directive_value_ref = $target_value ;

  # Return status code meaning "no errors detected".
  return 0;
}




sub qprepDirectiveWrite
{
=pod
  NAME
    qprepDirectiveWrite: write qprep directive

  USAGE
   $status_code = qprepDirectiveWrite(\%state_table,
                                      \%message_table,
                                      \%translation_table,
                                       $directive_key,
                                       $directive_value,
                                       $output_stream);

  ARGUMENTS
   \%state_table (in/out): reference to hash table of qprep properties

   \%message_table (in): nested hash table of error messages and codes.
     (See qprepMessageTableInitialize(3))

   \%translation_table (in): table of directive translation rules

   $directive_key (in): string containing input directive key

   $directive_value (in): string containing input directive key

   $output_stream (in/out): file handle to output script


  DESCRIPTION
    This routine writes a directive to the output stream.


  RETURN VALUE
    This routine returns zero if no errors are detected.


  SEE ALSO
    qprepPostTranslationCallback(in 'localQprep.pm')


=cut
  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my($state_table_ref,
     $message_table_ref,
     $translation_table_ref,
     $directive_key,
     $directive_value,
     $output_stream)         = @ARG;

  # Declare local variables

  if ( $state_table_ref->{operation_verbosity} >= 2 )
  {
    print STDERR "qprepDirectiveWrite: ",
     "$state_table_ref $message_table_ref $translation_table_ref ",
     "$directive_key $directive_value $output_stream\n";
  }

  if($output_stream eq "no_output_yet")
  {
    # Apparently this directive came from a command-line argument,
    # so do not yet write it to output.
    return 0;
  }

  if(( $directive_key ne "" ) || ( $directive_value ne "" ))
  {
    # Write prefix (e.g. pseudo-comment) of directive
    print $output_stream "$state_table_ref->{target_directive_prefix}";

    # Write rest of directive
    if( $directive_key eq "" )
    {
      # Target key is empty so skip that and separator
      print $output_stream "$directive_value\n" ;
    }
    else
    {
      # Write directive as "key separator value"
      print $output_stream
        "$directive_key",
        "$state_table_ref->{target_key_value_separator}",
        "$directive_value\n" ;
    }
  }

  # Return status code meaning "no errors detected".
  return 0;
}




sub qprepDirectiveParse
{

=pod
  NAME
    qprepDirectiveParse: parse and evaluate qprep directive


  USAGE
    $status_code = qprepDirectiveParse(\%state_table,
                                       \%message_table,
                                       \%directives_table,
                                       \%translation_table,
                                        $string_to_parse,
                                        $output_stream)

  ARGUMENTS
   \%state_table (in/out): reference to hash table of qprep properties

   \%message_table (in): nested hash table of error messages and codes.
     (See qprepMessageTableInitialize(3))

   \%directives_table (in): table of valid directives

   \%translation_table (in): table of directive translation rules

   $string_to_parse (in): string containing candidate directive

   $output_stream (in/out): file handle to output script


  DESCRIPTION
    This routine attempts to parse a string as a directive in the form
    "key=value", then evaluates that directive:

      () The parser verifies the syntax of the directive, and also
         verifies that the value is in the valid range for the associated
         key, by looking up the set of possible values indicated in
         directives_table.

      () If the value is acceptable then it is assigned to the
         corresponding key entry in the state_table, via
         qprepDirectiveAssign().

      () Then the qprepPreTranslationCallback is called, which can modify
         the directive key and value, and write to $output_stream.

      () Then qprepTranslationTableApply is called to perform table-based
         translation on the directive key and value, and to write the
         result to the $output_stream.


  RETURN VALUES
    Returns error code from message_table if this routine or one of
    its subordinates detects an error.  Possible errors include a
    syntax error of the string_to_parse, a bad directive value for the
    associated directive key, or a failure within the machine-specific
    qprepPreTranslationCallback subroutine.

    Returns zero if no errors detected.


  SEE ALSO
    qprepDirectiveCheck(in 'qprep.pm'),
    qprepDirectiveAssign(in 'qprep.pm'),
    qprepPreTranslationCallback(in 'localQprep.pm'),
    qprepTranslationTableApply(in 'qprep.pm').


  AUTHOR
    Written by Michael J. Gourlay
    in collaboration with Joe Werne, Chris Bizon and others.


=cut

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my($state_table_ref,
     $message_table_ref,
     $directives_table_ref,
     $translation_table_ref,
     $string_to_parse,
     $output_stream
    ) = @ARG;

  # Verbose reporting
  if ( $state_table_ref->{operation_verbosity} >= 2 )
  {
    print STDERR "qprepDirectiveParse: ",
           "$state_table_ref $message_table_ref $directives_table_ref ",
           "$translation_table_ref $string_to_parse $output_stream\n" ;
  }

  # Declare local variables
  my($directive_key);
  my($directive_value);

  # Verify directive syntax and preliminary semantics
  my($status_code) = qprepDirectiveCheck( $state_table_ref,
                                          $message_table_ref,
                                          $directives_table_ref,
                                          $string_to_parse,
                                         \$directive_key,
                                         \$directive_value);

  if($status_code != 0)
  {
    if ( $state_table_ref->{operation_verbosity} >= 1 )
    {
     print STDERR  "qprepDirectiveParse: ERROR: qprepDirectiveCheck failed.\n";
    }
    return $status_code;
  }

  # Assign directive value to directive key within qprep state table
  qprepDirectiveAssign($state_table_ref,
                       $message_table_ref,
                       $directive_key,
                       $directive_value);

  # If verbose_script is on (note test for not "n" instead of for "y".
  # verbose_script can be "y" (verbose), "Y" (very verbose) or "n" (quiet).
  # In this case we accept either "y" or "Y".
  if(($state_table_ref->{verbose_script} ne "n")
     && ($output_stream ne "no_output_yet") )
  {
    # Write the original directive to the output stream, as a comment,
    # to aid the user in understanding how the original input produces
    # the translated output.
    chomp($string_to_parse);  # Remove training newline for cleaner output

    print $output_stream
      "$state_table_ref->{target_comment_prefix} (original): ",
      "$state_table_ref->{source_directive_prefix}",
      "$string_to_parse ",
      "$state_table_ref->{target_comment_suffix}\n";
  }

  # Call machine-specific callback
  if(($status_code = TUSC::localQprep::qprepPreTranslationCallback(
                       $state_table_ref,
                       $directives_table_ref,
                      \$directive_key,
                      \$directive_value,
                       $output_stream)) != 0)
  {
    return $status_code;
  }

  # Perform table-based translation
  $status_code = qprepTranslationTableApply($state_table_ref,
                                            $message_table_ref,
                                            $translation_table_ref,
                                           \$directive_key,
                                           \$directive_value,
                                            $output_stream);

  # Call machine-specific post-translation callback
  if(defined &TUSC::localQprep::qprepPostTranslationCallback)
  {
    if(($status_code = TUSC::localQprep::qprepPostTranslationCallback(
                         $state_table_ref,
                         $directives_table_ref,
                        \$directive_key,
                        \$directive_value,
                         $output_stream)) != 0)
    {
      return $status_code;
    }
  }
  elsif ( $state_table_ref->{operation_verbosity} >= 2 )
  {
    print STDERR "qprepDirectiveParse: COMMENT: no post-translation callback\n";
  }

  # Write translated line
  $status_code = qprepDirectiveWrite($state_table_ref,
                                     $message_table_ref,
                                     $translation_table_ref,
                                     $directive_key,
                                     $directive_value,
                                     $output_stream);

  # Return status code value
  return $status_code;
}




sub qprepCommandLineDirectivesParse
{

=pod

  NAME
    qprepCommandLineDirectivesParse: parse and evaluate command-line directives


  USAGE
    $status_code = qprepCommandLineDirectivesParse(\%state_table,
                                                   \%message_table,
                                                   \%directives_table,
                                                   \%translation_table,
                                                   \@cmd_line_directives_array,
                                                    $output_stream) ;


  ARGUMENTS
   \%state_table (in/out): reference to hash table of qprep options

   \%message_table (in): nested hash table of error messages and codes.
                         (See qprepMessageTableInitialize(3))

   \%directives_table (in): table of valid directives

   \%translation_table (in): table of directive translation rules

   \@cmd_line_directives_array (in): array of directive strings

   $output_stream (in/out): file handle to output script


  DESCRIPTION
    This routine parses directives previously extracted from the
    qprep command-line arguments.

    This routine evaluates those qprep control directives,
    and calls qprepPreTranslationCallback.


  RETURN VALUES
    Returns 0 if no errors occurred.
    Returns non-zero if error occurred.


  AUTHORS
    Written by Michael J. Gourlay
    in collaboration with Joe Werne, Chris Bizon and others.


  SEE ALSO
    qprep(1),
    Practical Supercomputing Toolkit web site: http://pstoolkit.org


=cut

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my($state_table_ref,
     $message_table_ref,
     $directives_table_ref,
     $translation_table_ref,
     $cmd_line_directives_array_ref,
     $output_stream
    ) = @ARG;

  # Verbose reporting
  if ( $state_table_ref->{operation_verbosity} >= 2 )
  {
    print STDERR "qprepCommandLineDirectivesParse: ",
           "$state_table_ref ",
           "$message_table_ref ",
           "$directives_table_ref ",
           "$translation_table_ref ",
           "$cmd_line_directives_array_ref ",
           "$output_stream\n" ;
  }

  # Assign number of command-line directives to $cmd_line_dir_count
  my($cmd_line_dir_count) = scalar(@$cmd_line_directives_array_ref);

  # Iterate through each element in the command-line directive array
  for(my($iarg)=0; $iarg < $cmd_line_dir_count; $iarg++)
  {
    $cmd_line_directives_array_ref->[$iarg];

    # Parse and evaluate directive
    my($status_code) = qprepDirectiveParse($state_table_ref,
                                           $message_table_ref,
                                           $directives_table_ref,
                                           $translation_table_ref,
                                       $cmd_line_directives_array_ref->[$iarg],
                                           $output_stream);

    if($status_code != 0)
    {
      return $status_code;
    }
  }

  # Return status code value for "no errors detected".
  return 0;
}




sub qprepCommandLineParse
{

=pod

  NAME
    qprepCommandLineParse: parse command-line arguments of qprep


  USAGE
    $status_code = qprepCommandLineParse(\%state_table,
                                         \%message_table,
                                         \%directives_table,
                                         \%translation_table,
                                          $cmd_line_opts_array_ref,
                                         \@cmd_line_directives) ;


  ARGUMENTS
   \%state_table (in/out): reference to hash table of qprep options

   \%message_table (in): nested hash table of error messages and codes.
                         (See qprepMessageTableInitialize(3))

   \%directives_table (in): table of valid directives

   \%translation_table (in): table of directive translation rules

    $cmd_line_opts_array_ref (in): ref to array of command line args

   \@cmd_line_directives (out): array of directive strings parsed from cmdline


  DESCRIPTION
    This routine parses the command-line arguments of "qprep".

    See the qprep(1) man page for valid syntax of command line.

    This routine extracts from the command line an array of directives,
    which are strings with the format "key=value", and the name of an
    input script file.

    This routine also evaluates parser control directives since they
    could affect how qprep performs subsequent procedures.  Evaluation of
    other directives is not performed here; they simply get stored in
    the cmd_line_directives array.


  RETURN VALUES
    Returns 0 if no errors occurred.
    Returns non-zero if error occurred.


  AUTHORS
    Written by Michael J. Gourlay
    in collaboration with Joe Werne, Chris Bizon and others.


  SEE ALSO
    qprep(1), qprepCommandLineDirectivesParse(3),
    Practical Supercomputing Toolkit web site: http://pstoolkit.org


=cut

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my($state_table_ref,
     $message_table_ref,
     $directives_table_ref,
     $translation_table_ref,
     $cmd_line_args_array_ref,
     $cmd_line_directives_array_ref
    ) = @ARG;

  # Verbose reporting
  if ( $state_table_ref->{operation_verbosity} >= 2 )
  {
    print STDERR "qprepCommandLineParse: ",
           "$state_table_ref ",
           "$message_table_ref ",
           "$directives_table_ref ",
           "$translation_table_ref ",
           "$cmd_line_args_array_ref ",
           "$cmd_line_directives_array_ref\n" ;
  }

  # Assign number of command-line args to $cmd_line_arg_count
  my($cmd_line_arg_count) = scalar(@$cmd_line_args_array_ref);

  if( $cmd_line_arg_count < 1 )
  {
    # Too few command-line arguments were present,
    # so report error and exit this routine with an error code.
    printf(STDERR
      $message_table_ref->{ERR_TOO_FEW_CMD_LINE_ARGS}->{MSG_TEXT},
      $cmd_line_arg_count) ;
    return $message_table_ref->{ERR_TOO_FEW_CMD_LINE_ARGS}->{ERR_CODE} ;
  }

  # Iterate through each command-line argument...
  for(my($iarg)=0; $iarg < $cmd_line_arg_count - 1; $iarg++)
  {
    $cmd_line_directives_array_ref->[$iarg]
        = $cmd_line_args_array_ref->[$iarg] ;
  }

  $state_table_ref->{in_script}
    = $cmd_line_args_array_ref->[$cmd_line_arg_count-1];

  if ( $state_table_ref->{operation_verbosity} >= 3 )
  {
    print STDERR "qprepCommandLineParse: ",
          "input script name '$state_table_ref->{in_script}'\n" ;
  }

  # Parse and evaluate command-line directives.
  # At this stage, only evaluate parser controls directives.
  my($status_code) = qprepCommandLineDirectivesParse(
                       $state_table_ref,
                       $message_table_ref,
                       $directives_table_ref,
                       $translation_table_ref,
                       $cmd_line_directives_array_ref,
                       "no_output_yet") ;

  # Return code value for "no errors detected".
  return $status_code;
}




sub qprepSetOutputScriptFileName
{
=pod
  NAME
    qprepSetOutputScriptFileName: set name of output script file


  USAGE
    qprepSetOutputScriptFileName(\%state_table, \%message_table);


  ARGUMENTS
    state_table_ref (in/out): reference to qprep state hash table.
      Entries used:
        incoming value of 'in_script'
        'out_script' set in this routine

    message_table_ref (in): reference to message hash table.
      (Used for reporting errors, warnings and other messages.)
      (See qprepMessageTableInitialize(3))


  DESCRIPTION
    This routine sets the name of the output script.

    If the output script filename is set from a command-line directive
    then use that name.

    If the output script filename is not already set (e.g., from a
    command-line directive), then concatenate ".pst" to the end of the
    input script filename.

=cut

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my($state_table_ref, $message_table_ref) = @ARG;

  # Verbose reporting
  if ( $state_table_ref->{operation_verbosity} >= 2 )
  {
    print STDERR "qprepSetOutputScriptFileName: ",
          "$state_table_ref $message_table_ref\n";
  }

  # If the output script filename is not already set
  # (e.g., from a command-line directive), then...
  if( length($state_table_ref->{out_script}) == 0 )
  {
    # Concatenate ".pst" to the end of the input script filename.
    $state_table_ref->{out_script} = $state_table_ref->{in_script} . ".pst";
  }

  if ( $state_table_ref->{operation_verbosity} >= 1 )
  {
    print STDERR "qprepSetOutputScriptFileName: ",
          "output script name '$state_table_ref->{out_script}'\n" ;
  }

}




sub qprepInputScriptFileParse
{

=pod

  NAME
    qprepInputScriptFileParse: parse script file preamble


  USAGE
    $status_code = qprepInputScriptFileParse(\%state_table,
                                             \%message_table,
                                             \%directives_table,
                                              $input_stream,
                                              $output_stream) ;


  ARGUMENTS
   \%state_table (in/out): reference to hash table of qprep options

   \%message_table (in): nested hash table of error messages and codes.
      (See qprepMessageTableInitialize(3))

   \%directives_table (in): table of valid directives

   $input_stream (in): file handle for input script

   $output_stream (in): file handle for output script



  DESCRIPTION
    This routine parses directives in the preamble of a qprep script.

    See the qprep(1) man page for valid syntax directives.

    This routine extracts directives from the script preamble,
    which are pseudo-comments of the form
      #PSTQ key=value .

    This routine evaluates those qprep control directives,
    and calls qprepPreTranslationCallback.


  RETURN VALUES
    Returns 0 if no errors occurred.
    Returns non-zero if error occurred.


  AUTHORS
    Written by Michael J. Gourlay
    in collaboration with Joe Werne, Chris Bizon and others.


  SEE ALSO
    qprep(1),
    Practical Supercomputing Toolkit web site: http://pstoolkit.org


=cut

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my($state_table_ref,
     $message_table_ref,
     $directives_table_ref,
     $translation_table_ref,
     $input_stream,
     $output_stream
    ) = @ARG;

  # Verbose reporting
  if ( $state_table_ref->{operation_verbosity} >= 2 )
  {
    print STDERR "qprepInputScriptFileParse: ",
           "$state_table_ref ",
           "$message_table_ref ",
           "$directives_table_ref ",
           "$translation_table_ref ",
           "$input_stream ",
           "$output_stream\n" ;
  }

  # Declare local scope for these variables
  my($input_line);             # text line input from script
  my($input_directive);        # input line minus pseudo-comment prefix
  my($status_code);            # error status of subordinate routine
  my($cummulative_errors) = 0; # number of errors this routine detected

  # Read input script file one line at a time.
  #
  # The while condition statement reads a line from the filehandle
  # refered to by the scalar variable $input_stream,
  # and assigns that line to the Perl variable "$_", a.k.a. $ARG.
  # The statement returns 'true' until an attempt to read past end-of-file.
  #
  # NOTE that if you put any spaces inside the angle brackets,
  # the semantics of that operator change drastically:
  # The operator becomes the "filename globbing operator",
  # which is not what we want here.

  while ( <$input_stream> )
  {
    # Copy input line from "$_" to "$input_line", for readability.
    $input_line=$_;

    #
    # Is this line a directive?
    #

    if( $input_line =~ m/^$state_table_ref->{source_directive_prefix}/ )
    {
      # Input line looks like a directive.

      # Remove "#PSTQ " prefix from input line.
      ( $input_directive = $input_line ) =~
        s/^$state_table_ref->{source_directive_prefix}// ;

      if( $input_directive =~ m/ *END_OF_PREAMBLE *$/ )
      {
        if(   ($state_table_ref->{verbose_script} ne "n")
           && ($output_stream ne "no_output_yet") )
        {
          # Write original directive to output stream, as a comment,
          # to aid user in understanding how the original input produces
          # translated output.
          chomp($input_directive);  # Remove training newline; cleaner output

          print $output_stream
            "$state_table_ref->{target_comment_prefix} (original): ",
            "$state_table_ref->{source_directive_prefix}",
            "$input_directive ",
            "$state_table_ref->{target_comment_suffix}\n";
        }

        # Leave this read loop (i.e. treat the rest as after-preamble).
        last;
      }

      if ( $state_table_ref->{operation_verbosity} >= 3 )
      {
        print STDERR "qprepInputScriptFileParse: directive='$input_directive'";
      }

      # Parse and evaluate directive
      if(($status_code = qprepDirectiveParse($state_table_ref,
                                             $message_table_ref,
                                             $directives_table_ref,
                                             $translation_table_ref,
                                             $input_directive,
                                             $output_stream) ) != 0)
      {
        $cummulative_errors ++ ;
      }

    }
    else
    {
      # Input line is not a PST qprep directive.
      # What to do with this line depends on setting of explicit_preamble.

      if ( $state_table_ref->{explicit_preamble} ne "y" )
      {
	# Preamble ends implicitly at first executable line in script.
	# Check to see if input line is blank or a PST comment.
        if (! (   ( $input_line =~ m/^ *$/ )
               || ( $input_line =~ m/^$state_table_ref->{preamble_comment}/ )))
        {
          # Input is neither blank nor a PST qprep comment.
          # Treat this as the end of preamble.

          # Store input line to output after FinishPreamble callback.

          $state_table_ref->{first_executable_line} = $input_line ;

          # Leave this read loop (i.e. treat the rest as after-preamble).
          last;
        }
      }

      # Simply write the input line unmodified, to output stream.
      print $output_stream $input_line ;
    }
  }

  # Return code value for "no errors detected".
  if($cummulative_errors)
  {
    printf STDERR $message_table_ref->{ERR_PARSING}{MSG_TEXT},
      $cummulative_errors;
    return $message_table_ref->{ERR_PARSING}{ERR_CODE};
  }

  # Return status code meaning "no errors detected".
  return 0;
}




sub writeRestOfInput
{
  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my($state_table_ref, $input_stream, $output_stream) = @ARG;

  if($state_table_ref->{first_executable_line} ne "")
  {
    print $output_stream $state_table_ref->{first_executable_line} ;
  }

  # The while condition statement reads a line from the filehandle
  # refered to by the scalar variable $input_stream,
  # and assigns that line to the Perl variable "$_", a.k.a. $ARG.
  # The statement returns 'true' until an attempt to read past end-of-file.
  #
  # NOTE that if you put any spaces inside the angle brackets,
  # the semantics of that operator change drastically:
  # The operator becomes the "filename globbing operator",
  # which is not what we want here.
  while ( <$input_stream> )
  {
    # Write input line to output stream
    print $output_stream $_ ;
  }
}




sub qprepMain
{

=pod

  NAME
    qprepMain: qprep "main" subroutine


  USAGE
    $status_code = qprepMain(\@ARGV);


  ARGUMENTS
    \@ARGV (in) : array of command-line arguments.


  DESCRIPTION
    This routine performs all of the processing done by qprep.


  AUTHORS
    Written by Michael J. Gourlay
    in collaboration with Joe Werne, Chris Bizon and others.


  SEE ALSO
    qprepStateInitialize(3), qprepMessageTableInitialize(3),
    qprepValidDirectiveTableInitialize(3),
    qprepTranslationTableInitialize(3), qprepCommandLineParse(3),
    qprepSetOutputScriptFileName(3), qprepInitCallback(3),
    qprepInputScriptFileParse(3), qprepCommandLineDirectivesParse(3),
    qprepFinishPreambleCallback(3), qprepFinishScriptCallback(3),

    qprep(1),

    Practical Supercomputing Toolkit web site: http://pstoolkit.org


  NOTES
    Thu Oct 25 22:40:08 MDT 2001: just started

=cut

  # Link to "localQprep.pm"
  use lib PSTDIR;
  use TUSC::localQprep;

  # Unpack subroutine arguments from Perl ARG array (a.k.a. @_).
  my ($cmd_line_opts_array_ref) = @ARG ;

  # Declare local scope for these variables.
  my(%state_table);              # hash table of qprep property settings.
  my(%message_table);            # hash table of text messages and error codes
  my(%directives_table);         # hash table of valid qprep directives.
  my(%translation_table);        # hash table of translation rules
  my(@cmd_line_directives);      # array of directive strings from command line

  # Note use of typeglob "*" in these IO stream variable values.
  # See section 7.17 of Perl Cookbook, 1st ed (1998).
  # If you try to use "OSTREAM" instead of *OSTREAM, then Perl will
  # complain about using a symbol ref while "strict refs" is used.
  my($input_stream)  = *ISTREAM  ; # input script file stream
  my($output_stream) = *OSTREAM  ; # output script file stream

  # Initialize default values for qprep properties.
  qprepStateInitialize(\%state_table) ;

  # Assign table of messages and return code values.
  qprepMessageTableInitialize(\%message_table) ;

  # Assign table of valid directives.
  qprepValidDirectiveTableInitialize(\%directives_table) ;

  # Assign table of translation rules
  qprepTranslationTableInitialize(\%translation_table) ;

  if ( $state_table{operation_verbosity} >= 3 )
  {
    print STDERR "qprepMain: state_table:\n" ;
    hashTablePrint(\%state_table) ;
    print STDERR "qprepMain: message_table:\n" ;
    hashTablePrint(\%message_table) ;
    print STDERR "qprepMain: directives_table:\n" ;
    hashTablePrint(\%directives_table) ;
    print STDERR "qprepMain: translation_table:\n" ;
    hashTablePrint(\%translation_table) ;
  }

  # Parse input directives.
  my($pcl_err_code) = qprepCommandLineParse(\%state_table,
                                            \%message_table,
                                            \%directives_table,
                                            \%translation_table,
                                             $cmd_line_opts_array_ref,
                                            \@cmd_line_directives) ;

  if($pcl_err_code)
  {
    print STDERR "qprep: Exiting due to errors on command line.\n";
    return $pcl_err_code;
  }

  if ( $state_table{operation_verbosity} >= 3 )
  {
    print STDERR "qprepMain: cmd_line_directives:\n" ;
    arrayPrint(\@cmd_line_directives);
  }

  # Open stream to input script file.
  # Use "sysopen";  Perl's "open" has a funny interpretation of filenames.
  unless(sysopen($input_stream , $state_table{in_script}, O_RDONLY))
  {
    printf(STDERR
      $message_table{ERR_FILE_NOT_READABLE}{MSG_TEXT}, $state_table{in_script});
    return $message_table{ERR_FILE_NOT_READABLE}{ERR_CODE} ;
  }

  qprepSetOutputScriptFileName(\%state_table, \%message_table);

  if ( -r $state_table{out_script} )
  {
    printf STDERR
      $message_table{WARN_OUTPUT_SCRIPT_EXISTS}{MSG_TEXT},
      $state_table{out_script};
    unlink $state_table{out_script};
  }

  # Open stream to output script file.
  # Use "sysopen";  Perl's "open" has a funny interpretation of filenames.
  unless(sysopen($output_stream, $state_table{out_script}, O_WRONLY | O_CREAT))
  {
    printf(STDERR
      $message_table{ERR_FILE_NOT_WRITEABLE}{MSG_TEXT},
      $state_table{out_script});
    return $message_table{ERR_FILE_NOT_WRITEABLE}{ERR_CODE} ;
  }

  # Perform externally defined initializations.
  #
  # This includes machine-dependent initializations,
  # which might not require any actions.
  TUSC::localQprep::qprepInitCallback(\%state_table,
                                      \%directives_table,
                                      \%translation_table,
                                       $input_stream,
                                       $output_stream,
                                      \@cmd_line_directives);

  # Parse preamble and command-line directives (in that order).
  if(qprepInputScriptFileParse(\%state_table,
                               \%message_table,
                               \%directives_table,
                               \%translation_table,
                                $input_stream,
                                $output_stream))
  {
    printf "qprep: Exiting due to errors in input script.\n";
    return $message_table{ERR_PARSING}{ERR_CODE};
  }

  qprepCommandLineDirectivesParse(\%state_table,
                                  \%message_table,
                                  \%directives_table,
                                  \%translation_table,
                                  \@cmd_line_directives,
                                   $output_stream);

  TUSC::localQprep::qprepFinishPreambleCallback(\%state_table,
                                                \%directives_table,
                                                $input_stream,
                                                $output_stream);

  # Pass-through the rest of the input script file.
  writeRestOfInput(\%state_table, $input_stream, $output_stream);

  TUSC::localQprep::qprepFinishScriptCallback(\%state_table,
                                              \%directives_table,
                                               $input_stream,
                                               $output_stream);

  close $input_stream ;
  close $output_stream ;

  if($state_table{submit} eq "y")
  {
    # Submit output script.

    if($state_table{operation_verbosity} >= 1)
    {
      print STDERR "qprep: running submit command:\n",
        "$state_table{target_submit_command} ",
          "$state_table{target_cmd_line_arg} $state_table{out_script}\n" ;
    }

    # Construct submit command.
    my(@submit_args) = ("$state_table{target_submit_command} ",
                        "$state_table{target_cmd_line_arg} ",
                        "$state_table{out_script}") ;

    # Verify that submit command returns no errors.
    if(system(@submit_args) != 0)
    {
      # Submit command failed.
      print STDERR
        "qrep: ERROR: submit command failed: ", $CHILD_ERROR / 256, "\n",
        " $state_table{target_submit_command} ",
          "$state_table{target_cmd_line_arg} ",
          "$state_table{out_script}\n" ;
    }
    elsif($state_table{erase} eq "y")
    {
      # Submit command did not fail,
      # and user requested to erase output script,
      # so erase it.

      if($state_table{operation_verbosity} >= 1)
      {
        print STDERR
          "qprep: erasing output script '$state_table{out_script}'\n" ;
      }

      unlink $state_table{out_script};
    }
  }

  # Return code value for "no errors detected".
  return 0 ;
}





# [What does this "1" do and mean? I suspect it simply evaluates to "1",
#  so that this module can execute and return a value,
#  but for what purpose?  Document this.  --MJG]

1;

# [I think __END__ tells Perl to stop processing everything below that line.
# --MJG]

__END__
