package App::Yath::Tester;
use strict;
use warnings;

our $VERSION = '1.000170';

use Test2::API qw/context run_subtest/;
use Test2::Tools::Compare qw/is/;

use Carp qw/croak/;
use File::Spec;
use File::Temp qw/tempfile tempdir/;
use POSIX;
use Fcntl qw/SEEK_CUR/;

use App::Yath::Util qw/find_yath/;
use Test2::Harness::Util qw/clean_path apply_encoding/;
use Test2::Harness::Util::IPC qw/run_cmd/;
use Test2::Harness::Util::File::JSONL;

use Importer Importer => 'import';
our @EXPORT = qw/yath make_example_dir/;

my $pdir = tempdir(CLEANUP => 1);

require App::Yath;
my $apppath = App::Yath->app_path;

sub cover {
    return unless $ENV{T2_DEVEL_COVER};
    $ENV{T2_COVER_SELF} = 1;
    return '-MDevel::Cover=-silent,1,+ignore,^t/,+ignore,^t2/,+ignore,^xt,+ignore,^test.pl';
}

sub yath {
    my %params = @_;

    local $?;

    my $ctx = context();

    my $cmd = delete $params{cmd} // delete $params{command};
    my $cli = delete $params{cli} // delete $params{args} // [];
    my $pre = delete $params{pre} // delete $params{pre_command} // [];
    my $env = delete $params{env} // {};
    my $enc = delete $params{encoding};
    my $prefix = delete $params{prefix};

    my $subtest  = delete $params{test} // delete $params{tests} // delete $params{subtest};
    my $exittest = delete $params{exit};

    my $debug   = delete $params{debug}   // 0;
    my $inc     = delete $params{inc}     // 1;
    my $capture = delete $params{capture} // 1;
    my $log     = delete $params{log}     // 0;

    my $no_app_path = delete $params{no_app_path};
    my $lib = delete $params{lib} // [];

    if (keys %params) {
        croak "Unexpected parameters: " . join (', ', sort keys %params);
    }

    my (@inc, @dev);
    if ($inc) {
        my ($pkg, $file) = caller();
        my $dir = $file;
        $dir =~ s/\.t2?$//g;

        my $inc = File::Spec->catdir($dir, 'lib');
        push @dev => "-D$inc" if -d $inc;
    }

    my ($wh, $cfile);
    if ($capture) {
        ($wh, $cfile) = tempfile("yath-$$-XXXXXXXX", TMPDIR => 1, UNLINK => 1, SUFFIX => '.out');
        $wh->autoflush(1);
    }

    my (@log, $logfile);
    if ($log) {
        my $fh;
        ($fh, $logfile) = tempfile("yathlog-$$-XXXXXXXX", TMPDIR => 1, UNLINK => 1, SUFFIX => '.jsonl');
        close($fh);
        @log = ('-F' => $logfile);
        print "DEBUG: log file = '$logfile'\n" if $debug;
    }

    unless ($no_app_path) {
        push @inc => "-I$apppath" if $cmd =~ m/^(test|start|projects)$/;
        push @dev => "-D$apppath";
    }

    my @cover = cover();

    my $yath = find_yath;
    my @cmd = ($^X, @$lib, @cover, $yath, @$pre, @dev, $cmd ? ($cmd) : (), @inc, @log, @$cli);

    print "DEBUG: Command = " . join(' ' => @cmd) . "\n" if $debug;

    local %ENV = %ENV;
    $ENV{YATH_PERSISTENCE_DIR} = $pdir;
    $ENV{YATH_CMD} = $cmd;
    $ENV{NESTED_YATH} = 1;
    $ENV{'YATH_SELF_TEST'} = 1;
    $ENV{$_} = $env->{$_} for keys %$env;
    my $pid = run_cmd(
        no_set_pgrp => 1,
        $capture ? (stderr => $wh, stdout => $wh) : (),
        command => \@cmd,
        run_in_parent => [sub { close($wh) }],
    );

    my (@lines, $exit);
    if ($capture) {
        open(my $rh, '<', $cfile) or die "Could not open output file: $!";
        # Do not apply encoding here — non-blocking reads can split
        # multi-byte characters, corrupting the :utf8 decode.
        $rh->blocking(0);
        while (1) {
            seek($rh, 0, SEEK_CUR); # CLEAR EOF
            my @new = <$rh>;
            push @lines => @new;
            print map { chomp($_); "DEBUG: > $_\n" } @new if $debug > 1;

            waitpid($pid, WNOHANG) or next;
            $exit = $?;
            last;
        }

        # Child is done — re-read the complete file with proper encoding.
        # This avoids partial multi-byte sequences from non-blocking reads.
        if ($enc) {
            open(my $fh, '<', $cfile) or die "Could not re-open output file: $!";
            apply_encoding($fh, $enc);
            @lines = <$fh>;
            close($fh);
        }
        else {
            seek($rh, 0, SEEK_CUR); # CLEAR EOF
            while (my @new = <$rh>) {
                push @lines => @new;
                print map { chomp($_); "DEBUG: > $_\n" } @new if $debug > 1;
            }
        }
    }
    else {
        print "DEBUG: Waiting for $pid\n" if $debug;
        waitpid($pid, 0);
        $exit = $?;
    }

    print "DEBUG: Exit: $exit\n" if $debug;

    my $out = {
        exit => $exit,
        $capture ? (output => join('', @lines)) : (),
        $log ? (log => Test2::Harness::Util::File::JSONL->new(name => $logfile)) : (),
    };

    my $name = join(' ', map { length($_) < 30 ? $_ : substr($_, 0, 10) . "[...]" . substr($_, -10) } grep { defined($_) } $prefix, 'yath', @$pre, $cmd ? ($cmd) : (), @$cli);
    run_subtest(
        $name,
        sub {
            if (defined $exittest) {
                my $ictx = context(level => 3);
                is($exit, $exittest, "Exit Value Check");
                $ictx->release;
            }

            if ($subtest) {
                local $_ = $out->{output};
                local $? = $out->{exit};
                $subtest->($out);
            }

            my $ictx = context(level => 3);

            $ictx->diag("Command = " . join(' ' => grep { defined $_ } @cmd) . "\nExit = $exit\n==== Output ====\n$out->{output}\n========")
                unless $ictx->hub->is_passing;

            $ictx->release;
        },
        {buffered => 1},
        $out,
    ) if $subtest || defined $exittest;

    $ctx->release;

    return $out;
}

