Current Path : /usr/local/lib/perl5/site_perl/5.8.9/TAP/Formatter/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
Current File : //usr/local/lib/perl5/site_perl/5.8.9/TAP/Formatter/Console.pm |
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.16 =cut $VERSION = '3.16'; =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 _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;