=head1 NAME

CFX5::Parallel::Host - Object representing a host in a parallel run

=head1 SYNOPSIS

  use CFX5::Parallel::Host;
  my $host=new CFX5::Parallel::Host('xenon');
  die "Cannot run on remote hosts" unless $host->is_local();

=head1 DESCRIPTION

The C<CFX5::Parallel::Host> class represents a single host in a
parallel run, and can be used to do operations on that host such as
running a command on it, retrieving various pieces of information, and
so on.

Internally, it works in terms of a CCL API instance.  If no such
instance is provided, it will ****

=cut

package CFX5::Parallel::Host;

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 do_termerr_cmd);

use CFX5::PlatformInfo;

use CFX5::HostAddr;

use CFX5::PkgLoader qw(cfx5_require);

# some (constant) defaults
sub CCLROOT () { '/SIMULATION CONTROL/EXECUTION CONTROL/PARALLEL HOST LIBRARY'; }
sub OBJTYPE () { 'HOST DEFINITION'; }

=head2 CONSTRUCTORS

=head3 new

  my $h = new CFX5::Parallel::Host ( $api, 'triton' );

Initialises a new host object.  The arguments are
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.  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 hosts, for example,
querying their architecture or running commands remotely.  These
routines also use the L<CFX5::Job::Settings> to cache their results,
so they work together with the CCL handling to ensure that host
details are cached in the CCL for a run.

=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->{job}=$job;

  my $name=shift;

  # first, check for special indicators in the host name; we allow
  # 'user@host:rootpath', so strip that off before trying to find the
  # host
  my ($root,$user);
  if ($name =~ s!:(.*)$!!) {
    # user has specified a root directory too
    $root=$1;
  }
  if ($name =~ s!(.*)\@!!) {
    # user id too
    $user=$1;
  }

  # DNS is (should be!) case-insensitive, so we always access the
  # hostnames in this file in lowercase, whatever case they were
  # specified in.  Since this is the only entry point to
  # (programatically) access the hostinfo.ccl file, this should be fully
  # consistent unless the user hacks it themselves.
  #
  # on the other hand, the user may have hacked it themselves, so we
  # will check for an object in the original case.  If such a thing is
  # found, we'll use it.
  $self->{name}=$name; # needed so we can call cclpath
  unless (lc($name) ne $name
          # if this is a working object (eg, for parallel), it may be
          # backed by a dummy database, which doesn't have a CCL API
          # behind it.  In that case, the user can't have set up
          # anything funny, so we don't need to worry!
          and $self->get_ccldb_obj()->can('ccl_api_obj')
          and $self->get_ccldb_obj()->ccl_api_obj()->haveObject($self->cclpath())) {
    $self->{name}=lc($name);
  }

  # check for underscores or leading digits in the name and, if
  # possible, do something with them.
  if ($name =~ m![_-]! or $name =~ m!^[0-9]!) {
    # this is an invalid or unhelpful CCL object name.  We will try to
    # use it without the underscores (spaces are no good, as the host
    # list is space-separated) if that's not going to cause a
    # conflict.  If there are leading digits, we prepend 'host'.  We
    # also have to remove hyphens as, although they are valid in an
    # object name, the parser silently turns them into spaces.  Silly
    # thing.
    (my $newname=lc($name)) =~ s![_-]!!g;
    if ($newname =~ m!^[0-9]!) {
      $newname='host'.$newname;
    }
    my $suff = '';
    my $usename;

    # first we do a simple text comparison, which is fast
    _debug("$name is not a valid CCL object name, searching for replacement by text string");
    for ($suff=''; !$suff or $suff < 10; ++$suff) {
      $self->{name}=$newname.$suff;
      #_debug("Trying object name $newname$suff");
      my $v=$self->get_parm('Remote Host Name');
      if (defined $v and $v eq $name) {
        $usename=$newname.$suff;
        _debug("Found existing object $newname$suff with remote host name $v");
        last;
      }
    }

    unless (defined $usename) {
      # if we failed to find it by text comparison, use DNS to compare
      # the remote names.
    _debug("$name is not a valid CCL object name, searching for replacement by resolved IP address");
      for ($suff=''; !$suff or $suff < 10; ++$suff) {
        $self->{name}=$newname.$suff;
        #_debug("Trying object name $newname$suff");
        my $v=$self->get_parm('Remote Host Name');
        if (defined $v and $v ne $name) {
          # we already have a Remote Host Name, and it's not the same as
          # we were about to set.  See if it's the same host.
          my $newaddr=$self->get_hostaddr_obj($name);
          my $prevaddr=$self->get_hostaddr_obj($v);

          unless (defined $newaddr and defined $prevaddr
                  and $newaddr->same_as($prevaddr)) {
            next;
          }
        }

        if (defined $v) {
          _debug("Found existing object $newname$suff with remote host name $v");
        }

        # if we get here, we can use this name
        $usename=$newname.$suff;
        last;
      }
    }

    unless (defined $usename) {
      _error("Unable to create a host object to represent the host $name as objects with the correct Command Language object names up to $newname$suff already exist, and have inconsistent values for the Remote Host Name parameter.  To use this host with $Config{CFX_PRODUCT_FULLNAME} parallel, you must create the host object manually.");
      return undef;
    }

    _debug("Using $usename as object name for $name");

    # we already set our ->{name} parameter, so now all we need to do
    # is to record the actual network hostname.
    $self->hostname($name);
  }

  # now, if right at the top the user specified a root directory or a
  # user name, we can finally fill them in
  if (defined $root) {
    $self->root($root);
  }
  if (defined $user) {
    $self->username($user);
  }

  return $self;
}

=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 host.  Must be provided.  This member
cannot be set, it corresponds to the name of the object in the CCL
database representing the host.

=cut

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

=head3 hostname

This is the network hostname of the host.  It defaults to the same as
the name above.

=cut

sub hostname {
  my $self=shift;
  my $cclname='Remote Host Name';

  # set?
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(0))[3])
      if @_;
    if ($v =~ m/^[^\'\"\s]*$/) {
      $self->set_parm($cclname,$v);
    } else {
      _error("Invalid $cclname $v");
    }
  }

  my $v=$self->get_parm($cclname);

  # need to set or update default?
  if (!defined $v or $self->is_default($cclname)) {
    $v=$self->name();
    # for some things it's not worth recording the defaults, they
    # aren't useful
    #$self->set_default($cclname,$v);
  }

  return $v;
}

=head3 username

This is the username of the user on the specified host.  If not
specified, it is undefined.

=cut

sub username {
  my $self=shift;
  my $cclname='Remote User Name';

  # set?
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(0))[3])
      if @_;
    if ($v =~ m/^[^\'\"\s]*$/) {
      $self->set_parm($cclname,$v);
    } else {
      _error("Invalid $cclname $v");
    }
  }

  my $v=$self->get_parm($cclname);

  # no default for this
  #if (!defined $v or $self->is_default($cclname)) {
    #$v=$self->name();
    # for some things it's not worth recording the defaults, they
    # aren't useful
    #$self->set_default($cclname,$v);
  #}

  return $v;
}

=head3 pvmname

This is the name by which PVM knows the host, I believe it is the
result of the C<gethostname> call on the remote host.  It will be
filled in by the PVM code if necessary.  Unless set explicitly, it
defaults to the C<hostname>, and so can be used happily in other PPE
modes.