sub _gen_passing_test {
    my ($dir, $subdir, $file) = @_;

    my $path = File::Spec->catdir($dir, $subdir);
    my $full = File::Spec->catfile($path, $file);

    mkdir($path) or die "Could not make $subdir subdir: $!"
        unless -d $path;

    open(my $fh, '>', $full);
    print $fh "use Test2::Tools::Tiny;\nok(1, 'a passing test');\ndone_testing\n";
    close($fh);

    return $full;
}

sub make_example_dir {
    my $dir = tempdir(CLEANUP => 1, TMP => 1);

    _gen_passing_test($dir, 't', 'test.t');
    _gen_passing_test($dir, 't2', 't2_test.t');
    _gen_passing_test($dir, 'xt', 'xt_test.t');

    return $dir;
}


1;

__END__

=pod

=encoding UTF-8

=head1 NAME

App::Yath::Tester - Tools for testing yath

=head1 DESCRIPTION

This package provides utilities for running yath from within tests to verify
its behavior. This is primarily used for integration testing of yath and for
third party components.

=head1 SYNOPSIS

    use App::Yath::Tester qw/yath/;

    my $result = yath(
        # Command and arguments
        command => 'test',
        args    => ['-pMyPlugin', 'path/to/test', ...],

        # Exit code we expect from yath
        exit => 0,

        # Subtest to verify results
        test => sub {
            my $result = shift;

            # Redundant since we have the exit check above
            is($result->{exit}, 0, "Verify exit");

            is($result->{output}, $expected_output, "Got the expected output from yath");
        },
    );

=head1 EXPORTS

