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   77775 use strict;
  5         16  
  5         162  
4 5     5   58 use warnings;
  5         15  
  5         189  
5 5     5   31 use base 'TAP::Formatter::Base';
  5         11  
  5         1506  
6 5     5   53 use POSIX qw(strftime);
  5         16  
  5         37  
7              
8             =head1 NAME
9              
10             TAP::Formatter::Console - Harness output delegate for default console output
11              
12             =head1 VERSION
13              
14             Version 3.40_01
15              
16             =cut
17              
18             our $VERSION = '3.40_01';
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 127 my ( $self, $test, $parser ) = @_;
37              
38 14 50       142 my $class
39             = $self->jobs > 1
40             ? 'TAP::Formatter::Console::ParallelSession'
41             : 'TAP::Formatter::Console::Session';
42              
43 14         2494 eval "require $class";
44 14 50       111 $self->_croak($@) if $@;
45              
46 14         143 my $session = $class->new(
47             { name => $test,
48             formatter => $self,
49             parser => $parser,
50             show_count => $self->show_count,
51             }
52             );
53              
54 14         202 $session->header;
55              
56 14         558 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   430 my ( $self, @colors ) = @_;
62 79 100       364 if ( my $colorizer = $self->_colorizer ) {
63             my $output_func = $self->{_output_func} ||= sub {
64 45     45   557 $self->_output(@_);
65 45   100     236 };
66 45         207 $colorizer->set_color( $output_func, $_ ) for @colors;
67             }
68             }
69              
70             sub _failure_color {
71 23     23   64 my ($self) = @_;
72              
73 23   50     231 return $ENV{'HARNESS_SUMMARY_COLOR_FAIL'} || 'red';
74             }
75              
76             sub _success_color {
77 6     6   17 my ($self) = @_;
78              
79 6   50     73 return $ENV{'HARNESS_SUMMARY_COLOR_SUCCESS'} || 'green';
80             }
81              
82             sub _output_success {
83 6     6   36 my ( $self, $msg ) = @_;
84 6         35 $self->_set_colors( $self->_success_color() );
85 6         271 $self->_output($msg);
86 6         182 $self->_set_colors('reset');
87             }
88              
89             sub _failure_output {
90 23     23   62 my $self = shift;
91 23         82 $self->_set_colors( $self->_failure_color() );
92 23         616 my $out = join '', @_;
93 23         70 my $has_newline = chomp $out;
94 23         99 $self->_output($out);
95 23         933 $self->_set_colors('reset');
96 23 100       448 $self->_output($/)
97             if $has_newline;
98             }
99              
100             1;