=head1 NAME

CFX5::Parallel::StartMethod - Object representing a solver start method

=head1 SYNOPSIS


=head1 DESCRIPTION

The C<CFX5::Parallel::StartMethod> class represents a start method,
usually taken from the start-methods.ccl library file.  It uses the
information in the START METHOD object to handle actually starting an
executable.

=cut

package CFX5::Parallel::StartMethod;

use strict;

use vars qw($CVSVersion);
$CVSVersion='$Id$ ';

use base 'CFX5::CCLI::Defaulted';

use CFX5::Output qw(:all);
use CFX5::Config qw(%Config);
use CFX5::Commands qw(get_cmd_output do_output_cmd parse_rv);

use CFX5::PkgLoader qw(cfx5_require);

# some (constant) defaults
sub CCLROOT () { '/SIMULATION CONTROL/EXECUTION CONTROL/START METHOD LIBRARY'; }
sub OBJTYPE () { 'START METHOD'; }

=head2 CONSTRUCTORS

=head3 new

  my $h = new CFX5::Parallel::StartMethod ( $api, 'PVM Local Parallel' );

Initialises a new start method object.  The first argument is a
L<CFX5::Job:Settings> object (or derivative, noting that L<CFX5::Job>
is a descendent of L<CFX5::Job::Settings>) (or any other object
providing the C<read_ccl_parm> and C<set_ccl_parm> calls), which is
used as the canonical source of the information and (via the CCL
access calls), and as the repository to store that information as it
changes.  The second is the start method to represent.

This object serves partly as a proxy, for use by the L<CFX5::Job>
object to access itself.  It also contains routines which act on these
start methods.

=cut

sub new {
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = {};
  bless $self, $class;

  my $job=shift;
  $self->CFX5::CCLI::Defaulted::init($job);

  $self->{name} = shift;

  $self->check_existence()
    or return undef;

  return $self;
}

sub check_existence {
  my $self=shift;
  my $cmd=$self->access({ parm => 'Start Command', default => undef }, @_);
  my $option=$self->access({ parm => 'Option', default => undef }, @_);

  unless (defined $cmd or defined $option) {
    my $platform = $Config{CFX5OS};
    if ($Config{windows_nt}) {
      if (cfx5_require('CFX5::Win32::SysInfo')) {
        $platform = CFX5::Win32::SysInfo::get_osname();
      }
    }
    _error(sprintf("The start method: '%s'", $self->name()),
           "does not exist or is not available for this platform: '$platform'.",
           "Please refer to the documentation for start method availability information.");
    return 0;
  }
  1;
}
=head2 ACCESSORS

All of these calls will get the member if no argument is specified, or
set it if an argument is given.

=cut

sub cclpath {
  my $self=shift;
  my $path=shift;
  if (defined $path and $path =~ m!^/!) {
    # absolute paths are returned as-is
    return $path;
  } else {
    return (CCLROOT() . '/' . OBJTYPE() . ":" . $self->name() 
            . (defined $path ? '/'.$path : ''));
  }
}

=head3 name

The user-visible name of this start method.  Must be provided.  This
member cannot be set, it corresponds to the name of the object in the
CCL database representing the start method.

=cut

sub name {
  my $self=shift;
  if (@_) {
    internal_error("Cannot set the CCL object name");
  }
  $self->{name};
}

=head3 start_command

=cut

sub start_command {
  my $self=shift;
  my $cmd=$self->access({ parm => 'Start Command' }, @_);
  unless (defined $cmd) {
    _error("Missing Start Command for start method", $self->name());
  }
  return $cmd;
}

=head3 indirect_command

=cut

sub indirect_command {
  my $self=shift;
  my $parm='Indirect Command';
  my $cmd=$self->access({ parm => $parm }, @_);
  unless (defined $cmd) {
    _error("Missing parameter $parm for start method", $self->name());
  }
  return $cmd;
}

