File Coverage

blib/lib/Test/Rail/Parser.pm
Criterion Covered Total %
statement 357 364 98.0
branch 148 188 78.7
condition 103 133 77.4
subroutine 22 22 100.0
pod 8 8 100.0
total 638 715 89.2


line stmt bran cond sub pod time code
1             # ABSTRACT: Upload your TAP results to TestRail
2             # PODNAME: Test::Rail::Parser
3              
4             package Test::Rail::Parser;
5             $Test::Rail::Parser::VERSION = '0.050';
6 3     3   65167 use strict;
  3         7  
  3         109  
7 3     3   16 use warnings;
  3         7  
  3         98  
8 3     3   17 use utf8;
  3         5  
  3         23  
9              
10 3     3   104 use parent qw/TAP::Parser/;
  3         6  
  3         22  
11 3     3   127894 use Carp qw{cluck confess};
  3         10  
  3         168  
12 3     3   35 use POSIX qw{floor strftime};
  3         6  
  3         25  
13 3     3   3310 use Clone qw{clone};
  3         7  
  3         147  
14              
15 3     3   19 use TestRail::API;
  3         7  
  3         89  
16 3     3   499 use TestRail::Utils;
  3         8  
  3         99  
17 3     3   19 use Scalar::Util qw{reftype};
  3         6  
  3         144  
18              
19 3     3   18 use File::Basename qw{basename};
  3         8  
  3         15114  
