1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
|
#!/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 L<http://www.perl.com/perl/misc/Artistic.html>
#
#
#
########################################################################
#
########################################################################
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);
}
|
