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