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   17834 use strict;
  5         10  
  5         138  
4 5     5   20 use warnings;
  5         8  
  5         155  
5 5     5   20 use base 'TAP::Formatter::Base';
  5         10  
  5         1519  
6 5     5   28 use POSIX qw(strftime);
  5         6  
  5         27  
7              
8             =head1 NAME
9              
10             TAP::Formatter::Console - Harness output delegate for default console output
11              
12             =head1 VERSION
13              
14             Version 3.38
15              
16             =cut
17              
18             our $VERSION = '3.38';
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 35 my ( $self, $test, $parser ) = @_;
37              
38 14 50       51 my $class
39             = $self->jobs > 1
40             ? 'TAP::Formatter::Console::ParallelSession'
41             : 'TAP::Formatter::Console::Session';
42              
43 14         1003 eval "require $class";
44 14 50       50 $self->_croak($@) if $@;
45              
46 14         81 my $session = $class->new(
47             { name => $test,
48             formatter => $self,
49             parser => $parser,
50             show_count => $self->show_count,
51             }
52             );
53              
54 14         68 $session->header;
55              
56 14         255 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   94 my ( $self, @colors ) = @_;
62 79 100       114 if ( my $colorizer = $self->_colorizer ) {
63             my $output_func = $self->{_output_func} ||= sub {
64 45     45   154 $self->_output(@_);
65 45   100     74 };
66 45         95 $colorizer->set_color( $output_func, $_ ) for @colors;
67             }
68             }
69              
70             sub _failure_color {
71 23     23   20 my ($self) = @_;
72              
73 23   50     97 return $ENV{'HARNESS_SUMMARY_COLOR_FAIL'} || 'red';
74             }
75              
76             sub _success_color {
77 6     6   6 my ($self) = @_;
78              
79 6   50     31 return $ENV{'HARNESS_SUMMARY_COLOR_SUCCESS'} || 'green';
80             }
81              
82             sub _output_success {
83 6     6   13 my ( $self, $msg ) = @_;
84 6         15 $self->_set_colors( $self->_success_color() );
85 6         46 $self->_output($msg);
86 6         88 $self->_set_colors('reset');
87             }
88              
89             sub _failure_output {
90 23     23   22 my $self = shift;
91 23         30 $self->_set_colors( $self->_failure_color() );
92 23         113 my $out = join '', @_;
93 23         23 my $has_newline = chomp $out;
94 23         33 $self->_output($out);
95 23         243 $self->_set_colors('reset');
96 23 100       103 $self->_output($/)
97             if $has_newline;
98             }
99              
100             1;