#!/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,
             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;




=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
sub qprepInitCallback
{
  # 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->{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}    = "#PBS -"   ;
  $state_table_ref->{target_key_value_separator} = ""         ;
  $state_table_ref->{target_submit_command}      = "qsub"     ;
  $state_table_ref->{target_resource_limit_key}  = "l "       ;
  $state_table_ref->{target_job_dependency_key}  = "W depend=";

  # Limit directives.
  #
  # O2K only has "number of cpus",
  # so qprepPreTranslationCallback handles these.
  $state_table_ref->{nodes}             = "unset";
  $state_table_ref->{cpus_per_node}     = "unset";

  # PBS wants all job dependencies in one directive.
  # qprepPreTranslationCallback handles them.
  $state_table_ref->{sync_count}        = "unset" ;
  $state_table_ref->{sync_with}         = "unset" ;
  $state_table_ref->{after}             = "unset" ;
  $state_table_ref->{after_ok}          = "unset" ;
  $state_table_ref->{after_not_ok}      = "unset" ;
  $state_table_ref->{after_any}         = "unset" ;
  $state_table_ref->{depends_on}        = "unset" ;
  $state_table_ref->{before}            = "unset" ;
  $state_table_ref->{before_ok}         = "unset" ;
  $state_table_ref->{before_not_ok}     = "unset" ;
  $state_table_ref->{before_any}        = "unset" ;

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

  # Qprep output
  $translation_table_ref->{target_directive_prefix}    =
    [('KEY', "s/target_directive_prefix/C/")] ;

  # Job environment directives
  $translation_table_ref->{account}             = [('KEY',"s/account/A /")] ;
  $translation_table_ref->{username}            = [('KEY',"s/username/u /")] ;
  $translation_table_ref->{export_vars}         = [('KEY',"s/export_vars/V /")];
# $translation_table_ref->{shell}               = [] ;

  # Reporting directives
  $translation_table_ref->{stderr}              = [('KEY', "s/stderr/e /")] ;
  $translation_table_ref->{stdout}              = [('KEY', "s/stdout/o /")] ;
  $translation_table_ref->{keep}                =
    [
      ('KEY',   "s/keep/k /")   ,
      ('VALUE', "s/stderr/e/") ,
      ('VALUE', "s/stdout/o/") ,
      ('VALUE', "s/neither/n/"),
      ('VALUE', "s/,/ /")      ,
      ('VALUE', "s/ //g")
    ] ;

  # Mail options:
  # qprep defines an option to send email if the job reruns.
  # PBS does not have this so we translate this to "b",
  # meaning to send mail when the job begins.
  $translation_table_ref->{mail}                =
    [
      ('KEY',   "s/mail/m /"),
      ('VALUE', "s/r/b/g"),
      ('VALUE', "s/,//g")
    ] ;
  $translation_table_ref->{mail_to}             = [('KEY', "s/mail_to/M /")] ;

  # Job control directives
  $translation_table_ref->{queue}               = [('KEY', "s/queue/q /")] ;
  $translation_table_ref->{job_name}            = [('KEY', "s/job_name/N /")];
  $translation_table_ref->{checkpoint}          =
    [ ('KEY',   "s/checkpoint/c /"), ('VALUE', 's/([0-9]+)/c=$&/') ];

  # Fake directive.  qprepPreTranslationCallback will return
  # this directive key, and therefore qprep will try to apply
  # a translation to it, hence this entry.
  $translation_table_ref->{$state_table_ref->{target_resource_limit_key}} = [];
  $translation_table_ref->{$state_table_ref->{target_job_dependency_key}} = [] ;

  # 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/.*//')] ;
  $translation_table_ref->{cpus_per_node}       = [('BOTH', 's/.*//')] ;

  # NOTE: As far as I can tell, PBS for O2K does not have proc_file_size.
  $translation_table_ref->{wall_time}           =
    [
      ('KEY', 's/wall_time/l walltime=/'),
      ('VALUE', 's/.*/$&:00/')
    ] ;

  $translation_table_ref->{process_cpu_time}    =
    [
      ('KEY', 's/process_cpu_time/l pcput=/'),
      ('VALUE', 's/.*/$&:00/')
    ] ;

  $translation_table_ref->{total_cpu_time}    =
    [
      ('KEY', 's/total_cpu_time/l cput=/'),
      ('VALUE', 's/.*/$&:00/')
    ] ;

  $translation_table_ref->{total_file_size}    =
    [
      ('KEY', 's/total_file_size/l file=/'),
      ('VALUE', 's/.*/$&mb/')
    ] ;

  $translation_table_ref->{process_memory}    =
    [
      ('KEY', 's/process_memory/l pvmem=/'),
      ('VALUE', 's/.*/$&mb/')
    ] ;

  $translation_table_ref->{total_memory}    =
    [
      ('KEY', 's/total_memory/l vmem=/'),
      ('VALUE', 's/.*/$&mb/')
    ] ;

  # I do not know whether PBS has anything like this "tape" stuff.
# $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}                = [('KEY', 's/nice/p /')] ;

  # Job dependence directives
  # PBS wants job dependence directives all in one directive, hence
  # qprepPreTranslationCallback handles them.
  # We leave the default translation, which simply empties them.

  # Catch-all directive: default translation is okay.

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

  # This directive is "private"; scripts should not contain it.
  # Internal use only.
  $directives_table_ref->{$state_table_ref->{target_resource_limit_key}} = ['^ .* *$'] ;
  $directives_table_ref->{$state_table_ref->{target_job_dependency_key}} = ['^ .* *$'] ;

  return ;
}




