xref: /openbsd-src/gnu/usr.bin/perl/cpan/Test-Harness/lib/TAP/Formatter/Console.pm (revision d13be5d47e4149db2549a9828e244d59dbc43f15)
1package TAP::Formatter::Console;
2
3use strict;
4use TAP::Formatter::Base ();
5use POSIX qw(strftime);
6
7use vars qw($VERSION @ISA);
8
9@ISA = qw(TAP::Formatter::Base);
10
11=head1 NAME
12
13TAP::Formatter::Console - Harness output delegate for default console output
14
15=head1 VERSION
16
17Version 3.17
18
19=cut
20
21$VERSION = '3.17';
22
23=head1 DESCRIPTION
24
25This provides console orientated output formatting for TAP::Harness.
26
27=head1 SYNOPSIS
28
29 use TAP::Formatter::Console;
30 my $harness = TAP::Formatter::Console->new( \%args );
31
32=head2 C<< open_test >>
33
34See L<TAP::Formatter::base>
35
36=cut
37
38sub open_test {
39    my ( $self, $test, $parser ) = @_;
40
41    my $class
42      = $self->jobs > 1
43      ? 'TAP::Formatter::Console::ParallelSession'
44      : 'TAP::Formatter::Console::Session';
45
46    eval "require $class";
47    $self->_croak($@) if $@;
48
49    my $session = $class->new(
50        {   name       => $test,
51            formatter  => $self,
52            parser     => $parser,
53            show_count => $self->show_count,
54        }
55    );
56
57    $session->header;
58
59    return $session;
60}
61
62# Use _colorizer delegate to set output color. NOP if we have no delegate
63sub _set_colors {
64    my ( $self, @colors ) = @_;
65    if ( my $colorizer = $self->_colorizer ) {
66        my $output_func = $self->{_output_func} ||= sub {
67            $self->_output(@_);
68        };
69        $colorizer->set_color( $output_func, $_ ) for @colors;
70    }
71}
72
73sub _output_success {
74    my ( $self, $msg ) = @_;
75    $self->_set_colors('green');
76    $self->_output($msg);
77    $self->_set_colors('reset');
78}
79
80sub _failure_output {
81    my $self = shift;
82    $self->_set_colors('red');
83    my $out = join '', @_;
84    my $has_newline = chomp $out;
85    $self->_output($out);
86    $self->_set_colors('reset');
87    $self->_output($/)
88      if $has_newline;
89}
90
911;
92