=head3 local_error_file

File on the starting system -- not the master -- which might contain
errors after a failed run.

=cut

sub local_error_file {
  my $self=shift;
  return $self->access({ parm => 'Local Error File', default => undef }, @_);
}

=head3 option

=cut

sub option {
  my $self=shift;
  return $self->access({ parm => 'Option', default => 'Direct' }, @_);
}

=head3 remote_host

=cut

sub remote_host {
  my $self=shift;
  return $self->access({ parm => 'Remote Host', default => $Config{CFX_HOST} }, @_);
}

=head3 is_indirect

=cut

sub is_indirect {
  my $self=shift;
  return ($self->option() eq 'Indirect');
}

=head2 USE WITH CFX5::Parallel

Once a parallel environment has been set up, the methods in this
section can be used with it to get concrete information from some of
the substitutions.

=head3 use_solver_args

  $sm->use_solver_args(@argument_list);

Sets the arguments to substitute for the %{arguments} token.

(I'm not really sure this belongs on the StartMethod object, which was
intended as a representation of the START METHOD CCL object.  It's the
easiest place to put it, though!)

=cut

sub use_solver_args {
  my $self=shift;
  $self->{solver_args} = [@_];
}

=head3 fill_template

Fills in any template parameters in the string supplied.

I<internal>

  sub filled_in_start_command {
    my $self=shift;
    my $ppe=shift;
    return $self->fill_template($self->start_command(), $ppe);
  }

=cut

sub fill_templateXXX {
  my $self=shift;
  my $string=shift;
  my $ppe=shift;

  _debug("Filling template \"$string\"");

  $string=$self->fill_shared_template($string, $ppe);

  _debug("After filling shared, have \"$string\"");

  my $seenmaster;
  for my $partinfo ($ppe->consolidated_partitions()) {
    my $count=shift @$partinfo;
    my $host=shift @$partinfo;
    my $is_master;
    if ($ppe->is_master($host)) {
      $is_master++;
      $seenmaster++;
    }
    $string=$self->fill_host_template($string, $ppe, $count, $host, $is_master);
  }

  _debug("After filling all, have \"$string\"");

  $string;
}

=head3 fill_shared_template

Fills in the non-host-specific parts of the template

=cut

sub fill_shared_template {
  my $self=shift;
  my $string=shift;
  my $ppe=shift;

  while ($string =~ m!\%\{([^{}]+)\}!g) {
    my $keyword=$1;
    my $repl;
    if ($keyword eq 'partitions') {
      $repl=scalar $ppe->partitions();
    } elsif ($keyword eq 'partitionhostlist') {
      $repl=join(' ', (map { $_->hostname() } $ppe->partitions()));
    } elsif ($keyword eq 'uid') {
      # effective user ID -- always use the local one for now, on
      # UNIX.  On Windows, use -1, as this is used by PVM which can't
      # figure out the right answer.  Not that Perl does either,
      # AFAICT ...
      if ($Config{windows_nt}) {
        $repl=-1;
      } else {
        $repl=$>;
      }
    } elsif ($keyword eq 'workdir') {
      # working directory, necessary for mpirun on SGI
      # which picks up $PWD not the actual current directory - so
      # the current dir must be passed as an argument to mpirun
      my $wd=$ppe->workdir();
      $repl=$wd->dir();
    } elsif ($keyword eq 'tmpdir') {
      # system temporary directory, calculated from the environment
      # etc 
      $repl=$Config{TEMP} || $Config{TMP} || $Config{TMPDIR} || '/tmp';
    } elsif ($keyword =~ m!^req:(.*)!) {
      # arbitary text defined by a prerequisite
      my $reqname=$1;
      my $reqobj=$ppe->setup_req($reqname);
      if ($reqobj) {
        $repl=$reqobj->get_replacement_text();
      } else {
        _error("Error substituting \%{$keyword}: error in prerequisite $reqname");
      }
    } elsif ($keyword =~ m!^env:(.*)!) {
      # read an environment variable -- actually a config record, so
      # standard CFX-5 env vars get filled it magically -- and use its
      # contents here.
      my $var=$1;
      if ($var =~ s!(:?-)(.*)$!!) {
        $repl=$Config{$var};
        if (($1 eq ':-' and (not defined $repl or $repl eq ''))
            or ($1 eq '-' and not defined $repl)) {
          $repl=$2;
        }
      } else {
        # no default, just try it
        $repl=$Config{$1};
        # if there's nothing in the environment, follow the shell's
        # example and substitute silently with an empty string
        unless (defined $repl) {
          $repl='';
        }
      }

    } elsif ($keyword eq 'newline') {
      $repl="\n";

    } elsif ($keyword eq 'arguments') {
      $repl=join(" ", map { $_ =~ m! ! ? qq("$_") : $_ } @{$self->{solver_args}});
    }

    if (defined $repl) {
      _debug("Replacing \%{$keyword} with \"$repl\"");
      $string =~ s!\%\{$keyword\}!$repl!
        or internal_error("Substitution of \%{$keyword} failed unexpectedly in \"$string\"");
    }
  }

  $string;
}

