#!/usr/bin/perl
#
# NAME
#   localQprep.pm: Perl module defining site-specific qprep callback routines
#
#
# DESCRIPTION
#   This file is part of the Practical Supercomputing Toolkit,
#   http://pstoolkit.org.
#
#   This file contains callback subroutines for use with "qprep(1)",
#   a queue preparation utility that translates from "PSTQ" directives
#   to a form that the local queue system uses.
#
#   To port qprep to your site, modify the contents of each routine in
#   this file.



package TUSC::localQprep;    #Define TUSC/localQprep Perl module

use Exporter;
@ISA = "Exporter";
@EXPORT = qw(qprepInitCallback,
             qprepPreTranslationCallback,
             qprepPostTranslationCallback,
             qprepFinishScriptCallback,
             qprepFinishPreambleCallback
             );

$VERSION = "1.00";

use English;     # Provide symbols for improved Perl readability.
use strict;      # Enhance Perl strictness, for aid in development.
use FileHandle ; # Use sysopen to open the script file


####use warnings;




sub qprepInitCallback
{
=pod

  NAME
    qprepInitCallback: initialization callback for qprep


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

   \%directives_table (in/out): table of valid directives
     See qprepValidDirectiveTableInitialize.

   \%translation_table (in/out): hash table translation rules.
     See qprepTranslationTableInitialize.

   $input_stream (in): file handle for input script

   $output_stream (in): file handle for output script

   \@cmd_line_directives_array (in): array of directive strings
     See qprepCommandLineDirectivesParse.


  DESCRIPTION
    qprep calls this routine after performing generic initialization
    of the hash tables and reading and evaluating the command-line,
    and after opening the input script for reading, but before reading
    or evaluating input from the input script.  This routine specifies
    many of the parameter values specific to the site, by setting values
    in the hash tables.

    The primary utility of this routine is in establishing translation
    rules via the translation table and in special entries in the
    state table.

    State table entries related to translation:

      target_comment_prefix: string denoting start of comment in the
        language used for scripts that go to the local queue system.
        That language is usually  ashell, like sh or csh, so this value is
        "#" (the hash character) by default, and this routine probably
        does not need to change its value.

      target_comment_suffix: string denoting end of comment in the
        language used for scripts that go to the local queue system.
        That language is usually  ashell, like sh or csh, so this value
        is "" (the empty string) by default, and this routine probably
        does not need to change its value.

      target_directive_prefix: string that precedes directives
        in scripts going to local queue system.
        For example, in PBS, this is usually "#PBS -",
	and in LSF this is "#BSUB -".

      target_key_value_separator: string that separates directive keys
        and values scripts going to in local queue system.

      target_submit_command: command to use to submit script.
        For example, in PBS this is "qsub", and in LSF this is "bsub".

    This routine can set default values for any qprep directives.
    See qprep(1) for details about qprep directives.

    This routine is obliged either not to read from the input stream,
    or to return the input stream back to the original location (i.e.,
    the beginning of the file).  Theoretically, the input stream could
    be non-seekable, in which case this routine is strongly obliged not
    to read from the input stream.  Remember: Just because you can does
    not mean you should.


  SEE ALSO
    qprep(1),

    In "qprep.pm": (in "PST/TUSC")
      qprepMain(3), qprepStateInitialize(3),
      qprepMessageTableInitialize(3),
      qprepValidDirectiveTableInitialize(3),
      qprepTranslationTableInitialize(3), qprepCommandLineParse(3),
      qprepSetOutputScriptFileName(3), qprepInputScriptFileParse(3),
      qprepCommandLineDirectivesParse(3),

    In this file:
       qprepFinishPreambleCallback(3), qprepFinishScriptCallback(3),



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

  if ( $state_table_ref->{operation_verbosity} >= 2 )
  {
    print STDERR  "qprepInitCallback: ",
          "$state_table_ref $directives_table_ref ",
          "$translation_table_ref $input_stream ",
          "$output_stream $cmd_line_directives_array_ref\n";
  }

  #####
  ##### Assign state table entries for default values
  #####
  ###################################################
  ###################################################

  $state_table_ref->{hi}                  = "n" ;

  # target_num_cpus_key: key in target system for number of cpus.
  $state_table_ref->{target_num_cpus_key} = "num_cpus";
  $state_table_ref->{num_cpus}            = "unset";

  #### Properties associated with writing output:

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

  # Limit directives.
  #
  # Set nodes, cpus_per_node to nonsense values because we have to
  # deal with them in a special way.  We want to know when one or both
  # has been explicitly set.
  # See qprepPreTranslationCallback.
  $state_table_ref->{nodes}              = "unset";
  $state_table_ref->{cpus_per_node}      = "unset";

  #####
  ##### Assign translation table entries
  #####
  ###################################################
  ###################################################

  # Most of these are empty in this example "local.pm" file
  # because the default is to translate them to nothing.
  # An empty translation leaves them alone.

  # Dummy entry
  $translation_table_ref->{hi} =
  [
    ( 'KEY'   , 's/hi/hello/'     ),
    ( 'VALUE' , 's/ya/there/'     ),
    ( 'BOTH'  , 's/peeps/people/' ),
  ] ;

  $translation_table_ref->{ALL} =
  [
    ( 'BOTH'  , 's/^ *//' ),        # remove leading spaces
#   ( 'BOTH'  , 's/ *$//' ),        # remove trailing spaces
  ] ;

  # Qprep control directives
  $translation_table_ref->{erase}               = [] ;
  $translation_table_ref->{in_script}           = [] ;
  $translation_table_ref->{out_script}          = [] ;
  $translation_table_ref->{silent}              = [] ;
  $translation_table_ref->{submit}              = [] ;
  $translation_table_ref->{operation_verbosity} = [] ;
  $translation_table_ref->{verbose_script}      = [] ;

  # Qprep output
  $translation_table_ref->{target_comment_prefix}      = [] ;
  $translation_table_ref->{target_comment_suffix}      = [] ;
  $translation_table_ref->{target_directive_prefix}    = [] ;
  $translation_table_ref->{target_key_value_separator} = [] ;

  # Job environment directives
  $translation_table_ref->{account}             = [] ;
  $translation_table_ref->{username}            = [] ;
  $translation_table_ref->{export_vars}         = [] ;
  $translation_table_ref->{shell}               = [] ;

  # Reporting directives
  $translation_table_ref->{stderr}              = [] ;
  $translation_table_ref->{stdout}              = [] ;
  $translation_table_ref->{keep}                = [] ;
  $translation_table_ref->{mail}                = [] ;
  $translation_table_ref->{mail_to}             = [] ;

  # Job control directives
  $translation_table_ref->{queue}               = [] ;
  $translation_table_ref->{job_name}            = [] ;

  # The following shows how to translate a number to
  # 'c=number', which is useful for PBS.
  # Note the single-quotes around the substitution pattern.
  $translation_table_ref->{checkpoint}          =
    [ ('KEY',   's/checkpoint/-c/'), ('VALUE', 's/[0-9]*/c=$&/') ];

  # This entry must exist even though it does nothing,
  # since this implementation uses the fake directive 'num_cpus',
  # and qprep will apply a translation to all directives
  # passed back from qprepPreTranslationCallback.
  $translation_table_ref->{num_cpus}            = [] ;

  # Limit directives
  #
  # For node, cpus_per_node we remove the original directive from
  # the input script since they need special treatment.
  # See qprepPreTranslationCallback.
  $translation_table_ref->{nodes}               =
  [
    ( 'BOTH'  , 's/.*//' ),        # remove entire directive
  ] ;
  $translation_table_ref->{cpus_per_node}       =
  [
    ( 'BOTH'  , 's/.*//' ),        # remove entire directive
  ] ;
  $translation_table_ref->{wall_time}           = [] ;
  $translation_table_ref->{process_cpu_time}    = [] ;
  $translation_table_ref->{total_cpu_time}      = [] ;
  $translation_table_ref->{proc_file_size}      = [] ;
  $translation_table_ref->{total_file_size}     = [] ;
  $translation_table_ref->{tapemta}             = [] ;
  $translation_table_ref->{tapemtb}             = [] ;
  $translation_table_ref->{tapemtc}             = [] ;
  $translation_table_ref->{tapemtd}             = [] ;
  $translation_table_ref->{tapemte}             = [] ;
  $translation_table_ref->{tapemtf}             = [] ;
  $translation_table_ref->{tapemtg}             = [] ;
  $translation_table_ref->{tapemth}             = [] ;
  $translation_table_ref->{nice}                = [] ;
  $translation_table_ref->{process_memory}      = [] ;
  $translation_table_ref->{total_memory}        = [] ;

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


  #####
  ##### Augment table of valid directives
  #####
  ###################################################
  ###################################################

  $directives_table_ref->{hi}                 = ['.*'] ;

  # This directive is "private" in the sense that scripts
  # should not contain this directive.  We use this to
  # handle the fact that this system lacks the notion of
  # nodes versus cpus_per_node.
  $directives_table_ref->{num_cpus}            = ['^ *[0-9]* *$'] ;

  return ;
}




