=head1 NAME

CFX5::Commands::Result - Object representing a completed command

=head1 DESCRIPTION

This class is used by L<CFX5::Commands> to construct objects to
represent the return value of a completed command.  It should not
usually be used on its own.

For compatibility, the internal representation of the object is
currently the same as used to be returned by the parse_rv call from
L<CFX5::Commands>, which has been re-implemented in terms of these
objects.  However, this link may be broken in the future, and new code
should use the object-oriented access routines instead.

=cut

package CFX5::Commands::Result;

use strict;

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

use CFX5::Output qw(:all);
use Config;

=head2 OBJECT INSTATIATION

=head3 parse_rv

  $rv = CFX5::Commands::Result->parse_rv(do_cmd("ls"));

Takes the return value of C<do_cmd> (or C<system>), and breaks it down
into component pieces.  The return value is a reference to a new
object, initialised from the status.

Note that Perl 5.004 on Windows NT (incorrectly) returns the actual
return value of a process from C<system()>; this function handles that
case too, but obviously cannot fill in most of the fields in this
structure. 

=cut

# work out signal-number-to-name mappings
use vars qw(@SigNumber %SigName);

sub calc_SigNumber {
  # create a signal-number-to-name mapping
  internal_error "Perl doesn't understand signals?!"
    unless defined $Config{sig_name};
  my $n;
  my $i=0;
  for $n (split(' ', $Config{sig_name})) {
    $SigName{$n}=$i;
    $SigNumber[$i]=$n;
    $i++;
  }
}

sub parse_rv {
  my $this=shift;
  my $rv=shift;
  my @cmd=@_;

  if (ref $rv) {
    _debug("null reparse of rv $rv");
    return $rv;
  }

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

  if (defined $cmd[0]) {
    $self->{cmd}=$cmd[0];
  } elsif (defined $CFX5::Commands::LastCmd) {
    # this may not be right, but it usually is
    $self->{cmd}=$CFX5::Commands::LastCmd;
  }

  $self->{pid}=$CFX5::Commands::LastCmdPID if defined $CFX5::Commands::LastCmdPID;

  internal_error("Parsing undefined return value")
    unless defined $rv;

  $self->{runerr}=$CFX5::Commands::LastCmdError;

  _debug "Parsing return value $rv from", defined $self->{cmd} ? $self->{cmd} : 'unknown';

  $self->reparse_rv($rv);
}

=head3 reparse_rv

  $rv->reparse_rv(-1);

Re-parses the return value as given, without modifying any of the
other fields (command name etc).  This is particularly useful if
analysis of the output shows that the command did not actually run
after all, when the value -1 can be used to indicate "not run".
Another useful value is 0, for "ran successfully".

=cut

sub reparse_rv {
  my $self=shift;
  my $rv=shift;

  delete $self->{signal};
  delete $self->{sig_name};
  delete $self->{core};

  # perl 5.004 on NT returns the actual return value, wheras the
  # ActiveState port of 5.003 and native 5.005 does things the same as
  # the UNIX version.
  if ($^O eq 'MSWin32' and $] == 5004) {
    $self->{rv}=$rv;
    $self->{wait_rv} = $rv << 8;
    $self->{actual_rv}=$rv;
  } else {
    $self->{ran}=1;
    $self->{wait_rv}=$rv;

    # record this even if we decide hte cause of death is something
    # else, for error messages
    $self->{actual_rv}=$rv >> 8;

    if ($rv == 0xff00 or $rv == -1) {
      # from the 5.004 docs, this means "failed to run at all"; 5.005
      # doesn't say this, and I know of at least one case (ndiff)
      # where it's blatantly not true.  (Note that this is now fixed
      # in ndiff, but it's still possible that other programs may have
      # the same problem)
      #
      # However, it's still a good approximation!
      $self->{ran} = 0;
    } elsif ($rv == 0x00ff) {
      # this is from experience ... a parse error in the NT shell will
      # cause this return value. (This does not appear to be the same
      # as the above). TODO: what does this do on UNIX?
      $self->{ran} = 0;
    } elsif ($rv > 0xffff) {
      # I'm not sure what's going on, but it's not quite right!  Give
      # an internal error, asking them to tell me what happened;
      # hopefully I can work it out!  I think it's an NT problem
      # mostly ... THIS MUST BE FIXED BEFORE RELEASE!
      my $hex=sprintf("%04X", $rv);
      _warn("Return value $hex >FFFF in parse_rv, treating as not-run.");
      $self->{ran} = 0;
    } elsif ($rv & 0x00ff) {
      # stopped with a signal.  For a while, I thought I needed +1
      # here; now this appears not to be the case.  I'm slightly
      # confused by this, though ...
      $self->{signal}=($rv & 127);
      calc_SigNumber() unless @SigNumber;
      $self->{sig_name}=$SigNumber[$self->{signal}] || '(unknown)';
      $self->{core}=($rv & 128);
    } else {
      $self->{rv}=$rv >> 8;
    }
  }

  # success is a shortcut; we don't use this field internally any
  # more, but external users may still do so.
  $self->{success}=$self->is_success();

  return $self;
}