=head3 fill_host_template

Fills in any template parameters in the string supplied, from the
perspective of a particular host in the run.

I<internal>

  $self->fill_host_template($string, $ppe, $count, $host, $is_master);

$count and $host are this slightly odd way around because thats how
they come from C<consolidated_partitions>.

=cut

sub _quotesp {
  my $str=shift;
  # quote the path if necessary
  if ($str =~ m!\s! and $str !~ m!\"!) {
    $str=qq("$str");
  }
  $str;
}

sub fill_host_template {
  my $self=shift;
  my $string=shift;
  my $ppe=shift;
  my $count=shift;
  my $host=shift;
  my $is_master=shift;

  while ($string =~ m!\%\{([^{}]+)\}!g) {
    my $keyword=$1;
    my $repl;
    if ($keyword eq 'executable') {
      $repl=_quotesp($host->actual_executable($self));
    } elsif ($keyword eq 'cfx5remote') {
      $repl=_quotesp($host->cfx5remote_path());
    } elsif ($keyword eq 'cfx5solve') {
      $repl=_quotesp($host->cfx5solve_path());
    } elsif ($keyword eq 'hostname') {
      $repl=$host->hostname();
    } elsif ($keyword eq 'remoteuser') {
      $repl=$host->username();
      # username will be undefined if not specified; we want to ensure
      # it's replaced, so we'll default to the current user name
      unless (defined $repl) {
        my $user= eval { scalar getpwuid($<) } || $ENV{USER} || $ENV{USERNAME};
        if (defined $user) {
          $repl=$user;
        } else {
          _error("Unable to determine current user name");
        }
      }
    } elsif ($keyword eq 'hostprocs') {
      $repl=$count;
    } elsif ($keyword eq 'slaveprocs') {
      $repl=$count;
      if ($is_master) { $repl--; }
    } elsif ($keyword eq 'ldpathvar' ) {
      $repl = $Config{ld_path_var};
    } elsif ($keyword eq 'toolsroot') {
      $repl=_quotesp($host->tools_root());
    } elsif ($keyword eq 'cfxlibdir') {
      $repl=_quotesp($host->cfx_libdir($self));
    } elsif ($keyword eq 'cfxlibdirnq') {
      $repl= $host->cfx_libdir($self);
    } elsif ($keyword eq 'rldpath') {
      my $shlib = $self->shared_library_path();
      my @paths = ($host->cfx_libdir($self),
                   $host->multiport_paths(),
                   CFX5::PathManip::path_to_list($shlib));
      push @paths, $host->cfx_bindir($self) if ($Config{windows_nt});
      my $rldpath;
      for my $path (@paths) {
        CFX5::Config::prepend_to_path(\$rldpath,$path)
      }
      $repl=_quotesp($rldpath);
    } elsif ($keyword eq 'ibmmpidir' ) {
      $repl = $Config{CFX5_IBMMPI_DIR};
    } elsif ($keyword eq 'impidir' ) {
      $repl = $Config{CFX5_IMPI_DIR};
    } elsif ($keyword eq 'mportlibdir' ) {
      $repl = $host->multiport_wrapper_path();
    } elsif ($keyword eq 'mportroot' ) {
      $repl=_quotesp($host->tools_root());
    } elsif ($keyword eq 'cfx5root') {
      $repl=_quotesp($host->root());
    } elsif ($keyword eq 'workdir_host') {
      if ($ppe->is_master($host)) {
        $repl = $ppe->workdir()->dir();
      } else {
        $repl = $Config{CFX_SOLVE_REMOTE_WORKDIR};
      }
    }

    if (defined $repl) {
      _debug("Replacing \%{$keyword} with \"$repl\"");
      $string =~ s!\%\{$keyword\}!$repl!
        or internal_error("Substitution of \%{$keyword} failed unexpectedly in \"$string\"");
    } else {
      _debug("Not replacing \%{$keyword}");
    }
  }

  $string;
}