=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
sub qprepPreTranslationCallback
{
  # 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->{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};

      # Set directive key for resource limit.
      $$directive_key_ref   = $state_table_ref->{target_resource_limit_key};

      ##
      ## Set directive value for resource limit.
      ##
      #
      # ERDC O3K: (ruby/sand)
      $$directive_value_ref = "nodes=1:ppn=$state_table_ref->{num_cpus}";

      # ERDC IBM:
      $$directive_value_ref = "nodes=$state_table_ref->{num_cpus}:noserver";

      # ERDC Cray T3E: (jim)
      $$directive_value_ref = "mppe=$state_table_ref->{num_cpus}";

      # ASC O2K: (hpc03)
      $$directive_value_ref = "ncpus=$state_table_ref->{num_cpus}";
    }
  }

  # PBS apparently wants all job dependency options combined.
  if(   ($$directive_key_ref eq "after")
     || ($$directive_key_ref eq "after_ok")
     || ($$directive_key_ref eq "after_not_ok")
     || ($$directive_key_ref eq "after_any")
     || ($$directive_key_ref eq "depends_on")
     || ($$directive_key_ref eq "before")
     || ($$directive_key_ref eq "before_ok")
     || ($$directive_key_ref eq "before_not_ok")
     || ($$directive_key_ref eq "before_any")
     || ($$directive_key_ref eq "sync_count")
     || ($$directive_key_ref eq "sync_with")
    )
  {
    if(   ($state_table_ref->{after}         ne "unset")
       && ($state_table_ref->{after_ok}      ne "unset")
       && ($state_table_ref->{after_not_ok}  ne "unset")
       && ($state_table_ref->{after_any}     ne "unset")
       && ($state_table_ref->{depends_on}    ne "unset")
       && ($state_table_ref->{before}        ne "unset")
       && ($state_table_ref->{before_ok}     ne "unset")
       && ($state_table_ref->{before_not_ok} ne "unset")
       && ($state_table_ref->{before_any}    ne "unset")
       && ($state_table_ref->{sync_count}    ne "unset")
       && ($state_table_ref->{sync_with}     ne "unset")
      )
    {
      # All job dependencies set.  Now we can output.
      # Set directive key for resource limit.
      $$directive_key_ref   = $state_table_ref->{target_job_dependency_key};

      # Construct the value.
      $$directive_value_ref =
          "after:$state_table_ref->{after},"               .
          "afterok:$state_table_ref->{after_ok},"          .
          "afternotok:$state_table_ref->{after_not_ok},"   .
          "afterany:$state_table_ref->{after_any},"        .
          "dependson:$state_table_ref->{depends_on},"      .
          "before:$state_table_ref->{before},"             .
          "beforeok:$state_table_ref->{before_ok},"        .
          "beforenotok:$state_table_ref->{before_not_ok}," .
          "beforeany:$state_table_ref->{before_any},"      .
          "synccount:$state_table_ref->{sync_count},"      .
          "syncwith:$state_table_ref->{sync_with}"
          ;
    }
  }

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




