package Test2::Harness::Auditor::Watcher;
use strict;
use warnings;

our $VERSION = '1.000161';

use Carp qw/croak confess/;
use Scalar::Util qw/blessed/;
use List::Util qw/first max/;

use Test2::Harness::Util::UUID qw/gen_uuid/;

use Test2::Harness::Util qw/hub_truth parse_exit/;

use Test2::Harness::Auditor::TimeTracker;

use Test2::Harness::Util::HashBase qw{
    -job
    -try

    -assertion_count
    -exit
    -plan
    -_errors
    -_failures
    -_sub_failures
    -_plans
    -_info
    -_sub_info
    -_subtest_id
    -nested
    -subtests
    -numbers
    -times
    -halt
    -failed_subtest_tree
};

sub init {
    my $self = shift;

    croak "'job' is a required attribute"
        unless $self->{+JOB};

    croak "'try' is a required attribute"
        unless defined $self->{+TRY};

    $self->{+_FAILURES}       = 0;
    $self->{+_ERRORS}         = 0;
    $self->{+ASSERTION_COUNT} = 0;

    $self->{+NUMBERS} = {};
    $self->{+TIMES} = Test2::Harness::Auditor::TimeTracker->new();

    $self->{+NESTED} = 0 unless defined $self->{+NESTED};
}

sub pass { !$_[0]->fail }
sub file { $_[0]->{+JOB}->{file} }
sub fail { !!$_[0]->fail_error_facet_list }

sub has_exit { defined $_[0]->{+EXIT} }
sub has_plan { defined $_[0]->{+PLAN} }

sub process {
    my $self = shift;
    my ($event) = @_;

    my $f  = $event->{facet_data};
    my $hf = hub_truth($f);

    my $nested = $hf->{nested} || 0;

    $self->times->process($event, $f, $self->{+ASSERTION_COUNT}) unless $nested;

    return if $hf->{buffered};

    my $is_ours = $nested == $self->{+NESTED};

    return unless $is_ours || $f->{from_tap};

    # Add parent if we start a buffered subtest
    if ($f->{harness} && $f->{harness}->{subtest_start}) {
        my $st = $self->{+SUBTESTS}->{$nested + 1} ||= {};
        $st->{event} = $event;
        $f->{harness_watcher}->{no_render} = 1;
        return;
    }

    my @out;

    # Not actually a subtest end, someone printed to STDOUT
    if ($f->{from_tap} && $f->{harness}->{subtest_end} && !($self->{+SUBTESTS} && keys %{$self->{+SUBTESTS}})) {
        # Alter $f so that this incorrect event is not sent to the renderer.
        $f->{harness_watcher}->{no_render} = 1;

        # Make a new $f and $event for the rest of the processing.
        $f = {
            %{$f},
            harness_watcher => {added_by_watcher => 1},
            parent          => undef,
            trace           => undef,
            harness         => {
                %{$f->{harness} || {}},
                subtest_end => undef,
            },
            info => [
                @{$f->{info} || []},
                {
                    details      => $f->{from_tap}->{details},
                    tag          => $f->{from_tap}->{source} || 'STDOUT',
                    from_harness => 1,
                }
            ],
        };

        $event = Test2::Harness::Event->new(stamp => time, job_try => $self->{+TRY}, facet_data => $f);
    }

    push @out => $event;

    # Close any deeper subtests
    if (my $sts = $self->{+SUBTESTS}) {
        my @close = sort { $b <=> $a } grep { $_ > $nested } keys %$sts;

        for my $n (@close) {
            my $st = delete $sts->{$n};
            my $se = $st->{event} || $event;

            my $fd = $se->{facet_data};
            delete $fd->{harness_watcher}->{no_render};
            $fd->{parent}->{hid} ||= $n;
            $fd->{parent}->{children} ||= $st->{children};
            $fd->{harness}->{closed_by}     = $event;
            $fd->{harness}->{closed_by_eid} = $event->{event_id};

            my $pn = $n - 1;

            if ($st->{event}) {
                if ($pn > $self->{+NESTED}) {
                    push @{$sts->{$pn}->{children}} => $fd;
                }
                elsif ($pn == $self->{+NESTED}) {
                    $self->subtest_process($fd, $se);
                    push @out => $se;
                }
            }
            else {
                push @out => $se if $self->{+NESTED} && $pn == $self->{+NESTED};
            }
        }
    }

    unless ($is_ours) {
        my $st = $self->{+SUBTESTS}->{$nested} ||= {};
        my $fd = {%$f};
        push @{$st->{children}} => $fd;
        return @out;
    }

    $self->subtest_process($f, $event);
    return @out;
}