sub fill_indirect_template {
  my $self=shift;
  my $string=shift;
  my $job=shift;
  my @reinvoke_args=@_;

  while ($string =~ m!\%\{([^{}]+)\}!g) {
    my $keyword=$1;
    my $repl;
    if ($keyword eq 'fullpath') {
      $repl=_quotesp($job->fullname());
    }
    elsif ($keyword eq 'deffile') {
      $repl=_quotesp($job->deffile());
    }
    elsif ($keyword eq 'indirect_args') {
      $repl=join(" ", map { $_ =~ m! ! ? qq("$_") : $_ } @reinvoke_args);
    }

    if (defined $repl) {
      _debug("Replacing \%{$keyword} with \"$repl\"");
      $string =~ s!\%\{$keyword\}!$repl!
        or internal_error("Substitution of \%{$keyword} failed unexpectedly in \"$string\"");
    } else {
      _debug("Not replacing \%{$keyword}");
    }
  }

  $string;
}

=head3 assert_fully_replaced

  $sm->assert_fully_replaced($string) or die;

Checks that all template fields have been replaced, and gives an error
if not.

=cut

sub assert_fully_replaced {
  my $self=shift;
  my $string=shift;

  my @bad;
  while ($string =~ m!\%\{([^{}]+)\}!g) {
    push @bad, $1;
  }

  if (@bad) {
    _error("The following template keywords were not recognised:", @bad);
    return 0;
  }

  1;
}

=head3 local_check

Checks that all is as it should be.  In particular, checks that the
partition count is compatible with the selected start method.

=cut

sub local_check {
  my $self=shift;
  my $ppe=shift;
  my $part=$ppe->partitions();

  unless (defined $part) {
    internal_error("Unable to check the start method setup: the partition count is unknown.");
  }

  if (defined (my $min=$self->minimum_partition_count())) {
    if ($part < $min) {
      # if $part is 1, that probably means that the user didn't specify
      # a parition count at all, so we can give a more useful error
      # message
      if ($part == 1) {
        _error("You must specify a partition count for", $self->name() .'.');
      } else {
        _error("Invalid partition count: you can only use", $self->name(),
               "with $min or more partitions.");
      }
      return 0;
    }
  }

  if (defined (my $max=$self->maximum_partition_count())) {
    if ($part > $max) {
      # if $max is 1, this is serial-only, so we can give a more
      # useful error message
      if ($max == 1) {
        _error("You cannot use more than one partition with", $self->name() .'.');
      } else {
        _error("Invalid partition count: you can only use", $self->name(),
               "with up to $max partitions.");
      }
      return 0;
    }
  }

  # If the start method has a platform list, check it includes the master's OS
  my $master = $ppe->master_host();
  my $found = -1;
  for my $platform ($self->platform_list()) {
    $found = 0 if ($found == -1);
    $found = 1 if ($platform eq $master->os());
    last if ($found);
  }

  unless ($found) {
    _error(sprintf "The start method: '%s' is not available for this platform: '%s'. Please refer to the documentation for start method availability information.", $self->name(), $master->os());
  }

  1;
}

