Commit | Line | Data |
b965d173 |
1 | package TAP::Formatter::Console; |
2 | |
3 | use strict; |
bdaf8c65 |
4 | use TAP::Formatter::Base (); |
b965d173 |
5 | use POSIX qw(strftime); |
6 | |
7 | use vars qw($VERSION @ISA); |
8 | |
bdaf8c65 |
9 | @ISA = qw(TAP::Formatter::Base); |
b965d173 |
10 | |
11 | =head1 NAME |
12 | |
13 | TAP::Formatter::Console - Harness output delegate for default console output |
14 | |
15 | =head1 VERSION |
16 | |
a39e16d8 |
17 | Version 3.17 |
b965d173 |
18 | |
19 | =cut |
20 | |
a39e16d8 |
21 | $VERSION = '3.17'; |
b965d173 |
22 | |
23 | =head1 DESCRIPTION |
24 | |
25 | This 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 | |
bdaf8c65 |
32 | =head2 C<< open_test >> |
b965d173 |
33 | |
bdaf8c65 |
34 | See L<TAP::Formatter::base> |
b965d173 |
35 | |
36 | =cut |
37 | |
38 | sub 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( |
27fc0087 |
50 | { name => $test, |
51 | formatter => $self, |
52 | parser => $parser, |
53 | show_count => $self->show_count, |
b965d173 |
54 | } |
55 | ); |
56 | |
57 | $session->header; |
58 | |
59 | return $session; |
60 | } |
61 | |
b965d173 |
62 | # Use _colorizer delegate to set output color. NOP if we have no delegate |
63 | sub _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 | |
a39e16d8 |
73 | sub _output_success { |
74 | my ( $self, $msg ) = @_; |
75 | $self->_set_colors('green'); |
76 | $self->_output($msg); |
77 | $self->_set_colors('reset'); |
78 | } |
79 | |
b965d173 |
80 | sub _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 | |
b965d173 |
91 | 1; |