sub qprepPreTranslationCallback
{
=pod

  NAME
    qprepPreTranslationCallback: directive pre-translation callback for qprep


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

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

   $directive_key_ref (in/out): reference to directive key scalar

   $directive_value_ref (in/out): reference to directive key scalar

   $output_stream (in): file handle for output script


  DESCRIPTION
    qprep calls this routine after reading an input directive,
    but before applying the translation table.

    The primary utility of this routine is to record or alter state
    information and write directives in the local queue system language
    which would be too complicated or impossible to handle with the
    translation table.

    For example, some systems distinguish between "nodes" and "cpus",
    and to reflect this, qprep has directives to set each of these.
    Many systems, however, do not make this distinction, so you simply
    want to set the number of CPUs for the job to use.  A simple
    translation will not, in general, work, since the idea behind qprep
    is to allow users to write one script that works on all systems,
    hence the user often must specify "nodes" and "cpus_per_node",
    even on systems where those do not directly apply.  The solution is
    to write code in this routine to handle that situation:

    () qprepInitCallback would initialize state_table entries for "nodes"
       and "cpus_per_node" to special nonsense values to indicate to
       this routine that those values have not yet been set.

    () This routine would check to see whether directive_key_ref is either
       "nodes" or "cpus_per_node".

       [] If not, this routine ignores the input and returns.

       [] If so, this routine checks to see whether both values are unset.

          {} If not, this routine returns.

          {} If so then this routine alters the contents of
             directive_key_ref to the directive key that the local
             queue system uses to indicate the number of CPUs, sets
             directive_value_ref to that value, stores the value in
             the state table (which should be the product of node and
             cpus_per_node), and returns.

    () The qprepFinishPreambleCallback must also check to see whether
       this routine performed that last step.  If not then
       qprepFinishPreambleCallback must write the appropriate directive.

    This returned directive information will pass through table-based
    translation, and therefore the directives_table and translation_table
    must have an entry for the target directive key, and the associate
    directive table acceptance pattern must allow this value, or the qprep
    directive checker will reject the directive, report an error, and die.

    This routine can also handle other similar situations, such as
    in PBS, where multiple resources are set with a single directive.
    The solution there is similar to the one described above.


  SEE ALSO
    In this file:
       qprepInitCallback(), qprepFinishPreambleCallback(),
       qprepFinishScriptCallback().



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

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

  # This implements the example situation described in the header
  # comments: Qprep requires that you specify nodes and cpus_per_node
  # but the target system only cares/knows about number of CPUs.
  if(   ($$directive_key_ref eq "nodes")
     || ($$directive_key_ref eq "cpus_per_node") )
  {
    if ( $state_table_ref->{operation_verbosity} >= 3 )
    {
      print STDERR
        "qPTC: nodes   = $state_table_ref->{nodes} , ",
        "cpus_per_node = $state_table_ref->{cpus_per_node}\n";
    }
    if(   ($state_table_ref->{cpus_per_node} ne "unset")
       && ($state_table_ref->{nodes} ne "unset") )
    {
      # Both {nodes,cpus_per_node} parameters have been explicitly set.
      # Time to tell qprep to write some output.

      # Add entry in state table for number of cpus.
      $state_table_ref->{num_cpus} =
        $state_table_ref->{nodes} *
        $state_table_ref->{cpus_per_node};

      # Alter the directive so that qprep will output what we want.

      $$directive_key_ref   = $state_table_ref->{target_num_cpus_key};
      $$directive_value_ref = $state_table_ref->{num_cpus};

    }
    elsif ( $state_table_ref->{operation_verbosity} >= 3 )
    {
      print STDERR
        "qPTC: nodes  = $state_table_ref->{nodes} , ",
        "cpus_per_node= $state_table_ref->{cpus_per_node}\n";
    }
  }

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




sub qprepPostTranslationCallback
{
=pod

  NAME
    qprepPostTranslationCallback: directive post-translation callback for qprep


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

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

   $directive_key_ref (in/out): reference to directive key scalar

   $directive_value_ref (in/out): reference to directive key scalar

   $output_stream (in): file handle for output script


  DESCRIPTION
    qprep calls this routine after reading an input directive,
    and after applying the translation table.

    The primary utility of this routine is to clean up directives whose
    values translated to nothing because the target job queue system
    does not support any the input value.

    This subroutine is optional.  If the local configuraiton module does
    not define this routine, qprep skips this step and simply outputs
    the result of applying the translation table.


  SEE ALSO
    In this file:
       qprepInitCallback(), qprepFinishPreambleCallback(),
       qprepPostTranslationCallback(), qprepFinishScriptCallback().



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

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

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




sub qprepFinishPreambleCallback
{
=pod

  NAME
    qprepFinishPreambleCallback: post-preamble callback for qprep


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

   \%directives_table (in): reference to hash table of valid directives
     See qprepValidDirectiveTableInitialize.

   $input_stream (in): file handle for input script

   $output_stream (in): file handle for output script


  DESCRIPTION
    qprep calls this routine after reading the entire preamble,
    but before reading the rest of the input script.

    The primary utility of this routine is to write pending write
    directives in the local queue system language.  See the description of
    qprepPreTranslationCallback for an example of when this is necessary.



  SEE ALSO
    In this file:
       qprepInitCallback(),
       qprepFinishScriptCallback(). qprepPreTranslationCallback



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

  if ( $state_table_ref->{operation_verbosity} >= 2 )
  {
    print STDERR  "qprepFinishPreambleCallback: ",
          "$state_table_ref $directives_table_ref $input_stream ",
          "$output_stream\n";
  }

  # If either of {nodes,cpus_per_node} is still not set,
  # assume "1" for each unset parameter,
  # and write appropriate output.
  if($state_table_ref->{num_cpus} eq "unset")
  {
    # Either {nodes,cpus_per_node} parameters not yet set.

    # Set any unset parameters.
    if($state_table_ref->{cpus_per_node} eq "unset")
    {
      $state_table_ref->{cpus_per_node} = 1;
      if($state_table_ref->{verbose_script} ne "n")
      {
        print $output_stream
          "$state_table_ref->{target_comment_prefix} ",
          " qprepFinishPreambleCallback: cpus_per_node not yet set.",
          "  Assuming $state_table_ref->{cpus_per_node}.\n"
      }
    }

    if($state_table_ref->{nodes} eq "unset")
    {
      $state_table_ref->{nodes} = 1;
      if($state_table_ref->{verbose_script} ne "n")
      {
        print $output_stream
          "$state_table_ref->{target_comment_prefix} ",
          " qprepFinishPreambleCallback: nodes not yet set.",
          "  Assuming $state_table_ref->{nodes}.\n"
      }
    }

    # Add entry in state table for number of cpus.
    $state_table_ref->{num_cpus} =
      $state_table_ref->{nodes} *
      $state_table_ref->{cpus_per_node};

    print $output_stream
      "$state_table_ref->{target_directive_prefix}",
      "$state_table_ref->{target_num_cpus_key}",
      "$state_table_ref->{source_key_value_separator}",
      "$state_table_ref->{num_cpus}\n";
  }
}




sub qprepFinishScriptCallback
{
=pod

  NAME
    qprepFinishScriptCallback: post-input script callback for qprep


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

   \%directives_table (in): reference to hash table of valid directives
     See qprepValidDirectiveTableInitialize.

   $input_stream (in): file handle for input script

   $output_stream (in): file handle for output script


  DESCRIPTION
    qprep calls this routine after reading the entire input script,
    but before closing the input and output streams.

    This routine should not be necessary (or even useful) for translating
    queue directives, but could be useful for chaining other commands
    or further altering the output script, such as to effectively unify
    a job execution command (e.g. mpprun).


  SEE ALSO
    In this file:
       qprepInitCallback(),
       qprepFinishScriptCallback(). qprepPreTranslationCallback



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

  if ( $state_table_ref->{operation_verbosity} >= 2 )
  {
    print STDERR  "qprepFinishScriptCallback: ",
          "$state_table_ref $directives_table_ref $input_stream ",
          "$output_stream\n";
  }

  print $output_stream
    "$state_table_ref->{target_comment_prefix}",
    " qprepFinishScriptCallback: bye.",
    "$state_table_ref->{target_comment_suffix}\n";
}




__END__