20              
21             sub new {
22 57     57 1 103991 my ( $class, $opts ) = @_;
23 57         276954 $opts = clone $opts; #Convenience, if we are passing over and over again...
24              
25             #Load our callbacks
26 57         8990 $opts->{'callbacks'} = {
27             'test' => \&testCallback,
28             'comment' => \&commentCallback,
29             'unknown' => \&unknownCallback,
30             'bailout' => \&bailoutCallback,
31             'EOF' => \&EOFCallback,
32             'plan' => \&planCallback,
33             };
34              
35             my $tropts = {
36             'apiurl' => delete $opts->{'apiurl'},
37             'user' => delete $opts->{'user'},
38             'pass' => delete $opts->{'pass'},
39             'debug' => delete $opts->{'debug'},
40             'browser' => delete $opts->{'browser'},
41             'run' => delete $opts->{'run'},
42             'project' => delete $opts->{'project'},
43             'project_id' => delete $opts->{'project_id'},
44             'step_results' => delete $opts->{'step_results'},
45             'plan' => delete $opts->{'plan'},
46             'plan_id' => delete $opts->{'plan_id'},
47             'configs' => delete $opts->{'configs'} // [],
48             'testsuite_id' => delete $opts->{'testsuite_id'},
49             'testsuite' => delete $opts->{'testsuite'},
50             'encoding' => delete $opts->{'encoding'},
51             'sections' => delete $opts->{'sections'},
52             'autoclose' => delete $opts->{'autoclose'},
53             'config_group' => delete $opts->{'config_group'},
54              
55             #Stubs for extension by subclassers
56             'result_options' => delete $opts->{'result_options'},
57             'result_custom_options' => delete $opts->{'result_custom_options'},
58             'test_bad_status' => delete $opts->{'test_bad_status'},
59 57   100     2425 'max_tries' => delete $opts->{'max_tries'} || 1,
      100        
60             };
61              
62             confess("plan passed, but no run passed!")
63 57 50 66     1476 if !$tropts->{'run'} && $tropts->{'plan'};
64              
65             #Allow natural confessing from constructor
66             #Force-on POST redirects for maximum compatibility
67             #Also ensure all opts that need string type have it when undef
68             my $tr = TestRail::API->new(
69             $tropts->{'apiurl'} // '',
70             $tropts->{'user'} // '',
71             $tropts->{'pass'} // '',
72             $tropts->{'encoding'} // '',
73             $tropts->{'debug'},
74             1,
75             $tropts->{max_tries},
76 56   50     3547 { 'skip_usercache' => 1 },
      50        
      50        
      50        
77             );
78 56         264 $tropts->{'testrail'} = $tr;
79             $tr->{'browser'} = $tropts->{'browser'}
80 56 50       1937 if defined( $tropts->{'browser'} ); #allow mocks
81 56         191 $tr->{'debug'} = 0; #Always suppress in production
82              
83             #Get project ID from name, if not provided
84 56 100       307 if ( !defined( $tropts->{'project_id'} ) ) {
85 52         195 my $pname = $tropts->{'project'};
86 52         587 $tropts->{'project'} = $tr->getProjectByName($pname);
87             confess("Could not list projects! Shutting down.")
88 52 50       242 if ( $tropts->{'project'} == -500 );
89 52 50       228 if ( !$tropts->{'project'} ) {
90 0         0 confess(
91             "No project (or project_id) provided, or that which was provided was invalid!"
92             );
93             }
94             }
95             else {
96 4         50 $tropts->{'project'} = $tr->getProjectByID( $tropts->{'project_id'} );
97             confess("No such project with ID $tropts->{project_id}!")
98 4 50       24 if !$tropts->{'project'};
99             }
100 56         259 $tropts->{'project_id'} = $tropts->{'project'}->{'id'};
101              
102             # Ok, let's cache the users since we have the project ID now
103 56         422 $tr->getUsers( $tropts->{'project_id'} );
104              
105             #Discover possible test statuses
106 56         620 $tropts->{'statuses'} = $tr->getPossibleTestStatuses();
107 56         321 my @ok = grep { $_->{'name'} eq 'passed' } @{ $tropts->{'statuses'} };
  504         1130  
  56         230  
108 56         148 my @not_ok = grep { $_->{'name'} eq 'failed' } @{ $tropts->{'statuses'} };
  504         916  
  56         155  
109 56         142 my @skip = grep { $_->{'name'} eq 'skip' } @{ $tropts->{'statuses'} };
  504         960  
  56         151  
110 56         127 my @todof = grep { $_->{'name'} eq 'todo_fail' } @{ $tropts->{'statuses'} };
  504         907  
  56         143  
111 56         111 my @todop = grep { $_->{'name'} eq 'todo_pass' } @{ $tropts->{'statuses'} };
  504         877  
  56         126  
112 56         127 my @retest = grep { $_->{'name'} eq 'retest' } @{ $tropts->{'statuses'} };
  504         881  
  56         139  
113 56         110 my @tbad;
114             @tbad =
115 162         299 grep { $_->{'name'} eq $tropts->{test_bad_status} }
116 18         43 @{ $tropts->{'statuses'} }
117 56 100       244 if $tropts->{test_bad_status};
118 56 50       201 confess("No status with internal name 'passed' in TestRail!")
119             unless scalar(@ok);
120 56 50       202 confess("No status with internal name 'failed' in TestRail!")
121             unless scalar(@not_ok);
122 56 50       188 confess("No status with internal name 'skip' in TestRail!")
123             unless scalar(@skip);
124 56 50       195 confess("No status with internal name 'todo_fail' in TestRail!")
125             unless scalar(@todof);
126 56 50       149 confess("No status with internal name 'todo_pass' in TestRail!")
127             unless scalar(@todop);
128 56 50       183 confess("No status with internal name 'retest' in TestRail!")
129             unless scalar(@retest);
130             confess(
131             "No status with internal name '$tropts->{test_bad_status}' in TestRail!"
132 56 100 100     970 ) unless scalar(@tbad) || !$tropts->{test_bad_status};
133              
134             #Map in all the statuses
135 55         162 foreach my $status ( @{ $tropts->{'statuses'} } ) {
  55         205  
136 495         1389 $tropts->{ $status->{'name'} } = $status;
137             }
138              
139             #Special aliases
140 55         187 $tropts->{'ok'} = $ok[0];
141 55         135 $tropts->{'not_ok'} = $not_ok[0];
142              
143             confess "testsuite and testsuite_id are mutually exclusive"
144 55 50 66     451 if ( $tropts->{'testsuite_id'} && $tropts->{'testsuite'} );
145              
146             #Grab testsuite by name if needed
147 55 100       208 if ( $tropts->{'testsuite'} ) {
148             my $ts = $tr->getTestSuiteByName( $tropts->{'project_id'},
149 3         56 $tropts->{'testsuite'} );
150 3 50       23 confess( "No such testsuite '" . $tropts->{'testsuite'} . "' found!" )
151             unless $ts;
152 3         20 $tropts->{'testsuite_id'} = $ts->{'id'};
153             }
154              
155             #Grab run
156 55         153 my ( $run, $plan, $config_ids );
157              
158             # See if we have to create a configuration
159 55         596 my $configz2create = $tr->getConfigurations( $tropts->{'project_id'} );
160             @$configz2create = grep {
161 55         174 my $c = $_;
  231         369  
162 231         315 ( grep { $_ eq $c->{'name'} } @{ $tropts->{'configs'} } )
  73         242  
  231         581  
163             } @$configz2create;
164 55 100 100     395 if ( scalar(@$configz2create) && $tropts->{'config_group'} ) {
165             my $cgroup = $tr->getConfigurationGroupByName( $tropts->{project_id},
166 3         38 $tropts->{'config_group'} );
167 3 50       17 unless ( ref($cgroup) eq 'HASH' ) {
168 3         946 print "# Adding Configuration Group $tropts->{config_group}...\n";
169             $cgroup = $tr->addConfigurationGroup( $tropts->{project_id},
170 3         47 $tropts->{'config_group'} );
171             }
172             confess(
173 3 50       188 "Could neither find nor create the provided configuration group '$tropts->{config_group}'"
174             ) unless ref($cgroup) eq 'HASH';
175 3         13 foreach my $cc (@$configz2create) {
176 3         1011 print "# Adding Configuration $cc->{name}...\n";
177 3         39 $tr->addConfiguration( $cgroup->{'id'}, $cc->{'name'} );
178             }
179             }
180              
181             #check if configs passed are defined for project. If we can't get all the IDs, something's hinky
182             @$config_ids = $tr->translateConfigNamesToIds( $tropts->{'project_id'},
183 55         424 @{ $tropts->{'configs'} } );
  55         490  
184 55 50 50     382 confess("Could not retrieve list of valid configurations for your project.")
185             unless ( reftype($config_ids) || 'undef' ) eq 'ARRAY';
186 55         175 my @bogus_configs = grep { !defined($_) } @$config_ids;
  16         67  
187 55         117 my $num_bogus = scalar(@bogus_configs);
188 55 50       377 confess(
189             "Detected $num_bogus bad config names passed. Check available configurations for your project."
190             ) if $num_bogus;
191              
192 55 100       268 if ( $tropts->{'plan'} ) {
193              
194             #Attempt to find run, filtered by configurations
195 21 50       119 if ( $tropts->{'plan_id'} ) {
196 0         0 $plan = $tr->getPlanByID( $tropts->{'plan_id'} );
197             }
198             else {
199             $plan =
200 21         224 $tr->getPlanByName( $tropts->{'project_id'}, $tropts->{'plan'} );
201             }
202             confess(
203             "Test plan provided is completed, and spawning was not indicated")
204             if ( ref $plan eq 'HASH' )
205             && $plan->{'is_completed'}
206 21 100 100     1811 && ( !$tropts->{'testsuite_id'} );
      100        
207 20 100 100     421 if ( $plan && !$plan->{'is_completed'} ) {
208 12         121 $tropts->{'plan'} = $plan;
209             $run = $tr->getChildRunByName( $plan, $tropts->{'run'},
210 12         103 $tropts->{'configs'} ); #Find plan filtered by configs
211              
212 12 100 100     163 if ( defined($run) && ( reftype($run) || 'undef' ) eq 'HASH' ) {
      66        
213 10         33 $tropts->{'run'} = $run;
214 10         36 $tropts->{'run_id'} = $run->{'id'};
215             }
216             }
217             else {
218             #Try to make it if spawn is passed
219             $tropts->{'plan'} = $tr->createPlan( $tropts->{'project_id'},
220             $tropts->{'plan'}, "Test plan created by TestRail::API" )
221 8 50       119 if $tropts->{'testsuite_id'};
222             confess("Could not find plan "
223             . $tropts->{'plan'}
224             . " in provided project, and spawning failed (or was not indicated)!"
225 8 50       666 ) if !$tropts->{'plan'};
226             }
227             }
228             else {
229 34         351 $run = $tr->getRunByName( $tropts->{'project_id'}, $tropts->{'run'} );
230             confess(
231             "Test run provided is completed, and spawning was not indicated")
232             if ( ref $run eq 'HASH' )
233             && $run->{'is_completed'}
234 34 100 100     501 && ( !$tropts->{'testsuite_id'} );
      100        
235 33 100 100     726 if ( defined($run)
      66        
      100        
236             && ( reftype($run) || 'undef' ) eq 'HASH'
237             && !$run->{'is_completed'} )
238             {
239 12         92 $tropts->{'run'} = $run;
240 12         43 $tropts->{'run_id'} = $run->{'id'};
241             }
242             }
243              
244             #If spawn was passed and we don't have a Run ID yet, go ahead and make it
245 53 100 100     540 if ( $tropts->{'testsuite_id'} && !$tropts->{'run_id'} ) {
246 30         2612 print "# Spawning run\n";
247 30         179 my $cases = [];
248 30 100       196 if ( $tropts->{'sections'} ) {
249 9         431 print "# with specified sections\n";
250              
251             #Then translate the sections into an array of case IDs.
252             confess("Sections passed to spawn must be ARRAYREF")
253 9 50 50     126 unless ( reftype( $tropts->{'sections'} ) || 'undef' ) eq 'ARRAY';
254 8         42 @{ $tropts->{'sections'} } = $tr->sectionNamesToIds(
255             $tropts->{'project_id'},
256             $tropts->{'testsuite_id'},
257 9         46 @{ $tropts->{'sections'} }
  9         172  
258             );
259 8         86 foreach my $section ( @{ $tropts->{'sections'} } ) {
  8         32  
260              
261             #Get the child sections, and append them to our section list so we get their cases too.
262             my $append_sections = $tr->getChildSections(
263             $tropts->{'project_id'},
264             {
265             'id' => $section,
266 9         90 'suite_id' => $tropts->{'testsuite_id'}
267             }
268             );
269             @$append_sections = grep {
270 9         43 my $sc = $_;
  6         14  
271 18         41 !scalar( grep { $_ == $sc->{'id'} }
272 6         10 @{ $tropts->{'sections'} } )
  6         15  
273             } @$append_sections
274             ; #de-dup in case the user added children to the list
275 9         34 @$append_sections = map { $_->{'id'} } @$append_sections;
  2         6  
276 9         28 push( @{ $tropts->{'sections'} }, @$append_sections );
  9         34  
277              
278             my $section_cases = $tr->getCases(
279             $tropts->{'project_id'},
280 9         87 $tropts->{'testsuite_id'},
281             { 'section_id' => $section }
282             );
283 9 50 50     692 push( @$cases, @$section_cases )
284             if ( reftype($section_cases) || 'undef' ) eq 'ARRAY';
285             }
286             }
287              
288 29 100       171 if ( scalar(@$cases) ) {
289 5         31 @$cases = map { $_->{'id'} } @$cases;
  11         139  
290             }
291             else {
292 24         73 $cases = undef;
293             }
294              
295 29 100       156 if ( $tropts->{'plan'} ) {
296 9         1056 print "# inside of plan\n";
297             $plan = $tr->createRunInPlan(
298             $tropts->{'plan'}->{'id'},
299             $tropts->{'testsuite_id'},
300 9         126 $tropts->{'run'}, undef, $config_ids, $cases
301             );
302             $run = $plan->{'runs'}->[0]
303             if exists( $plan->{'runs'} )
304             && ( reftype( $plan->{'runs'} ) || 'undef' ) eq 'ARRAY'
305 9 50 50     752 && scalar( @{ $plan->{'runs'} } );
  9   33     75  
      50        
306 9 50 50     111 if ( defined($run) && ( reftype($run) || 'undef' ) eq 'HASH' ) {
      33        
307 9         36 $tropts->{'run'} = $run;
308 9         40 $tropts->{'run_id'} = $run->{'id'};
309             }
310             }
311             else {
312             $run = $tr->createRun(
313             $tropts->{'project_id'},
314             $tropts->{'testsuite_id'},
315 20         249 $tropts->{'run'},
316             "Automatically created Run from TestRail::API",
317             undef,
318             undef,
319             $cases
320             );
321 20 50 50     1655 if ( defined($run) && ( reftype($run) || 'undef' ) eq 'HASH' ) {
      33        
322 20         91 $tropts->{'run'} = $run;
323 20         73 $tropts->{'run_id'} = $run->{'id'};
324             }
325             }
326             confess("Could not spawn run with requested parameters!")
327 29 50       134 if !$tropts->{'run_id'};
328 29         2100 print "# Success!\n";
329             }
330             confess(
331             "No run ID provided, and no run with specified name exists in provided project/plan!"
332 52 100       776 ) if !$tropts->{'run_id'};
333              
334 51         542 my $self = $class->SUPER::new($opts);
335 51 100 66     388241 if ( defined( $self->{'_iterator'}->{'command'} )
336             && reftype( $self->{'_iterator'}->{'command'} ) eq 'ARRAY' )
337             {
338 33         236 $self->{'file'} = $self->{'_iterator'}->{'command'}->[-1];
339 33         2227 print "# PROCESSING RESULTS FROM TEST FILE: $self->{'file'}\n";
340 33         346 $self->{'track_time'} = 1;
341             }
342             else {
343             #Not running inside of prove in real-time, don't bother with tracking elapsed times.
344 18         56 $self->{'track_time'} = 0;
345             }
346              
347             #Make sure the step results field passed exists on the system
348 51         321 my $sr_name = $tropts->{'step_results'};
349             $tropts->{'step_results'} =
350             $tr->getTestResultFieldByName( $tropts->{'step_results'},
351             $tropts->{'project_id'} )
352 51 100       694 if defined $tropts->{'step_results'};
353             confess(
354             "Invalid step results value '$sr_name' passed. Check the spelling and confirm that your project can use the '$sr_name' custom result field."
355 51 100 100     1874 ) if ref $tropts->{'step_results'} ne 'HASH' && $sr_name;
356              
357 50         361 $self->{'tr_opts'} = $tropts;
358 50         314 $self->{'errors'} = 0;
359              
360             #Start the shot clock
361 50         215 $self->{'starttime'} = time();
362              
363             #Make sure we get the time it took to get to each step from the last correctly
364 50         149 $self->{'lasttime'} = $self->{'starttime'};
365 50         328 $self->{'raw_output'} = "";
366              
367 50         17667 return $self;
368             }
369              
370             # Look for file boundaries, etc.
371             sub unknownCallback {
372 87     87 1 3804 my ($test) = @_;
373 87         179 my $self = $test->{'parser'};
374 87         258 my $line = $test->as_string;
375 87         483 $self->{'raw_output'} .= "$line\n";
376              
377             #Unofficial "Extensions" to TAP
378 87         231 my ($status_override) = $line =~ m/^% mark_status=([a-z|_]*)/;
379 87 100       244 if ($status_override) {
380             cluck "Unknown status override"
381 1 50       5 unless defined $self->{'tr_opts'}->{$status_override}->{'id'};
382             $self->{'global_status'} =
383             $self->{'tr_opts'}->{$status_override}->{'id'}
384 1 50       7 if $self->{'tr_opts'}->{$status_override};
385             print "# Overriding status to $status_override ("
386             . $self->{'global_status'}
387             . ")...\n"
388 1 50       38 if $self->{'global_status'};
389             }
390              
391             #XXX I'd love to just rely on the 'name' attr in App::Prove::State::Result::Test, but...
392             #try to pick out the filename if we are running this on TAP in files, where App::Prove is uninvolved
393 87         516 my $file = TestRail::Utils::getFilenameFromTapLine($line);
394 87 100 100     395 $self->{'file'} = $file if !$self->{'file'} && $file;
395 87         253 return;
396             }
397              
398             # Register the current suite or test desc for use by test callback, if the line begins with the special magic words
399             sub commentCallback {
400 77     77 1 2543 my ($test) = @_;
401 77         200 my $self = $test->{'parser'};
402 77         321 my $line = $test->as_string;
403 77         618 $self->{'raw_output'} .= "$line\n";
404              
405 77 50       402 if ( $line =~ m/^#TESTDESC:\s*/ ) {
406 0         0 $self->{'tr_opts'}->{'test_desc'} = $line;
407 0         0 $self->{'tr_opts'}->{'test_desc'} =~ s/^#TESTDESC:\s*//g;
408             }
409 77         232 return;
410             }
411              
412             sub testCallback {
413 69     69 1 10869 my ($test) = @_;
414 69         184 my $self = $test->{'parser'};
415              
416 69 100       310 if ( $self->{'track_time'} ) {
417              
418             #Test done. Record elapsed time.
419 45         145 my $tm = time();
420             $self->{'tr_opts'}->{'result_options'}->{'elapsed'} =
421 45         240 _compute_elapsed( $self->{'lasttime'}, $tm );
422             $self->{'elapse_display'} =
423             defined( $self->{'tr_opts'}->{'result_options'}->{'elapsed'} )
424 45 100       376 ? $self->{'tr_opts'}->{'result_options'}->{'elapsed'}
425             : "0s";
426 45         142 $self->{'lasttime'} = $tm;
427             }
428              
429 69         340 my $line = $test->as_string;
430 69         1981 my $tline = $line;
431             $tline = "["
432             . strftime( "%H:%M:%S %b %e %Y", localtime( $self->{'lasttime'} ) )
433             . " ($self->{elapse_display})] $line"
434 69 100       4073 if $self->{'track_time'};
435 69         523 $self->{'raw_output'} .= "$tline\n";
436              
437             #Don't do anything if we don't want to map TR case => ok or use step-by-step results
438 69 100       300 if ( !$self->{'tr_opts'}->{'step_results'} ) {
439             print
440             "# step_results not set. No action to be taken, except on a whole test basis.\n"
441 57 50       2244 if $self->{'tr_opts'}->{'debug'};
442 57         387 return 1;
443             }
444              
445 12         153 $line =~ s/^(ok|not ok)\s[0-9]*\s-\s//g;
446 12         52 my $test_name = $line;
447              
448             print "# Assuming test name is '$test_name'...\n"
449 12 50 33     183 if $self->{'tr_opts'}->{'debug'} && !$self->{'tr_opts'}->{'step_results'};
450              
451 12         45 my $todo_reason;
452              
453             #Setup args to pass to function
454 12         50 my $status = $self->{'tr_opts'}->{'not_ok'}->{'id'};
455 12         61 my $status_name = 'NOT OK';
456 12 100       64 if ( $test->is_actual_ok() ) {
457 9         94 $status = $self->{'tr_opts'}->{'ok'}->{'id'};
458 9         39 $status_name = 'OK';
459 9 100       47 if ( $test->has_skip() ) {
460 1         8 $status = $self->{'tr_opts'}->{'skip'}->{'id'};
461 1         2 $status_name = 'SKIP';
462 1         9 $test_name =~ s/^(ok|not ok)\s[0-9]*\s//g;
463 1         5 $test_name =~ s/^# skip //gi;
464 1         39 print "# '$test_name'\n";
465             }
466 9 100       87 if ( $test->has_todo() ) {
467 4         33 $status = $self->{'tr_opts'}->{'todo_pass'}->{'id'};
468 4         25 $status_name = 'TODO PASS';
469 4         24 $test_name =~ s/^(ok|not ok)\s[0-9]*\s//g;
470 4         14 $test_name =~ s/^# todo & skip //gi; #handle todo_skip
471 4         45 $test_name =~ s/# todo\s(.*)$//gi;
472 4         19 $todo_reason = $test->explanation();
473             }
474             }
475             else {
476 3 100       47 if ( $test->has_todo() ) {
477 1         20 $status = $self->{'tr_opts'}->{'todo_fail'}->{'id'};
478 1         16 $status_name = 'TODO FAIL';
479 1         11 $test_name =~ s/^(ok|not ok)\s[0-9]*\s//g;
480 1         9 $test_name =~ s/^# todo & skip //gi; #handle todo_skip
481 1         15 $test_name =~ s/# todo\s(.*)$//gi;
482 1         18 $todo_reason = $test->explanation();
483             }
484             }
485              
486             #XXX much of the above code would be unneeded if $test->description wasn't garbage
487 12         134 $test_name =~ s/\s+$//g;
488              
489             #If this is a TODO, set the reason in the notes
490 12 100       71 $self->{'tr_opts'}->{'test_notes'} .= "\nTODO reason: $todo_reason\n"
491             if $todo_reason;
492              
493 12         69 my $sr_sys_name = $self->{'tr_opts'}->{'step_results'}->{'name'};
494             $self->{'tr_opts'}->{'result_custom_options'} = {}
495 12 100       70 if !defined $self->{'tr_opts'}->{'result_custom_options'};
496             $self->{'tr_opts'}->{'result_custom_options'}->{$sr_sys_name} = []
497 12 100       74 if !defined $self->{'tr_opts'}->{'result_custom_options'}->{$sr_sys_name};
498              
499             #TimeStamp every particular step
500              
501             $line = "["
502             . strftime( "%H:%M:%S %b %e %Y", localtime( $self->{'lasttime'} ) )
503             . " ($self->{elapse_display})] $line"
504 12 100       532 if $self->{'track_time'};
505              
506             #XXX Obviously getting the 'expected' and 'actual' from the tap DIAGs would be ideal
507             push(
508 12         53 @{ $self->{'tr_opts'}->{'result_custom_options'}->{$sr_sys_name} },
  12         145  
509             TestRail::API::buildStepResults( $line, "OK", $status_name, $status )
510             );
511 12 50       1529 print "# Appended step results.\n" if $self->{'tr_opts'}->{'debug'};
512 12         107 return 1;
513             }
514              
515             sub bailoutCallback {
516 1     1 1 45 my ($test) = @_;
517 1         7 my $self = $test->{'parser'};
518 1         18 my $line = $test->as_string;
519 1         12 $self->{'raw_output'} .= "$line\n";
520              
521 1 50       69 if ( $self->{'tr_opts'}->{'step_results'} ) {
522 1         6 my $sr_sys_name = $self->{'tr_opts'}->{'step_results'}->{'name'};
523              
524             #Handle the case where we die right off
525 1   50     5 $self->{'tr_opts'}->{'result_custom_options'}->{$sr_sys_name} //= [];
526             push(
527 1         15 @{ $self->{'tr_opts'}->{'result_custom_options'}->{$sr_sys_name} },
528             TestRail::API::buildStepResults(
529             "Bail Out!.", "Continued testing",
530 1         2 $test->explanation, $self->{'tr_opts'}->{'not_ok'}->{'id'}
531             )
532             );
533             }
534 1         6 $self->{'is_bailout'} = 1;
535 1         4 return;
536             }
537              
538             sub EOFCallback {
539 45     45 1 1225066 my ($self) = @_;
540              
541 45 100       271 if ( $self->{'track_time'} ) {
542              
543             #Test done. Record elapsed time.
544             $self->{'tr_opts'}->{'result_options'}->{'elapsed'} =
545 29         248 _compute_elapsed( $self->{'starttime'}, time() );
546             }
547              
548             #Fail if the file is not set
549 45 50       257 if ( !defined( $self->{'file'} ) ) {
550 0         0 cluck(
551             "ERROR: Cannot detect filename, will not be able to find a Test Case with that name"
552             );
553 0         0 $self->{'errors'}++;
554 0         0 return 0;
555             }
556              
557 45         222 my $run_id = $self->{'tr_opts'}->{'run_id'};
558 45         4942 my $test_name = basename( $self->{'file'} );
559              
560 45         305 my $status = $self->{'tr_opts'}->{'ok'}->{'id'};
561 45         385 my $todo_failed = $self->todo() - $self->todo_passed();
562 45 100       826 $status = $self->{'tr_opts'}->{'not_ok'}->{'id'} if $self->has_problems();
563 45 100 100     1118 if ( !$self->tests_run()
      100        
564             && !$self->is_good_plan()
565             && $self->{'tr_opts'}->{test_bad_status} )
566             { #No tests were run, no plan, code is probably bad so allow custom marking
567             $status =
568 1         20 $self->{'tr_opts'}->{ $self->{'tr_opts'}->{test_bad_status} }->{'id'};
569             }
570 45 100 100     815 $status = $self->{'tr_opts'}->{'todo_pass'}->{'id'}
      100        
571             if $self->todo_passed()
572             && !$self->failed()
573             && $self->is_good_plan(); #If no fails, but a TODO pass, mark as TODOP
574 45 50 66     761 $status = $self->{'tr_opts'}->{'todo_fail'}->{'id'}
      66        
575             if $todo_failed
576             && !$self->failed()
577             && $self->is_good_plan()
578             ; #If no fails, but a TODO fail, prefer TODOF to TODOP
579 45 100       383 $status = $self->{'tr_opts'}->{'skip'}->{'id'}
580             if $self->skip_all(); #Skip all, whee
581              
582             #Global status override
583 45 100       456 $status = $self->{'global_status'} if $self->{'global_status'};
584              
585             #Notify user about bad plan a bit better, supposing we haven't bailed
586 45 100 100     146 if ( !$self->is_good_plan()
      66        
      100        
587             && !$self->{'is_bailout'}
588             && defined $self->tests_run
589             && defined $self->tests_planned )
590             {
591 6         243 $self->{'raw_output'} .=
592             "\n# ERROR: Bad plan. You ran "
593             . $self->tests_run
594             . " tests, but planned "
595             . $self->tests_planned . ".";
596 6 100       108 if ( $self->{'tr_opts'}->{'step_results'} ) {
597 3         11 my $sr_sys_name = $self->{'tr_opts'}->{'step_results'}->{'name'};
598              
599             #Handle the case where we die right off
600 3   100     21 $self->{'tr_opts'}->{'result_custom_options'}->{$sr_sys_name} //=
601             [];
602             push(
603             @{
604 3         10 $self->{'tr_opts'}->{'result_custom_options'}
605 3         24 ->{$sr_sys_name}
606             },
607             TestRail::API::buildStepResults(
608             "Bad Plan.",
609             $self->tests_planned . " Tests",
610             $self->tests_run . " Tests",
611             $status
612             )
613             );
614             }
615             }
616              
617             #Optional args
618 45         537 my $notes = $self->{'raw_output'};
619 45         146 my $options = $self->{'tr_opts'}->{'result_options'};
620 45         118 my $custom_options = $self->{'tr_opts'}->{'result_custom_options'};
621              
622 45         2050 print "# Setting results...\n";
623 45         434 my $cres =
624             $self->_set_result( $run_id, $test_name, $status, $notes, $options,
625             $custom_options );
626 45         330 $self->_test_closure();
627 45         713 $self->{'global_status'} = $status;
628              
629 45 50       264 undef $self->{'tr_opts'} unless $self->{'tr_opts'}->{'debug'};
630              
631 45         411 return $cres;
632             }
633              
634             sub planCallback {
635 43     43 1 5842 my ($plan) = @_;
636 43         207 my $self = $plan->{'parser'};
637 43 50       212 $self->{raw_output} .= $plan->as_string if $plan->as_string;
638             }
639              
640             sub _set_result {
641 45     45   281 my ( $self, $run_id, $test_name, $status, $notes, $options,
642             $custom_options ) = @_;
643 45         109 my $tc;
644              
645             print "# Test elapsed: " . $options->{'elapsed'} . "\n"
646 45 100       397 if $options->{'elapsed'};
647              
648 45         784 print "# Attempting to find case by title '"
649             . $test_name
650             . "' in run $run_id...\n";
651             $tc =
652 45         840 $self->{'tr_opts'}->{'testrail'}->getTestByName( $run_id, $test_name );
653 45 100 100     669 if ( !defined($tc) || ( reftype($tc) || 'undef' ) ne 'HASH' ) {
      66        
654 1         374 cluck("ERROR: Could not find test case: $tc");
655 1         655 $self->{'errors'}++;
656 1         7 return 0;
657             }
658              
659 44 50       226 my $xid = $tc ? $tc->{'id'} : '???';
660              
661 44         97 my $cres;
662              
663             #Set test result
664 44 50       152 if ($tc) {
665 44         2189 print
666             "# Reporting result of case $xid in run $self->{'tr_opts'}->{'run_id'} as status '$status'...";
667              
668             # createTestResults(test_id,status_id,comment,options,custom_options)
669             $cres =
670             $self->{'tr_opts'}->{'testrail'}
671 44         701 ->createTestResults( $tc->{'id'}, $status, $notes, $options,
672             $custom_options );
673 44 100 100     4774 print "# OK! (set to $status)\n"
674             if ( reftype($cres) || 'undef' ) eq 'HASH';
675             }
676 44 100 100     1299 if ( !$tc || ( ( reftype($cres) || 'undef' ) ne 'HASH' ) ) {
      66        
677 1         19 print "# Failed!\n";
678 1         16 print "# No Such test case in TestRail ($xid).\n";
679 1         14 $self->{'errors'}++;
680             }
681              
682             }
683              
684             #Compute the expected testrail date interval from 2 unix timestamps.
685             sub _compute_elapsed {
686 78     78   1500 my ( $begin, $end ) = @_;
687 78         247 my $secs_elapsed = $end - $begin;
688 78         624 my $mins_elapsed = floor( $secs_elapsed / 60 );
689 78         294 my $secs_remain = $secs_elapsed % 60;
690 78         318 my $hours_elapsed = floor( $mins_elapsed / 60 );
691 78         208 my $mins_remain = $mins_elapsed % 60;
692              
693 78         351 my $datestr = "";
694              
695             #You have bigger problems if your test takes days
696 78 100       306 if ($hours_elapsed) {
697 2         22 $datestr .= "$hours_elapsed" . "h $mins_remain" . "m";
698             }
699             else {
700 76         393 $datestr .= "$mins_elapsed" . "m";
701             }
702 78 100       284 if ($mins_elapsed) {
703 3         9 $datestr .= " $secs_remain" . "s";
704             }
705             else {
706 75         417 $datestr .= " $secs_elapsed" . "s";
707             }
708 78 100       394 undef $datestr if $datestr eq "0m 0s";
709 78         606 return $datestr;
710             }
711              
712             sub _test_closure {
713 45     45   173 my ($self) = @_;
714 45 100       271 return unless $self->{'tr_opts'}->{'autoclose'};
715 8 100       93 my $is_plan = $self->{'tr_opts'}->{'plan'} ? 1 : 0;
716             my $id =
717             $self->{'tr_opts'}->{'plan'}
718             ? $self->{'tr_opts'}->{'plan'}->{'id'}
719 8 100       97 : $self->{'tr_opts'}->{'run'};
720              
721 8 100       72 if ($is_plan) {
722             my $plan_summary =
723 4         80 $self->{'tr_opts'}->{'testrail'}->getPlanSummary($id);
724              
725             return
726             if ( $plan_summary->{'totals'}->{'Untested'} +
727 4 100       43 $plan_summary->{'totals'}->{'Retest'} );
728 3         129 print "# No more outstanding cases detected. Closing Plan.\n";
729 3         33 $self->{'plan_closed'} = 1;
730 3         39 return $self->{'tr_opts'}->{'testrail'}->closePlan($id);
731             }
732              
733 4         78 my ($run_summary) = $self->{'tr_opts'}->{'testrail'}->getRunSummary($id);
734             return
735             if ( $run_summary->{'run_status'}->{'Untested'} +
736 4 100       37 $run_summary->{'run_status'}->{'Retest'} );
737 1         45 print "# No more outstanding cases detected. Closing Run.\n";
738 1         14 $self->{'run_closed'} = 1;
739             return $self->{'tr_opts'}->{'testrail'}
740 1         14 ->closeRun( $self->{'tr_opts'}->{'run_id'} );
741             }
742              
743             sub make_result {
744 277     277 1 27048611 my ( $self, @args ) = @_;
745 277         1303 my $res = $self->SUPER::make_result(@args);
746 277         15334 $res->{'parser'} = $self;
747 277         1355 return $res;
748             }
749              
750             1;
751              
752             __END__