1package Test2::Formatter::QVF; 2use strict; 3use warnings; 4 5our $VERSION = '1.000082'; 6 7BEGIN { require Test2::Formatter::Test2; our @ISA = qw(Test2::Formatter::Test2) } 8 9use Test2::Util::HashBase qw{ 10 -job_buffers 11 -real_verbose 12}; 13 14sub init { 15 my $self = shift; 16 $self->SUPER::init(); 17 18 $self->{+REAL_VERBOSE} = $self->{+VERBOSE}; 19 20 $self->{+VERBOSE} ||= 100; 21} 22 23sub update_active_disp { 24 my $self = shift; 25 my ($f) = @_; 26 27 return if $f->{__RENDER__}->{update_active_disp}++; 28 29 $self->SUPER::update_active_disp($f); 30} 31 32sub write { 33 my ($self, $e, $num, $f) = @_; 34 35 return $self->SUPER::write($e, $num, $f) if $self->{+REAL_VERBOSE}; 36 37 $f ||= $e->facet_data; 38 39 my $job_id = $f->{harness}->{job_id}; 40 41 push @{$self->{+JOB_BUFFERS}->{$job_id}} => [$e, $num, $f] 42 if $job_id; 43 44 my $show = $self->update_active_disp($f); 45 46 if ($f->{harness_job_end} || !$job_id) { 47 $show = 1; 48 49 my $buffer = delete $self->{+JOB_BUFFERS}->{$job_id}; 50 51 if($f->{harness_job_end}->{fail}) { 52 $self->SUPER::write(@{$_}) for @$buffer; 53 } 54 else { 55 $f->{info} = [grep { $_->{tag} ne 'TIME' } @{$f->{info}}] if $f->{info}; 56 $self->SUPER::write($e, $num, $f) 57 } 58 } 59 60 $self->{+ECOUNT}++; 61 62 return unless $self->{+TTY}; 63 return unless $self->{+PROGRESS}; 64 65 $show ||= 1 unless $self->{+ECOUNT} % 10; 66 67 if ($show) { 68 # Local is expensive! Only do it if we really need to. 69 local($\, $,) = (undef, '') if $\ || $,; 70 71 my $io = $self->{+IO}; 72 if ($self->{+_BUFFERED}) { 73 print $io "\r\e[K"; 74 $self->{+_BUFFERED} = 0; 75 } 76 77 print $io $self->render_status($f); 78 $self->{+_BUFFERED} = 1; 79 } 80 81 return; 82} 83 841; 85 86__END__ 87 88=pod 89 90=encoding UTF-8 91 92=head1 NAME 93 94Test2::Formatter::QVF - Test2 formatter that is [Q]uiet but [V]erbose on 95[F]ailure. 96 97=head1 DESCRIPTION 98 99This formatter is a subclass of L<Test2::Formatter::Test2>. This one will 100buffer all output from a test file and only show it to you if there is a 101failure. Most of the time it willonly show you the completion notifications for 102each test. 103 104=head1 SYNOPSIS 105 106 $ yath test --qvf ... 107 108=head1 SOURCE 109 110The source code repository for Test2-Harness can be found at 111F<http://github.com/Test-More/Test2-Harness/>. 112 113=head1 MAINTAINERS 114 115=over 4 116 117=item Chad Granum E<lt>exodist@cpan.orgE<gt> 118 119=back 120 121=head1 AUTHORS 122 123=over 4 124 125=item Chad Granum E<lt>exodist@cpan.orgE<gt> 126 127=back 128 129=head1 COPYRIGHT 130 131Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>. 132 133This program is free software; you can redistribute it and/or 134modify it under the same terms as Perl itself. 135 136See F<http://dev.perl.org/licenses/> 137 138=cut 139 140