# File: ExecUtils.pm
# Project: Anything
# Description: Helper functions for executing external programs and scripts from perl.

package ExecUtils;

use strict;
use warnings;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(invoke stringify_arg stringify_args);

use Fcntl qw(SEEK_SET);
use File::Spec::Functions qw(catfile tmpdir);
use File::Temp qw(tempfile);
use Time::HiRes qw(gettimeofday tv_interval);

#
# Run a command and optionally save stderr/stdout
# to a variable/file and optionally read stdin
# from a variable/file
#
# Makes use of temporary files to do the reading/writing
# from/to variables.
#
# PROG => program name
# BIN => program directory
# ARGS => reference to array of program arguments
# IN_FILE => file name or handle to set as stdin
# IN_VAR => variable (or reference to variable) to feed in as stdin
# IN_NAME => the displayed name for the source of stdin
# ALL_FILE => file name or handle to store stdout and stderr
# ALL_VAR => reference to variable to store stdout and stderr
# ALL_NAME => the displayed name for the destination of output
# OUT_FILE => file name or handle to store stdout
# OUT_VAR => reference to variable to store stdout
# OUT_NAME => the displayed name for the destination of stdout
# ERR_FILE => file name or handle to store stderr
# ERR_VAR => reference to variable to store stderr
# ERR_NAME => the displayed name for the destination of stderr
# CHECK_STATUS => true to die on bad status codes
# TRUNCATE => true to truncate output files if they exist
# CMD => reference to store a human readable form of the command run
# TIME => reference to store the running time in seconds (floating point)
# TMPDIR => directory to create temporary files
# NICE => the level of nicing to use (niceing disabled by default)
# 
sub invoke {
  my %opts = @_;
  my $logger = $opts{LOGGER};
  $logger->trace("sub invoke") if $logger;
  # output truncates?
  my $dir = ($opts{TRUNCATE} ? '>' : '>>'); #direction
  # temp file directory
  my $tmpdir = ($opts{TMPDIR} ? $opts{TMPDIR} : &tmpdir());
  # get niceing
  my @nice = ();
  if (defined($opts{NICE})) {
    if ($opts{NICE} !~ m/^[+-]?\d+$/ || 
      $opts{NICE} < -20 || $opts{NICE} > 19) {
      die("Nice level not in range -20 to 19");
    }
    push(@nice, 'nice', '-n', int($opts{NICE}));
  }
  # get program
  my $prog = $opts{PROG};
  die("No program passed to invoke") unless defined($prog);
  my $exe = (defined($opts{BIN}) ? &catfile($opts{BIN}, $prog) : $prog);
  # get args
  my $args_ref = $opts{ARGS};
  my @args = ();
  if (defined($args_ref)) {
    @args = @{$args_ref};
  }
  # make command line for printing
  my $cmd = &stringify_args(@nice, $prog, @args);
  # do redirection
  my $display_name;
  # check if we're redirecting stdin
  my ($in_old, $in_tmp, $in_nam);
  if (defined($opts{IN_FILE}) || defined($opts{IN_VAR})) {
    $logger->trace("invoke - redirecing stdin") if $logger;
    # save stdin
    open($in_old, "<&STDIN") or die("Can't dup STDIN: $!");
    # redirect stdin
    if (defined($opts{IN_FILE})) { # read stdin from specified file
      if (ref($opts{IN_FILE})) { # file handle (we hope)
        my $handle = $opts{IN_FILE};
        open(STDIN, '<&', $handle) or die("Can't redirect STDIN: $!");
        $display_name = 'input_file';
      } else { # file name (we hope)
        my $name = $opts{IN_FILE};
        open(STDIN, '<', $name) or die("Can't redirect STDIN: $!");
        $display_name = &stringify_arg($name);
      }
    } else { # read stdin from a temp file which we preload with the var
      $in_tmp = &tempfile('stdin_XXXXXXXXXX', DIR => $tmpdir, UNLINK => 1); # make a temporary file
      my $var = $opts{IN_VAR}; # variable could be passed as a ref or scalar
      my $var_ref = (ref($var) ? $var : \$var);
      print $in_tmp ${$var_ref}; # write variable to file
      seek($in_tmp, 0, SEEK_SET); # rewind file
      open(STDIN, '<&', $in_tmp) or die("Can't redirect STDIN: $!");
      $display_name = '$input';
    }
    $display_name = $opts{IN_NAME} if defined($opts{IN_NAME});
    $cmd .= ' < ' . $display_name;
  }
  # check for output redirection
  my ($out_old, $err_old);
  my ($all_tmp, $out_tmp, $err_tmp);
  if (defined($opts{ALL_FILE}) || defined($opts{ALL_VAR})) {
    $logger->trace("invoke - redirecing output") if $logger;
    # save stdout and stderr
    open($out_old, ">&STDOUT") or die("Can't dup STDOUT: $!");
    open($err_old, ">&STDERR") or die("Can't dup STDERR: $!");
    # redirect stdout and stderr
    if (defined($opts{ALL_FILE})) { # send output to specified file
      truncate($opts{ALL_FILE}, 0) if ($opts{TRUNCATE});
      if (ref($opts{ALL_FILE})) { # file handle (we hope)
        my $handle = $opts{ALL_FILE};
        open(STDOUT, '>>&', $handle) or die("Can't redirect STDOUT: $!");
        open(STDERR, '>>&', $handle) or die("Can't redirect STDERR: $!");
        $display_name = 'output_file';
      } else { # file name (we hope)
        my $name = $opts{ALL_FILE};
        open(STDOUT, '>>', $name) or die("Can't redirect STDOUT: $!");
        open(STDERR, '>>', $name) or die("Can't redirect STDERR: $!");
        $display_name = &stringify_arg($name);
      }
    } else {
      $all_tmp = &tempfile('allout_XXXXXXXXXX', DIR => $tmpdir, UNLINK => 1); # make a temporary file
      open(STDOUT, '>>&', $all_tmp) or die("Can't redirect STDOUT: $!");
      open(STDERR, '>>&', $all_tmp) or die("Can't redirect STDERR: $!");
      $display_name = '$all_messages';
    }
    # turn off buffering so output order is maintained
    my $oldfh;
    $oldfh = select(STDOUT);
    $| = 1;
    select(STDERR);
    $| = 1;
    select($oldfh);
    # update command
    $display_name = $opts{ALL_NAME} if defined($opts{ALL_NAME});
    $cmd .= ' &'. $dir . ' ' . $display_name;
  } else {
    # check if we're redirecting stdout
    if (defined($opts{OUT_FILE}) || defined($opts{OUT_VAR})) {
    $logger->trace("invoke - redirecing stdout") if $logger;
      # save stdout
      open($out_old, ">&STDOUT") or die("Can't dup STDOUT: $!");
      # redirect stdout
      if (defined($opts{OUT_FILE})) { # send stdout to specified file
        if (ref($opts{OUT_FILE})) { # file handle (we hope)
          my $handle = $opts{OUT_FILE};
          open(STDOUT, $dir.'&', $handle) or die("Can't redirect STDOUT: $!");
          $display_name = 'output_file';
        } else { # file name (we hope)
          my $name = $opts{OUT_FILE};
          open(STDOUT, $dir, $name) or die("Can't redirect STDOUT: $!");
          $display_name = &stringify_arg($name);
        }
      } else { # send stdout to a temp file which we can read in to the var
        $out_tmp = &tempfile('stdout_XXXXXXXXXX', DIR => $tmpdir, UNLINK => 1); # make a temporary file
        open(STDOUT, '>&', $out_tmp) or die("Can't redirect STDOUT: $!");
        $display_name = '$output_messages';
      }
      $display_name = $opts{OUT_NAME} if defined($opts{OUT_NAME});
      $cmd .= ' 1'. $dir . ' ' . $display_name;
    }
    # check if we're redirecting stderr
    if (defined($opts{ERR_FILE}) || defined($opts{ERR_VAR})) {
    $logger->trace("invoke - redirecing stderr") if $logger;
      # save stderr
      open($err_old, ">&STDERR") or die("Can't dup STDERR: $!");
      # redirect stderr
      if (defined($opts{ERR_FILE})) { # send stderr to specified file
        if (ref($opts{ERR_FILE})) { # file handle (we hope)
          my $handle = $opts{ERR_FILE};
          open(STDERR, $dir.'&', $handle) or die("Can't redirect STDERR: $!");
          $display_name = 'error_file';
        } else { # file name (we hope)
          my $name = $opts{ERR_FILE};
          open(STDERR, $dir, $name) or die("Can't redirect STDERR: $!");
          $display_name = &stringify_arg($name);
        }
      } else { # send stderr to a temp file which we can read in to the var
        $err_tmp = &tempfile('stderr_XXXXXXXXXX', DIR => $tmpdir, UNLINK => 1); # make a temporary file
        open(STDERR, '>&', $err_tmp) or die("Can't redirect STDERR: $!");
        $display_name = '$error_messages';
      }
      $display_name = $opts{ERR_NAME} if defined($opts{ERR_NAME});
      $cmd .= ' 2' . $dir . ' ' . $display_name;
    }
  }
  # record the time before starting the program
  $logger->trace("invoke - recording start time") if $logger;
  my $t0 = [&gettimeofday()];
  # run the command
  $logger->trace("invoke - running") if $logger;
  my $status = system(@nice, $exe, @args);
  # record the time after completing the program
  $logger->trace("invoke - recording end time") if $logger;
  my $t1 = [&gettimeofday()];
  # check if the caller wants the elapsed time
  if (defined($opts{TIME})) {
    ${$opts{TIME}} = &tv_interval($t0, $t1);
  }
  # reset file descriptors
  if (defined($in_old)) {
    $logger->trace("invoke - reseting stdin") if $logger;
    open(STDIN, "<&", $in_old) or die("Can't reset STDIN: $!");
  }
  if (defined($out_old)) {
    $logger->trace("invoke - reseting stdout") if $logger;
    open(STDOUT, ">&", $out_old) or die("Can't reset STDOUT: $!");
  }
  if (defined($err_old)) {
    $logger->trace("invoke - reseting stderr") if $logger;
    open(STDERR, ">&", $err_old) or die("Can't reset STDERR: $!");
  }
  # close stdin temporary file
  close($in_tmp) if (defined($in_tmp));
  # rewind, slurp and close temporary files
  ${$opts{ALL_VAR}} = &rewind_slurp_close($all_tmp) if (defined($all_tmp));
  ${$opts{OUT_VAR}} = &rewind_slurp_close($out_tmp) if (defined($out_tmp));
  ${$opts{ERR_VAR}} = &rewind_slurp_close($err_tmp) if (defined($err_tmp));

  if ($opts{CHECK_STATUS}) {
    $logger->trace("invoke - checking status") if $logger;
    # check status
    if ($status == -1) {
      die("Failed to execute command '". $cmd . "': $!");
    } elsif ($status & 127) {
      die(sprintf("Process executing command '%s' died with signal %d, %s coredump.",
          $cmd, ($status & 127), ($status & 128) ? 'with' : 'without'));
    } elsif ($status != 0) {
      die(sprintf("Process executing command '%s' exited with value %d indicating failure.", 
          $cmd, $? >> 8));
    }
  }
  if (defined($opts{CMD})) {
    ${$opts{CMD}} = $cmd;
  }

  $logger->trace("invoke - returning") if $logger;
  return $status;
}

#
# stringify_arg
# 
# Escapes and quotes an argument
#
sub stringify_arg {
  my ($argcpy) = @_;
  # escape shell characters (Bourne shell specific)
  $argcpy =~ s/([;<>\*\|`&\$!#\(\)\[\]\{\}:'"])/\\$1/g;
  # quote string if it contains spaces
  $argcpy = "\"$argcpy\"" if $argcpy =~ m/\s/;
  return $argcpy;
}

#
# stringify_args
#
# Convert an arguments array into a string in a way that should
# not be ambiguous. Intended for logging. If you are invoking a
# program you should still use the extended version of system
# that takes an argument array.
#
sub stringify_args {
  my @dest = ();
  foreach my $arg (@_) {
    push(@dest, &stringify_arg($arg));
  }
  return join(' ', @dest);
}

sub rewind_slurp_close {
  my ($fh) = @_;
  seek($fh, 0, SEEK_SET);
  my $content = do {local $/ = undef; <$fh>};
  close($fh);
  return $content;
}