=head3 os_checks

Does any checks on the operating system compatibility for the hosts in
the run.  Should be called once the OSes are known!

=cut

sub os_checks {
  my $self=shift;
  my $ppe=shift;

  if ($self->die_heterogeneous_parallel()) {
    my $master=$ppe->master_host();
    my @bad;
    for my $h ($ppe->hosts()) {
      if ($h->os() ne $master->os()) {
        push @bad, $h;
      }
    }
    if (@bad) {
      _error("Some of the hosts in this run have a different operating system",
            "from the master host,", $master->descname(), "(" . $master->os() . ").",
            "This combination is not supported by the selected start",
            "method,", $self->name() . ".",
            "\n\nThe affected hosts are:", 
            join(', ',  map { $_->descname() . " (" . $_->os() . ")" } @bad)
           );
      return 0;
    }
  }

  1;
}

=head3 gather_errors

  my @errs=$sm->gather_errors();

Gathers any additional error information from the system, and returns
it.  Eg for PVM, this looks in the Local Error File.

=cut

sub gather_errors {
  my $self=shift;

  my @errs;

  if (defined (my $f=$self->local_error_file())) {
    $f=$self->fill_shared_template($f, $self);
    #my $localh=$self->local_host();
    #$f=$self->fill_host_template($f, $self, 1, $localh,
    #                           $master->same_as($localh));
    #$f=$self->fill_args_template($f, @args);

    $self->assert_fully_replaced($f) 
      or return CFX5::Commands::Result->new_not_run("bad local error file template");

    cfx5_require('CFX5::FileOps');
    if (-e $f) {
      my $cont=CFX5::FileOps::get_file_contents($f);
      if (defined $cont) {
        push @errs, '', "\n\nContents of $f:\n\n", split(/\r?\n\r?/, $cont);
      } else {
        push @errs, '', "Error reading local error file $f: $!";
      }
    }
  }

  @errs;
}

=head2 MISC SETTINGS

Not really critical to the object's operation, a load of misc things
which are queried by CFX5::Parallel and friends.

=head3 exec_suffix

Returns the suffix on executables for use with this method.

=cut

sub exec_suffix {
  my $self=shift;
  return $self->access({
                        parm => 'Executable Suffix',
                       }, @_);
}

=head3 appfile_header

Returns the appfile line for the header

=cut

sub appfile_header {
  my $self=shift;
  return $self->access({
                        parm => 'Appfile Header',
                        default => undef,
                       }, @_);
}

=head3 appfile_host_entry

Returns the appfile line for the host entry

=cut

sub appfile_host_entry {
  my $self=shift;
  return $self->access({
                        parm => 'Appfile Host Entry',
                       }, @_);
}

=head3 minimum_partition_count

Returns the minimum partition count for this start method.  If the
minimum is not specified, or if it is 'Any', returns undef.

=cut

sub minimum_partition_count {
  my $self=shift;
  my $rv=$self->access({
                        parm => 'Minimum Partition Count',
                       }, @_);
  if (defined $rv and lc($rv) eq 'any') {
    undef $rv;
  }
  $rv;
}

=head3 maximum_partition_count

Returns the maximum partition count for this start method.  If the
maximum is not specified, or if it is 'Any', returns undef.

=cut

