Commit | Line | Data |
b965d173 |
1 | package TAP::Formatter::Console::ParallelSession; |
2 | |
3 | use strict; |
4 | use File::Spec; |
5 | use File::Path; |
6 | use TAP::Formatter::Console::Session; |
7 | use Carp; |
8 | |
9 | use constant WIDTH => 72; # Because Eric says |
10 | use vars qw($VERSION @ISA); |
11 | |
12 | @ISA = qw(TAP::Formatter::Console::Session); |
13 | |
14 | my %shared; |
15 | |
16 | sub _initialize { |
17 | my ( $self, $arg_for ) = @_; |
18 | |
19 | $self->SUPER::_initialize($arg_for); |
20 | my $formatter = $self->formatter; |
21 | |
22 | # Horrid bodge. This creates our shared context per harness. Maybe |
23 | # TAP::Harness should give us this? |
24 | my $context = $shared{$formatter} ||= $self->_create_shared_context; |
25 | push @{ $context->{active} }, $self; |
26 | |
27 | return $self; |
28 | } |
29 | |
30 | sub _create_shared_context { |
31 | my $self = shift; |
32 | return { |
33 | active => [], |
34 | tests => 0, |
35 | fails => 0, |
36 | }; |
37 | } |
38 | |
39 | sub _need_refresh { |
40 | my $self = shift; |
41 | my $formatter = $self->formatter; |
42 | $shared{$formatter}->{need_refresh}++; |
43 | } |
44 | |
45 | =head1 NAME |
46 | |
47 | TAP::Formatter::Console::ParallelSession - Harness output delegate for parallel console output |
48 | |
49 | =head1 VERSION |
50 | |
69f36734 |
51 | Version 3.06 |
b965d173 |
52 | |
53 | =cut |
54 | |
69f36734 |
55 | $VERSION = '3.06'; |
b965d173 |
56 | |
57 | =head1 DESCRIPTION |
58 | |
59 | This provides console orientated output formatting for L<TAP::Harness::Parallel>. |
60 | |
61 | =head1 SYNOPSIS |
62 | |
63 | =cut |
64 | |
65 | =head1 METHODS |
66 | |
67 | =head2 Class Methods |
68 | |
69 | =head3 C<header> |
70 | |
71 | Output test preamble |
72 | |
73 | =cut |
74 | |
75 | sub header { |
76 | my $self = shift; |
77 | $self->_need_refresh; |
78 | } |
79 | |
80 | sub _refresh { |
81 | } |
82 | |
83 | sub _clear_line { |
84 | my $self = shift; |
85 | $self->formatter->_output( "\r" . ( ' ' x WIDTH ) . "\r" ); |
86 | } |
87 | |
88 | sub _output_ruler { |
89 | my $self = shift; |
90 | my $formatter = $self->formatter; |
91 | return if $formatter->really_quiet; |
92 | |
93 | my $context = $shared{$formatter}; |
94 | |
95 | my $ruler = sprintf( "===( %7d )", $context->{tests} ); |
96 | $ruler .= ( '=' x ( WIDTH - length $ruler ) ); |
97 | $formatter->_output("\r$ruler"); |
98 | } |
99 | |
100 | =head3 C<result> |
101 | |
102 | Called by the harness for each line of TAP it receives . |
103 | |
104 | =cut |
105 | |
106 | sub result { |
107 | my ( $self, $result ) = @_; |
108 | my $parser = $self->parser; |
109 | my $formatter = $self->formatter; |
110 | my $context = $shared{$formatter}; |
111 | |
112 | $self->_refresh; |
113 | |
114 | # my $really_quiet = $formatter->really_quiet; |
115 | # my $show_count = $self->_should_show_count; |
116 | my $planned = $parser->tests_planned; |
117 | |
118 | if ( $result->is_bailout ) { |
119 | $formatter->_failure_output( |
120 | "Bailout called. Further testing stopped: " |
121 | . $result->explanation |
122 | . "\n" ); |
123 | } |
124 | |
125 | if ( $result->is_test ) { |
126 | $context->{tests}++; |
127 | |
128 | my $test_print_modulus = 1; |
129 | my $ceiling = $context->{tests} / 5; |
130 | $test_print_modulus *= 2 while $test_print_modulus < $ceiling; |
131 | |
132 | unless ( $context->{tests} % $test_print_modulus ) { |
133 | $self->_output_ruler; |
134 | } |
135 | } |
136 | } |
137 | |
138 | =head3 C<close_test> |
139 | |
140 | =cut |
141 | |
142 | sub close_test { |
143 | my $self = shift; |
144 | my $name = $self->name; |
145 | my $parser = $self->parser; |
146 | my $formatter = $self->formatter; |
147 | my $context = $shared{$formatter}; |
148 | |
149 | unless ( $formatter->really_quiet ) { |
150 | $self->_clear_line; |
151 | |
152 | # my $output = $self->_output_method; |
153 | $formatter->_output( |
154 | $formatter->_format_name( $self->name ), |
155 | ' ' |
156 | ); |
157 | } |
158 | |
159 | if ( $parser->has_problems ) { |
160 | $self->_output_test_failure($parser); |
161 | } |
162 | else { |
163 | $formatter->_output("ok\n") |
164 | unless $formatter->really_quiet; |
165 | } |
166 | |
167 | $self->_output_ruler; |
168 | |
169 | # $self->SUPER::close_test; |
170 | my $active = $context->{active}; |
171 | |
172 | my @pos = grep { $active->[$_]->name eq $name } 0 .. $#$active; |
173 | |
174 | die "Can't find myself" unless @pos; |
175 | splice @$active, $pos[0], 1; |
176 | |
177 | $self->_need_refresh; |
178 | |
179 | unless (@$active) { |
180 | |
181 | # $self->formatter->_output("\n"); |
182 | delete $shared{$formatter}; |
183 | } |
184 | } |
185 | |
186 | 1; |