File Coverage

blib/lib/swat.pm
Criterion Covered Total %
statement 30 181 16.5
branch 1 76 1.3
condition 0 18 0.0
subroutine 10 19 52.6
pod 0 1 0.0
total 41 295 13.9


line stmt bran cond sub pod time code
1             package swat;
2              
3             our $VERSION = '0.2.0';
4              
5 1     1   68867 use base 'Exporter';
  1         2  
  1         206  
6              
7             our @EXPORT = qw{version};
8              
9             sub version {
10 0     0 0   print $VERSION, "\n"
11             }
12              
13              
14             1;
15              
16             package main;
17              
18 1     1   8 use strict;
  1         1  
  1         22  
19              
20 1     1   4 use Carp;
  1         2  
  1         72  
21 1     1   782 use File::Temp qw/ tempfile /;
  1         21595  
  1         62  
22              
23 1     1   431 use swat::story;
  1         3  
  1         131  
24              
25 1     1   7 use Carp;
  1         2  
  1         48  
26 1     1   563 use Config::Tiny;
  1         1024  
  1         32  
27 1     1   467 use YAML qw{LoadFile};
  1         6994  
  1         56  
28              
29 1     1   686 use Term::ANSIColor;
  1         8405  
  1         1977  
30              
31             my $config;
32              
33             our $STATUS = 1;
34              
35             sub config {
36              
37 0 0   0     unless ($config){
38 0 0 0       if (get_prop('suite_ini_file_path') and -f get_prop('suite_ini_file_path') ){
    0 0        
    0          
    0          
39 0           my $path = get_prop('suite_ini_file_path');
40 0 0         $config = $config = Config::Tiny->read($path) or confess "file $path is not valid .ini file";
41             }elsif(get_prop('suite_yaml_file_path') and -f get_prop('suite_yaml_file_path')){
42 0           my $path = get_prop('suite_yaml_file_path');
43 0           ($config) = LoadFile($path);
44             }elsif ( -f 'suite.ini' ){
45 0           my $path = 'suite.ini';
46 0 0         $config = $config = Config::Tiny->read($path) or confess "file $path is not valid .ini file";
47             }elsif ( -f 'suite.yaml'){
48 0           my $path = 'suite.yaml';
49 0           ($config) = LoadFile($path);
50             }else{
51 0           confess "configuration file is not found"
52             }
53             }
54              
55 0           return $config;
56             }
57              
58             sub make_http_request {
59              
60 0 0   0     return if get_prop('response_done');
61              
62 0           my ($fh, $content_file) = tempfile( DIR => get_prop('test_root_dir') );
63            
64 0           my $try_i;
65              
66 0           my $try = get_prop('try_num');
67              
68 0 0 0       if (get_prop('response') and @{get_prop('response')} ){
  0            
69              
70 0           swat_note(1,'server response is spoofed');
71              
72 0 0         open F, ">", $content_file or die $!;
73 0           print F ( join "\n", @{get_prop('response')});
  0            
74 0           close F;
75              
76 0 0         open F, ">", "$content_file.stderr" or die $!;
77 0           close F;
78              
79 0 0         open F, ">", "$content_file.hdr" or die $!;
80 0           close F;
81              
82 0           swat_note("response saved to $content_file");
83              
84             }else{
85              
86 0           my $curl_cmd = get_prop('curl_cmd');
87 0           my $hostname = get_prop('hostname');
88 0           my $resource = get_prop('resource');
89 0           my $http_method = get_prop('http_method');
90              
91 0           my $curl_runner = "$curl_cmd -w '%{response_code}' -D $content_file.hdr -o $content_file --stderr $content_file.stderr '$hostname$resource' > $content_file.http_status";
92 0           my $curl_runner_short = tapout( "$curl_cmd -D - '$hostname$resource'", ['cyan'] );
93 0           my $http_status = 0;
94              
95 0           TRY: for my $i (1..$try){
96 0 0         swat_note("try N [$i] $curl_runner") if debug_mod12();
97 0           $try_i = $i;
98 0           system($curl_runner);
99 0 0         if(open HTTP_STATUS, "$content_file.http_status"){
100 0           $http_status = ;
101 0           close HTTP_STATUS;
102 0           chomp $http_status;
103 0 0         swat_note("got http status: $http_status") if debug_mod12();
104 0 0 0       last TRY if $http_status < 400 and $http_status > 0;
105 0 0 0       last TRY if $http_status >= 400 and ignore_http_err();
106              
107             }
108 0           my $delay = ($i)**2;
109 0 0         swat_note("sleep for $delay seconds before next try") if debug_mod12();
110 0           sleep $delay;
111              
112             }
113              
114            
115             #swat_note($curl_runner);
116              
117 0 0 0       if ( $http_status < 400 and $http_status > 0 ) {
    0          
118              
119 0           swat_ok(1, tapout( $http_status, ['green'] )." / $try_i of $try ".$curl_runner_short);
120              
121             }elsif(ignore_http_err()){
122              
123 0           swat_ok(1, tapout( $http_status, ['red'] )." / $try_i of $try ".$curl_runner_short);
124 0           swat_note(
125             tapout(
126             "server returned bad response, ".
127             "but we still continue due to ignore_http_err set to 1",
128             ['blue on_black']
129             )
130             );
131              
132             }else{
133              
134 0           swat_ok(1, tapout( $http_status, ['red'] )." / $try_i of $try ".$curl_runner_short);
135              
136 0           swat_note("stderr:");
137              
138 0 0         open CURL_ERR, "$content_file.stderr" or die $!;
139 0           while ( my $i = ){
140 0           chomp $i;
141 0           swat_note($i);
142             }
143 0           close CURL_ERR;
144              
145 0           swat_note("http headers:");
146 0 0         open CURL_HDR, "$content_file.hdr" or die $!;
147 0           while ( my $i = ){
148 0           chomp $i;
149 0           swat_note($i);
150             }
151 0           close CURL_HDR;
152              
153 0           swat_note("http body:");
154 0 0         open CURL_RSP, "$content_file" or die $!;
155 0           while ( my $i = ){
156 0           chomp $i;
157 0           swat_note($i);
158             }
159 0           close CURL_RSP;
160              
161 0           swat_note("can't continue here due to unsuccessfull http status code");
162 0           exit(1);
163             }
164              
165 0 0         if (debug_mod12()) {
166 0           swat_note(tapout( "http headers saved to $content_file.hdr", ['bright_blue'] ));
167 0           swat_note(tapout( "body saved to $content_file", ['bright_blue'] ));
168             }
169              
170             }
171              
172              
173 0 0         open F, $content_file or die $!;
174 0           my $body_str = '';
175 0           $body_str.= $_ while ;
176 0           close F;
177              
178 0           set_prop( body => $body_str );
179              
180 0 0         open F, "$content_file.hdr" or die $!;
181 0           my $headers_str = '';
182 0           $headers_str.= $_ while ;
183 0           close F;
184              
185 0           set_prop( headers => $headers_str );
186              
187 0 0         if (debug_mod12()){
188 0           my $debug_bytes = get_prop('debug_bytes');
189 0           my $bshort = substr( $body_str, 0, $debug_bytes );
190 0 0         if (length($bshort) < length($body_str)) {
191 0           swat_note("body:\n$bshort ... ( output truncated to $debug_bytes bytes )");
192             } else{
193 0           swat_note("body:\n$body_str");
194             }
195             }
196              
197              
198 0           set_prop( response_done => 1 );
199              
200             }
201              
202             sub header {
203              
204            
205 0     0     my $project = get_prop('project');
206 0           my $swat_module = get_prop('swat_module');
207 0           my $hostname = get_prop('hostname');
208 0           my $resource = get_prop('resource');
209 0           my $http_method = get_prop('http_method');
210 0           my $curl_cmd = get_prop('curl_cmd');
211 0           my $debug = get_prop('debug');
212 0           my $try_num = get_prop('try_num');
213 0           my $ignore_http_err = get_prop('ignore_http_err');
214            
215 0           swat_note(1, "project: $project");
216 0           swat_note(1, "hostname: $hostname");
217 0           swat_note(1, "resource: $resource");
218 0           swat_note(1, "http method: $http_method");
219 0           swat_note(1,"swat module: $swat_module");
220 0           swat_note(1, "debug: $debug");
221 0           swat_note(1, "try num: $try_num");
222 0           swat_note(1, "ignore http errors: $ignore_http_err");
223            
224             }
225              
226             sub generate_asserts {
227              
228              
229 0     0     my $check_file = shift;
230              
231 0 0         header() if debug_mod2();
232              
233 0           dsl()->{debug_mod} = get_prop('debug');
234              
235 0           dsl()->{match_l} = get_prop('match_l');
236              
237 0 0         return if http_method() eq 'META';
238              
239 0           eval {
240              
241 0           make_http_request();
242              
243 0           dsl()->{output} = headers().body();
244              
245 0           run_response_processor();
246              
247 0           dsl()->validate($check_file);
248             };
249              
250 0           my $err = $@;
251              
252 0           for my $r ( @{dsl()->results}){
  0            
253 0 0         swat_note($r->{message}) if $r->{type} eq 'debug';
254 0 0         swat_ok($r->{status}, $r->{message}) if $r->{type} eq 'check_expression';
255              
256             }
257              
258 0 0         if ($err){
259 0           $STATUS = -1;
260 0           confess "parser error: $err" ;
261             }
262              
263             }
264              
265             sub tapout {
266              
267 0     0     my $line = shift;
268 0           my $color = shift;
269              
270 0 0         if ($ENV{'swat_disable_color'}){
271 0           $line;
272             }else{
273 0           colored($color,$line);
274             }
275             }
276              
277             sub print_meta {
278              
279 0     0     swat_note('@'.http_method());
280 0 0         open META, resource_dir()."/meta.txt" or die $!;
281 0           while (my $i = ){
282 0           chomp $i;
283 0           swat_note( tapout( "$i", ['yellow'] ));
284             }
285 0           close META;
286            
287             }
288              
289             sub swat_ok {
290              
291 0     0     my $status = shift;
292 0           my $message = shift;
293              
294 0 0         if ($status) {
295 0           print "OK ", $message, "\n";
296             } else {
297 0           print "FAIL ", $message, "\n";
298 0           $STATUS = -1;
299             }
300             }
301              
302             sub swat_note {
303              
304 0     0     my $message = shift;
305 0           print $message, "\n";
306             }
307              
308             END {
309              
310 1 50   1   251 if ($STATUS == 1){
    0          
311 1         52 print "FINISHED. OK\n";
312 1         14 exit(0);
313             } elsif($STATUS == -1){
314 0           print "FINISHED. FAIL\n";
315 0           exit(1);
316             }
317              
318             }
319              
320             1;
321              
322              
323             __END__