sub maximum_partition_count {
  my $self=shift;
  my $rv=$self->access({
                        parm => 'Maximum Partition Count',
                       }, @_);
  if (defined $rv and lc($rv) eq 'any') {
    undef $rv;
  }
  $rv;
}

=head3 platform_list

Returns the supported platform list for this start method. 
Returns empty list for 'Any', 'None' or if no platform list is specified.

=cut

sub platform_list {
  my $self=shift;
  my $rv = $self->access({
                          parm => 'Platform List',
                          default => 'any'
                         }, @_);
  return () if (defined $rv and (lc($rv) eq 'any' or lc($rv) eq 'none'));
  return split(m/ *, */, $rv);
}

=head3 prerequisites

Returns the list of prerequisites for this start method

=cut

sub prerequisites {
  my $self=shift;
  return split(m/ *, */, $self->access({
                                        parm => 'Start Command Prerequisites',
                                        default => ''
                                       }, @_));
}

=head3 shared_library_path

Returns the directories to add to the shared library path for this
start method

=cut

sub shared_library_path {
  my $self=shift;
  return $self->access({
                        parm => 'Shared Library Path',
                        default => undef
                       }, @_);
}

=head3 reset_shared_library_path

Returns TRUE if the shared library path is to be reset before
start method execution

=cut

sub reset_shared_library_path {
  my $self=shift;
  return $self->access_logl({
                             parm => 'Reset Shared Library Path',
                             default => 'no'
                            }, @_);
}


=head3 execution_path

Returns the directories to add to the execution path for this
start method

=cut

sub execution_path {
  my $self=shift;
  return $self->access({
                        parm => 'Execution Path',
                        default => undef
                       }, @_);
}

=head3 use_host_list

Returns TRUE if we need to do CFX-5's custom actions to set up and
shut down the PVM daemon supplied with CFX-5.  The CCL for the start
method does not give enough flexibility to do this otherwise.

=cut

sub use_host_list {
  my $self=shift;
  return $self->access_logl({
                             parm => 'Use Host List',
                            }, @_);
}

=head3 host_assignment

Returns the host assignment method to control how partitions are assigned
to hosts. Either 'Automatic' (the default), 'Round Robin' or 'Block'.

=cut

sub host_assignment {
  my $self=shift;
  return $self->access({
                        parm => 'Host Assignment',
                        default => 'Automatic'
                       }, @_);
}

=head3 die_heterogeneous_parallel

Returns TRUE if we should die if a heterogeneous parallel run is
attempted.

=cut

sub die_heterogeneous_parallel {
  my $self=shift;
  return $self->access_logl({
                             parm => 'Homogeneous Parallel Only',
                             default => 'no'
                            }, @_);
}

=head3 do_pvm_custom

Returns TRUE if we need to do CFX-5's custom actions to set up and
shut down the PVM daemon supplied with CFX-5.  The CCL for the start
method does not give enough flexibility to do this otherwise.

=cut

sub do_pvm_custom {
  my $self=shift;
  return $self->access_logl({
                             parm => 'Custom PVM Setup',
                             default => 'no'
                            }, @_);
}

=head3 need_master_ip_check

Returns TRUE if we need to check that the master host doesn't believe
it's own IP address to be the loopback address.  We check by default,
but because some things (MPICH, for example) don't care, we allow this
to be switched off.

=cut

sub need_master_ip_check {
  my $self=shift;
  return $self->access_logl({
                             parm => 'Require Valid Master IP Address',
                             default => $Config{CFX5_NO_MASTER_IP_CHECK} ? 'no' : 'yes',
                            }, @_);
}

=head3 finalize_indirect

Returns TRUE if an indirect start method is to carry out finalization
of the run. This is set to 'yes' by default. It may be useful to switch
of if a downstream direct start method finalizes the run.

=cut

sub finalize_indirect {
  my $self=shift;
  return $self->access_logl({
                             parm => 'Indirect Finalization',
                             default => 'yes'
                            }, @_);
}

1;