sub subtest_process {
    my $self = shift;
    my ($f, $event) = @_;

    my $closer = delete $f->{harness}->{closed_by};
    $event ||= Test2::Harness::Event->new(facet_data => $f, job_try => $self->{+TRY});

    $self->{+NUMBERS}->{$f->{assert}->{number}}++
        if $f->{assert} && $f->{assert}->{number};

    if ($f->{parent} && $f->{assert}) {
        my $name = $f->{assert}->{details} // "unnamed subtest ($f->{trace}->{frame}->[1] line $f->{trace}->{frame}->[2])";

        my $subwatcher = blessed($self)->new(nested => $self->{+NESTED} + 1, job => $self->{+JOB}, try => $self->{+TRY});

        my $id = 1;
        for my $sf (@{$f->{parent}->{children}}) {
            $sf->{harness}->{job_id}   ||= $f->{harness}->{job_id};
            $sf->{harness}->{run_id}   ||= $f->{harness}->{run_id};
            $sf->{harness}->{event_id} ||= $sf->{about}->{uuid} ||= gen_uuid();
            $subwatcher->subtest_process($sf);
        }

        my @errors = $subwatcher->subtest_fail_error_facet_list();

        if ($f->{harness}->{subtest_start}) {
            push @{$f->{errors}} => {tag => 'REASON', fail => 1, from_harness => 1, details => "Buffered subtest ended abruptly (missing closing brace event)"}
                unless $closer && $closer->{facet_data}->{harness}->{subtest_end};
        }

        my $fail = 0;
        if (@errors) {
            push @{$f->{errors}} => @errors;
            $fail = 1;
        }
        else {
            $fail ||= $f->{assert} && !$f->{assert}->{pass} && !($f->{amnesty} && @{$f->{amnesty}});
            $fail ||= $f->{control} && ($f->{control}->{halt} || $f->{control}->{terminate});
            $fail ||= $f->{errors} && first { $_->{fail} } @{$f->{errors}};
        }

        if ($fail) {
            $self->{+_SUB_FAILURES}++;

            # Populate the tree up to this subtest
            my $tree = $self->{+FAILED_SUBTEST_TREE} //= [];
            push @$tree => [$name, $subwatcher->{+FAILED_SUBTEST_TREE} // []];
        }
    }

    $self->{+ASSERTION_COUNT}++ if $f->{assert};

    if ($f->{assert} && !$f->{assert}->{pass} && !($f->{amnesty} && @{$f->{amnesty}})) {
        $self->{+_FAILURES}++;
    }

    if ($f->{control} || $f->{errors}) {
        my $err ||= $f->{control} && ($f->{control}->{halt} || $f->{control}->{terminate});
        $err ||= $f->{errors} && first { $_->{fail} } @{$f->{errors}};
        $self->{+_ERRORS}++ if $err;
        $self->{+HALT} = $f->{control}->{details} || '1' if $f->{control} && $f->{control}->{halt} && (!$self->{+HALT} || $self->{+HALT} eq '1');
    }

    if ($f->{plan} && !$f->{plan}->{none}) {
        $self->{+_PLANS}++;
        $self->{+PLAN} = $f->{plan};
    }

    if ($f->{harness_job_exit}) {
        $self->{+EXIT} = $f->{harness_job_exit}->{exit};

        my $file = $self->file();

        my $end = $f->{harness_job_end} = {
            file     => $file,
            rel_file => File::Spec->abs2rel($file),
            abs_file => File::Spec->rel2abs($file),
            retry    => $f->{harness_job_exit}->{retry},
            fail     => $self->fail(),
            stamp    => $f->{harness_job_exit}->{stamp},
        };

        my $plan = $self->plan;
        $end->{skip} = $plan->{details} || "No reason given" if $plan && !$plan->{count};

        my $times = $self->times;
        if ($times && $times->useful) {
            $end->{times} = $times->data_dump;
            push @{$f->{harness_job_fields}} => $times->job_fields;
            push @{$f->{info}} => {tag => 'TIME', details => $times->summary, table => $times->table};
        }

        push @{$f->{errors}} => $self->fail_error_facet_list;
    }

    return;
}

sub subtest_fail_error_facet_list {
    my $self = shift;

    return @{$self->{+_SUB_INFO}} if $self->{+_SUB_INFO};

    my @out;

    my $plan = $self->{+PLAN} ? $self->{+PLAN}->{count} : undef;
    my $count = $self->{+ASSERTION_COUNT};

    my $numbers = $self->{+NUMBERS};
    my $max     = max(keys %$numbers);
    if ($max) {
        for my $i (1 .. $max) {
            if (!$numbers->{$i}) {
                push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Assertion number $i was never seen"};
            }
            elsif ($numbers->{$i} > 1) {
                push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Assertion number $i was seen more than once"};
            }
        }
    }

    if (!$self->{+_PLANS}) {
        if ($count) {
            push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "No plan was declared"};
        }
        else {
            push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "No plan was declared, and no assertions were made."};
        }
    }
    elsif ($self->{+_PLANS} > 1) {
        push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Too many plans were declared (Count: $self->{+_PLANS})"};
    }

    push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Planned for $plan assertions, but saw $self->{+ASSERTION_COUNT}"}
        if $plan && $count != $plan;

    push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Subtest failures were encountered (Count: $self->{+_SUB_FAILURES})"}
        if $self->{+_SUB_FAILURES};

    return @out;
}