=cut

sub pvmname {
  my $self=shift;

  if (@_) {
    my $new=shift;
    $self->{intsettings}{pvmname}=$new;
    return $new;
  }

  if (exists $self->{intsettings}{pvmname}) {
    return $self->{intsettings}{pvmname};
  }
  return $self->hostname();
}

=head3 root

The ANSYS CFX installation location on the remote host.  Defaults to the
same as on the local host.

This can also be set to the special token C<none> either in the CCL or
programmatically, in which case it will be assumed that there is no
ANSYS CFX installation accessible on the remote host, and various checks
(such as the use of cfx5info) will be switched off.  In this case, the
root will be returned as C<undef>.

=cut

sub root {
  my $self=shift;
  my $cclname='Installation Root';

  # set?
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(0))[3])
      if @_;
    if (defined $v) {
      $self->set_parm($cclname,$v);
    } else {
      _error("Invalid $cclname $v");
    }
  }

  my $v=$self->get_parm($cclname);

  # need to set or update default?
  if (!defined $v or $self->is_default($cclname)) {
    $v=$Config{CFX5ROOT};
    $v =~ s!v\Q$Config{ANSYSCFXRELEASE}\E!v\%v!g;
    $self->set_default($cclname,$v);
  }

  # having set the CCL name if necessary, we'll replace the %v again
  # here, so we ensure that the correct name is always used.  XXX
  # Better might be to always pass executables and directory names through
  # fill_in_exec, but this is safer!
  $v =~ s!v\%v!v$Config{ANSYSCFXRELEASE}!g;

  # now map none => undef
  undef $v if defined $v and $v eq 'none';

  # For remote hosts convert long path names to short paths for PVM
  # We probably don't know if it's windows yet, so look at the path
  # There is no short version of unc paths, so only check for X:
  if(not $self->is_local() and not $self->disable_remote_checks() and ($self->is_win32() or $v=~m/^[a-zA-Z]:/)){
    my $rv=$self->do_cmd("cmd /c echo off && for %I in (\\\"$v\\\") do echo %~sI");
    my @output=$rv->cmd_output();
    if( $rv->is_success() and @output ){
      my $output;
      # Win XP SP2 rsh bug
      # rsh returns:
      # Terminal Read: The handle is invalid
      # <stdout>
      # :
      #
      # We are only expecting one line so take the second one 
      # if there are multiple lines
      if($Config{windows_nt} and scalar(@output) > 1){
        $output=$output[1];
      } else {
        $output=$output[0];
      }

      $output =~ s![\r\n]+!!g;
      # Does it still look like a path?
      if($output and $output=~m/^[a-zA-Z]:/ and not $output=~m/\s/){
         _trace("Converting root $v to short path $output");
	 $v=$output;
      }
    }
  }

  return $v;
}

=head3 executable

The solver executable location.  Defaults to the standard location
inside whatever CFX5ROOT is defined for this host.  This name will
almost certainly contain placeholders which are substituted when the
actual type of run (architecture, attributes) is known, see also
C<actual_executable>.

If the environment variable CFX_SOLVER_EXEC is set, that will provide
the default, and will be stored in the CCL.

=cut

sub executable {
  my $self=shift;
  my $cclname='Solver Executable';

  # set?
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(0))[3])
      if @_;
    if (defined $v) {
      $self->set_parm($cclname,$v);
    } else {
      _error("Cannot set $cclname to undefined value");
    }
  }

  my $v=$Config{CFX_SOLVER_EXEC};

  if (defined $v) {
    $self->set_parm($cclname,$v);
  } else {
    $v=$self->{job}->solver_exec($self->os());
 
    if (defined $v) {
      $self->set_parm($cclname,$v);
    } else {
      $v=$self->get_parm($cclname);
  
      # need to set or update default?
      if (!defined $v or $self->is_default($cclname)) {
        $v=$self->join_file($self->root(),'bin','%a','solver%p.exe');
        # there's no point in recording this, methinks
        #$self->set_default($cclname,$v);
      }
    }
  }

  return $v;
}

=head3 pvm_root

The path to the PVM daemon on the remote host.  By default, taken from
the tools directory relative to the ANSYS CFX installation (see C<root>).

=cut

sub pvm_root {
  my $self=shift;
  my $cclname='PVM Root Directory';

  # set?
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(0))[3])
      if @_;
    if (defined $v) {
      $self->set_parm($cclname,$v);
    } else {
      _error("Cannot set $cclname to undefined value");
    }
  }

  my $v=$self->get_parm($cclname);

  # need to set or update default?
  if (!defined $v or $self->is_default($cclname)) {
    if ($self->is_win32()) {
      $v=$self->join_file($self->root(),'tools','CYGWIN32_NT',
                          'pvm' . $Config{CFX_PVM_VERSION});
    } else {
      # we can't use the OS name, as we need to call the wrapper to
      # ensure PVM_ROOT gets set correctly.
      $v=$self->join_file($self->root(), 'tools',
                          'pvm' . $Config{CFX_PVM_VERSION});
    }
    # there's no point in recording this, methinks
    #$self->set_default($cclname,$v);
  }

  return $v;
}

=head3 tools_root

The path to the ANSYS CFX tools directory on the remote host.  By default,
taken relative to the remote root directory in the same way as the
local tools.

=cut

sub tools_root {
  my $self=shift;
  my $cclname='Installation Shared Root';

  # set?
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(0))[3])
      if @_;
    if (defined $v) {
      $self->set_parm($cclname,$v);
    } else {
      _error("Cannot set $cclname to undefined value");
    }
  }

  my $v=$self->get_parm($cclname);

  # need to set or update default?
  if (!defined $v or $self->is_default($cclname)) {
    # could be in two places -- either CFX5ROOT/tools (for a central
    # development version), or CFX5ROOT/../../Shared for a customer
    # install.  We can't know for sure, but it's likely that it's the
    # same as the installation we're in now!  If not, people will have
    # to supply the PVM Daemon Executable directly.
    $v=$self->root();
    if ($Config{CFX_TOOLS_ROOT} =~ m!tools$!i) {
      $v=$self->join_file($v, 'tools');
    } else {
      # assume Shared-style if we're not sure -- we should be sure,
      # though, really ...
      $v =~ s![\\/][^\\/]*[\\/]?$!!;
      $v =~ s![\\/][^\\/]*[\\/]?$!!;
      $v=$self->join_file($v, 'Shared');
    }
  }

  return $v;
}

=head3 pvmd_path

The path to the PVM daemon on the remote host.  By default, taken from
the tools directory relative to the ANSYS CFX installation (see C<root>).

=cut

sub pvmd_path {
  my $self=shift;
  my $cclname='PVM Daemon Executable';

  # set?
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(0))[3])
      if @_;
    if (defined $v) {
      $self->set_parm($cclname,$v);
    } else {
      _error("Cannot set $cclname to undefined value");
    }
  }

  my $v=$self->get_parm($cclname);

  # need to set or update default?
  if (!defined $v or $self->is_default($cclname)) {
    # fairly logically ... we assume the same PVM version on all
    # machines!
    if ($self->is_win32()) {
      $v=$self->join_file($self->tools_root(), 'pvm' . $Config{PVM_VERSION}, 'lib','%P','pvmd3.exe');
    } else {
      # we can't use the OS name, as we need to call the wrapper to
      # ensure PVM_ROOT gets set correctly.
      $v=$self->join_file($self->tools_root(), 'pvm' . $Config{PVM_VERSION}, 'lib','pvmd');
    }
    # there's no point in recording this, methinks
    #$self->set_default($cclname,$v);
  }

  return $v;
}

