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.051';
6 3     3   73036 use strict;
  3         10  
  3         121  
7 3     3   19 use warnings;
  3         7  
  3         106  
8 3     3   16 use utf8;
  3         6  
  3         29  
9              
10 3     3   118 use parent qw/TAP::Parser/;
  3         6  
  3         24  
11 3     3   134270 use Carp qw{cluck confess};
  3         11  
  3         172  
12 3     3   37 use POSIX qw{floor strftime};
  3         7  
  3         29  
13 3     3   3605 use Clone qw{clone};
  3         9  
  3         140  
14              
15 3     3   19 use TestRail::API;
  3         5  
  3         95  
16 3     3   536 use TestRail::Utils;
  3         7  
  3         85  
17 3     3   19 use Scalar::Util qw{reftype};
  3         6  
  3         169  
18              
19 3     3   20 use File::Basename qw{basename};
  3         8  
  3         15386  
20              
21             sub new {
22 57     57 1 105388 my ( $class, $opts ) = @_;
23 57         274942 $opts = clone $opts; #Convenience, if we are passing over and over again...
24              
25             #Load our callbacks
26 57         7416 $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     2316 'max_tries' => delete $opts->{'max_tries'} || 1,
      100        
60             };
61              
62             confess("plan passed, but no run passed!")
63 57 50 66     1197 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     1590 { 'skip_usercache' => 1 },
      50        
      50        
      50        
77             );
78 56         250 $tropts->{'testrail'} = $tr;
79             $tr->{'browser'} = $tropts->{'browser'}
80 56 50       1702 if defined( $tropts->{'browser'} ); #allow mocks
81 56         200 $tr->{'debug'} = 0; #Always suppress in production
82              
83             #Get project ID from name, if not provided
84 56 100       275 if ( !defined( $tropts->{'project_id'} ) ) {
85 52         155 my $pname = $tropts->{'project'};
86 52         516 $tropts->{'project'} = $tr->getProjectByName($pname);
87             confess("Could not list projects! Shutting down.")
88 52 50       208 if ( $tropts->{'project'} == -500 );
89 52 50       202 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         43 $tropts->{'project'} = $tr->getProjectByID( $tropts->{'project_id'} );
97             confess("No such project with ID $tropts->{project_id}!")
98 4 50       26 if !$tropts->{'project'};
99             }
100 56         187 $tropts->{'project_id'} = $tropts->{'project'}->{'id'};
101              
102             # Ok, let's cache the users since we have the project ID now
103 56         519 $tr->getUsers( $tropts->{'project_id'} );
104              
105             #Discover possible test statuses
106 56         620 $tropts->{'statuses'} = $tr->getPossibleTestStatuses();
107 56         199 my @ok = grep { $_->{'name'} eq 'passed' } @{ $tropts->{'statuses'} };
  504         1086  
  56         221  
108 56         147 my @not_ok = grep { $_->{'name'} eq 'failed' } @{ $tropts->{'statuses'} };
  504         906  
  56         147  
109 56         147 my @skip = grep { $_->{'name'} eq 'skip' } @{ $tropts->{'statuses'} };
  504         898  
  56         148  
110 56         139 my @todof = grep { $_->{'name'} eq 'todo_fail' } @{ $tropts->{'statuses'} };
  504         848  
  56         148  
111 56         125 my @todop = grep { $_->{'name'} eq 'todo_pass' } @{ $tropts->{'statuses'} };
  504         958  
  56         121  
112 56         130 my @retest = grep { $_->{'name'} eq 'retest' } @{ $tropts->{'statuses'} };
  504         876  
  56         154  
