<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package TAP::Formatter::Console::Session;

use strict;
use warnings;

use base 'TAP::Formatter::Session';

my @ACCESSOR;

BEGIN {
    my @CLOSURE_BINDING = qw( header result clear_for_close close_test );

    for my $method (@CLOSURE_BINDING) {
        no strict 'refs';
        *$method = sub {
            my $self = shift;
            return ( $self-&gt;{_closures} ||= $self-&gt;_closures )-&gt;{$method}
              -&gt;(@_);
        };
    }
}

=head1 NAME

TAP::Formatter::Console::Session - Harness output delegate for default console output

=head1 VERSION

Version 3.43

=cut

our $VERSION = '3.43';

=head1 DESCRIPTION

This provides console orientated output formatting for TAP::Harness.

=cut

sub _get_output_result {
    my $self = shift;

    my @color_map = (
        {   test =&gt; sub { $_-&gt;is_test &amp;&amp; !$_-&gt;is_ok },
            colors =&gt; ['red'],
        },
        {   test =&gt; sub { $_-&gt;is_test &amp;&amp; $_-&gt;has_skip },
            colors =&gt; [
                'white',
                'on_blue'
            ],
        },
        {   test =&gt; sub { $_-&gt;is_test &amp;&amp; $_-&gt;has_todo },
            colors =&gt; ['yellow'],
        },
    );

    my $formatter = $self-&gt;formatter;
    my $parser    = $self-&gt;parser;

    return $formatter-&gt;_colorizer
      ? sub {
        my $result = shift;
        for my $col (@color_map) {
            local $_ = $result;
            if ( $col-&gt;{test}-&gt;() ) {
                $formatter-&gt;_set_colors( @{ $col-&gt;{colors} } );
                last;
            }
        }
        $formatter-&gt;_output( $self-&gt;_format_for_output($result) );
        $formatter-&gt;_set_colors('reset');
      }
      : sub {
        $formatter-&gt;_output( $self-&gt;_format_for_output(shift) );
      };
}

sub _closures {
    my $self = shift;

    my $parser     = $self-&gt;parser;
    my $formatter  = $self-&gt;formatter;
    my $pretty     = $formatter-&gt;_format_name( $self-&gt;name );
    my $show_count = $self-&gt;show_count;

    my $really_quiet = $formatter-&gt;really_quiet;
    my $quiet        = $formatter-&gt;quiet;
    my $verbose      = $formatter-&gt;verbose;
    my $directives   = $formatter-&gt;directives;
    my $failures     = $formatter-&gt;failures;
    my $comments     = $formatter-&gt;comments;

    my $output_result = $self-&gt;_get_output_result;

    my $output          = '_output';
    my $plan            = '';
    my $newline_printed = 0;

    my $last_status_printed = 0;

    return {
        header =&gt; sub {
            $formatter-&gt;_output($pretty)
              unless $really_quiet;
        },

        result =&gt; sub {
            my $result = shift;

            if ( $result-&gt;is_bailout ) {
                $formatter-&gt;_failure_output(
                        "Bailout called.  Further testing stopped:  "
                      . $result-&gt;explanation
                      . "\n" );
            }

            return if $really_quiet;

            my $is_test = $result-&gt;is_test;

            # These are used in close_test - but only if $really_quiet
            # is false - so it's safe to only set them here unless that
            # relationship changes.

            if ( !$plan ) {
                my $planned = $parser-&gt;tests_planned || '?';
                $plan = "/$planned ";
            }
            $output = $formatter-&gt;_get_output_method($parser);

            if ( $show_count and $is_test ) {
                my $number = $result-&gt;number;
                my $now    = CORE::time;

                # Print status roughly once per second.
                # We will always get the first number as a side effect of
                # $last_status_printed starting with the value 0, which $now
                # will never be. (Unless someone sets their clock to 1970)
                if ( $last_status_printed != $now ) {
                    $formatter-&gt;$output("\r$pretty$number$plan");
                    $last_status_printed = $now;
                }
            }

            if (!$quiet
                &amp;&amp; (   $verbose
                    || ( $is_test &amp;&amp; $failures &amp;&amp; !$result-&gt;is_ok )
                    || ( $comments   &amp;&amp; $result-&gt;is_comment )
                    || ( $directives &amp;&amp; $result-&gt;has_directive ) )
              )
            {
                unless ($newline_printed) {
                    $formatter-&gt;_output("\n");
                    $newline_printed = 1;
                }
                $output_result-&gt;($result);
                $formatter-&gt;_output("\n");
            }
        },

        clear_for_close =&gt; sub {
            my $spaces
              = ' ' x length( '.' . $pretty . $plan . $parser-&gt;tests_run );
            $formatter-&gt;$output("\r$spaces");
        },

        close_test =&gt; sub {
            if ( $show_count &amp;&amp; !$really_quiet ) {
                $self-&gt;clear_for_close;
                $formatter-&gt;$output("\r$pretty");
            }

            # Avoid circular references
            $self-&gt;parser(undef);
            $self-&gt;{_closures} = {};

            return if $really_quiet;

            if ( my $skip_all = $parser-&gt;skip_all ) {
                $formatter-&gt;_output("skipped: $skip_all\n");
            }
            elsif ( $parser-&gt;has_problems ) {
                $self-&gt;_output_test_failure($parser);
            }
            else {
                my $time_report = $self-&gt;time_report($formatter, $parser);
                $formatter-&gt;_output( $self-&gt;_make_ok_line($time_report) );
            }
        },
    };
}

=head2 C&lt;&lt; 	clear_for_close &gt;&gt;

=head2 C&lt;&lt; 	close_test &gt;&gt;

=head2 C&lt;&lt; 	header &gt;&gt;

=head2 C&lt;&lt; 	result &gt;&gt;

=cut

1;
</pre></body></html>