=head3 cfx5remote_path

The path to the cfx5remote command on the remote host.  By default,
taken from the install directory (see C<root>).

=cut

sub cfx5remote_path {
  my $self=shift;
  my $cclname='Remote Helper Path';

  # set?
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(0))[3])
      if @_;
    if (defined $v) {
      $self->set_parm($cclname,$v);
    } else {
      _error("Cannot set $cclname to undefined value");
    }
  }

  my $v=$self->get_parm($cclname);

  # need to set or update default?
  if (!defined $v or $self->is_default($cclname)) {
    if ($self->is_win32()) {
      $v=$self->join_file('%r','bin','cfx5remote.exe');
    } else {
      $v=$self->join_file('%r','bin','cfx5remote');
    }
    # there's no point in recording this, methinks
    #$self->set_default($cclname,$v);
  }

  return $self->fill_in_exec($v);
}

=head3 cfx5solve_path

The path to the cfx5solve command on the remote host.  By default,
taken from the install directory (see C<root>).

=cut

sub cfx5solve_path {
  my $self=shift;
  my $cclname='Solver Script Path';

  # set?
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(0))[3])
      if @_;
    if (defined $v) {
      $self->set_parm($cclname,$v);
    } else {
      _error("Cannot set $cclname to undefined value");
    }
  }

  my $v=$self->get_parm($cclname);

  # need to set or update default?
  if (!defined $v or $self->is_default($cclname)) {
    if ($self->is_win32()) {
      $v=$self->join_file('%r','bin','cfx5solve.exe');
    } else {
      $v=$self->join_file('%r','bin','cfx5solve');
    }
    # there's no point in recording this, methinks
    #$self->set_default($cclname,$v);
  }

  return $self->fill_in_exec($v);
}

=head3 use_cfx5remote

Whether to use cfx5remote in the commands in a PVM or MPICH host file.

=cut

use CFX5::Config::def CFX5_SOLVE_USE_CFX5REMOTE => sub { 1; };

sub use_cfx5remote {
  return $Config{CFX5_SOLVE_USE_CFX5REMOTE};
}


=head3 speed

The relative speed of this host. Unset by default.

=cut

sub speed {
  my $self=shift;
  my $cclname='Relative Speed';

  # set?
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(0))[3])
      if @_;
    if ($v =~ m/^(\d+\.?|\d*\.\d+)$/) {
      $self->set_parm($cclname,$v);
    } else {
      _error("Invalid $cclname $v");
    }
  }

  my $v=$self->get_parm($cclname);

  # need to set or update default?
  if (!defined $v or $self->is_default($cclname)) {
    $v=1.0;
    # for some things it's not worth recording the defaults, they
    # aren't useful
    #$self->set_default($cclname,$v);
  }

  return $v;
}

=head3 processors

The number of processors in this machine. Unset by default.

=cut

sub processors {
  my $self=shift;
  my $cclname='Number of Processors';

  # set?
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(0))[3])
      if @_;
    if ($v =~ m/^\d+$/) {
      $self->set_parm($cclname,$v);
    } else {
      _error("Invalid $cclname $v");
    }
  }

  my $v=$self->get_parm($cclname);

  # need to set or update default?
  if (!defined $v or $self->is_default($cclname)) {
    $v=1;
    # for some things it's not worth recording the defaults, they
    # aren't useful
    #$self->set_default($cclname,$v);
  }

  return $v;
}

=head3 architecture

The CFX5_HOST_ARCH setting for this host.  Undefined by default until
calculated, apart from on the local host, where we cheat and use the
value we have anyway.

Note that this may also be set to a C<CFX5OS> value, but this will
switch off any optimised binary selection.

=cut

sub architecture {
  my $self=shift;
  my $cclname='Host Architecture String';

  # set?
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(0))[3])
      if @_;
    if (defined $v and CFX5::Arch->is_valid_arch($v)) {
      $self->set_parm($cclname,$v);
    } else {
      _error("Invalid $cclname $v");
    }
  }

  my $v=$self->get_parm($cclname);

  # need to set or update default?
  if (!defined $v or $self->is_default($cclname)) {
    # we don't precalculate this one, it's too time-consuming, but if
    # we already know we might as well use it
    if ($self->is_local()) {
      $v=$Config{CFX5OS};
      $self->set_default($cclname, $v);
    }
  }

  return $v;
}

=head3 pvm_arch

The PVM_ARCH setting for this host.  Unless specified in the CCL this
is calculated from C<os>, or undefined until that is calculated.

=cut

sub pvm_arch {
  my $self=shift;
  my $cclname='PVM Architecture String';

  # set?
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(0))[3])
      if @_;
    if (defined $v) {
      # this will abort if it's not parsable
      $self->set_parm($cclname,$v);
    } else {
      _error("Invalid $cclname $v");
    }
  }

  my $v=$self->get_parm($cclname);

  # need to set or update default?
  if (!defined $v or $self->is_default($cclname)) {
    my $arch=$self->archobj();
    if (defined $arch) {
      $v=$arch->pvm_arch();
    }
    # don't bother recording it
  }

  return $v;
}

=head3 ccl_def

  print join("\n", $host->ccl_def());

  HOST DEFINITION : host
  END

This call returns a CCL fragment for this host, without the full
nesting.

=cut

sub ccl_def {
  my $self=shift;
  my $api=$self->get_ccldb_obj()->ccl_api_obj();

  my $haref;
  my $rv = $api->getChildInfoList($self->cclpath(''), \$haref);
  if ($rv) {
    _error("Error retrieving host information for", $self->name().":", format_ccl_error($rv));
    return ();
  }

  my @rv;
  push @rv, "      HOST DEFINITION: " . $self->name();
  for my $hn (@$haref) {
    push @rv, "        " . $hn->{name} . " = " . $self->get_parm($hn->{name});
  }
  push @rv, "      END # HOST DEFINITION " . $self->name();

  @rv;
}

=head3 root

The root directory of the ANSYS CFX installation on this host.  Defaults
to the same as the local host if unset.

=head3 ***

If defined, should be set to "C<UNIX>" or "C<NT>", and indicates the
operating system on the host (and therefore how to communicate with it).
See the C<get_host_type> function. Not set by default.

=cut

=head2 DERIVED INFORMATION

This information is not settable, it is derived from the above.  It is
not stored in the CCL directly.

=head3 descname

  _error($host->descname()." cannot be contacted.");

Returns a descriptive name for the host represented by the current
object.  Normally this is simply the C<name>, but if there is an
explicitly-supplied C<hostname> that will be included in parentheses.

=cut

sub descname {
  my $self=shift;
  my $rv=$self->name();
  if (defined $self->hostname()
      and $self->hostname() ne $self->name()) {
    $rv .= " (".$self->hostname().")";
  }
  $rv;
}

=head3 get_hostaddr_obj

Gets the CFX5::HostAddr object for the argument.  If this object has
been told to suppress DNS lookups, it will use get_obj_nolookup rather
than get_obj.

=cut

