#!/usr/bin/perl -w
########################################################################
# Copyright 2004 by Malcolm Nooning
# This program does not impose any
# licensing restrictions on files generated by their execution, in
# accordance with the 8th article of the Artistic License:
#
#    "Aggregation of this Package with a commercial distribution is
#    always permitted provided that the use of this Package is embedded;
#    that is, when no overt attempt is made to make this Package's
#    interfaces visible to the end user of the commercial distribution.
#    Such use shall not be construed as a distribution of this Package."
#
# Therefore, you are absolutely free to place any license on the resulting
# executable(s), as long as the packed 3rd-party libraries are also available
# under the Artistic License.
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# See F<LICENSE>.
#
#
########################################################################
#
########################################################################
our $VERSION = '0.07';
########################################################################
# Usage:
# $error =
#    pipe_a_command(
#                  $test_number,
#                  $sub_test,
#                  $test_name_string,
#                  $test_dir,
#                  $command_string,  # e.g. "pp -I", or maybe empty ""
#                  $executable_name,
#                  $expected_result, # e.g. "hello"
#                  $os,
#                  $verbose,
#                  $message_ref,
#                );
#
# $error will be one of POSIX (EXIT_SUCCESS EXIT_FAILURE)
#
########################################################################
# Outline
# -------
# . chdir to the test directory
# . Pipe executable and collect the result.
# . Compare the result with the expected result.
# . Report back success or failure.
########################################################################
#
package pipe_a_command;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = ("pipe_a_command");
use POSIX qw(EXIT_SUCCESS EXIT_FAILURE);
use File::Copy;
use Cwd qw(chdir cwd);
use strict;
########################################################################
sub pipe_a_command {
  my (
       $test_number,
       $sub_test,
       $test_name_string,
       $directory,
       $command_string,
       $executable_name,
       $expected_result,
       $os,
       $verbose,
       $message_ref,
       $print_cannot_locate_message,
     ) = @_;
  my $results = "";
  my $cwd1 = cwd;
  my $cwd2;
  my $cmd = "";
  my $log_file = "log_file_from_pipe";
  my $stdline = "";
  #.................................................................
  if (!(chdir("$directory"))) {
      $$message_ref = "\n\[405\]" .
            "sub $test_name_string cannot chdir $directory\n:$!:\n";
      return (EXIT_FAILURE);
  }
   
  $cwd2 = cwd;
  if ($verbose) {
    print ("pipe_a_command started in dir $cwd1\n");
    print ("but is now in $cwd2\n");
  }
  #.................................................................
  if ($os !~ m/^Win/i) {
    if ($executable_name ne "") {
      if (!(chmod (0775, "$executable_name"))) {
        $$message_ref = "\n\[410\]sub $test_name_string cannot " .
                        "chmod file $executable_name\n";
        return (EXIT_FAILURE);
      }
    }
    $executable_name = './' . $executable_name;
  }
  $cmd = "$command_string $executable_name";
  #.................................................................
  #################################################################
  # Open up a log file to hold the data.  Then send the $cmd to
  # a pipe.  Capture the stdout and stderr of the pipe and 
  # print it to the log file.
  #################################################################
  if (!(open (PIPE_LOGFILE, ">$log_file"))){
        $$message_ref = "\n\[415\]sub $test_name_string cannot " .
                        "open $log_file\n";
        return (EXIT_FAILURE);
  }
  if ($print_cannot_locate_message) {
    print PIPE_LOGFILE ("\nThe Line Below SHOULD BE  \"Can\'t locate \.\.\. ");
    print PIPE_LOGFILE (" along with a \"BEGIN failed \.\.\. \" line\n");
    if ($verbose) {
      print ("\nThe Line Below SHOULD BE  \"Can\'t locate \.\.\. ");
      print (" along with a \"BEGIN failed \.\.\. \" line\n");
    }
  }
  if (!(open (CMD_STDOUT_AND_STDERR, "$cmd 2>&1 |"))){
    close(PIPE_LOGFILE);
        $$message_ref = "\n\[420\]sub $test_name_string cannot " .
                        "open a pipe for $cmd 2>&1 |\n";
        return (EXIT_FAILURE);
  }
  # Take in any STDOUT and STDERR that "cmd" might cause
  while ($stdline = <CMD_STDOUT_AND_STDERR>) {
      print PIPE_LOGFILE $stdline;
      if ($verbose) {
        print $stdline;
      }
  }
  # Close before copying it to force an output flush.
  close(PIPE_LOGFILE); 
  close(CMD_STDOUT_AND_STDERR);
  #................................................................
  # Slurp in the results to a single scaler.
  if (open (FH, "$log_file")) {
    # Slurp in all the lines of the file at once
    local $/; $results = <FH>;
    if (!(close(FH))) {
      $$message_ref = 
         "Something is wrong with test $test_name_string "            .
         "in directory $cwd1\n"                                       .
         "File $log_file exists, and I opened it, "                   .
         "but now I cannot close it.\n"                               .
         "Cannot continue with test $test_name_string\n";
      return (EXIT_FAILURE);
    }
  } else {
    $$message_ref = 
       "Something is wrong with test $test_name_string "            .
       "in directory $cwd1\n"                                       .
       "File $log_file exists but I cannot open it.\n"              .
       "Cannot continue with test $test_name_string\n";
    return (EXIT_FAILURE);
  }
   
  #.....................................................................
  chomp($results);
  if ($verbose) {
    print ("\n\[415\]Test ${test_number}_${sub_test}: Directory ");
    print ("$directory, sub $test_name_string: \n");
    print ("Result of $cmd was: \n");
    print ("$results\n");
  }
  #.................................................................
  if ($results !~ m/$expected_result/) {
    $$message_ref = "\n\[430\]\n"                                  .
       "Test ${test_number}_${sub_test} "                          .
       "The command string \"$command_string $executable_name \" " .
       "in directory $directory,"                                  .
       "did not produce :: \"$expected_result\" ::\n"              .
       "Instead, it produced :: $results ::\n"                     .
       "End of [430] results \n";
    return (EXIT_FAILURE);
  }
  #.................................................................
  return (EXIT_SUCCESS);
}