sub execute_command
{
  my ($command,$dummy) = @_;
  $dummy && return;
  ($command) = ($command =~ /^\s*(.+)\s*$/);
  $command || return;
  return &create_and_read_from_another_process($command,"STDOUT");
}

sub backtick
{
  my ($command,$dummy) = @_;
  $dummy && return;
  ($command) = ($command =~ /^\s*(.+)\s*$/);
  $command || return;
  return &create_and_read_from_another_process($command,"capture_and_return");
}

sub create_and_read_from_another_process
#	Code very similar to get_JGOFS_record stuff (in wjs*perl*routines*)
#	and should probably be unified.		WJS  Dec 08

#  25 Dec 12  WJS
#	Add capability to control where output from executed process ends up
#	  Included adding an entry for each of the 2 (so far) ways of doing things
#   2 Dec 12  WJS
#	Correct documentation comments to reflect that 7 args can be returned

#   Get output from another pipe to another process, recording all 
#						available diagnostic information.
#     Returns 0 or 7 values.
#	0 vals: Bad input argument list (eg, no command or > 1 arg)
#	7 vals:
#		Val 1 = data received from child process
#		Val 2 = $? of child process
#		Val 3 = pid of child process (= return value from open)
#		Val 4 = $! of open
#		Val 5 = $! of last read from child process
#		Val 6 = return value from close
#		Val 7 = $! of close
#	Vals 2-7 returned as numbers rather than strings
#   	None of vals 4-7 seem to be documented to mean anything, and, indeed, 
#   using them has often caused trouble in the sense that a normal perl 
#   operation will alter a 0 $! to a non-zero (abnormal) one.  Vals are
#   returned anyway in case my doc reading has come up short

#     A child that completes properly (not necessarily normally) will
#   communicate its status either via its $? or what it writes to this
#   routine.  If the child always writes SOMETHING (either an answer or an
#   error message), then this non-emptiness is the best status available.
#     The perl book says to check for the successful creation of the child
#   process by looking to see if the pid is defined (if undefined, this
#   routine returns the empty string).  However, it seems to me that the
#   child could be created, write to its output, and exit before the pid
#   check has been performed.  The fork system service (presumably used by
#   perl to create the child) is documented to return 0 in the child process
#   and, in the parent, either the pid of the child or -1.  If the latter,
#   errno is set to reflect the cause of failure.  Thus one could guess that
#   either the returned pid value or the $! of the open would have failure
#   info.  However, the perl book does not document either.
#     perl does not document any method of determining a read error
#   experienced via the angle bracket operator, either.  That operator
#   returns next record or undefined.  This routine returns the $! associated
#   with the undefined angle bracket return.
#     The perl close function is what causes $? to be set.  Presumably the
#   close could fail, too, but this is not documented to happen.  The
#   $! from close is notoriously flaky (my opinion).  Under
#   normal circumstances on globec (Solaris), for example, it acquires the
#   value "Illegal seek".  In perl's defense, there is no suggestion that
#   $! is in fact useful after a close.

{
  my ($command,$output_processing_directive,$dummy) = @_;
  my ($open_result,$record,$command_result,$last_record_status);
  my ($close_return,$close_status);
  my ($pid);

  $dummy && return;
  ($output_processing_directive eq "STDOUT") || 
	($output_processing_directive eq "capture_and_return") ||
	return;
  ($command) = ($command =~ /^\s*(.+)\s*$/);
  $command || return;

  $command_result = $close_return = "";
  $open_status = $last_record_status = $close_status = 0;
  $! = $? = 0;

  $pid = open (BACKTICK,"$command |");
  $open_status = $!;
  defined($pid) || ($pid = "");
  if ($pid ne "") {
    $! = 0;
    while (defined ($record = <BACKTICK>)) {
      if ($output_processing_directive eq "capture_and_return") {
	$command_result .= $record;
      } elsif ($output_processing_directive eq "STDOUT") {
#	  Be good to handle errors from next  print  , but not now (Dec 12)
	print $record;
      } else {
	return;
      }
      $! = 0;
    }
    $last_record_status = $!;
    $! = 0;
    $close_return = close BACKTICK;
    $close_status = $!;
    defined ($close_return) || ($close_return = "");
  }

  return $command_result,$?+0,$pid+0,$open_status+0,$last_record_status+0,
	 $close_return+0,$close_status+0;
}