113 56         111 my @tbad;
114             @tbad =
115 162         303 grep { $_->{'name'} eq $tropts->{test_bad_status} }
116 18         49 @{ $tropts->{'statuses'} }
117 56 100       305 if $tropts->{test_bad_status};
118 56 50       192 confess("No status with internal name 'passed' in TestRail!")
119             unless scalar(@ok);
120 56 50       193 confess("No status with internal name 'failed' in TestRail!")
121             unless scalar(@not_ok);
122 56 50       158 confess("No status with internal name 'skip' in TestRail!")
123             unless scalar(@skip);
124 56 50       192 confess("No status with internal name 'todo_fail' in TestRail!")
125             unless scalar(@todof);
126 56 50       182 confess("No status with internal name 'todo_pass' in TestRail!")
127             unless scalar(@todop);
128 56 50       158 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     910 ) unless scalar(@tbad) || !$tropts->{test_bad_status};
133              
134             #Map in all the statuses
135 55         138 foreach my $status ( @{ $tropts->{'statuses'} } ) {
  55         210  
136 495         1417 $tropts->{ $status->{'name'} } = $status;
137             }
138              
139             #Special aliases
140 55         201 $tropts->{'ok'} = $ok[0];
141 55         186 $tropts->{'not_ok'} = $not_ok[0];
142              
143             confess "testsuite and testsuite_id are mutually exclusive"
144 55 50 66     461 if ( $tropts->{'testsuite_id'} && $tropts->{'testsuite'} );
145              
146             #Grab testsuite by name if needed
147 55 100       206 if ( $tropts->{'testsuite'} ) {
148             my $ts = $tr->getTestSuiteByName( $tropts->{'project_id'},
149 3         50 $tropts->{'testsuite'} );
150 3 50       12 confess( "No such testsuite '" . $tropts->{'testsuite'} . "' found!" )
151             unless $ts;
152 3         16 $tropts->{'testsuite_id'} = $ts->{'id'};
153             }
154              
155             #Grab run
156 55         179 my ( $run, $plan, $config_ids );
157              
158             # See if we have to create a configuration
159 55         594 my $configz2create = $tr->getConfigurations( $tropts->{'project_id'} );
160             @$configz2create = grep {
161 55         178 my $c = $_;
  231         336  
162 231         303 ( grep { $_ eq $c->{'name'} } @{ $tropts->{'configs'} } )
  73         248  
  231         666  
163             } @$configz2create;
164 55 100 100     363 if ( scalar(@$configz2create) && $tropts->{'config_group'} ) {
165             my $cgroup = $tr->getConfigurationGroupByName( $tropts->{project_id},
166 3         34 $tropts->{'config_group'} );
167 3 50       24 unless ( ref($cgroup) eq 'HASH' ) {
168 3         160 print "# Adding Configuration Group $tropts->{config_group}...\n";
169             $cgroup = $tr->addConfigurationGroup( $tropts->{project_id},
170 3         27 $tropts->{'config_group'} );
171             }
172             confess(
173 3 50       123 "Could neither find nor create the provided configuration group '$tropts->{config_group}'"
174             ) unless ref($cgroup) eq 'HASH';
175 3         11 foreach my $cc (@$configz2create) {
176 3         122 print "# Adding Configuration $cc->{name}...\n";
177 3         29 $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         265 @{ $tropts->{'configs'} } );
  55         405  
184 55 50 50     400 confess("Could not retrieve list of valid configurations for your project.")
185             unless ( reftype($config_ids) || 'undef' ) eq 'ARRAY';
186 55         217 my @bogus_configs = grep { !defined($_) } @$config_ids;
  16         76  
187 55         143 my $num_bogus = scalar(@bogus_configs);
188 55 50       302 confess(
189             "Detected $num_bogus bad config names passed. Check available configurations for your project."
190             ) if $num_bogus;
191              
192 55 100       335 if ( $tropts->{'plan'} ) {
193              
194             #Attempt to find run, filtered by configurations
195 21 50       79 if ( $tropts->{'plan_id'} ) {
196 0         0 $plan = $tr->getPlanByID( $tropts->{'plan_id'} );
197             }
198             else {
199             $plan =
200 21         232 $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     1725 && ( !$tropts->{'testsuite_id'} );
      100        
207 20 100 100     391 if ( $plan && !$plan->{'is_completed'} ) {
208 12         131 $tropts->{'plan'} = $plan;
209             $run = $tr->getChildRunByName( $plan, $tropts->{'run'},
210 12         129 $tropts->{'configs'} ); #Find plan filtered by configs
211              
212 12 100 100     160 if ( defined($run) && ( reftype($run) || 'undef' ) eq 'HASH' ) {
      66        
213 10         35 $tropts->{'run'} = $run;
214 10         31 $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       121 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       556 ) if !$tropts->{'plan'};
226             }
227             }
228             else {
229 34         384 $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     470 && ( !$tropts->{'testsuite_id'} );
      100        
235 33 100 100     674 if ( defined($run)
      66        
      100        
236             && ( reftype($run) || 'undef' ) eq 'HASH'
237             && !$run->{'is_completed'} )
238             {
239 12         81 $tropts->{'run'} = $run;
240 12         37 $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     404 if ( $tropts->{'testsuite_id'} && !$tropts->{'run_id'} ) {
246 30         3095 print "# Spawning run\n";
247 30         186 my $cases = [];
248 30 100       167 if ( $tropts->{'sections'} ) {
249 9         323 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     124 unless ( reftype( $tropts->{'sections'} ) || 'undef' ) eq 'ARRAY';
254 8         47 @{ $tropts->{'sections'} } = $tr->sectionNamesToIds(
255             $tropts->{'project_id'},
256             $tropts->{'testsuite_id'},
257 9         39 @{ $tropts->{'sections'} }
  9         134  
258             );
259 8         23 foreach my $section ( @{ $tropts->{'sections'} } ) {
  8         29  
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         87 'suite_id' => $tropts->{'testsuite_id'}
267             }
268             );
269             @$append_sections = grep {
270 9         37 my $sc = $_;
  6         11  
271 18         36 !scalar( grep { $_ == $sc->{'id'} }
272 6         9 @{ $tropts->{'sections'} } )
  6         11  
273             } @$append_sections
274             ; #de-dup in case the user added children to the list
275 9         24 @$append_sections = map { $_->{'id'} } @$append_sections;
  2         6  
276 9         19 push( @{ $tropts->{'sections'} }, @$append_sections );
  9         29  
277              
278             my $section_cases = $tr->getCases(
279             $tropts->{'project_id'},
280 9         81 $tropts->{'testsuite_id'},
281             { 'section_id' => $section }
282             );
283 9 50 50     576 push( @$cases, @$section_cases )
284             if ( reftype($section_cases) || 'undef' ) eq 'ARRAY';
285             }
286             }
287              
288 29 100       135 if ( scalar(@$cases) ) {
289 5         21 @$cases = map { $_->{'id'} } @$cases;
  11         57  
290             }
291             else {
292 24         84 $cases = undef;
293             }
294              
295 29 100       157 if ( $tropts->{'plan'} ) {
296 9         513 print "# inside of plan\n";
297             $plan = $tr->createRunInPlan(
298             $tropts->{'plan'}->{'id'},
299             $tropts->{'testsuite_id'},
300 9         165 $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     550 && scalar( @{ $plan->{'runs'} } );
  9   33     72  
      50        
306 9 50 50     136 if ( defined($run) && ( reftype($run) || 'undef' ) eq 'HASH' ) {
      33        
307 9         35 $tropts->{'run'} = $run;
308 9         33 $tropts->{'run_id'} = $run->{'id'};
309             }
310             }
311             else {
312             $run = $tr->createRun(
313             $tropts->{'project_id'},
314             $tropts->{'testsuite_id'},
315 20         238 $tropts->{'run'},
316             "Automatically created Run from TestRail::API",
317             undef,
318             undef,
319             $cases
320             );
321 20 50 50     1577 if ( defined($run) && ( reftype($run) || 'undef' ) eq 'HASH' ) {
      33        
322 20         88 $tropts->{'run'} = $run;
323 20         67 $tropts->{'run_id'} = $run->{'id'};
324             }
325             }
326             confess("Could not spawn run with requested parameters!")
327 29 50       128 if !$tropts->{'run_id'};
328 29         1935 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       816 ) if !$tropts->{'run_id'};
333              
334 51         486 my $self = $class->SUPER::new($opts);
335 51 100 66     377464 if ( defined( $self->{'_iterator'}->{'command'} )
336             && reftype( $self->{'_iterator'}->{'command'} ) eq 'ARRAY' )
337             {
338 33         220 $self->{'file'} = $self->{'_iterator'}->{'command'}->[-1];
339 33         4428 print "# PROCESSING RESULTS FROM TEST FILE: $self->{'file'}\n";
340 33         351 $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         46 $self->{'track_time'} = 0;
345             }
346              
347             #Make sure the step results field passed exists on the system
348 51         232 my $sr_name = $tropts->{'step_results'};
349             $tropts->{'step_results'} =
350             $tr->getTestResultFieldByName( $tropts->{'step_results'},
351             $tropts->{'project_id'} )
352 51 100       586 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     1946 ) if ref $tropts->{'step_results'} ne 'HASH' && $sr_name;
356              
357 50         357 $self->{'tr_opts'} = $tropts;
358 50         339 $self->{'errors'} = 0;
359              
360             #Start the shot clock
361 50         261 $self->{'starttime'} = time();
362              
363             #Make sure we get the time it took to get to each step from the last correctly
364 50         160 $self->{'lasttime'} = $self->{'starttime'};
365 50         269 $self->{'raw_output'} = "";
366              
367 50         16937 return $self;
368             }
369              
370             # Look for file boundaries, etc.
371             sub unknownCallback {
372 87     87 1 3948 my ($test) = @_;
373 87         181 my $self = $test->{'parser'};
374 87         252 my $line = $test->as_string;
375 87         490 $self->{'raw_output'} .= "$line\n";
376              
377             #Unofficial "Extensions" to TAP
378 87         223 my ($status_override) = $line =~ m/^% mark_status=([a-z|_]*)/;
379 87 100       230 if ($status_override) {
380             cluck "Unknown status override"
381 1 50       28 unless defined $self->{'tr_opts'}->{$status_override}->{'id'};
382             $self->{'global_status'} =
383             $self->{'tr_opts'}->{$status_override}->{'id'}
384 1 50       9 if $self->{'tr_opts'}->{$status_override};
385             print "# Overriding status to $status_override ("
386             . $self->{'global_status'}
387             . ")...\n"
388 1 50       42 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         532 my $file = TestRail::Utils::getFilenameFromTapLine($line);
394 87 100 100     422 $self->{'file'} = $file if !$self->{'file'} && $file;
395 87         259 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 2633 my ($test) = @_;
401 77         203 my $self = $test->{'parser'};
402 77         303 my $line = $test->as_string;
403 77         605 $self->{'raw_output'} .= "$line\n";
404              
405 77 50       405 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         225 return;
410             }
411              
412             sub testCallback {
413 69     69 1 10658 my ($test) = @_;
414 69         199 my $self = $test->{'parser'};
415              
416 69 100       289 if ( $self->{'track_time'} ) {
417              
418             #Test done. Record elapsed time.
419 45         138 my $tm = time();
420             $self->{'tr_opts'}->{'result_options'}->{'elapsed'} =
421 45         326 _compute_elapsed( $self->{'lasttime'}, $tm );
422             $self->{'elapse_display'} =
423             defined( $self->{'tr_opts'}->{'result_options'}->{'elapsed'} )
424 45 100       400 ? $self->{'tr_opts'}->{'result_options'}->{'elapsed'}
425             : "0s";
426 45         130 $self->{'lasttime'} = $tm;
427             }
428              
429 69         296 my $line = $test->as_string;
430 69         1998 my $tline = $line;
431             $tline = "["
432             . strftime( "%H:%M:%S %b %e %Y", localtime( $self->{'lasttime'} ) )
433             . " ($self->{elapse_display})] $line"
434 69 100       5037 if $self->{'track_time'};
435 69         431 $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       317 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       4097 if $self->{'tr_opts'}->{'debug'};
442 57         386 return 1;
443             }
444              
445 12         170 $line =~ s/^(ok|not ok)\s[0-9]*\s-\s//g;
446 12         46 my $test_name = $line;
447              
448             print "# Assuming test name is '$test_name'...\n"
449 12 50 33     174 if $self->{'tr_opts'}->{'debug'} && !$self->{'tr_opts'}->{'step_results'};
450              
451 12         50 my $todo_reason;
452              
453             #Setup args to pass to function
454 12         55 my $status = $self->{'tr_opts'}->{'not_ok'}->{'id'};
455 12         48 my $status_name = 'NOT OK';
456 12 100       78 if ( $test->is_actual_ok() ) {
457 9         95 $status = $self->{'tr_opts'}->{'ok'}->{'id'};
458 9         31 $status_name = 'OK';
459 9 100       45 if ( $test->has_skip() ) {
460 1         7 $status = $self->{'tr_opts'}->{'skip'}->{'id'};
461 1         12 $status_name = 'SKIP';
462 1         10 $test_name =~ s/^(ok|not ok)\s[0-9]*\s//g;
463 1         7 $test_name =~ s/^# skip //gi;
464 1         132 print "# '$test_name'\n";
465             }
466 9 100       80 if ( $test->has_todo() ) {
467 4         26 $status = $self->{'tr_opts'}->{'todo_pass'}->{'id'};
468 4         30 $status_name = 'TODO PASS';
469 4         19 $test_name =~ s/^(ok|not ok)\s[0-9]*\s//g;
470 4         18 $test_name =~ s/^# todo & skip //gi; #handle todo_skip
471 4         60 $test_name =~ s/# todo\s(.*)$//gi;
472 4         24 $todo_reason = $test->explanation();
473             }
474             }
475             else {
476 3 100       42 if ( $test->has_todo() ) {
477 1         13 $status = $self->{'tr_opts'}->{'todo_fail'}->{'id'};
478 1         13 $status_name = 'TODO FAIL';
479 1         15 $test_name =~ s/^(ok|not ok)\s[0-9]*\s//g;
480 1         4 $test_name =~ s/^# todo & skip //gi; #handle todo_skip
481 1         14 $test_name =~ s/# todo\s(.*)$//gi;
482 1         16 $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         139 $test_name =~ s/\s+$//g;
488              
489             #If this is a TODO, set the reason in the notes
490 12 100       90 $self->{'tr_opts'}->{'test_notes'} .= "\nTODO reason: $todo_reason\n"
491             if $todo_reason;
492              
493 12         56 my $sr_sys_name = $self->{'tr_opts'}->{'step_results'}->{'name'};
494             $self->{'tr_opts'}->{'result_custom_options'} = {}
495 12 100       75 if !defined $self->{'tr_opts'}->{'result_custom_options'};
496             $self->{'tr_opts'}->{'result_custom_options'}->{$sr_sys_name} = []
497 12 100       88 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       564 if $self->{'track_time'};
505              
506             #XXX Obviously getting the 'expected' and 'actual' from the tap DIAGs would be ideal
507             push(
508 12         46 @{ $self->{'tr_opts'}->{'result_custom_options'}->{$sr_sys_name} },
  12         125  
509             TestRail::API::buildStepResults( $line, "OK", $status_name, $status )
510             );
511 12 50       16742 print "# Appended step results.\n" if $self->{'tr_opts'}->{'debug'};
512 12         121 return 1;
513             }
514              
515             sub bailoutCallback {
516 1     1 1 41 my ($test) = @_;
517 1         10 my $self = $test->{'parser'};
518 1         15 my $line = $test->as_string;
519 1         13 $self->{'raw_output'} .= "$line\n";
520              
521 1 50       50 if ( $self->{'tr_opts'}->{'step_results'} ) {
522 1         5 my $sr_sys_name = $self->{'tr_opts'}->{'step_results'}->{'name'};
523              
524             #Handle the case where we die right off
525 1   50     9 $self->{'tr_opts'}->{'result_custom_options'}->{$sr_sys_name} //= [];
526             push(
527 1         9 @{ $self->{'tr_opts'}->{'result_custom_options'}->{$sr_sys_name} },
528             TestRail::API::buildStepResults(
529             "Bail Out!.", "Continued testing",
530 1         4 $test->explanation, $self->{'tr_opts'}->{'not_ok'}->{'id'}
531             )
532             );
533             }
534 1         4 $self->{'is_bailout'} = 1;
535 1         4 return;
536             }
537              
538             sub EOFCallback {
539 45     45 1 1379469 my ($self) = @_;
540              
541 45 100       264 if ( $self->{'track_time'} ) {
542              
543             #Test done. Record elapsed time.
544             $self->{'tr_opts'}->{'result_options'}->{'elapsed'} =
545 29         359 _compute_elapsed( $self->{'starttime'}, time() );
546             }
547              
548             #Fail if the file is not set
549 45 50       248 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         159 my $run_id = $self->{'tr_opts'}->{'run_id'};
558 45         5180 my $test_name = basename( $self->{'file'} );
559              
560 45         274 my $status = $self->{'tr_opts'}->{'ok'}->{'id'};
561 45         365 my $todo_failed = $self->todo() - $self->todo_passed();
562 45 100       932 $status = $self->{'tr_opts'}->{'not_ok'}->{'id'} if $self->has_problems();
563 45 100 100     1216 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     766 $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     778 $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       393 $status = $self->{'tr_opts'}->{'skip'}->{'id'}
580             if $self->skip_all(); #Skip all, whee
581              
582             #Global status override
583 45 100       538 $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     203 if ( !$self->is_good_plan()
      66        
      100        
587             && !$self->{'is_bailout'}
588             && defined $self->tests_run
589             && defined $self->tests_planned )
590             {
591 6         281 $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       110 if ( $self->{'tr_opts'}->{'step_results'} ) {
597 3         7 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         8 $self->{'tr_opts'}->{'result_custom_options'}
605 3         19 ->{$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         548 my $notes = $self->{'raw_output'};
619 45         138 my $options = $self->{'tr_opts'}->{'result_options'};
620 45         149 my $custom_options = $self->{'tr_opts'}->{'result_custom_options'};
621              
622 45         3739 print "# Setting results...\n";
623 45         445 my $cres =
624             $self->_set_result( $run_id, $test_name, $status, $notes, $options,
625             $custom_options );
626 45         353 $self->_test_closure();
627 45         627 $self->{'global_status'} = $status;
628              
629 45 50       226 undef $self->{'tr_opts'} unless $self->{'tr_opts'}->{'debug'};
630              
631 45         375 return $cres;
632             }
633              
634             sub planCallback {
635 43     43 1 6272 my ($plan) = @_;
636 43         141 my $self = $plan->{'parser'};
637 43 50       215 $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         105 my $tc;
644              
645             print "# Test elapsed: " . $options->{'elapsed'} . "\n"
646 45 100       906 if $options->{'elapsed'};
647              
648 45         1929 print "# Attempting to find case by title '"
649             . $test_name
650             . "' in run $run_id...\n";
651             $tc =
652 45         852 $self->{'tr_opts'}->{'testrail'}->getTestByName( $run_id, $test_name );
653 45 100 100     675 if ( !defined($tc) || ( reftype($tc) || 'undef' ) ne 'HASH' ) {
      66        
654 1         423 cluck("ERROR: Could not find test case: $tc");
655 1         705 $self->{'errors'}++;
656 1         10 return 0;
657             }
658              
659 44 50       230 my $xid = $tc ? $tc->{'id'} : '???';
660              
661 44         101 my $cres;
662              
663             #Set test result
664 44 50       177 if ($tc) {
665 44         2387 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         708 ->createTestResults( $tc->{'id'}, $status, $notes, $options,
672             $custom_options );
673 44 100 100     5757 print "# OK! (set to $status)\n"
674             if ( reftype($cres) || 'undef' ) eq 'HASH';
675             }
676 44 100 100     1315 if ( !$tc || ( ( reftype($cres) || 'undef' ) ne 'HASH' ) ) {
      66        
677 1         19 print "# Failed!\n";
678 1         15 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   1324 my ( $begin, $end ) = @_;
687 78         316 my $secs_elapsed = $end - $begin;
688 78         594 my $mins_elapsed = floor( $secs_elapsed / 60 );
689 78         284 my $secs_remain = $secs_elapsed % 60;
690 78         307 my $hours_elapsed = floor( $mins_elapsed / 60 );
691 78         169 my $mins_remain = $mins_elapsed % 60;
692              
693 78         360 my $datestr = "";
694              
695             #You have bigger problems if your test takes days
696 78 100       319 if ($hours_elapsed) {
697 2         20 $datestr .= "$hours_elapsed" . "h $mins_remain" . "m";
698             }
699             else {
700 76         413 $datestr .= "$mins_elapsed" . "m";
701             }
702 78 100       301 if ($mins_elapsed) {
703 3         8 $datestr .= " $secs_remain" . "s";
704             }
705             else {
706 75         368 $datestr .= " $secs_elapsed" . "s";
707             }
708 78 100       371 undef $datestr if $datestr eq "0m 0s";
709 78         659 return $datestr;
710             }
711              
712             sub _test_closure {
713 45     45   154 my ($self) = @_;
714 45 100       256 return unless $self->{'tr_opts'}->{'autoclose'};
715 8 100       68 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       77 : $self->{'tr_opts'}->{'run'};
720              
721 8 100       60 if ($is_plan) {
722             my $plan_summary =
723 4         66 $self->{'tr_opts'}->{'testrail'}->getPlanSummary($id);
724              
725             return
726             if ( $plan_summary->{'totals'}->{'Untested'} +
727 4 100       35 $plan_summary->{'totals'}->{'Retest'} );
728 3         95 print "# No more outstanding cases detected. Closing Plan.\n";
729 3         30 $self->{'plan_closed'} = 1;
730 3         40 return $self->{'tr_opts'}->{'testrail'}->closePlan($id);
731             }
732              
733 4         61 my ($run_summary) = $self->{'tr_opts'}->{'testrail'}->getRunSummary($id);
734             return
735             if ( $run_summary->{'run_status'}->{'Untested'} +
736 4 100       40 $run_summary->{'run_status'}->{'Retest'} );
737 1         53 print "# No more outstanding cases detected. Closing Run.\n";
738 1         17 $self->{'run_closed'} = 1;
739             return $self->{'tr_opts'}->{'testrail'}
740 1         15 ->closeRun( $self->{'tr_opts'}->{'run_id'} );
741             }
742              
743             sub make_result {
744 277     277 1 27039034 my ( $self, @args ) = @_;
745 277         1343 my $res = $self->SUPER::make_result(@args);
746 277         15911 $res->{'parser'} = $self;
747 277         1273 return $res;
748             }
749              
750             1;
751              
752             __END__