sub get_hostaddr_obj {
  my $self=shift;
  my $host=shift;

  if ($self->suppress_dns()) {
    return CFX5::HostAddr->get_obj_nolookup($host);
  } else {
    return CFX5::HostAddr->get_obj($host);
  }
}

=head3 hostaddrobj

Returns an object of type L<CFX5::HostAddr> for this host.

=cut

sub hostaddrobj {
  my $self=shift;
  return $self->get_hostaddr_obj($self->hostname());
}

=head3 hostaddr

This is the network address of the host, in the form returned by
C<gethostbyname>.  If it cannot be found, this function will return
the hostname, not the undefined value.  This information cannot be
set.

=cut

sub hostaddr {
  my $self=shift;

  # we do no caching, as that's the whole point of the HostAddr stuff.
  my $ha=$self->hostaddrobj();
  if (defined $ha) {
    return $ha->ip();
  }
  undef;
}

=head3 archobj

An object representing the architecture of this host, if known.
Currently the object is recreated every time it is used (as the
creation is cheap!), but this would be changeable at a later date.
The return value is undef if no architecture is yet known.

=cut

sub archobj {
  my $self=shift;
  my $arch=$self->architecture();
  return undef unless defined $arch;
  # if we don't check, the new() call will abort if it's invalid
  return undef unless CFX5::Arch->isok($arch);
  return CFX5::Arch->new($arch);
}

=head3 os

The CFX5OS setting for this host.  Calculated from CFX5ARCH, undefined
until that is calculated.

=cut

sub os {
  my $self=shift;

  my $arch=$self->archobj();
  return undef unless defined $arch;
  return $arch->osname();
}

=head3 is_win32

Returns TRUE if the host is a Win32 host, or FALSE if it is UNIX.  If
it is not yet known, returns C<undef> (which is false).  The
C<detect_host_type> call will fill in a value for this member for a
while, which can be used for working out the rest.

=cut

sub is_win32 {
  my $self=shift;

  my $os=$self->os();

  # set it ...
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(0))[3])
      if @_;
    $self->{intsettings}{is_win32}=$v;

    if (defined $os) {
      # if we've also got an OS, check that it's consistant, as the OS
      # will be used in preference
      if ($v xor ($os eq 'winnt' or $os eq 'winnt-amd64')) {
        internal_error("Setting is_win32 to", ($v ? 'true' : 'false'),
                       "when the os is $os");
      }
    }
  }

  if (defined $os) {
    return ($os eq 'winnt' or $os eq "winnt-amd64" ? 1 : 0);
  }
  # do we have an explicit setting for is_win32?
  if (exists $self->{intsettings}->{is_win32}) {
    return $self->{intsettings}->{is_win32};
  }
  return undef unless defined $os;
}

=head3 suppress_dns

Set this to TRUE to suppress DNS lookups when comparing against the
local host -- if it is not already known to be local, it is assumed
not to be.

=cut

sub suppress_dns {
  my $self=shift;

  # set it ...
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(0))[3])
      if @_;
    $self->{intsettings}{suppress_dns}=$v;
  }

  return $self->{intsettings}->{suppress_dns};
}

=head3 allow_shmem

  if ($host->allow_shmem()) {
    # merge partitions together
  }

Returns TRUE if MPI runs should be allowed to merge partitions I<on
this machine> together into the same procgroup file line (which is
only supported when MPICH was built with -comms=shared, and not always
then (eg Sun)).  This will be FALSE if CFX5_MPI_NO_SHMEM is set,
otherwise TRUE for all os types apart from Solaris.

=cut

use CFX5::Config::def 
  CFX5_MPI_NO_SHMEM => sub { 0; },
  CFX5_MPI_NO_SOLARIS_SHMEM => sub { 0; },
;

sub allow_shmem {
  my $self=shift;
  if ($Config{CFX5_MPI_NO_SHMEM}) {
    return '';
  }
  if (defined $self->os() and $self->os() eq 'solaris' 
      and $Config{CFX5_MPI_NO_SOLARIS_SHMEM}) {
    # doesn't work on the Sun (or is that random?)
    return '';
  }
  1;
}

=head3 fill_in_exec

  my $exec=$host->fill_in_exec($default_exec);

Fills in the various %x substitutions in the executable path.  The
only one not handled here is %a, the optimised architecture, which
will cause an error if it is found; that should be done beforehand if
necessary.

Available substitutions are:

=over

=item %r

ANSYS CFX root directory

=item %v

ANSYS CFX version number

=item %p

PVM/MPI specifier on the executable.  Either -pvm for a PVM run, or
empty for an MPI run.

=item %P

PVM architecture string.

=item %o

CFX5OS string.

=back

=cut

sub fill_in_exec {
  my $self=shift;
  my $exec=shift;
  my $start_method=shift;

  if ($exec =~ m!%a!) {
    _abort("\%a token is not valid in path $exec");
  }

  # for error messages!
  my $orig=$exec;

  # root directory.  This may seem silly, but it's useful in hst files
  # and for testing!
  if ($exec =~ m!%r!) {
    my $root=$self->root();
    $exec =~ s!%r!$root!g;
  }

  # tools directory
  if ($exec =~ m!%t!) {
    my $root=$self->tools_root();
    $exec =~ s!%t!$root!g;
  }

  # parallel selection - PVM or MPI
  if ($exec =~ m!%p!) {
    if (defined $start_method) {
      my $paropt=$start_method->exec_suffix();
      $exec =~ s!%p!$paropt!g;
    } else {
      # if this isn't the solver exec, we may not bother to pass the
      # start method object.  In that case, the implication is that
      # the user can't use the '%p' token, but if you get this error
      # unexpectedly, check the caller!
      _error("The \%p token is not valid in this context, while expanding path $orig");
    }
  }

  # ANSYS CFX version
  if ($exec =~ m!%v!) {
    $exec =~ s!v%v!v$Config{ANSYSCFXRELEASE}!g;
  }

  if ($exec =~ m!%P!) {
    my $arch=$self->pvm_arch();
    defined $arch or return undef;
    $exec =~ s!%P!$arch!g;
  }

  if ($exec =~ m!%o!) {
    my $arch=$self->os();
    defined $arch or return undef;
    $exec =~ s!%o!$arch!g;
  }

  $exec;
}

=head3 arch_dir

  $host->arch_dir($start_method);

Returns the architecture specific directory for use on this host.

=cut

sub arch_dir {
  my $self=shift;
  my $start_method=shift;

  if (@_) {
    internal_error("arch_dir cannot be set");
  }

  $self->detect_host_arch();
  my $os=$self->os();
  unless (defined $os) {
    # we'll already have an error from detect_host_arch?
    return undef;
  }

  unless (defined $start_method) {
    internal_error("Undefined start method");
  }

  # determine the attributes.  XXX should we have some way of saying
  # which object we're getting them from?
  my $atts = $self->{job}->solver_exec_type();

  my $arch=$self->architecture() || $self->os();
  my $suffix=$start_method->exec_suffix();

  # make sure it's all valid before we continue
  unless (CFX5::Arch->is_valid_arch($arch)) {
    _error("Architecture string \"$arch\" for host", $self->descname(),
           "is not valid.");
    return undef;
  }

  # now figure out if we can use an optimised architecture
  my $pinf=CFX5::PlatformInfo->get();
  my $cclpath=$pinf->find_arch_for('solver',$arch,$atts,$suffix);

  my $dir;
  if (defined $cclpath) {
    _debug("Using solver from CCL path $cclpath");
    $dir=$pinf->archos($cclpath);

    # if we've not done so already, give a warning
    unless ($self->{intsettings}{have_warned_arch}) {
      my $hostarch=new CFX5::Arch($arch);
      my $codearch=new CFX5::Arch($dir);
      my $name="ANSYS CFX";
      if (defined $atts) {
        $name .= qq( "$atts");
      }
      $hostarch->maybe_warn_code_for($codearch,
                                     "The best available $name Solver executable for slave host ".$self->name()." is built for $dir. ");
      $self->{intsettings}{have_warned_arch}=1;
    }

  } else {
    # couldn't find one.  Belt-and-braces fallback position: use the
    # OS, like we used to in the good old days
    $dir=$self->os();
    _debug("Unable to find solver, using default os $dir");
  }

  return $dir;
}

