1b39c5158Smillertpackage TAP::Formatter::Console; 2b39c5158Smillert 3b39c5158Smillertuse strict; 46fb12b70Safresh1use warnings; 56fb12b70Safresh1use base 'TAP::Formatter::Base'; 6b39c5158Smillertuse POSIX qw(strftime); 7b39c5158Smillert 8b39c5158Smillert=head1 NAME 9b39c5158Smillert 10b39c5158SmillertTAP::Formatter::Console - Harness output delegate for default console output 11b39c5158Smillert 12b39c5158Smillert=head1 VERSION 13b39c5158Smillert 14*3d61058aSafresh1Version 3.48 15b39c5158Smillert 16b39c5158Smillert=cut 17b39c5158Smillert 18*3d61058aSafresh1our $VERSION = '3.48'; 19b39c5158Smillert 20b39c5158Smillert=head1 DESCRIPTION 21b39c5158Smillert 22b39c5158SmillertThis provides console orientated output formatting for TAP::Harness. 23b39c5158Smillert 24b39c5158Smillert=head1 SYNOPSIS 25b39c5158Smillert 26b39c5158Smillert use TAP::Formatter::Console; 27b39c5158Smillert my $harness = TAP::Formatter::Console->new( \%args ); 28b39c5158Smillert 29b39c5158Smillert=head2 C<< open_test >> 30b39c5158Smillert 31898184e3SsthenSee L<TAP::Formatter::Base> 32b39c5158Smillert 33b39c5158Smillert=cut 34b39c5158Smillert 35b39c5158Smillertsub open_test { 36b39c5158Smillert my ( $self, $test, $parser ) = @_; 37b39c5158Smillert 38b39c5158Smillert my $class 39b39c5158Smillert = $self->jobs > 1 40b39c5158Smillert ? 'TAP::Formatter::Console::ParallelSession' 41b39c5158Smillert : 'TAP::Formatter::Console::Session'; 42b39c5158Smillert 43b39c5158Smillert eval "require $class"; 44b39c5158Smillert $self->_croak($@) if $@; 45b39c5158Smillert 46b39c5158Smillert my $session = $class->new( 47b39c5158Smillert { name => $test, 48b39c5158Smillert formatter => $self, 49b39c5158Smillert parser => $parser, 50b39c5158Smillert show_count => $self->show_count, 51b39c5158Smillert } 52b39c5158Smillert ); 53b39c5158Smillert 54b39c5158Smillert $session->header; 55b39c5158Smillert 56b39c5158Smillert return $session; 57b39c5158Smillert} 58b39c5158Smillert 59b39c5158Smillert# Use _colorizer delegate to set output color. NOP if we have no delegate 60b39c5158Smillertsub _set_colors { 61b39c5158Smillert my ( $self, @colors ) = @_; 62b39c5158Smillert if ( my $colorizer = $self->_colorizer ) { 63b39c5158Smillert my $output_func = $self->{_output_func} ||= sub { 64b39c5158Smillert $self->_output(@_); 65b39c5158Smillert }; 66b39c5158Smillert $colorizer->set_color( $output_func, $_ ) for @colors; 67b39c5158Smillert } 68b39c5158Smillert} 69b39c5158Smillert 706fb12b70Safresh1sub _failure_color { 716fb12b70Safresh1 my ($self) = @_; 726fb12b70Safresh1 736fb12b70Safresh1 return $ENV{'HARNESS_SUMMARY_COLOR_FAIL'} || 'red'; 746fb12b70Safresh1} 756fb12b70Safresh1 766fb12b70Safresh1sub _success_color { 776fb12b70Safresh1 my ($self) = @_; 786fb12b70Safresh1 796fb12b70Safresh1 return $ENV{'HARNESS_SUMMARY_COLOR_SUCCESS'} || 'green'; 806fb12b70Safresh1} 816fb12b70Safresh1 82b39c5158Smillertsub _output_success { 83b39c5158Smillert my ( $self, $msg ) = @_; 846fb12b70Safresh1 $self->_set_colors( $self->_success_color() ); 85b39c5158Smillert $self->_output($msg); 86b39c5158Smillert $self->_set_colors('reset'); 87b39c5158Smillert} 88b39c5158Smillert 89b39c5158Smillertsub _failure_output { 90b39c5158Smillert my $self = shift; 916fb12b70Safresh1 $self->_set_colors( $self->_failure_color() ); 92b39c5158Smillert my $out = join '', @_; 93b39c5158Smillert my $has_newline = chomp $out; 94b39c5158Smillert $self->_output($out); 95b39c5158Smillert $self->_set_colors('reset'); 96b39c5158Smillert $self->_output($/) 97b39c5158Smillert if $has_newline; 98b39c5158Smillert} 99b39c5158Smillert 100b39c5158Smillert1; 101