=head1 NAME

CFX5::Commands::UNIX - UNIX functions for spawning processes

=head1 DESCRIPTION

This package actually defines functions in the CFX5::Commands namespace.

=cut

package CFX5::Commands;

use strict;

use CFX5::Commands::Result;

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

=head2 Export tags

There is only one export tag, C<:all>, which imports all the functions
defined in this file.

=cut

use CFX5::Output qw(:all);
use CFX5::CurrentConfig qw(%Config);
use Carp;

sub do_cmd_quiet {
  return do_cmd(@_);
}

sub do_output_cmd {
  my @cmd=@_;
  _trace "do_output_cmd: @_";
  $LastCmd=$_[0];
  @LastCmd=@_;
  undef $LastCmdPID;
  undef $LastCmdError;

  # ignore pipe signals, as we may well get some.  (Not sure why, but
  # it definitely happens ...)
  local $SIG{PIPE}='IGNORE';

  check_for_executable(@_)
    or return CFX5::Commands::Result->new_not_run("Executable $_[0] not found");

  # make sure we are tidied up before we start
  reap_dead_children();

  # see perlipc

  local *KID_TO_READ;
  my $pid = open(KID_TO_READ, "-|");

  if ($pid) {   # parent
    1;
  } elsif (defined $pid) {      # child
    # try to run the child in a new process group so we can kill it
    setpgrp(0,0)
      or _warn("Error creating process group for child process $$: $!");
    open(STDERR,'>/dev/null');
    exec(@_)
      || die "can't exec $_[0]: $!";
    # NOTREACHED
  } else {
    _abort("Cannot fork: $!");
  }

  # handle ALRM signals if we get them, by killing the child process.
  my $alarmed=0;
  my @output;
  {
    my @sigs=qw(15 9);
    local $SIG{ALRM} = sub {
      $alarmed=1;
      if (@sigs) {
        #warn "Killing $pid with $sig";
        kill -$sigs[0], $pid
          or warn "kill -$sigs[0], $pid: $!";
        shift @sigs;
        # in case it doesn't die, queue another alarm
        alarm 10;
      } else {
        # not sure what we can do from here, but let's dump a message
        # so the user might know what's going on, at least ...
        warn "Error killing process $pid (which has exceeded its timeout), $0 will block until this process exits\n";
      }
    };

    # it seems we have to check for EINTR on the DEC. :-(
    while (defined ($_ = <KID_TO_READ>) 
           or $! eq 'Interrupted system call') {
      if (defined $_) {
        push @output,$_;
      } else {
        _debug("Got errno=$!, will continue");
        $!=0;
      }
    }
    close(KID_TO_READ);
  }

  my $rv=$?;

  $LastCmdPID=$pid;
  register_child_death($pid,$rv);

  reap_dead_children();

  $?=$rv;

  my $prv=parse_rv($rv);
  $prv->set_cmd_output(@output);

  _debug("Output is:", @output);

  if ($alarmed) {
    $prv->set_killederr("was terminated due to a timeout.");
  }

  return $prv;
}

sub fork_cmd {
  _trace "fork_cmd: @_";
  my $name=shift;

  if ($Config{windows_nt}) {
    internal_error("fork_cmd is not implemented for NT");
  }

  check_for_executable(@_)
    or return undef;

  # make sure we are tidied up before we start
  reap_dead_children();

  my $pid=fork();
  if ($pid) {
    # parent: we've got more to do yet
    1;
  } elsif (defined $pid) {
    # child - re-set signals etc
    if (%CFX5::ExitRoutines::) {
      # it's loaded: remove the funny signal traps
      CFX5::ExitRoutines::default_signal_traps();
      # and the tidyup routines
      while (CFX5::ExitRoutines::pop_tidyup()) { 1; }
    }
    return $pid;
  } else {
    # failed
    _abort "Cannot fork: $!";
  }

  # parent

  _debug("Forked $name in background as PID $pid");

  # unset the return value so we know the process hasn't finished;
  # this is no longer a race condition, as we don't handle SIGCHLD
  # explicitly any more.
  delete $bg_cmd_status{$pid};
  # and record the command line for Ron
  $BGCmdLines{$pid}=[$name];

  return $pid;
}

1;