sub format_backtick_return_status
{
#   Used to format info returned by backtick.  
#	If this routine thinks that everything is normal, it returns the
#   empty string.  Suggested use of this routine is to call it only when
#   caller believes something has gone wrong.  In that case, an empty
#   string return from this routine represents its own exceptional case

#   Order of args below matches return from backtick.pl, w/ command
#   in place of the return of the command.  An extra optional arg can be
#   specified at the end, to be included w/the text w/the prefix "More info:"

#   backtick users can code as follows
#	($results,@status_info) = &backtick($command);
#	($results eq "") && 
#		die (&format_backtick_return_status($command,@status_info));
#			or
#	($results,$exit_status,@status_info) = &backtick($command);
#	($exit_status == 0) || 
#		die (
#			&format_backtick_return_status
#					($command,$exit_status,@status_info)
#		    );
#   If $results contains useful diagnostic info, it can be included in the
#   format call; eg
#	&format_backtick_return_status($command,@status_info,$results));
#			or
#	&format_backtick_return_status($command,@status_info,
#				       "return from command = $results"));

  my ($command,
	$command_exit_status,
	$open_return,$open_status,
	$last_io_status,
	$close_return,$close_status,
	$extra_info,
	$dummy
      ) = @_;
  my ($bad_call) = " *** terminating error processing due to bad/incomplete " .
		   "call to format_backtick_return_status";
  my ($return_val,$initial_return_val);

  $command || return "*** format_backtick_return_status called w/no args";
  $dummy && return "*** format_backtick_return_status called too many args\n" .
		   "*** Call probably dealt with I/O on pipe to $command\n";

  $initial_return_val = " *** Problem with I/O on pipe to $command\n";
  $return_val = $initial_return_val;

  (defined $command_exit_status) || return $return_val . $bad_call;
  ($command_exit_status == 0) ||
	($return_val .= " *** Abnormal exit status from child process: " .
			$command_exit_status . "\n");

  (defined $open_return) || return $return_val . $bad_call;
#   open return is documented to be pid, which in parent process is > 0
#   (pid of child).  perl pids seem to be in decimal, not hex.
#   Not documented what comes back if open fails - guess is undefined
#   (arriving here as empty), but could be a -1 (based on fork return
#   statuses)
  if ( ! (($open_return =~ /\d+/) && ($open_return > 0))  ) {
    $return_val .= " *** Abnormal return from pipe open: ";
    $return_val .= ($open_return eq "") ? "empty/undefined" : $open_return;
    $return_val .= "\n";
  }
  (defined $open_status) || return $return_val . $bad_call;
  ($open_status == 0) ||
	($return_val .= " *** Abnormal status of open close: $open_status\n");

  (defined $last_io_status) || return $return_val . $bad_call;
  ($last_io_status == 0) ||
	($return_val .= " *** Abnormal final I/O status: $last_io_status\n");

#   close return stuff empirically determined (under VMS, no less, so
#   feel relatively free to alter it)
  (defined close_return) || return $return_val . $bad_call;
  if ($close_return != 1) {
    $return_val .= " *** Abnormal return from pipe close: ";
    $return_val .= ($close_return eq "") ? "empty/undefined" : $close_return;
    $return_val .= "\n";
  }
  (defined $close_status) || return $return_val . $bad_call;
  ($close_status == 0) ||
	($return_val .= " *** Abnormal status of pipe close: $close_status\n");

  (defined $extra_info) && ($extra_info ne "") &&
	($return_val .= " ... More info (next line et seq)\n$extra_info\n");

  ($return_val eq $initial_return_val) && ($return_val = "");
  return $return_val;
}

$BACKTICK_LOADED = 1;