=head3 cfx_libdir

The CFX library directory on the remote host.  By default,
taken from the installation directory (see C<root>).

=cut

sub cfx_libdir {
  my $self=shift;
  my $start_method=shift;

  if (@_) {
    internal_error("cfx_libdir cannot be set");
  }

  _debug("About to calculate library path for host", $self->descname());

  return $self->join_file($self->root(), 'lib', $self->arch_dir($start_method));
}

=head3 cfx_bindir

The CFX binary directory on the remote host.  By default,
taken from the installation directory (see C<root>).

=cut

sub cfx_bindir {
  my $self=shift;
  my $start_method=shift;

  if (@_) {
    internal_error("cfx_bindir cannot be set");
  }

  _debug("About to calculate binary path for host", $self->descname());

  return $self->join_file($self->root(), 'bin', $self->arch_dir($start_method));
}

=head3 multiport_wrapper_path

The multiport MPI wrapper library path on a host.  By default,
taken from the installation directory (see C<root>).

=cut

sub multiport_wrapper_path {
  my $self=shift;

  if (@_) {
    internal_error("multiport_libdir cannot be set");
  }

  _debug("About to calculate multiport library path for host", $self->descname());

  return $self->join_file($self->tools_root(), 'multiport', 'mpi_wrapper', $Config{FLUENTOS});
}

=head3 multiport_paths

Multiport paths (including stub library).  By default,
taken from the installation directory (see C<root>).

=cut

sub multiport_paths {
  my $self=shift;

  if (@_) {
    internal_error("multiport_paths cannot be set");
  }

  _debug("About to calculate multiport paths for host", $self->descname());

  my $multiport_root = $self->join_file($self->tools_root(), 'multiport');

  my @paths;
  push @paths, $self->join_file($multiport_root, $Config{FLUENTOS}, 'mpi', 'shared'),
               $self->join_file($multiport_root, 'utilities', $Config{FLUENTOS});  

  return @paths;
}

=head3 actual_executable

  $host->do_cmd($host->actual_executable());

Returns the name of the executable for use on this host, with all the
architecture and parallel-mode strings filled in.

=cut

sub actual_executable {
  my $self=shift;
  my $start_method=shift;

  if (@_) {
    internal_error("actual_executable cannot be set");
  }
  my $exec=$self->executable();

  return undef unless defined $exec;

  _debug("About to calculate executable details for path $exec, host", $self->descname());

  # Substitute architecture specific directory
  if ($exec =~ m!%a!) {
    my $dir = $self->arch_dir($start_method);
    my $atts = $self->{job}->solver_exec_type();
    if (defined $atts and $atts) {
      $dir = $self->join_file($dir, $atts);
    }
    $exec =~ s!%a!$dir!g;
  }

  return $self->fill_in_exec($exec, $start_method);
}

=head2 REMOTE ACCESS CALLS

The calls in this section are used to run commands on the remote host,
in the current implementation via rsh.

=head3 do_cmd

  my $rv=$host->do_cmd($cmd, @args);

Runs a command on the host.  The method of access to the host will be
dependant on the host: for the local host, the command is run
directly, and for a remote host, the method of access specified in the
CCL is used.  Currently there is no way to specify the access method
in CCL, and this is always rsh.

=cut

sub do_cmd {
  my $self=shift;

  # if called in a list context, it's probably old code expecting a
  # list of returned lines
  if (wantarray) {
    internal_error("do_cmd should only be called in scalar context");
  }

  if ($self->is_local()) {
    # run it here
    my $rv=do_output_cmd(@_);
    $rv->set_cmd_desc("Command on host ".$self->descname());

    # we make sure we remove any undefs from the list, not sure if
    # this is an old problem or still happens
    my @list=grep { defined $_ } $rv->cmd_output();

    return $rv;
  }

  # otherwise, we need to choose a method.  For now, rsh it is.
  return $self->rsh(@_);
}

=head3 do_batch_cmd

  my $rv=$host->do_batch_cmd($cmd, @args);

Runs a command on the host.  The method of access to the host will be
dependant on the host: for the local host, the command is run
directly, and for a remote host, the method of access specified in the
CCL is used.  Currently there is no way to specify the access method
in CCL, and this is always rsh.

Unlike C<do_cmd>, C<do_batch_cmd> does not set a timeout on the rsh,
and so is suitable for long-running commands.  It also uses
do_termerr_cmd rather than do_output_cmd, so that output gets sent to
the terminal as it happens, which makes a difference in a long run.

=cut

sub do_batch_cmd {
  my $self=shift;

  # if called in a list context, it's probably old code expecting a
  # list of returned lines
  if (wantarray) {
    internal_error("do_cmd should only be called in scalar context");
  }

  if ($self->is_local()) {
    # run it here
    my $rv=do_termerr_cmd(@_);
    $rv->set_cmd_desc("Command on host ".$self->descname());

    return $rv;
  }

  # otherwise, we need to choose a method.  For now, rsh it is.
  my @cmd=@_;
  unless ($Config{CFX5_DIRECT_REMOTE_CMDS}) {
    # unless the user really really knows what they're doing, we'll
    # use the cfx5remote command to set up the library path, current
    # directory, etc.
    cfx5_require('CFX5::PathManip');
    unshift @cmd, (
                   $self->fill_in_exec($self->cfx5remote_path()),
                   -chdir => CFX5::PathManip::get_cwd(),
                   -env   => q('PVM_ROOT=) . $self->pvm_root() . q('),
                   '-std-vars' => 'CFX_DATA_DIR,LM_LICENSE_FILE',
                   '-set-rld-path',
                  );
  }
  my $rv=$self->rsh_batch(@cmd);

  # if it displayed anything, it's likely an error
  $rv->set_term_error($rv->cmd_output());
  $rv->set_cmd_output();
  return $rv;
}

=head3 rsh_internal

I<internal>

Actually does the rsh.

=cut

