package App::Yath::Options::Debug;
use strict;
use warnings;

our $VERSION = '1.000162';

use Test2::Harness::Util::JSON qw/encode_pretty_json/;
use Test2::Util::Table qw/table/;
use Test2::Harness::Util qw/find_libraries mod2file clean_path/;

use Errno qw/EINTR/;

use App::Yath::Options;

option_group {prefix => 'debug', category => 'Help and Debugging'} => sub {
    post 99999 => \&_post_process_show_opts;
    post 99998 => \&_post_process_interactive;
    post \&_post_process_version;
    post \&_post_process_help;

    option dummy => (
        short          => 'd',
        description    => 'Dummy run, do not actually execute anything',
        env_vars       => [qw/T2_HARNESS_DUMMY/],
        clear_env_vars => 1,
        default        => 0,
    );

    option procname_prefix => (
        type => 's',
        default => '',
        description => 'Add a prefix to all proc names (as seen by ps).',
    );

    option keep_dirs => (
        short       => 'k',
        alt         => ['keep_dir'],
        description => 'Do not delete directories when done. This is useful if you want to inspect the directories used for various commands.',
        default     => 0,
    );

    option 'show-opts' => (
        description => 'Exit after showing what yath thinks your options mean',
        pre_command => 1,
    );

    option version => (
        short       => 'V',
        description => "Exit after showing a helpful usage message",
        pre_command => 1,
    );

    option help => (
        short       => 'h',
        description => "exit after showing help information",
    );

    option interactive => (
        short => 'i',
        description => 'Use interactive mode, 1 test at a time, stdin forwarded to it',
    );

    option summary => (
        type        => 'd',
        description => "Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted.",

        long_examples => ['', '=/path/to/summary.json'],

        normalize  => \&normalize_summary,
        action     => \&summary_action,
        applicable => sub {
            my ($option, $options) = @_;

            return 1 if $options->included->{'App::Yath::Options::Run'};
            return 0;
        },
    );
};

sub normalize_summary {
    my $val = shift;

    return $val if $val eq '1';

    $val =~ s/\.json$//g;
    $val .= '.json';

    return clean_path($val);
}

sub summary_action {
    my ($prefix, $field, $raw, $norm, $slot, $settings) = @_;

    return $$slot = clean_path($norm)
        unless $norm eq '1';

    return if $$slot;
    return $$slot = clean_path('summary.json');
}

sub _post_process_help {
    my %params = @_;

    return unless $params{settings}->debug->help;

    my $help;
    if (my $cmd = $params{command}) {
        $help = $cmd->cli_help(%params);
    }
    else {
        $help = __PACKAGE__->cli_help(%params);
    }

    if (eval { require IO::Pager; 1 }) {
        local $SIG{PIPE} = sub {};
        my $pager = IO::Pager->new(*STDOUT);
        $pager->print($help);
    }
    else {
        print $help;
    }

    exit 0;
}

sub _post_process_show_opts {
    my %params = @_;

    return unless $params{settings}->debug->show_opts;

    my $settings = $params{settings};

    print "\nCommand selected: " . $params{command}->name . "  (" . ref($params{command}) . ")\n" if $params{command};

    my $args = $params{args};
    print "\nCommand args: " . join(', ' => @$args) . "\n" if @$args;

    my $out = encode_pretty_json($settings);

    print "\nCurrent command line and config options result in these settings:\n";
    print "$out\n";

    exit 0;
}