=head3 new

The C<new> call is provided as an alias for C<parse_rv>.  

=cut

sub new {
  my $this=shift;
  my $rv=shift;
  
  $rv=0 unless defined $rv;

  $this->parse_rv($rv, @_);
}

=head3 new_not_run

  return CFX5::Commands::Result->new_not_run("Initialisation failed", @cmd);

Returns a new object, with the exit status "not run", but does set the
"runerr" property to its argument so that error messages come out
correct.

=cut

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

  $self->{runerr}=shift;
  $self->{ran}='';

  if (defined $_[0]) {
    $self->{cmd}=$_[0];
  }

  $self;
}

=head2 OBJECT INTERROGATION

=head3 is_success

  if ($rv->is_success()) { ... }

Returns TRUE or FALSE, depending on whether or not the command was
successful (ie, ran and returned 0).

=cut

sub is_success {
  my $self=shift;
  return ((exists $self->{rv} and $self->{rv} == 0)
	  and (!exists $self->{signal})
	  and (!defined $self->{ran} or $self->{ran}));
}

=head3 rv

The return value of the process (what it passed to B<exit()>).  If the
process exited because of a signal, this will be undefined.

=cut

sub rv {
  my $self=shift;
  return $self->{rv};
}

=head3 actual_rv

The return value of the process (what it passed to B<exit()>).  This
will be set even if our heuristics decide that the process never ran
in the first place.

=cut

sub actual_rv {
  my $self=shift;
  return $self->{actual_rv};
}

=head3 ran

TRUE if the program was started successfully.

=cut

sub ran {
  my $self=shift;
  return $self->{ran};
}

=head3 set_ran

Sets the indicator of whether the process ran or not

=cut

sub set_ran {
  my $self=shift;
  $self->{ran}=shift;
}

=head3 signal

If the program was stopped by a signal, the signal number. Otherwise
undefined.

=cut

sub signal {
  my $self=shift;
  return $self->{signal};
}

=head3 sig_name

If C<signal> is set, this contains the name of this signal; otherwise,
it too is undefined.

=cut

sub sig_name {
  my $self=shift;
  return $self->{sig_name};
}

=head3 core

TRUE if the program dumped core on exit.

=cut

sub core {
  my $self=shift;
  return $self->{core};
}

=head3 wait_rv

The original return value from wait is stored here.

=cut

sub wait_rv {
  my $self=shift;
  return $self->{wait_rv};
}

=head3 cmd

This is not actually the command which was run, as this is not encoded
in the return value (!). To get around this, we keep track of the last
command which was run by do_cmd and friends, and set this member to
that command name. So long as you keep the limitations of this in
mind, it's fairly useful.

If you use C<handle_rv>, this member is used, so if you pass the
command which you passed to C<system> (or C<do_cmd>) to this function
they will be used to set this correctly. For example. rather than
  $rv=handle_rv(system("ls", "/home"));
you might do
  $rv=handle_rv(parse_rv(system("ls", "/home"),"ls"));

=cut '

sub cmd {
  my $self=shift;
  return $self->{cmd};
}

sub set_cmd {
  my $self=shift;
  $self->{cmd}=shift;
}

=head3 pid

Again, this is hard to keep track of reliably, but when a command
exits we try to find it's PID and record that (for tidying up of
temporary files and so on).  Unsuprisingly, this works better with
L<wait_bg_cmd> than with L<do_cmd>, but we do have a handler for
SIGCHLD and we can usually get this from L<do_cmd> as well.  There is
a small race condition there, though, I think -- it gets the PID of
the most recent command which has exited when system() returns -- so
don't rely totally on this!

=cut

sub pid {
  my $self=shift;
  return $self->{pid};
}

sub set_pid {
  my $self=shift;
  my $pid=shift;
  $self->{pid}=$pid;
}

=head3 errstr

  _error($rv->errstr("The ANSYS CFX Solver"));

Returns a string which can be used in an error report by the caller,
if an error condition has occurred.  It will always return a string
describing how the process exited, so it is not in itself an indicator
of an error condition.

The argument, if any, is a descriptive name which is used instead of
the executable name.

If the C<term_error> information is set on this object, some lines
from this information will also be included in the error message.  See
the C<do_termerr_cmd> call in L<CFX5::Commands> for more details.

=cut