sub fail_error_facet_list {
    my $self = shift;

    return @{$self->{+_INFO}} if $self->{+_INFO};

    my @out;

    my $incomplete_subtests = values %{$self->{+SUBTESTS}};
    push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "One or more incomplete subtests (Count: $incomplete_subtests)"}
        if $incomplete_subtests;

    if (my $wstat = $self->{+EXIT}) {
        if ($wstat == -1) {
            push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "The harness could not get the exit code! (Code: $wstat)"};
        }
        else {
            my $e = parse_exit($wstat);
            if ($e->{err}) {
                push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Test script returned error (Err: $e->{err})"};
            }
            if ($e->{sig}) {
                push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Test script returned error (Signal: $e->{sig})"};
            }
        }
    }

    push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Errors were encountered (Count: $self->{+_ERRORS})"}
        if $self->{+_ERRORS};

    push @out => {tag => 'REASON', fail => 1, from_harness => 1, details => "Assertion failures were encountered (Count: $self->{+_FAILURES})"}
        if $self->{+_FAILURES};

    push @out => $self->subtest_fail_error_facet_list();

    return @out;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test2::Harness::Auditor::Watcher - Class to monitor events for a single job and
pass judgement on the result.

=head1 DESCRIPTION

This module represents a per-job state tracker. This module sees every event
and manages the state produced. In the end this tracker determines if a test
job passed or failed, and why.

=head1 SYNOPSIS

    use Test2::Harness::Auditor::Watcher;

    my $watcher = Test2::Harness::Auditor::Watcher->new();

    for my $event (@events) {
        $watcher->process($event);
    }

    print "Pass!" if $watcher->pass;
    print "Fail!" if $watcher->fail;

=head1 METHODS

=over 4

=item $int = $watcher->assertion_count()

Number of assertions that have been seen.

=item $exit = $watcher->exit()

If the job has exited this will return the exit value (integer, 0 or greater).
If the job has not exited yet (or at least if the watcher has not seen the exit
event yet) this will return undef.

=item $bool = $watcher->fail()

Returns true if the job has failed/is failing.

=item @error_facets = $watcher->fail_error_facet_list

Used internally to get a list of 'error' facets to inject into the
harness_job_exit event.

=item $file = $watcher->file

If the test file is known this will return it (string). This will return undef
if the file is not yet known.

=item $string = $watcher->halt

If the test was halted (bail-out) this will contain the human readible reason.

=item $bool = $watcher->has_exit

Check if the exit value is known.

=item $bool = $watcher->has_plan

Check if a plan has been seen.

=item $job = $watcher->job

If the job is known this will return the detailed structure of the job.

=item $int = $watcher->nested

If this watcher represents a subtest this will be an integer greater than 0,
the top-level test is 0.

=item $hash = $watcher->numbers

This is an internal state tracking what test numbers have been seen. This is
really only applicable in tests that produced TAP.

=item $bool = $watcher->pass

Check if the test job is passing.

=item $plan_facet = $watcher->plan()

If the plan facet has been seen this will return it.

=item $watcher->process($event);

Modify the state based on the provided event.

=item $watcher->subtest_fail_error_facet_list

Used internally to get a list of 'error' facets to inject into the
harness_job_exit event.

=item $times = $watcher->times()

Retuns the L<Test2::Harness::Auditor::TimeTracker> instance.

=item $int = $watcher->try()

Sometimes a job is run more than once, in those cases this will be an integer
greater than 0 representing the try. 0 is used for the first try.

=back

=head1 SOURCE

The source code repository for Test2-Harness can be found at
F<http://github.com/Test-More/Test2-Harness/>.

=head1 MAINTAINERS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 AUTHORS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 COPYRIGHT

Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See F<http://dev.perl.org/licenses/>

=cut
