#!/usr/bin/perl -w # $File: //pipe_a_command.pm $ $Author: mnooning $ # $Revision: #007 $ $Change: 20040501_01 $ $DateTime: 2004/05/01 12:21: ######################################################################## # 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 L # # # ######################################################################## # ######################################################################## our $VERSION = 0.01; ######################################################################## # 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 = ) { 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 = ; 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); }