sub errstr {
  my $self=shift;
  my $desc=shift || $self->cmd_desc() || $self->cmd() || "Command";

  my $outinfo='';
  # we restrict this to the top 10 and bottom 10 lines if we need to
  if (my @outinfo = $self->term_error()) {
    if (scalar(@outinfo) > 20) {
      splice(@outinfo,10,(scalar(@outinfo) - 20),'...');
    }
    $outinfo=join("\n  ",
		  "\n\nIt gave the following output:",
		  @outinfo)."\n";
  }

  my $killederr='';
  if (defined $self->killederr()) {
    $killederr = " " . $self->killederr() . "  It";
  }

  unless ($self->ran()) {
    # usually this means it couldn't start ... but sometimes, it's a
    # "valid" return code, at least on NT.  Grrr.
    my $msg="$desc$killederr could not be started";
    if (defined $self->actual_rv()) {
      $msg .= ", or exited with return code " . $self->actual_rv();
    }
    if (defined $self->runerr()) {
      return "$msg: " . $self->runerr() . "." . $outinfo;
    } else {
      return "$msg." . $outinfo;
    }
  }
  if ($self->signal()) {
    return ("$desc$killederr was interrupted by signal " . 
	    $self->sig_name() . " (" . $self->signal() . ")" .
	    ($self->core() ? ' and dumped core' : '') . $outinfo);
  }
  # if it ran, and didn't have signal death, it gave a return value?
  if (defined $self->rv()) {
    return "$desc$killederr exited with return code " . $self->rv(). ". " . $outinfo;
  }
  # no, not even that.  If we have a killed error, return that, as
  # otherwise it would look funny ...
  if ($killederr) {
    return "$desc" . $self->killederr() . "  $outinfo";
  }
  # so give up.
  return "$desc aborted for unknown reasons.  $outinfo";
}

=head3 cmd_desc

If a textual description of the command is available, this can be used
to store and retrieve it, for use in error messages etc.

=cut

sub cmd_desc {
  my $self=shift;
  return $self->{cmd_desc};
}

=head3 set_cmd_desc

Sets the C<cmd_desc> string.

=cut

sub set_cmd_desc {
  my $self=shift;
  $self->{cmd_desc}=shift;
}

=head3 runerr

This item is only relevant when the C<ran> item is FALSE.  It contains
the string to give as an error message indicating why the command
failed to run (which may be something like 'unknown error' if it is
not known).  You should use this instead of C<$!>, which is not
reliable for this purpose.

=cut

sub runerr {
  my $self=shift;
  return $self->{runerr};
}

=head3 set_runerr

Sets the C<runerr> string.  This is useful when a descriptive error
from the system cannot be easily encoded in $?, for example on Win32.

=cut

sub set_runerr {
  my $self=shift;
  $self->{runerr}=shift;
}

=head3 killederr

This item contains, if relevant, a string describing why a process was
terminated.  It is used by timeout code to explain that a process was
explicitly timed out.

=cut

sub killederr {
  my $self=shift;
  return $self->{killederr};
}

=head3 set_killederr

Sets the C<killederr> string.

=cut

sub set_killederr {
  my $self=shift;
  $self->{killederr}=shift;
}

=head3 shell_rv

Returns a shell-style numeric return value.  This is either the actual
return value, the signal number +128 if the process was killed by a
signal, or 255 if the process could not run.

=cut

sub shell_rv {
  my $self=shift;

  unless ($self->ran()) {
    return 255;
  } elsif ($self->signal()) {
    return $self->signal() + 128;
  } else {
    return $self->rv();
  }
}


=head2 ADDITIONAL INFORMATION

Objects of this type have the capability to store additional
information about the result of a command, which can be interrogated
by users of the object when necessary.  So far, we have only a single
field, storing the output of the command, for use if it was run with
the get_cmd_output call.

=head3 cmd_output

Returns the command output from the command which produced this
result.  If called in a list context, returns a list of CR-separated
lines; in a scalar context, returns all the lines joined together as a
large string.

=cut

sub cmd_output {
  my $self=shift;
  if (wantarray) {
    if (defined $self->{cmd_output}) {
      return @{$self->{cmd_output}};
    } else {
      return ();
    }
  } else {
    if (defined $self->{cmd_output}) {
      return join("\n", @{$self->{cmd_output}});
    } else {
      return undef;
    }
  }
}

=head3 set_cmd_output

The counterpart of the C<cmd_output> call, this sets the field
containing the output.  The arguments should be the list of lines in
the output.

=cut

sub set_cmd_output {
  my $self=shift;
  # we might as well try to split it, it may or may not contain
  # embedded newlines
  $self->{cmd_output}=[@_];
}

=head3 term_error

Returns the output from the command which produced this result.  This
behaves largely like C<cmd_output>, but if any text is recorded in
this slot it will be included in any error messages which are produced
by this object.  See the C<do_termerr_cmd> call in L<CFX5::Commands>
for more details.

If called in a list context, returns a list of CR-separated lines; in
a scalar context, returns all the lines joined together as a large
string.

=cut

sub term_error {
  my $self=shift;
  if (wantarray) {
    if (defined $self->{term_error}) {
      return @{$self->{term_error}};
    } else {
      return ();
    }
  } else {
    if (defined $self->{term_error}) {
      return join("\n", @{$self->{term_error}});
    } else {
      return undef;
    }
  }
}

=head3 set_term_error

The counterpart of the C<term_error> call, this sets the field
containing the output.  The arguments should be the list of lines in
the output.

=cut

sub set_term_error {
  my $self=shift;
  $self->{term_error}=[@_];
}

1;
