xref: /openbsd-src/gnu/usr.bin/perl/cpan/Test-Harness/lib/TAP/Formatter/Console/Session.pm (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
1package TAP::Formatter::Console::Session;
2
3use strict;
4use warnings;
5
6use base 'TAP::Formatter::Session';
7
8my @ACCESSOR;
9
10BEGIN {
11    my @CLOSURE_BINDING = qw( header result clear_for_close close_test );
12
13    for my $method (@CLOSURE_BINDING) {
14        no strict 'refs';
15        *$method = sub {
16            my $self = shift;
17            return ( $self->{_closures} ||= $self->_closures )->{$method}
18              ->(@_);
19        };
20    }
21}
22
23=head1 NAME
24
25TAP::Formatter::Console::Session - Harness output delegate for default console output
26
27=head1 VERSION
28
29Version 3.48
30
31=cut
32
33our $VERSION = '3.48';
34
35=head1 DESCRIPTION
36
37This provides console orientated output formatting for TAP::Harness.
38
39=cut
40
41sub _get_output_result {
42    my $self = shift;
43
44    my @color_map = (
45        {   test => sub { $_->is_test && !$_->is_ok },
46            colors => ['red'],
47        },
48        {   test => sub { $_->is_test && $_->has_skip },
49            colors => [
50                'white',
51                'on_blue'
52            ],
53        },
54        {   test => sub { $_->is_test && $_->has_todo },
55            colors => ['yellow'],
56        },
57    );
58
59    my $formatter = $self->formatter;
60    my $parser    = $self->parser;
61
62    return $formatter->_colorizer
63      ? sub {
64        my $result = shift;
65        for my $col (@color_map) {
66            local $_ = $result;
67            if ( $col->{test}->() ) {
68                $formatter->_set_colors( @{ $col->{colors} } );
69                last;
70            }
71        }
72        $formatter->_output( $self->_format_for_output($result) );
73        $formatter->_set_colors('reset');
74      }
75      : sub {
76        $formatter->_output( $self->_format_for_output(shift) );
77      };
78}
79
80sub _closures {
81    my $self = shift;
82
83    my $parser     = $self->parser;
84    my $formatter  = $self->formatter;
85    my $pretty     = $formatter->_format_name( $self->name );
86    my $show_count = $self->show_count;
87
88    my $really_quiet = $formatter->really_quiet;
89    my $quiet        = $formatter->quiet;
90    my $verbose      = $formatter->verbose;
91    my $directives   = $formatter->directives;
92    my $failures     = $formatter->failures;
93    my $comments     = $formatter->comments;
94
95    my $output_result = $self->_get_output_result;
96
97    my $output          = '_output';
98    my $plan            = '';
99    my $newline_printed = 0;
100
101    my $last_status_printed = 0;
102
103    return {
104        header => sub {
105            $formatter->_output($pretty)
106              unless $really_quiet;
107        },
108
109        result => sub {
110            my $result = shift;
111
112            if ( $result->is_bailout ) {
113                $formatter->_failure_output(
114                        "Bailout called.  Further testing stopped:  "
115                      . $result->explanation
116                      . "\n" );
117            }
118
119            return if $really_quiet;
120
121            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            if ( !$plan ) {
128                my $planned = $parser->tests_planned || '?';
129                $plan = "/$planned ";
130            }
131            $output = $formatter->_get_output_method($parser);
132
133            if ( $show_count and $is_test ) {
134                my $number = $result->number;
135                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                if ( $last_status_printed != $now ) {
142                    $formatter->$output("\r$pretty$number$plan");
143                    $last_status_printed = $now;
144                }
145            }
146
147            if (!$quiet
148                && (   $verbose
149                    || ( $is_test && $failures && !$result->is_ok )
150                    || ( $comments   && $result->is_comment )
151                    || ( $directives && $result->has_directive ) )
152              )
153            {
154                unless ($newline_printed) {
155                    $formatter->_output("\n");
156                    $newline_printed = 1;
157                }
158                $output_result->($result);
159                $formatter->_output("\n");
160            }
161        },
162
163        clear_for_close => sub {
164            my $spaces
165              = ' ' x length( '.' . $pretty . $plan . $parser->tests_run );
166            $formatter->$output("\r$spaces");
167        },
168
169        close_test => sub {
170            if ( $show_count && !$really_quiet ) {
171                $self->clear_for_close;
172                $formatter->$output("\r$pretty");
173            }
174
175            # Avoid circular references
176            $self->parser(undef);
177            $self->{_closures} = {};
178
179            return if $really_quiet;
180
181            if ( my $skip_all = $parser->skip_all ) {
182                $formatter->_output("skipped: $skip_all\n");
183            }
184            elsif ( $parser->has_problems ) {
185                $self->_output_test_failure($parser);
186            }
187            else {
188                my $time_report = $self->time_report($formatter, $parser);
189                $formatter->_output_success( $self->_make_ok_line($time_report) );
190            }
191        },
192    };
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
2051;
206