my $RAN = 0;
sub _post_process_interactive {
    return if $RAN++;
    my %params = @_;

    return unless $params{settings}->debug->interactive;

    my $settings = $params{settings};

    my ($fifo);
    if ($settings->check_prefix('workspace')) {
        my $dir = $settings->workspace->workdir;
        $fifo = "$dir/fifo-$$";
    }
    else {
        require File::Temp;
        my $fh;
        ($fh, $fifo) = File::Temp::tempfile("YATH-FIFO-$$-XXXXXX", TMPDIR => 1);
        close($fh);
        unlink($fifo);
    }

    ${$settings->debug->vivify_field('fifo')} = $fifo;

    if ($settings->check_prefix('display')) {
        $settings->display->field(quiet => 0);
        $settings->display->field(verbose => 1) unless $settings->display->verbose;
    }

    if ($settings->check_prefix('formatter')) {
        $settings->formatter->field(qvf => 0);
    }

    if ($settings->check_prefix('run')) {
        $settings->run->env_vars->{YATH_INTERACTIVE} = $fifo;
        $ENV{YATH_INTERACTIVE} = $fifo;
    }

    my $pid = fork() // die "Could not fork: $!";
    if ($pid) {
        require Scope::Guard;
        require POSIX;
        POSIX::mkfifo($fifo, 0700) or die "Failed to make fifo ($fifo): $!";
        my $fh;

        my $cleanup = sub {
            close($fh)    if $fh;
            unlink($fifo) if -e $fifo;
        };

        my $old_int_handler  = $SIG{INT};
        my $old_term_handler = $SIG{TERM};

        $SIG{INT}  = sub { $cleanup->('INT');  $old_int_handler->()  if ref $old_int_handler;  exit 1; };
        $SIG{TERM} = sub { $cleanup->('TERM'); $old_term_handler->() if ref $old_term_handler; exit 1; };
        $SIG{PIPE} = sub { exit 1 };

        $SIG{CHLD} = sub {
            local $?;
            my $res = waitpid($pid, 0);
            my $exit = ($? >> 8);

            close($fh) if $fh;
            unlink($fifo) if -e $fifo;

            # Forward the exit code from our child
            exit($exit);
        };

        for (1 .. 10) {
            last if open($fh, '>', $fifo);
            die "Could not open fifo ($fifo): $!" unless $! == EINTR;
            sleep 1;
        }
        die "Could not open fifo ($fifo): $!" unless $fh;

        $fh->autoflush(1);
        my $guard = Scope::Guard->new($cleanup);

        while(1) {
            my $data = <STDIN>;
            if (defined($data) && length($data)) {
                print $fh $data;
                next;
            }

            next if defined($data);

            next if kill(0, $pid);
            print STDERR "Lost child process $pid\n";
            $cleanup->();
            exit 255;
        }
    }

    close(STDIN);
    open(STDIN, '<', '/dev/null');

    require Time::HiRes;
    while (! -e $fifo) { Time::HiRes::sleep(0.1) };
}

sub _post_process_version {
    my %params = @_;

    return unless $params{settings}->debug->version;

    require App::Yath;
    my $out = <<"    EOT";

Yath version: $App::Yath::VERSION

Extended Version Info
    EOT

    my $plugin_libs = find_libraries('App::Yath::Plugin::*');

    my @vers = (
        [perl        => $^V],
        ['App::Yath' => App::Yath->VERSION],
        (
            map {
                eval { require(mod2file($_)); 1 }
                    ? [$_ => $_->VERSION // 'N/A']
                    : [$_ => 'N/A']
            } qw/Test2::API Test2::Suite Test::Builder/
        ),
        (
            map {
                eval { require($plugin_libs->{$_}); 1 }
                    && [$_ => $_->VERSION // 'N/A']
            } sort keys %$plugin_libs
        ),
    );

    $out .= join "\n" => table(
        header => [qw/COMPONENT VERSION/],
        rows   => \@vers,
    );

    print "$out\n\n";

    exit 0;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

App::Yath::Options::Debug - Debug options for Yath

=head1 DESCRIPTION

This is where debug related command line options live.

=head1 PROVIDED OPTIONS

=head2 YATH OPTIONS (PRE-COMMAND)

=head3 Help and Debugging

=over 4

=item --show-opts

=item --no-show-opts

Exit after showing what yath thinks your options mean


=item --version

=item -V

=item --no-version

Exit after showing a helpful usage message


=back

=head2 COMMAND OPTIONS

=head3 Help and Debugging

=over 4

=item --dummy

=item -d

=item --no-dummy

Dummy run, do not actually execute anything

Can also be set with the following environment variables: C<T2_HARNESS_DUMMY>


=item --help

=item -h

=item --no-help

exit after showing help information


=item --interactive

=item -i

=item --no-interactive

Use interactive mode, 1 test at a time, stdin forwarded to it


=item --keep-dirs

=item --keep_dir

=item -k

=item --no-keep-dirs

Do not delete directories when done. This is useful if you want to inspect the directories used for various commands.


=item --procname-prefix ARG

=item --procname-prefix=ARG

=item --no-procname-prefix

Add a prefix to all proc names (as seen by ps).


=item --summary

=item --summary=/path/to/summary.json

=item --no-summary

Write out a summary json file, if no path is provided 'summary.json' will be used. The .json extension is added automatically if omitted.


=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