sub rsh_internal {
  my $self=shift;
  my $timeout=shift;

  my @cmd=@_;

  unless ((caller(2))[3] =~ m/CFX5::Parallel::Host::do_cmd/
          or (caller(2))[3] =~ m/CFX5::Parallel::Host::do_batch_cmd/) {
    if ($^W) {
      warn "rsh() called from ", (caller(1))[3],
	" not do_cmd";
    }
  }

  my $rsh = $Config{CFX5RSH_PROBE};
  unless (defined $rsh) {
    _error("Cannot determine rsh command (CFX5RSH_PROBE)");
    return undef;
  }

  my @rshcmd;
  my @args;
  if (defined $self->username()) {
    push @args, '-l', $self->username();
  }
  if ($Config{windows_nt}) {
    @rshcmd=($rsh, $self->hostname(),@args,
             join(' ',@cmd));
  } else {
    # we need to pass it as a single string as it contains shell
    # metachars, so it needs to go through the shell.
    @rshcmd=join(' ', $rsh, $self->hostname(), '-n', @args,
                 '"' . join(' ',@cmd) .'"', '2>&1');
  }

  _trace("Capturing", @rshcmd);

  my $rv;
  {
    local $SIG{ALRM} = 'IGNORE';
    #local $SIG{ALRM} = sub { warn "Brrrinnnggg!"; };
    # if it's not finished inside a minute, it's probably not going to?
    if (defined $timeout) {
      alarm $timeout;
    }
    $rv=do_output_cmd(@rshcmd);
    if (defined $timeout) {
      alarm 0;
    }
  }

  $rv->set_cmd_desc("Remote command " . join(" ", @cmd) . " on host ".$self->descname());

  my @list=$rv->cmd_output();

  # Win32 hosts don't set $? correctly after an rsh, so check for
  # recognised errors and record them correctly.
  if (@list == 1) {
    my $l=$list[0];
    $l =~ s!\r*\n$!!g;
    if (lc($list[0]) eq 'the system cannot find the file specified.') {
      _debug("Overriding return value with not-run");
      # record the error ...
      $rv->set_runerr($l);
      # ... make sure it's marked "not run" ...
      $rv->reparse_rv(-1);
      # ... and remove this line of output
      shift @list;
    }
  }

  $rv->set_cmd_output(@list);

  $rv;
}

=head3 rsh

I<This call should not usually be used>, see the C<do_cmd> call for
the normal way of doing this.

  my $rv=$host->rsh($cmd,@args);

Uses rsh to run a remote command on the host.  The return value is an
object of type C<CFX5::Command::Result>, containing the output from
the command in the C<cmd_output> slot.  The status recorded in this
object will be the exit status of the rsh command, rather than that of
the command run on the remote host.

Because the rsh functionality is prone to hanging, this call imposes a
timeout (currently 120s) on the command.  If it takes longer than
that, it will be killed.

Do not use this function to run commands which expect to interact with
the user.

=cut

use CFX5::Config::def CFX5_RSH_TIMEOUT => sub { 60; };

sub rsh {
  my $self=shift;
  return $self->rsh_internal($Config{CFX5_RSH_TIMEOUT}, @_);
}

=head3 rsh_batch

Like rsh, but expects to run a batch command rather than a quick query
command.  Basically, this means it does not use a timeout!

=cut

sub rsh_batch {
  my $self=shift;
  return $self->rsh_internal(undef, @_);
}

=head2 REMOTE CHECKS

A set of calls to check various things about the remote system.  All
of these calls cache their result internally, and will do nothing if
called again.

=head3 disable_remote_checks

Returns true if we should not make any remote checks on this host.
This means that we assume that we can connect to the host in whatever
way we need to, and that the installation (ie, the solver executable)
is in the location described in the CCL.

Note that in particular, if this is enabled, users must specify an
architecture string for this host, as the script will be unable to
determine this for itself.

=cut

sub disable_remote_checks {
  my $self=shift;
  return $Config{CFX_SOLVE_DISABLE_REMOTE_CHECKS} ? 1 : '';
}

=head3 check_link

  abort() unless $host->check_link();

Returns TRUE if a machine can be accessed, or FALSE otherwise.  If the
access fails, signals an error.

Additionally, it will check for additional output before the result we
were expecting, and if that is found, will give a warning.  If this
warning is triggered, the TRUE value will be the string 'dirty'.  This
is particularly important for PVM on Windows hosts, and may be
disabled later for UNIX and/or MPI.

The error currently refers to remote connections, as this is the most
likely case where it could go wrong: this should be fixed.  The call
is still usable on the local host.

If remote connections are disabled for this host, the return value
from check_link will still be true, as we're assuming that things are
working correctly.  See also the rsh_works call.

=cut

sub check_link {
  my $self=shift;
  if ( $self->disable_remote_checks() ) {
    # if we're not doing any remote checks, just return success ("the
    # link is in a sufficient state for the scripts to work")
    _debug("Link to ", $self->descname(), " not checked.");
    return 1;
  }

  # we won't re-do this, even if we get an error
  if (exists $self->{intsettings}{check_link}) {
    return $self->{intsettings}{check_link};
  }
  my $rrv=\$self->{intsettings}{check_link};
  $$rrv=undef;

  my $rv = $self->do_cmd(($self->is_win32() ? ("cmd", "/c") : ()),
                         "echo", "TRUE");

  # TODO: get a manual reference?
  # TODO: what about different remote access protocols?
  my @args;
  my $user=$Config{CFX_USER};
  if (defined $self->username()) {
    push @args, '-l', $self->username();
    $user=$self->username();
  }
  my @xtra;
  if ( $Config{CFX5RSH} =~ m!rsh! ) {
    @xtra=("\nCheck that you have typed the hostname correctly, that you have an account \"$user\" on the specified host with permission to rsh from this host, and that (particularly for Windows hosts) it is running an rsh daemon.  You can use the following command to check the connection to a UNIX machine:\n  $Config{CFX5RSH_PROBE}", $self->hostname(), @args, "uname\nor the following command if it is a Windows machine:\n  $Config{CFX5RSH_PROBE}", $self->hostname(), @args, "cmd /c echo working\n");
  }
  else {
    my ($rshcmd,$args) = split ' ', $Config{CFX5RSH_PROBE}, 2;
    @xtra=("\nCheck that you have typed the hostname correctly, and that you have an account \"$user\" on the specified host with access permission from this host.  You can use the following command to check the connection to a UNIX machine:\n  $rshcmd", $self->hostname(), @args, "uname\nor the following command if it is a Windows machine:\n  $rshcmd", $self->hostname(), @args, "cmd /c echo working\n");
  }

  unless ($rv->is_success()) {
    my @output=$rv->cmd_output();
    if (@output) {
      @output=("It gave the following output:\n\n",
               map { ("\n  ",$_) } (@output), "\n\n");
    }

    _error($rv->errstr("Remote connection to ".$self->descname()).' ', 
           @output, @xtra);
    $$rrv=0;
    return $$rrv;
  }

  unless ($rv->cmd_output()) {
    _error($rv->errstr("Remote connection to ".$self->descname()).' without giving any output. ', @xtra);
    $$rrv=0;
    return $$rrv;
  }

  my ($found,@before,@after);
  for my $o ($rv->cmd_output()) {
    chomp $o;
    $o =~ s![\r\n]!!g; # chomp doesn't remove ^M on UNIX!
    
    if ( not $found ) {
      if ($o=~m/TRUE(.+)?/) {
	if(defined $1){
	  my $tmpval=$1;
	  # Substitute a space with "<space>" as it will not be obvious
	  $tmpval=~s/ /<space>/g;
          push @after, $tmpval;
        }
        # success
        $found=1;
      }
      else {
        push @before, $o;
      }
    }
    # We've already got it - so this is garbage
    else {
     push @after, $o;
    }
  }

  unless ($found) {
    # our "TRUE" didn't appear in the output, ergo we failed.
    _error("Cannot open remote connection to", $self->descname()
	   .".  Error message was:\n  ",
	   join("\n  ", $rv->cmd_output()), @xtra);
    $$rrv=0;
    return $$rrv;
  }

  $$rrv=1;

  # we succeeded.  If this is a remote host, check for leading and trailing
  # garbage, since PVM gets upset about this (on Windows only?).  If
  # it's a local host we don't need to check, since PVM never rshes to
  # the local host, and so it won't get confused.  It is possible to
  # trigger this check locally, on Windows, by running in a UNC share:
  # then cmd gives an error and resets its working directory, and the
  # error triggers the check.
  if( not $self->is_local()) {
    if (@before) {
      _warn("$Config{CFX5RSH_PROBE} connection to host", $self->descname(),
          "produces the following output before the",
          "output of the command:\n  ". join("\n  ", @before). 
          "\nThis may cause problems spawning parallel slaves, especially on",
          "Windows.");
      $$rrv='dirty';
    }

    if (@after) {
      my $winwarning=$self->is_win32() ? "\nIt could indicate that an rshd service from a different vendor is running, which may not provide the necessary functionality." : '';
      _warn("$Config{CFX5RSH_PROBE} connection to host", $self->descname(),
          "produces the following output after the",
          "output of the command:\n  ". join("\n  ", @after). $winwarning .
          "\nThis may cause problems spawning parallel slaves.");
      $$rrv='dirty';
    }
  }
  
  return $$rrv;
}

