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