File Coverage

blib/lib/TAP/Formatter/Console/Session.pm
Criterion Covered Total %
statement 76 87 87.3
branch 28 34 82.3
condition 8 17 47.0
subroutine 17 18 94.4
pod n/a
total 129 156 82.6


line stmt bran cond sub pod time code
1             package TAP::Formatter::Console::Session;
2              
3 3     3   13 use strict;
  3         3  
  3         89  
4 3     3   10 use warnings;
  3         3  
  3         114  
5              
6 3     3   19 use base 'TAP::Formatter::Session';
  3         5  
  3         900  
7              
8             my @ACCESSOR;
9              
10             BEGIN {
11 3     3   12 my @CLOSURE_BINDING = qw( header result clear_for_close close_test );
12              
13 3         4 for my $method (@CLOSURE_BINDING) {
14 3     3   15 no strict 'refs';
  3         3  
  3         217  
15             *$method = sub {
16 82     82   76 my $self = shift;
        74      
17 82   66     258 return ( $self->{_closures} ||= $self->_closures )->{$method}
18             ->(@_);
19 12         2017 };
20             }
21             }
22              
23             =head1 NAME
24              
25             TAP::Formatter::Console::Session - Harness output delegate for default console output
26              
27             =head1 VERSION
28              
29             Version 3.39
30              
31             =cut
32              
33             our $VERSION = '3.39';
34              
35             =head1 DESCRIPTION
36              
37             This provides console orientated output formatting for TAP::Harness.
38              
39             =cut
40              
41             sub _get_output_result {
42 14     14   15 my $self = shift;
43              
44             my @color_map = (
45 19 100   19   28 { test => sub { $_->is_test && !$_->is_ok },
46             colors => ['red'],
47             },
48 17 100   17   29 { test => sub { $_->is_test && $_->has_skip },
49             colors => [
50             'white',
51             'on_blue'
52             ],
53             },
54 17 100   17   26 { test => sub { $_->is_test && $_->has_todo },
55 14         222 colors => ['yellow'],
56             },
57             );
58              
59 14         40 my $formatter = $self->formatter;
60 14         30 my $parser = $self->parser;
61              
62             return $formatter->_colorizer
63             ? sub {
64 19     19   14 my $result = shift;
65 19         29 for my $col (@color_map) {
66 53         45 local $_ = $result;
67 53 100       68 if ( $col->{test}->() ) {
68 2         4 $formatter->_set_colors( @{ $col->{colors} } );
  2         10  
69 2         24 last;
70             }
71             }
72 19         96 $formatter->_output( $self->_format_for_output($result) );
73 19         223 $formatter->_set_colors('reset');
74             }
75             : sub {
76 3     3   12 $formatter->_output( $self->_format_for_output(shift) );
77 14 100       54 };
78             }
79              
80             sub _closures {
81 14     14   20 my $self = shift;
82              
83 14         36 my $parser = $self->parser;
84 14         34 my $formatter = $self->formatter;
85 14         54 my $pretty = $formatter->_format_name( $self->name );
86 14         29 my $show_count = $self->show_count;
87              
88 14         43 my $really_quiet = $formatter->really_quiet;
89 14         38 my $quiet = $formatter->quiet;
90 14         28 my $verbose = $formatter->verbose;
91 14         49 my $directives = $formatter->directives;
92 14         45 my $failures = $formatter->failures;
93 14         57 my $comments = $formatter->comments;
94              
95 14         44 my $output_result = $self->_get_output_result;
96              
97 14         22 my $output = '_output';
98 14         19 my $plan = '';
99 14         16 my $newline_printed = 0;
100              
101 14         14 my $last_status_printed = 0;
102              
103             return {
104             header => sub {
105 14 100   14   63 $formatter->_output($pretty)
106             unless $really_quiet;
107             },
108              
109             result => sub {
110 54     54   51 my $result = shift;
111              
112 54 50       106 if ( $result->is_bailout ) {
113 0         0 $formatter->_failure_output(
114             "Bailout called. Further testing stopped: "
115             . $result->explanation
116             . "\n" );
117             }
118              
119 54 100       84 return if $really_quiet;
120              
121 39         79 my $is_test = $result->is_test;
122              
123             # These are used in close_test - but only if $really_quiet
124             # is false - so it's safe to only set them here unless that
125             # relationship changes.
126              
127 39 100       60 if ( !$plan ) {
128 10   50     21 my $planned = $parser->tests_planned || '?';
129 10         20 $plan = "/$planned ";
130             }
131 39         111 $output = $formatter->_get_output_method($parser);
132              
133 39 50 33     73 if ( $show_count and $is_test ) {
134 0         0 my $number = $result->number;
135 0         0 my $now = CORE::time;
136              
137             # Print status roughly once per second.
138             # We will always get the first number as a side effect of
139             # $last_status_printed starting with the value 0, which $now
140             # will never be. (Unless someone sets their clock to 1970)
141 0 0       0 if ( $last_status_printed != $now ) {
142 0         0 $formatter->$output("\r$pretty$number$plan");
143 0         0 $last_status_printed = $now;
144             }
145             }
146              
147 39 100 33     200 if (!$quiet
      66        
148             && ( $verbose
149             || ( $is_test && $failures && !$result->is_ok )
150             || ( $comments && $result->is_comment )
151             || ( $directives && $result->has_directive ) )
152             )
153             {
154 22 100       35 unless ($newline_printed) {
155 8         18 $formatter->_output("\n");
156 8         78 $newline_printed = 1;
157             }
158 22         29 $output_result->($result);
159 22         210 $formatter->_output("\n");
160             }
161             },
162              
163             clear_for_close => sub {
164 0     0   0 my $spaces
165             = ' ' x length( '.' . $pretty . $plan . $parser->tests_run );
166 0         0 $formatter->$output("\r$spaces");
167             },
168              
169             close_test => sub {
170 14 50 33 14   40 if ( $show_count && !$really_quiet ) {
171 0         0 $self->clear_for_close;
172 0         0 $formatter->$output("\r$pretty");
173             }
174              
175             # Avoid circular references
176 14         43 $self->parser(undef);
177 14         22 $self->{_closures} = {};
178              
179 14 100       272 return if $really_quiet;
180              
181 11 50       31 if ( my $skip_all = $parser->skip_all ) {
    100          
182 0         0 $formatter->_output("skipped: $skip_all\n");
183             }
184             elsif ( $parser->has_problems ) {
185 5         28 $self->_output_test_failure($parser);
186             }
187             else {
188 6         29 my $time_report = $self->time_report($formatter, $parser);
189 6         21 $formatter->_output( $self->_make_ok_line($time_report) );
190             }
191             },
192 14         270 };
193             }
194              
195             =head2 C<< clear_for_close >>
196              
197             =head2 C<< close_test >>
198              
199             =head2 C<< header >>
200              
201             =head2 C<< result >>
202              
203             =cut
204              
205             1;