=head3 detect_host_type

  $host->detect_host_type();
  applaud() unless $host->is_win32();

Uses rsh to query whether a remote host is UNIX or Win32, and stashes
that information in the object.  If the type is already known (for
example, if the architecture is already set), no check is done.

In the current implementation, any host which cannot be contacted will
be (irrelevantly) assumed to be UNIX.

=cut

sub detect_host_type {
  my $self=shift;

  # this check will always trigger for the local host
  if (defined $self->os()) {
    # OK, we'll be able to work it out on the fly
    return 1;
  }

  if (defined $self->is_win32()) {
    # we can't do any more than we already know
    return 1;
  }

  # if we've not got anything yet, we need to query the host.
  if ( $self->disable_remote_checks() and not $self->is_local() ) {
    _error("No architecture information is known for host",
           $self->descname(),
           "and remote queries are disabled for this host.  Please specify",
           "the architecture of this host in your run setup.");
    return '';
  }

  # any UNIX system on which this succeeds is severely confused ... As
  # an alternative, we could use $self->do_cmd('uname'), which would
  # allow us to fill in the os() field without any extra work.
  # However, the below is (a) known to be safe, and (b) expected to
  # work (rather than fail) on Windows, which is probably the most
  # fragile platform anyway.  TODO: Maybe this should be revisited.
  my $rv=$self->do_cmd(qw(cmd /c echo TRUE));
  unless ($rv->is_success()) {
    _debug("rsh failed, will attempt to continue");
  }
  unless ($rv->cmd_output()) {
    _error("Unable to determine type of remote host",
	   $self->descname(),
	   "as no data was returned.");
    return undef;
  }
  my @out=$rv->cmd_output();
  for my $o (@out) {
    $o =~ s/[\n\r ]*$//;
    if ($o eq 'TRUE') {
      # got an NT host
      $self->is_win32(1);
      return 1;
    }
  }

  # if we got here, we probably got an error message from rsh, so it's
  # probably not NT.  If it is, we can't get at it anyway!  We'll log
  # it, for future reference, but this is presumably a UNIX box.
  _debug("Output was:", join('; ',@out));
  $self->is_win32('');
  1;
}

=head3 detect_host_arch

  $host->detect_host_arch();
  applaud() unless $host->is_win32();

Uses rsh to query the architecture string for a remote host, and
stashes that information in the object.  If the architecture is
already known, no check is done.

If we have a ANSYS CFX Installation Root setting for the host, the
cfx5info command will be used to work out the exact architecture.
Otherwise (ie, if the Installation Root setting is "none", so C<root>
returns undef), the CFX5OS setting will be used, guessed from the
uname on UNIX systems and assumed to be "winnt" for Windows systems.

=cut

sub detect_host_arch {
  my $self=shift;

  # if we already have it, we don't need to calculate it!  We do,
  # however, need to check if it's valid, since the user could have
  # explicitly supplied bad data -- this function is responsible for
  # giving errors about architectures (see actual_executable), and so
  # we need to do so even if the user supplied it.
  if (defined (my $arch=$self->architecture())) {
    if (CFX5::Arch->is_valid_arch($arch)) {
      return $arch;
    }
  }

  if ($self->is_local()) {
    # on the local machine, we should already know this.
    internal_error("Architecture not assumed for local host");
  }

  # if we've already been through this, even if we didn't get an
  # answer, there's no point in going through it all again.  If we
  # succeeded, architecture() will have returned something above, so
  # at the moment this will always be undef.
  if (exists $self->{intsettings}{detect_host_arch}) {
    return $self->{intsettings}{detect_host_arch};
  }

  $self->{intsettings}{detect_host_arch}=undef;

  # give the error, see above
  if (defined (my $arch=$self->architecture())) {
    unless (CFX5::Arch->is_valid_arch($arch)) {
      _error("Supplied architecture string \"$arch\" for", $self->descname(),
             "is not valid.");
      return undef;
    }
  }

  # if we've not got anything yet, we need to query the host.
  if ( $self->disable_remote_checks() and not $self->is_local() ) {
    _error("No architecture information is known for host",
           $self->descname(),
           "and remote queries are disabled for this host.  Please specify",
           "the architecture of this host in your run setup.");
    return undef;
  }

  # assume it's going to succeed ...
  $self->{intsettings}{detect_host_arch}=1;

  # we need to know if it's Win32, as on Win32 we need to add the .exe
  # to the cfx5info command in order for it to be found.
  $self->detect_host_type();

  my $root=$self->root();

  if (defined $root) {
    # try to work it out with cfx5info
    my $_exe=$self->is_win32() ? '.exe' : '';
    my $rv=$self->do_cmd($self->join_file($root,'bin',
                                          "cfx5info$_exe"), '-os');
    unless ($rv->is_success()) {
      _debug("rsh failed, will attempt to continue");
    }
    my @out=$rv->cmd_output();
    unless (@out) {
      if ($self->check_link()) {
        _warn("Unable to determine architecture of remote host",
              $self->descname(),
              "using the cfx5info command\n\n",
              "  ".$self->join_file($root,'bin',
                                    'cfx5info'), '-os',
              "\nas no data was returned.");
      }
    } else {
      my $arch;
      for my $oo (@out) {
        # strip all w/s
        (my $o=$oo) =~ s/[\n\r ]+//g;
        # does it look like an architecture?
        if (CFX5::Arch->is_valid_arch($o)) {
          $arch=$o;
          # we don't return now, in case there's another one to
          # follow, in which case it's more likely to be correct ...
        }
      }
      if (defined $arch) {
        $self->architecture($arch);
        return $arch;
      } else {
        if ($self->check_link()) {
          _warn("Unable to determine architecture of remote host",
                $self->descname(),
                "using the cfx5info command\n\n",
                "  ".$self->join_file($root,'bin',
                                      'cfx5info'), '-os',
                "\n\nExpected an architecture string, but the actual",
                "returned text was:\n\n",
                map { "  $_\n" } @out,
               );
        }
      }
    }
  }

  #
  # cfx5info isn't going to work, let's try uname.  First of all,
  # though, we can take a shortcut for NT boxen.
  #

  if ($self->is_win32()) {
    # it's winnt!
    $self->architecture('winnt');
    return 'winnt';
  }

  # now try uname
  my $rv=$self->do_cmd('uname');
  unless ($rv->is_success()) {
    _debug("rsh failed, will attempt to continue");
  }
  my @out=$rv->cmd_output();
  unless (@out) {
    if ($self->check_link()) {
      _warn("Unable to determine architecture of remote host",
            $self->descname(),
            "using the uname command, as no data was returned.");
    }
  } else {
    my $uname=pop @out;
    $uname =~ s/[\n\r ]+//g;
    my %map=(
             AIX => 'aix',
             IRIX => 'irix',
             IRIX64 => 'irix',
             'HP-UX' => 'hpux',
             Linux => 'linux',
             OSF1 => 'osf',
             SunOS => 'solaris',
             CYGWIN32_NT => 'winnt',
             Windows_NT => 'winnt',
            );
    if (exists $map{$uname}) {
      $self->architecture($map{$uname});
      return $map{$uname};
    } elsif ($uname =~ m!CYGWIN.*NT!) {
      # anything matching this is probably Windows
      $self->architecture('winnt');
      return 'winnt';
    }
  }

  # no, after all that, we failed
  $self->{intsettings}{detect_host_arch}=undef;

  _error("The architecture string for host", $self->descname(), 
         "could not be determined.");

  undef;
}