=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
sub qprepFinishPreambleCallback
{
  # 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";
  }

  print $output_stream
    "$state_table_ref->{target_comment_prefix}",
    " qprepFinishPreambleCallback: there it went.",
    "$state_table_ref->{target_comment_suffix}\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};

    # Write resource limit directive to output script.
    print $output_stream
      "$state_table_ref->{target_directive_prefix}",
      "$state_table_ref->{target_resource_limit_key}",
      "nodes=1:ppn=$state_table_ref->{num_cpus}\n"
  }

  # Handle pending job dependency attributes
  if(   ($state_table_ref->{after}         eq "unset")
     || ($state_table_ref->{after_ok}      eq "unset")
     || ($state_table_ref->{after_not_ok}  eq "unset")
     || ($state_table_ref->{after_any}     eq "unset")
     || ($state_table_ref->{depends_on}    eq "unset")
     || ($state_table_ref->{before}        eq "unset")
     || ($state_table_ref->{before_ok}     eq "unset")
     || ($state_table_ref->{before_not_ok} eq "unset")
     || ($state_table_ref->{before_any}    eq "unset")
    )
  {
    # Some job dependencies not set.  Output dependency list now.
    # Construct job dependency value from the list

    my($at_least_one_attribute_was_set) = 0; # Flag.  Self-explanatory.

    # Initialize job_dependency_value to be empty.
    my($job_dependency_value)="";

    # Hash table of job dependency attributes.
    # Keys are PSTQ names.  Values are PBS names.
    my(%job_dependency_key_hash) =
      ( 'after'         => 'after'       ,
        'after_ok'      => 'afterok'     ,
        'after_not_ok'  => 'afternotok'  ,
        'after_any'     => 'afterany'    ,
        'depends_on'    => 'on'          ,
        'before'        => 'before'      ,
        'before_ok'     => 'beforeok'    ,
        'before_not_ok' => 'beforenotok' ,
        'before_any'    => 'beforeany'   ,
        'sync_count'    => 'synccount'   ,
        'sync_with'     => 'syncwith'
      );

    my($job_dependency_key_pst);
    my($jdk_target);
    while ( ($job_dependency_key_pst, $jdk_target) = each %job_dependency_key_hash )
    {
      # If this job dependency attribute was given a value...
      if( $state_table_ref->{$job_dependency_key_pst} ne "unset" )
      {
        if($at_least_one_attribute_was_set)
        {
          # Append a comma to separate job dependency attributes
          $job_dependency_value = $job_dependency_value . "," ;
        }
        # Append another attribute to job dependency list
        $job_dependency_value = $job_dependency_value .
          "$jdk_target:$state_table_ref->{$job_dependency_key_pst}" ;

        # Set flag...
        $at_least_one_attribute_was_set = 1;
      }
    }

    if($at_least_one_attribute_was_set == 1)
    {
      # Write job dependency attribute list directive to output script.
      print $output_stream
        "$state_table_ref->{target_directive_prefix}",
        "$state_table_ref->{target_job_dependency_key}",
        $job_dependency_value, "\n" ;
    }
  }
}




=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
sub qprepFinishScriptCallback
{
  # 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__
