diff options
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/TAP/Formatter/Console.pm')
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/TAP/Formatter/Console.pm | 91 |
1 files changed, 91 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/lib/TAP/Formatter/Console.pm b/Master/tlpkg/tlperl0/lib/TAP/Formatter/Console.pm new file mode 100755 index 00000000000..ff6587ef8ac --- /dev/null +++ b/Master/tlpkg/tlperl0/lib/TAP/Formatter/Console.pm @@ -0,0 +1,91 @@ +package TAP::Formatter::Console; + +use strict; +use TAP::Formatter::Base (); +use POSIX qw(strftime); + +use vars qw($VERSION @ISA); + +@ISA = qw(TAP::Formatter::Base); + +=head1 NAME + +TAP::Formatter::Console - Harness output delegate for default console output + +=head1 VERSION + +Version 3.20 + +=cut + +$VERSION = '3.20'; + +=head1 DESCRIPTION + +This provides console orientated output formatting for TAP::Harness. + +=head1 SYNOPSIS + + use TAP::Formatter::Console; + my $harness = TAP::Formatter::Console->new( \%args ); + +=head2 C<< open_test >> + +See L<TAP::Formatter::Base> + +=cut + +sub open_test { + my ( $self, $test, $parser ) = @_; + + my $class + = $self->jobs > 1 + ? 'TAP::Formatter::Console::ParallelSession' + : 'TAP::Formatter::Console::Session'; + + eval "require $class"; + $self->_croak($@) if $@; + + my $session = $class->new( + { name => $test, + formatter => $self, + parser => $parser, + show_count => $self->show_count, + } + ); + + $session->header; + + return $session; +} + +# Use _colorizer delegate to set output color. NOP if we have no delegate +sub _set_colors { + my ( $self, @colors ) = @_; + if ( my $colorizer = $self->_colorizer ) { + my $output_func = $self->{_output_func} ||= sub { + $self->_output(@_); + }; + $colorizer->set_color( $output_func, $_ ) for @colors; + } +} + +sub _output_success { + my ( $self, $msg ) = @_; + $self->_set_colors('green'); + $self->_output($msg); + $self->_set_colors('reset'); +} + +sub _failure_output { + my $self = shift; + $self->_set_colors('red'); + my $out = join '', @_; + my $has_newline = chomp $out; + $self->_output($out); + $self->_set_colors('reset'); + $self->_output($/) + if $has_newline; +} + +1; |