=head3 check_for_executable

  $host->check_for_executable($exec);

Checks for the presence and accessibility of the executable named I<on
the host>, via rsh or similar. Returns TRUE or FALSE, or calls _error
and returns C<undef> if it is unable to determine existance.

=cut

sub check_for_executable {
  my $self=shift;
  my $exec=shift;

  # if we've not got anything yet, we need to query the host.
  if ( $self->disable_remote_checks() and not $self->is_local() ) {
    _debug("Assuming existance of executable on remote host",
           $self->descname(), "where remote checks are disabled");
    return 1;
  }

  unless (defined $exec) {
    if ($self->check_link()) {
      _error("Unable to check for executable on", $self->descname(),
             "as the executable name could not be determined.");
    }
    return undef;
  }

  unless (exists $self->{intsettings}{check_for_executable}) {
    $self->{intsettings}{check_for_executable} = {};
  }

  if (exists $self->{intsettings}{check_for_executable}{$exec}) {
    return $self->{intsettings}{check_for_executable}{$exec};
  }

  # we won't re-do this, even if we get an error
  my $rrv=\$self->{intsettings}{check_for_executable}{$exec};
  $$rrv=undef;

  if ($self->is_local()) {
    $$rrv=(-x $exec ? 1 : 0);
    return $$rrv;
  }

  my $rv;

  # in case the executable didn't need us to work out the
  # architecture, make sure we know the type at least.
  $self->detect_host_type();

  # if the other end is a Cygwin rsh server, we need to treat it as a
  # UNIX box, not Windows.  There's no point trying to autodetect
  # this, as most users won't use it this way, but this env var might
  # make it work if anybody wants to try.
  
  if ($self->is_win32() and not $Config{CFX5_SOLVE_CYGWIN_RSH}) {
    $rv = $self->do_cmd("cmd /c if exist \\\"$exec\\\" (echo TRUE) ".
                      " else (echo FALSE)");
  } else {
    $rv = $self->do_cmd("echo 'if test -x '\\''$exec'\\''; then echo TRUE; else echo FALSE; fi' | sh");
  }

  for my $o ($rv->cmd_output()) {
    $o =~ s/[\n\r ]*$//;
    if ($o eq 'TRUE') {
      $$rrv=1;
      return $$rrv;
    } elsif ($o eq 'FALSE') {
      $$rrv=0;
      return $$rrv;
    }
  }

  # ding dong, we lose.  Looks like the command failed somehow, so
  # make sure we can actually rsh to this machine ...
  if ($self->check_link()) {
    # yes we can, so I don't understand what's going on.
    _error("Unable to check for executable $exec on", $self->descname(), "(of type", 
           (defined $self->os() ? $self->os() : 
            ($self->is_win32() ? 'Win32' : 'UNIX')) .
           "):\n",
           "Expected TRUE or FALSE from rsh command, actual return was:\n  "
           .join("\n  ", $rv->cmd_output()));
  }

  return undef;
}

=head2 COMPARISON FUNCTIONS

=head3 same_as

Compares two host objects, and returns TRUE if they refer to the same
host, or FALSE otherwise.

=cut

sub same_as {
  my $na=shift;
  my $a=$na->get_hostaddr_obj($na->hostname());
  my $nb=shift;
  my $b=$na->get_hostaddr_obj($nb->hostname());

  return undef unless defined $a and defined $b;

  return $a->same_as($b);
}

=head3 is_local

  rsh() unless $host->is_local();

Returns TRUE if the network address of the given host is the same as
the local host.

=cut

sub is_local {
  my $self=shift;
  my $local=CFX5::HostAddr->get_local_obj();
  my $thishost=$self->get_hostaddr_obj($self->hostname());

  return undef unless defined $thishost and defined $local;

  return $thishost->same_as($local);
}

=head3 has_name

  if ($host->has_name('foo')) {
    # ...
  }

Returns TRUE if the name passed in could be a name for this host, or
FALSE otherwise.

=cut

sub has_name {
  my $self=shift;
  my $name=shift;

  my $hself=$self->get_hostaddr_obj($self->hostname());
  my $hnew=$self->get_hostaddr_obj($name);

  return undef unless defined $hself and defined $hnew;

  return $hself->same_as($hnew);
}

=head3 is_default_root

  $host->is_default_root();

Returns TRUE or FALSE depending on whether the installation root is default.

=cut

sub is_default_root {
  my $self = shift;
  my $root = $self->root();

  if (defined $root) {
    return CFX5::PathManip::is_same_dir($root,$Config{CFX5ROOT});
  }
  return undef;
}

=head2 HELPER ROUTINES

=head3 join_file

  my $rfile=$host->join_file($host->root(),'etc',$Config{BUILDID},'RULES');

This call acts very similar to the C<join_file> in L<CFX5::PathManip>,
except it uses the C<is_win32> method on the given object to decide
which path separator to use, rather than the architecture of the
current host.

=cut

sub join_file {
  my $self=shift;
  my $dirsep=$self->is_win32() ? '\\' : '/';
  join($dirsep,@_);
}

=head3 mark_non_library

  $host->mark_non_library();

Ensures that the CCL for this host is not marked as library CCL in the
database.

=cut

sub mark_non_library {
  my $self=shift;

  my @path=grep { defined $_ and $_ ne '' } split('/',$self->cclpath(''));
  my @ccl;
  # first go down the tree ...
  for my $p (@path) {
    if ($p =~ m!:!) {
      push @ccl, $p;
    } else {
      push @ccl, "$p:";
    }
  }

  # ... and now straight back up again, we don't need to set any
  # parameters
  push @ccl, ("END") x scalar(@path);

  return $self->parse_ccl_data(\@ccl,0);
}

1;
