line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::ShellScript; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
7904
|
use 5.008000; |
|
5
|
|
|
|
|
17
|
|
|
5
|
|
|
|
|
210
|
|
4
|
5
|
|
|
5
|
|
753
|
use strict; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
160
|
|
5
|
5
|
|
|
5
|
|
34
|
use warnings; |
|
5
|
|
|
|
|
13
|
|
|
5
|
|
|
|
|
238
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.04'; |
8
|
|
|
|
|
|
|
|
9
|
5
|
|
|
5
|
|
10335
|
use Test::More; |
|
5
|
|
|
|
|
205590
|
|
|
5
|
|
|
|
|
53
|
|
10
|
|
|
|
|
|
|
|
11
|
5
|
|
|
5
|
|
1628
|
use Exporter (); |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
543
|
|
12
|
|
|
|
|
|
|
our(@ISA, @EXPORT); |
13
|
|
|
|
|
|
|
@ISA = qw(Exporter Test::More); |
14
|
|
|
|
|
|
|
@EXPORT = qw( run_ok |
15
|
|
|
|
|
|
|
isCurrentVariable isCurrentValue nextSlot resetTimeline |
16
|
|
|
|
|
|
|
reset_timeline variable_ok variable_ocurrences |
17
|
|
|
|
|
|
|
); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=pod |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 NAME |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
Test::ShellScript - Shell script testing module |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 SYNOPSIS |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
use Test::ShellScript; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
run_ok("myScript.sh") |
31
|
|
|
|
|
|
|
variable_ok("executed", "false"); |
32
|
|
|
|
|
|
|
variable_ok("output", "0"); |
33
|
|
|
|
|
|
|
variable_ok("executed", "true"); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 DESCRIPTION |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
Call me insane, but sometimes a shell script becames too important or |
39
|
|
|
|
|
|
|
complicated that no one wants to touch it. Then why not to add some |
40
|
|
|
|
|
|
|
testing to gain some confidence and avoid disrupting its funcitionality ? |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head1 INTRO |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
The idea behind this module is to make testing simple for shell script writers |
45
|
|
|
|
|
|
|
and that means : |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
* simple testing code addition on shell script |
48
|
|
|
|
|
|
|
* minimal knowledge about Perl |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
This module will parse the output for the program under test, extracting and |
51
|
|
|
|
|
|
|
parsing only those devoted to testing. Each line is identified with a header, |
52
|
|
|
|
|
|
|
followed by a text that must be in the next format : |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
variable=value |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
simply the same format that a properties file line, assigning no meaning to any |
57
|
|
|
|
|
|
|
value or variable name. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
Suppose you have the next script that executes a command passed in the command line |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
#!/bin/bash |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
## execute any command |
64
|
|
|
|
|
|
|
[[ -z $1 ]] && $* |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
Unfortunately you don't know why it doesn't work, then you add some testing |
67
|
|
|
|
|
|
|
code |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
#!/bin/bash |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
echo "TEST: executed=false" |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
## execute any command |
74
|
|
|
|
|
|
|
[[ -z $1 ]] && echo "TEST: executed=true" && $* |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Run it again and you'll see the output |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
TEST: executed=false |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
Too bad, no execution simply because [[ -z $1 ]] is a bad test for a command |
81
|
|
|
|
|
|
|
passed in the command line it must be [[ ! -z $1 ]], then the new output |
82
|
|
|
|
|
|
|
for our script is |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
TEST: executed=false |
85
|
|
|
|
|
|
|
TEST: executed=true |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head1 Using Test::ShellScript |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Testing such a simple script is a piece of cake, but when scripts grow in size |
90
|
|
|
|
|
|
|
and complexity the game to play is very different. Anyway let me introduce you |
91
|
|
|
|
|
|
|
to how to use Test::ShellScript with the previous simple script. |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
Start creating a text file with the next lines and name it run.t : |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
#!/usr/bin/perl |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
use 5.006; |
98
|
|
|
|
|
|
|
use strict; |
99
|
|
|
|
|
|
|
use warnings; |
100
|
|
|
|
|
|
|
use Test::ShellScript; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
This simply instructs to use Perl (version 5.006 and onwards must be used), |
103
|
|
|
|
|
|
|
tell Perl to be srtict (that means declare all your variables), warn you |
104
|
|
|
|
|
|
|
about suspicious stuff and finally instruct it to use the shell script testing |
105
|
|
|
|
|
|
|
module. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
Now you must instruct it to run you program and then begin to look for the different |
108
|
|
|
|
|
|
|
variables and its associated values to show up in the right order. Add the next lines |
109
|
|
|
|
|
|
|
to run.t |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
run_ok( '/path/to/run/command ls', "^TEST:"); |
112
|
|
|
|
|
|
|
isCurrentVariable("executed"); |
113
|
|
|
|
|
|
|
isCurrentValue("false"); |
114
|
|
|
|
|
|
|
nextSlot(); |
115
|
|
|
|
|
|
|
isCurrentVariable("executed"); |
116
|
|
|
|
|
|
|
isCurrentValue("true"); |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
run_ok runs your program and parses the output. It expects two parameters, |
119
|
|
|
|
|
|
|
the first one is the whole command line to execute and the second is a regular |
120
|
|
|
|
|
|
|
expression that is used to identify the lines used for testing. In this case |
121
|
|
|
|
|
|
|
the lines begin (^) with the word TEST followed by the character ':' |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
Once parsed the whole output devoted to testing is our timeline and each output line |
124
|
|
|
|
|
|
|
becomes a time slot. Once run_ok is executed we're at the first one, then if we ask |
125
|
|
|
|
|
|
|
for the value of 'executed' it must be false or, in other words, the current variable |
126
|
|
|
|
|
|
|
should be 'executed' and its value 'false'. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Once we tested for these values nothing else can be done except for moving to the next |
129
|
|
|
|
|
|
|
time slot, then continue testing up to the end. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
Great, we have created our first test and if we execute it the output will be something |
132
|
|
|
|
|
|
|
like this |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
ok 1 - command: '/path/to/run/command ls' |
135
|
|
|
|
|
|
|
ok 2 - Current variable is 'executed' |
136
|
|
|
|
|
|
|
ok 3 - Current value is 'false' |
137
|
|
|
|
|
|
|
ok 4 - Current variable is 'executed' |
138
|
|
|
|
|
|
|
ok 5 - Current value is 'true' |
139
|
|
|
|
|
|
|
1..5 |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
meaning that each test was passed (ok) followed by a test number and a human readable comment. |
142
|
|
|
|
|
|
|
At the end the tests numbers executed is show. This is fine if you have 5 or so tests |
143
|
|
|
|
|
|
|
to execute but what if you need to make a hundred tests on tenths of scripts ? |
144
|
|
|
|
|
|
|
No way Macaya ! |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
There's a wonderful module called Test::Harness that parses this output and shows us tests |
147
|
|
|
|
|
|
|
statistics on success and failure. To run our humble test just type the command |
148
|
|
|
|
|
|
|
'perl -MTest::Harness -e 'runtests(@ARGV);' t/run.t' and lets the magic begin : |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# perl -MTest::Harness -e 'runtests(@ARGV);' t/run.t |
151
|
|
|
|
|
|
|
t/run.t .. ok |
152
|
|
|
|
|
|
|
All tests successful. |
153
|
|
|
|
|
|
|
Files=1, Tests=5, 0 wallclock secs ( 0.03 usr 0.00 sys + 0.02 cusr 0.01 csys = 0.06 CPU) |
154
|
|
|
|
|
|
|
Result: PASS |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head1 Continuos mode |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
What we've been using in the previous section is called Step-by-step mode, where |
160
|
|
|
|
|
|
|
you can do testing one slot at a time. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
Now suppose you need to look for a variable content then you'll need to do it inside |
163
|
|
|
|
|
|
|
a loop, search for it and once it's found look at it's value. Just to save errors, time, |
164
|
|
|
|
|
|
|
resources and everything-else-you-want-to the continuous mode will help you. |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
Let's continue with the previous example. Add the next lines to run.t |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
reset_timeline(); |
169
|
|
|
|
|
|
|
variable_ocurrences("executed",2); |
170
|
|
|
|
|
|
|
reset_timeline(); |
171
|
|
|
|
|
|
|
variable_ocurrences("non_exisent_variable",0); |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
What they do is to reset the timeline, count how many times the variable 'executed' |
174
|
|
|
|
|
|
|
is shown, resets the timeline again and now counts how many times the 'non_exisent_variable' |
175
|
|
|
|
|
|
|
variable is shown. |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=head1 using Test::More |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
As a side effect a compatbility with Test::More has been added meaning that you can |
180
|
|
|
|
|
|
|
mix Test::More and Test::ShellScript testing in the same test. |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
e.g. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
use 5.006; |
185
|
|
|
|
|
|
|
use strict; |
186
|
|
|
|
|
|
|
use warnings; |
187
|
|
|
|
|
|
|
use Test::ShellScript; |
188
|
|
|
|
|
|
|
use Test::More; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
my $testNUmber = 1; |
191
|
|
|
|
|
|
|
run_ok( '/path/to/run/command ls', "^TEST:"); |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
### --- step by step mode |
194
|
|
|
|
|
|
|
$testNUmber++; |
195
|
|
|
|
|
|
|
isCurrentVariable("executed"); |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
### using Test::More |
198
|
|
|
|
|
|
|
ok( $testNUmber == 2 ); |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
### Back again to Test::ShellScript !!! |
201
|
|
|
|
|
|
|
isCurrentValue("ls"); |
202
|
|
|
|
|
|
|
isCurrentValue("false"); |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head1 METHODS |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=cut |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
|
210
|
5
|
|
|
5
|
|
29
|
use constant OK => "ok"; |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
396
|
|
211
|
5
|
|
|
5
|
|
25
|
use constant NOT_OK => "not ok"; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
203
|
|
212
|
|
|
|
|
|
|
|
213
|
5
|
|
|
5
|
|
25
|
use constant TRUE => 1; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
188
|
|
214
|
5
|
|
|
5
|
|
24
|
use constant FALSE => 0; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
260
|
|
215
|
|
|
|
|
|
|
|
216
|
5
|
|
|
5
|
|
79
|
use constant VAR => 0; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
202
|
|
217
|
5
|
|
|
5
|
|
24
|
use constant VALUE => 1; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
284
|
|
218
|
|
|
|
|
|
|
|
219
|
5
|
|
|
5
|
|
31
|
use constant NOT_FOUND => "__NOT_FOUND__"; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
214
|
|
220
|
5
|
|
|
5
|
|
33
|
use constant UNKNOWN_VALUE => "UNKNOWN VALUE"; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
6506
|
|
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
my @cmdOutput; |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
## Timeline storage. |
225
|
|
|
|
|
|
|
## Each array entry contains a refernce to an array whose first element is the |
226
|
|
|
|
|
|
|
## variable name for this time slot, and the second one is the variable value |
227
|
|
|
|
|
|
|
my @timeLine; |
228
|
|
|
|
|
|
|
my $timeIndex = 0; |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
## Always runs with no plan, it's simpler for script programmers |
232
|
|
|
|
|
|
|
END { |
233
|
5
|
|
|
5
|
|
6258
|
done_testing(); |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=pod |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=head1 Step-by-step mode |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=head2 run_ok |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
run_ok("myScript.sh argument1 argument2", "TEST"); |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
Runs the command passed in the first argument and parses the command output. |
246
|
|
|
|
|
|
|
Accept as testing lines for output the ones with the regexp passed as second argument. |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=cut |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub run_ok($$) { |
251
|
5
|
|
|
5
|
1
|
5665
|
my $cmdLine = shift; |
252
|
5
|
|
|
|
|
14
|
my $acceptLines = shift; |
253
|
5
|
|
|
|
|
11
|
my $fh; |
254
|
5
|
|
|
|
|
15
|
my $runOK = FALSE; |
255
|
|
|
|
|
|
|
|
256
|
5
|
|
|
|
|
15
|
@cmdOutput = (); |
257
|
|
|
|
|
|
|
## Not redirects or similar allowed in the command line |
258
|
|
|
|
|
|
|
## TODO : error is shown if the command to run doesn't exist |
259
|
5
|
50
|
33
|
|
|
70916
|
if ( $cmdLine && open( $fh , "$cmdLine |") ) { |
260
|
5
|
|
|
|
|
5307
|
while( my $line = <$fh>) { |
261
|
21
|
|
|
|
|
309
|
push @cmdOutput, $line; |
262
|
|
|
|
|
|
|
}; |
263
|
5
|
|
|
|
|
401
|
close $fh; |
264
|
|
|
|
|
|
|
|
265
|
5
|
|
|
|
|
29
|
@timeLine = (); |
266
|
5
|
|
|
|
|
86
|
resetTimeline(); |
267
|
5
|
|
|
|
|
400
|
_parseOutput($acceptLines); |
268
|
5
|
|
|
|
|
43
|
resetTimeline(); |
269
|
5
|
|
|
|
|
88
|
$runOK = TRUE; |
270
|
|
|
|
|
|
|
} else { |
271
|
0
|
|
|
|
|
0
|
$runOK = FALSE; |
272
|
|
|
|
|
|
|
}; |
273
|
5
|
|
|
|
|
271
|
ok($runOK, "command: '$cmdLine'"); |
274
|
|
|
|
|
|
|
}; |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=pod |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=head2 isCurrentVariable |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
isCurrentVariable("Variable_name"); |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
test if the variable passed as argument exists in the current time slot |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=cut |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
sub isCurrentVariable($) { |
287
|
7
|
|
|
7
|
1
|
14841
|
my $variable = shift; |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
## TODO check these vlidations |
291
|
7
|
50
|
|
|
|
4797
|
return if ! _check($variable, "Undefined passed variable name"); |
292
|
7
|
|
|
|
|
28
|
my $timelineVariable = $timeLine[$timeIndex]->[VAR]; |
293
|
7
|
50
|
|
|
|
103
|
return if ! _check($timelineVariable, "Undefined variable name in timeline" ); |
294
|
|
|
|
|
|
|
|
295
|
7
|
|
|
|
|
81
|
ok( $timelineVariable eq $variable, |
296
|
|
|
|
|
|
|
"Current variable is '$timelineVariable'" ); |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=pod |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
=head2 isCurrentValue |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
isCurrentValue("Variable_value"); |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
test if the value for the variable in the current time slot is the one passed |
308
|
|
|
|
|
|
|
as parameter |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
=cut |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
sub isCurrentValue($) { |
313
|
7
|
|
|
7
|
1
|
8784
|
my $value = shift; |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
## TODO test these validations |
316
|
7
|
50
|
|
|
|
27
|
return if ! _check($value, "Undefined passed variable value" ); |
317
|
7
|
|
|
|
|
69
|
my $timelineValue = $timeLine[$timeIndex]->[VALUE]; |
318
|
7
|
50
|
|
|
|
16
|
return if ! _check($timelineValue, "Undefined variable value in timeline" ); |
319
|
|
|
|
|
|
|
|
320
|
7
|
|
|
|
|
216
|
ok( $timelineValue eq $value, |
321
|
|
|
|
|
|
|
"Current value is '$timelineValue'" ); |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=pod |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=head2 nextSlot |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
nextSlot() |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
advances to the next time slot |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=cut |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
sub nextSlot() { |
337
|
3
|
50
|
|
3
|
1
|
2069
|
if ($timeIndex < @timeLine) { |
338
|
3
|
|
|
|
|
8
|
$timeIndex++ |
339
|
|
|
|
|
|
|
} else { |
340
|
|
|
|
|
|
|
## TODO test this |
341
|
0
|
|
|
|
|
0
|
_notOK("Can't pass beyond last slot"); |
342
|
|
|
|
|
|
|
}; |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
=pod |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=head2 resetTimeline |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
resetTimeline() |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
moves to the first time slot |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
=cut |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
sub resetTimeline() { |
356
|
12
|
|
|
12
|
1
|
45
|
$timeIndex = 0; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=pod |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=head1 Continuos mode |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=head2 variable_ok |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
variable_ok("VARIALE_NAME", "value"); |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
Looks for the variable value and compares it to the passed value |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=cut |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
sub variable_ok($$) { |
373
|
6
|
|
|
6
|
1
|
1809
|
my $var = shift; |
374
|
6
|
|
|
|
|
2586
|
my $value = shift; |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
## TODO check these vlidations |
377
|
6
|
50
|
|
|
|
15
|
return if ! _check($var, "Undefined passed variable name"); |
378
|
6
|
50
|
|
|
|
13
|
return if ! _check($value, "Undefined passed variable value"); |
379
|
|
|
|
|
|
|
|
380
|
6
|
|
|
|
|
16
|
my ($found, $realValue) = _getNextValue($var); |
381
|
6
|
|
33
|
|
|
45
|
ok( $found && $realValue eq $value, "'$var' = '$realValue'"); |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=pod |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
=head2 variable_ok |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
variable_ocurrences("VARIALE_NAME", right_number_of_ocurrences); |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
Counts how many times the variable is shown, and compares it with the passed value |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=cut |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
sub variable_ocurrences($$) { |
395
|
0
|
|
|
0
|
0
|
0
|
my $var = shift; |
396
|
0
|
|
|
|
|
0
|
my $value = shift; |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
## TODO check these vlidations |
400
|
0
|
0
|
|
|
|
0
|
return if ! _check($var, "Undefined passed variable name"); |
401
|
0
|
0
|
|
|
|
0
|
return if ! _check($value, "Undefined passed variable value"); |
402
|
|
|
|
|
|
|
|
403
|
0
|
|
|
|
|
0
|
my $count = _varOccursTimes($var); |
404
|
0
|
|
|
|
|
0
|
ok( $count == $value, "Variable '$var' found '$count' times"); |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
=pod |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=head2 reset_timeline |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
reset_timeline() |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
moves to the first time slot |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=cut |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
sub reset_timeline() { |
418
|
2
|
|
|
2
|
1
|
1661
|
resetTimeline() |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
sub _notOK($) { |
422
|
0
|
|
|
0
|
|
0
|
my $msg = shift; |
423
|
0
|
|
|
|
|
0
|
ok( FALSE, $msg ); |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
sub _check($$) { |
427
|
40
|
|
|
40
|
|
60
|
my $var = shift; |
428
|
40
|
|
|
|
|
4952
|
my $msg = shift; |
429
|
40
|
50
|
|
|
|
7028
|
if ( ! defined $var ) { |
430
|
0
|
|
|
|
|
0
|
_notOK( $msg ); |
431
|
0
|
|
|
|
|
0
|
return FALSE; |
432
|
|
|
|
|
|
|
} else { |
433
|
40
|
|
|
|
|
528
|
return TRUE; |
434
|
|
|
|
|
|
|
}; |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
sub _getNextValue($) { |
438
|
6
|
|
|
6
|
|
9
|
my $variable = shift; |
439
|
|
|
|
|
|
|
|
440
|
6
|
|
|
|
|
14
|
while($timeIndex < @timeLine) { |
441
|
7
|
100
|
|
|
|
23
|
next if ($timeLine[$timeIndex++]->[VAR] ne $variable); |
442
|
6
|
|
|
|
|
20
|
return ( TRUE, $timeLine[$timeIndex - 1]->[VALUE] ); |
443
|
|
|
|
|
|
|
}; |
444
|
|
|
|
|
|
|
|
445
|
0
|
|
|
|
|
0
|
return (FALSE, UNKNOWN_VALUE); |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
sub _varOccursTimes($) { |
449
|
0
|
|
|
0
|
|
0
|
my $variable = shift; |
450
|
|
|
|
|
|
|
|
451
|
0
|
|
|
|
|
0
|
my $pc = $timeIndex; |
452
|
0
|
|
|
|
|
0
|
my $count = 0; |
453
|
0
|
|
|
|
|
0
|
while($pc < @timeLine) { |
454
|
0
|
0
|
|
|
|
0
|
$count++ if ($timeLine[$pc++]->[VAR] eq $variable); |
455
|
|
|
|
|
|
|
}; |
456
|
|
|
|
|
|
|
|
457
|
0
|
|
|
|
|
0
|
return $count; |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
sub _parseOutput($) { |
461
|
|
|
|
|
|
|
|
462
|
5
|
|
|
5
|
|
45
|
my $acceptLines = shift; |
463
|
5
|
|
|
|
|
40
|
foreach my $line (@cmdOutput) { |
464
|
21
|
100
|
|
|
|
374
|
next if $line !~ /$acceptLines/; |
465
|
16
|
|
|
|
|
140
|
$line =~ /$acceptLines\s*(\w*)=(.*)/; |
466
|
|
|
|
|
|
|
|
467
|
16
|
|
|
|
|
29
|
my @pair; |
468
|
16
|
|
|
|
|
84
|
push @pair, $1; |
469
|
16
|
|
|
|
|
80
|
push @pair, $2; |
470
|
16
|
|
|
|
|
29
|
push @timeLine, \@pair; |
471
|
16
|
|
|
|
|
63
|
$timeIndex++; |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
}; |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
1; |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
=pod |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
=head1 CONTRIBUTORS |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
=over 1 |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
=item Matias Palomec |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=item Luis Agustin Nieto |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
=back |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
=head1 AUTHOR |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
Copyright (C) 2010 by Victor A. Rodriguez. |
495
|
|
|
|
|
|
|
El bit Fantasma (Bit-Man) |
496
|
|
|
|
|
|
|
http://www.bit-man.com.ar/ |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
=cut |