There are 2 exports from this module.

=head2 $result = yath(...)

    my $result = yath(
        # Command and arguments
        command => 'test',
        args    => ['-pMyPlugin', 'path/to/test', ...],

        # Exit code we expect from yath
        exit => 0,

        # Subtest to verify results
        test => sub {
            my $result = shift;

            # Redundant since we have the exit check above
            is($result->{exit}, 0, "Verify exit");

            is($result->{output}, $expected_output, "Got the expected output from yath");
        },
    );

=head3 ARGUMENTS

=over 4

=item cmd => $command

=item command => $command

Either 'cmd' or 'command' can be used. This argument takes a string that should
be a command name.

=item cli => \@ARGS

=item args => \@ARGS

Either 'cli' or 'args' can be used. If none are provided an empty arrayref is
used. This argument takes an arrayref of arguments to the yath command.

    $ yath [PRE_COMMAND] [COMMAND] [ARGS]

=item pre => \@ARGS

=item pre_command => \@ARGS

Either 'pre' or 'pre_command' can be used. An empty arrayref is used if none
are provided. These are arguments provided to yath BEFORE the command on the
command line.

    $ yath [PRE_COMMAND] [COMMAND] [ARGS]

=item env => \%ENV

Provide custom environment variable values to set before running the yath
command.

=item encoding => $encoding_name

If you expect your yath command's output to be in a specific encoding you can
specify it here to make sure the C<< $result->{output} >> text has been read
properly.

=item test => sub { ... }

=item tests => sub { ... }

=item subtest => sub { ... }

These 3 arguments are all aliases for the same thing, only one should be used.
The codeblock will be called with C<$result> as the onyl argument. The
codeblock will be run as a subtest. If you specify the C<'exit'> argument that
check will also happen in the same subtest.

    test => sub {
        my $result = shift;

        ... verify result ...
    },

=item exit => $integer

Verify that the yath command exited with the specified exit code. This check
will be run in a subtest. If you specify a custom subtest then this check will
appear to come from that subtest.

=item debug => $integer

Output debug info in realtime, depending on the $integer value this may include
the output from the yath command being run.

    0 - No debugging
    1 - Output the command and other action being taken by the tool
    2 - Echo yath output as it happens

=item inc => $bool

This defaults to true.

When true the tool will look for a directory next to your test file with an
identical name except that '.t' or '.t2' will be stripped from it. If that
directory exists it will be added as a dev-lib to the yath command.

If your test file is 't/foo/bar.t' then your yath command will look like this:

    $ yath -D=t/foo/bar [PRE-COMMAND] [COMMAND] [ARGS]

=item capture => $bool

Defaults to true.

When true the yath output will be captured and put into
C<< $result->{output} >>.

=item log => $bool

Defaults to false.

When true yath will be instructed to produce a log, the log will be accessible
via C<< $result->{log} >>. C<< $result->{log} >> will be an instance of
L<Test2::Harness::Util::File::JSONL>.

=item no_app_path => $bool

Default to false.

Normally C<< -D=/path/to/lib >> is added to the yath command where
C<'/path/to/lib'> is the path the the lib dir L<App::Yath> was loaded from.
This normally insures the correct version of yath libraries is loaded.

When this argument is set to true the path is not added.

=item lib => [...]

This poorly named argument allows you to inject command line argumentes between
C<perl> and C<yath> in the command.

    perl [LIB] path/to/yath [PRE-COMMAND] [COMMAND] [ARGS]

=back

=head3 RESULT

The result hashref may containt he following fields depending on the arguments
passed into C<yath()>.

=over 4

=item exit => $integer

Exit value returned from yath.

=item output => $string

The output produced by the yath command.

=item log => $jsonl_object

An instance of L<Test2::Harness::Util::File::JSONL> opened from the log file
produced by the yath command.

B<Note:> By default no logging is done, you must specify the C<< log => 1 >>
argument to enable it.

=back

=head2 $path = make_example_dir()

This will create a temporary directory with 't', 't2', and 'xt' subdirectories
each of which will contain a single passing test.

=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
