File Coverage

blib/lib/TAP/Formatter/Console.pm
Criterion Covered Total %
statement 39 39 100.0
branch 6 8 75.0
condition 4 6 66.6
subroutine 11 11 100.0
pod 1 1 100.0
total 61 65 93.8


line stmt bran cond sub pod time code
1             package TAP::Formatter::Console;
2              
3 5     5   16353 use strict;
  5         8  
  5         152  
4 5     5   19 use warnings;
  5         6  
  5         151  
5 5     5   19 use base 'TAP::Formatter::Base';
  5         5  
  5         1534  
6 5     5   29 use POSIX qw(strftime);
  5         4  
  5         28  
7              
8             =head1 NAME
9              
10             TAP::Formatter::Console - Harness output delegate for default console output
11              
12             =head1 VERSION
13              
14             Version 3.39
15              
16             =cut
17              
18             our $VERSION = '3.39';
19              
20             =head1 DESCRIPTION
21              
22             This provides console orientated output formatting for TAP::Harness.
23              
24             =head1 SYNOPSIS
25              
26             use TAP::Formatter::Console;
27             my $harness = TAP::Formatter::Console->new( \%args );
28              
29             =head2 C<< open_test >>
30              
31             See L
32              
33             =cut
34              
35             sub open_test {
36 14     14 1 33 my ( $self, $test, $parser ) = @_;
37              
38 14 50       68 my $class
39             = $self->jobs > 1
40             ? 'TAP::Formatter::Console::ParallelSession'
41             : 'TAP::Formatter::Console::Session';
42              
43 14         1078 eval "require $class";
44 14 50       56 $self->_croak($@) if $@;
45              
46 14         88 my $session = $class->new(
47             { name => $test,
48             formatter => $self,
49             parser => $parser,
50             show_count => $self->show_count,
51             }
52             );
53              
54 14         74 $session->header;
55              
56 14         300 return $session;
57             }
58              
59             # Use _colorizer delegate to set output color. NOP if we have no delegate
60             sub _set_colors {
61 79     79   109 my ( $self, @colors ) = @_;
62 79 100       122 if ( my $colorizer = $self->_colorizer ) {
63             my $output_func = $self->{_output_func} ||= sub {
64 45     45   164 $self->_output(@_);
65 45   100     82 };
66 45         94 $colorizer->set_color( $output_func, $_ ) for @colors;
67             }
68             }
69              
70             sub _failure_color {
71 23     23   22 my ($self) = @_;
72              
73 23   50     104 return $ENV{'HARNESS_SUMMARY_COLOR_FAIL'} || 'red';
74             }
75              
76             sub _success_color {
77 6     6   8 my ($self) = @_;
78              
79 6   50     43 return $ENV{'HARNESS_SUMMARY_COLOR_SUCCESS'} || 'green';
80             }
81              
82             sub _output_success {
83 6     6   22 my ( $self, $msg ) = @_;
84 6         22 $self->_set_colors( $self->_success_color() );
85 6         51 $self->_output($msg);
86 6         82 $self->_set_colors('reset');
87             }
88              
89             sub _failure_output {
90 23     23   22 my $self = shift;
91 23         35 $self->_set_colors( $self->_failure_color() );
92 23         116 my $out = join '', @_;
93 23         30 my $has_newline = chomp $out;
94 23         36 $self->_output($out);
95 23         242 $self->_set_colors('reset');
96 23 100       109 $self->_output($/)
97             if $has_newline;
98             }
99              
100             1;