use strict;
our $VERSION = '1.000036';
use Test2::Util::Term qw/term_size/;
use Test2::Harness::Util qw/hub_truth apply_encoding/;
use Test2::Harness::Util::Term qw/USE_ANSI_COLOR/;
use Test2::Util qw/IS_WIN32 clone_io/;
use Time::HiRes qw/time/;
use File::Spec();
sub import {
my $class = shift;
return if $ENV{HARNESS_ACTIVE};
$class->SUPER::import;
}
-composer
-last_depth
-_buffered
<job_io
+io
<enc_io
-_encoding
-show_buffer
-color
-progress
-tty
-no_wrap
-verbose
-job_length
-ecount
-job_colors
-active_files
-_active_disp
-_file_stats
-job_names
};
sub TAG_WIDTH() { 8 }
sub hide_buffered() { 0 }
sub DEFAULT_TAG_COLOR() {
return (
'DEBUG' => Term::ANSIColor::color('red'),
'DIAG' => Term::ANSIColor::color('yellow'),
'ERROR' => Term::ANSIColor::color('red'),
'FATAL' => Term::ANSIColor::color('bold red'),
'FAIL' => Term::ANSIColor::color('red'),
'HALT' => Term::ANSIColor::color('bold red'),
'PASS' => Term::ANSIColor::color('green'),
'! PASS !' => Term::ANSIColor::color('cyan'),
'TODO' => Term::ANSIColor::color('cyan'),
'NO PLAN' => Term::ANSIColor::color('yellow'),
'SKIP' => Term::ANSIColor::color('bold cyan'),
'SKIP ALL' => Term::ANSIColor::color('bold white on_blue'),
'STDERR' => Term::ANSIColor::color('yellow'),
'RUN INFO' => Term::ANSIColor::color('bold bright_blue'),
'JOB INFO' => Term::ANSIColor::color('bold bright_blue'),
'LAUNCH' => Term::ANSIColor::color('bold bright_white'),
'RETRY' => Term::ANSIColor::color('bold bright_white'),
'PASSED' => Term::ANSIColor::color('bold bright_green'),
'TO RETRY' => Term::ANSIColor::color('bold bright_yellow'),
'FAILED' => Term::ANSIColor::color('bold bright_red'),
'REASON' => Term::ANSIColor::color('magenta'),
'TIMEOUT' => Term::ANSIColor::color('magenta'),
'TIME' => Term::ANSIColor::color('blue'),
'MEMORY' => Term::ANSIColor::color('blue'),
);
}
sub DEFAULT_FACET_COLOR() {
return (
time => Term::ANSIColor::color('blue'),
memory => Term::ANSIColor::color('blue'),
about => Term::ANSIColor::color('magenta'),
amnesty => Term::ANSIColor::color('cyan'),
assert => Term::ANSIColor::color('bold bright_white'),
control => Term::ANSIColor::color('bold red'),
error => Term::ANSIColor::color('yellow'),
info => Term::ANSIColor::color('yellow'),
meta => Term::ANSIColor::color('magenta'),
parent => Term::ANSIColor::color('magenta'),
trace => Term::ANSIColor::color('bold red'),
);
}
# These colors all look decent enough to use, ordered to avoid putting similar ones together
use constant DEFAULT_JOB_COLOR_NAMES => (
'bold green on_blue',
'bold blue on_white',
'bold black on_cyan',
'bold green on_bright_black',
'bold dark blue on_white',
'bold black on_green',
'bold cyan on_blue',
'bold black on_white',
'bold white on_cyan',
'bold cyan on_bright_black',
'bold white on_green',
'bold bright_black on_white',
'bold white on_blue',
'bold bright_cyan on_green',
'bold blue on_cyan',
'bold white on_bright_black',
'bold bright_black on_green',
'bold bright_green on_blue',
'bold bright_blue on_white',
'bold bright_white on_bright_black',
'bold yellow on_blue',
'bold bright_black on_cyan',
'bold bright_green on_bright_black',
'bold blue on_green',
'bold bright_cyan on_blue',
'bold bright_blue on_cyan',
'bold dark bright_white on_bright_black',
'bold bright_blue on_green',
'bold dark bright_blue on_white',
'bold bright_white on_blue',
'bold bright_cyan on_bright_black',
'bold bright_white on_cyan',
'bold bright_white on_green',
'bold bright_yellow on_blue',
#'bold magenta on_white',
#'bold dark magenta on_white',
#'bold dark cyan on_white',
'bold dark bright_cyan on_bright_black',
#'bold dark bright_green on_black',
#'bold dark bright_yellow on_black',
);
sub DEFAULT_JOB_COLOR() {
return map { Term::ANSIColor::color($_) } DEFAULT_JOB_COLOR_NAMES;
}
sub DEFAULT_COLOR() {
return (
reset => Term::ANSIColor::color('reset'),
blob => Term::ANSIColor::color('bold bright_black on_white'),
tree => Term::ANSIColor::color('bold bright_white'),
tag_border => Term::ANSIColor::color('bold bright_white'),
);
}
my %FACET_TAG_BORDERS = (
'default' => ['[', ']'],
'amnesty' => ['{', '}'],
'info' => ['(', ')'],
'error' => ['<', '>'],
'parent' => [' ', ' '],
);
sub init {
my $self = shift;
$self->{+COMPOSER} ||= Test2::Formatter::Test2::Composer->new;
$self->{+_ACTIVE_DISP} = ['', ''];
$self->{+_FILE_STATS} = {
passed => 0,
failed => 0,
running => 0,
todo => 0,
total => 0,
};
$self->{+VERBOSE} = 1 unless defined $self->{+VERBOSE};
$self->{+JOB_LENGTH} ||= 2;
my $io = $self->{+IO} = clone_io($self->{+IO} || \*STDOUT) or die "Cannot get a filehandle: $!";
$io->autoflush(1);
$self->{+TTY} = -t $io unless defined $self->{+TTY};
my $use_color = ref($self->{+COLOR}) ? 1 : delete($self->{+COLOR});
$use_color = $self->{+TTY} unless defined $use_color;
if ($self->{+TTY} && USE_ANSI_COLOR) {
$self->{+SHOW_BUFFER} = 1 unless defined $self->{+SHOW_BUFFER};
if ($use_color) {
$self->{+COLOR} = {
DEFAULT_COLOR(),
TAGS => {DEFAULT_TAG_COLOR()},
FACETS => {DEFAULT_FACET_COLOR()},
JOBS => [DEFAULT_JOB_COLOR()],
} unless defined $self->{+COLOR};
$self->{+JOB_COLORS} = {free => [@{$self->{+COLOR}->{JOBS}}]};
}
}
else {
$self->{+SHOW_BUFFER} = 0 unless defined $self->{+SHOW_BUFFER};
}
}
sub io {
my $self = shift;
my ($job_id) = @_;
return $self->{+IO} unless defined $job_id;
return $self->{+JOB_IO}->{$job_id} // $self->{+IO};
}
sub encoding {
my $self = shift;
if (@_) {
my ($enc, $job_id) = @_;
if (defined $job_id) {
my $io;
unless ($io = $self->{+ENC_IO}->{$enc}) {
$io = $self->{+ENC_IO}->{$enc} = clone_io($self->{+IO} || \*STDOUT) or die "Cannot get a filehandle: $!";
$io->autoflush(1);
apply_encoding($io, $enc);
}
$self->{+JOB_IO}->{$job_id} = $io;
}
else {
apply_encoding($self->{+IO}, $enc);
}
$self->{+_ENCODING} = $enc;
}
return $self->{+_ENCODING};
}
if ($^C) {
no warnings 'redefine';
*write = sub {};
}
sub write {
my ($self, $e, $num, $f) = @_;
$f ||= $e->facet_data;
my $should_show = $self->update_active_disp($f);
$self->{+ECOUNT}++;
my $job_id = $f->{harness}->{job_id};
$self->encoding($f->{control}->{encoding}, $job_id) if $f->{control}->{encoding};
my $hf = hub_truth($f);
my $depth = $hf->{nested} || 0;
return if $depth && (!$self->{+SHOW_BUFFER} || !$self->{+PROGRESS});
my $lines;
if (!$self->{+VERBOSE}) {
if ($depth) {
$lines = [];
}
else {
$lines = $self->render_quiet($f);
}
}
elsif ($depth) {
my $tree = $self->render_tree($f, '>');
$lines = $self->render_buffered_event($f, $tree);
}
else {
my $tree = $self->render_tree($f,);
$lines = $self->render_event($f, $tree);
}
$should_show ||= $lines && @$lines;
unless ($should_show || $self->{+VERBOSE}) {
if (my $last = $self->{last_rendered}) {
$self->{last_rendered} = time;
return if time - $last < 0.2;
}
else {
$self->{last_rendered} = time;
}
}
push @{$self->{+JOB_COLORS}->{free}} => delete $self->{+JOB_COLORS}->{used}->{$job_id}
if $job_id && $f->{harness_job_end};
# Local is expensive! Only do it if we really need to.
local($\, $,) = (undef, '') if $\ || $,;
my $io = $self->io($job_id);
if ($self->{+_BUFFERED}) {
print $io "\r\e[K";
$self->{+_BUFFERED} = 0;
}
if (!$self->{+VERBOSE}) {
print $io $_, "\n" for @$lines;
if ($self->{+TTY} && $self->{+PROGRESS}) {
print $io $self->render_status($f);
$self->{+_BUFFERED} = 1;
}
}
elsif ($depth && $lines && @$lines) {
print $io $lines->[0];
$self->{+_BUFFERED} = 1;
}
else {
print $io $_, "\n" for @$lines;
}
delete $self->{+JOB_IO}->{$job_id} if $job_id && $f->{harness_job_end};
}
sub finalize {
my $self = shift;
my $io = $self->{+IO};
print $io "\r\e[K" if $self->{+_BUFFERED};
return;
}
sub update_active_disp {
my $self = shift;
my ($f) = @_;
my $should_show = 0;
my $stats = $self->{+_FILE_STATS};
if (my $task = $f->{harness_job_queued}) {
$self->{+JOB_NAMES}->{$task->{job_id}} = $task->{job_name} || $task->{job_id};
$stats->{total}++;
$stats->{todo}++;
}
if ($f->{harness_job_launch}) {
my $job = $f->{harness_job};
$self->{+ACTIVE_FILES}->{File::Spec->abs2rel($job->{file})} = $job->{job_name} || $job->{job_id};
$should_show = 1;
$stats->{running}++;
$stats->{todo}--;
}
if ($f->{harness_job_end}) {
my $file = $f->{harness_job_end}->{file};
delete $self->{+ACTIVE_FILES}->{File::Spec->abs2rel($file)};
$should_show = 1;
$stats->{running}--;
if ($f->{harness_job_end}->{fail}) {
$stats->{failed}++;
}
else {
$stats->{passed}++;
}
}
return 0 unless $should_show;
my $statline = join '|' => (
$self->_highlight($stats->{passed}, 'P', 'green'),
$self->_highlight($stats->{failed}, 'F', 'red'),
$self->_highlight($stats->{running}, 'R', 'cyan'),
$self->_highlight($stats->{todo}, 'T', 'yellow'),
);
$statline = "[$statline]";
my $active = $self->{+ACTIVE_FILES};
return $self->{+_ACTIVE_DISP} = [$statline, ''] unless $active && keys %$active;
my $reset = $self->reset;
my $str .= "(";
{
no warnings 'numeric';
$str .= join(' ' => map { m{([^/]+)$}; "$active->{$_}:$1" } sort { ($active->{$a} || 0) <=> ($active->{$b} || 0) or $a cmp $b } keys %$active);
}
$str .= ")";
$self->{+_ACTIVE_DISP} = [$statline, $str];
return 1;
}
sub _highlight {
my $self = shift;
my ($val, $label, $color) = @_;
return "${label}:${val}" unless $val && $self->{+COLOR};
return sprintf('%s%s:%d%s', Term::ANSIColor::color($color), $label, $val, $self->reset);
}
sub colorstrip {
my $self = shift;
my ($str) = @_;
return $str unless USE_ANSI_COLOR;
return Term::ANSIColor::colorstrip($str);
}
sub render_status {
my $self = shift;
my $reset = $self->reset;
my $cyan = $self->{+COLOR} ? Term::ANSIColor::color('cyan') : '';
my $str = "$self->{+_ACTIVE_DISP}->[0] Events: $self->{+ECOUNT} ${cyan}$self->{+_ACTIVE_DISP}->[1]${reset}";
my $max = term_size() || 80;
if (length($str) > $max) {
my $nocolor = $self->colorstrip($str);
$str = substr($nocolor, 0, $max - 8) . " ...)$reset" if length($nocolor) > $max;
$str =~ s/\(/$cyan(/;
$str =~ s/^\[[^\]]+\]/$self->{+_ACTIVE_DISP}->[0]/;
}
return $str;
}
sub render_buffered_event {
my $self = shift;
my ($f, $tree) = @_;
my $comp = $self->{+COMPOSER}->render_one_line($f) or return;
return unless @$comp;
return [$self->build_line($tree, @$comp)];
}
sub render_event {
my $self = shift;
my ($f, $tree) = @_;
my $comps = $self->{+COMPOSER}->render_verbose($f);
my (@parent, @times);
if ($f->{parent}) {
@parent = $self->render_parent($f, $tree);
if (@$comps && $comps->[-1]->[0] eq 'times') {
my $times = pop(@$comps);
@times = $self->build_line($tree, @$times);
}
}
my @out;
for my $comp (@$comps) {
my $ctree = $tree;
push @out => $self->build_line($ctree, @$comp);
}
push @out => (@parent, @times);
return \@out;
}
sub render_quiet {
my $self = shift;
my ($f, $tree) = @_;
my @out;
my $comps = $self->{+COMPOSER}->render_brief($f);
for my $comp (@$comps) {
my $ctree = $tree ||= $self->render_tree($f);
push @out => $self->build_line($ctree, @$comp);
}
if ($f->{parent} && !$f->{amnesty}) {
push @out => $self->render_parent($f, $tree ||= $self->render_tree($f), quiet => 1);
}
return \@out;
}
sub reset {
my $self = shift;
return $self->{+COLOR} ? $self->{+COLOR}->{reset} : '';
}
sub job_color {
my $self = shift;
my ($id, $set) = @_;
return '' unless $self->{+JOB_COLORS};
return $self->{+JOB_COLORS}->{used}->{$id} || '' unless $set;
return $self->{+JOB_COLORS}->{used}->{$id} ||= shift @{$self->{+JOB_COLORS}->{free}} || '';
}
sub render_tree {
my $self = shift;
my ($f, $char) = @_;
$char ||= '|';
my $hf = hub_truth($f);
my $depth = $hf->{nested} || 0;
my @pipes = (' ', map $char, 1 .. $depth);
return join(' ', @pipes) . ' ';
}
sub build_line {
my $self = shift;
my ($tree, $facet, $tag, $text) = @_;
#filter output for 'end users'
unless ($self->{+VERBOSE}) {
return if $tag eq 'REASON';
return if $tag eq 'DIAG';
return if $tag eq 'STDERR';
}
return if $tag eq 'LAUNCH';
return if $tag eq 'PLAN';
$tree ||= '';
$tag ||= '';
$text ||= '';
chomp($text);
substr($tree, -2, 1, '-') if ($facet =~ m/^(assert|info)$/);
$tag = substr($tag, 0 - TAG_WIDTH, TAG_WIDTH) if length($tag) > TAG_WIDTH;
my $max = $self->{+TTY} && !$self->{+NO_WRAP} ? (term_size() || 80) : undef;
my $color = $self->{+COLOR};
my $reset = $self->reset;
my $tcolor = $color ? $color->{TAGS}->{$tag} || $color->{FACETS}->{$facet} || '' : '';
my ($ps, $pe) = @{$FACET_TAG_BORDERS{$facet} || $FACET_TAG_BORDERS{default}};
$tag = uc($tag);
my $length = length($tag);
if ($length > TAG_WIDTH) {
$tag = substr($tag, 0, TAG_WIDTH);
}
elsif($length < TAG_WIDTH) {
my $pad = (TAG_WIDTH - $length) / 2;
my $padl = $pad + (TAG_WIDTH - $length) % 2;
$tag = (' ' x $padl) . $tag . (' ' x $pad);
}
my $start = '';
if ($tree) {
if ($color) {
my $trcolor = $color->{tree} || '';
$start .= $trcolor . $tree . $reset;
}
else {
$start .= $tree;
}
}
my @lines = split /[\r\n]/, $text;
@lines = ($text) unless @lines;
my @out;
for my $line (@lines) {
if(@lines > 1 && $max && length("$ps$tag$pe $tree$line") > $max) {
@out = ();
last;
}
if ($color) {
push @out => "${start}${tcolor}${line}$reset";
}
else {
push @out => "${start}${line}";
}
}
return @out if @out;
return (
"$start----- START -----",
$text,
"$start------ END ------",
) unless $color;
my $blob = $color->{blob} || '';
return (
"$start${blob}----- START -----$reset",
"${tcolor}${text}${reset}",
"$start${blob}------ END ------$reset",
);
}
sub render_parent {
my $self = shift;
my ($f, $tree, %params) = @_;
my $meth = $params{quiet} ? 'render_quiet' : 'render_event';
my @out;
for my $sf (@{$f->{parent}->{children}}) {
$sf->{harness} ||= $f->{harness};
my $tree = $self->render_tree($sf);
push @out => @{$self->$meth($sf, $tree)};
}
return unless @out;
push @out => (
$self->build_line("$tree", 'parent', '', ''),
);
return @out;
}
sub DESTROY {
my $self = shift;
my $io = $self->{+IO} or return;
# Local is expensive! Only do it if we really need to.
local($\, $,) = (undef, '') if $\ || $,;
print $io Term::ANSIColor::color('reset')
if USE_ANSI_COLOR;
print $io "\n";
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Test2::Formatter::WWWWTF - Formatter for WWW::WTF output.
=head1 DESCRIPTION
Based on Test2::Formatter::Test2 with slight changes.
=head1 COPYRIGHT
Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>.
Copyright Atikon EDV & Marketing GmbH 2020
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut