# -*- Perl -*-
#
# run unix commands for expected results given particular inputs

package Test2::Tools::Command;
our $VERSION = '0.01';

use 5.10.0;
use strict;
use warnings;
use Cwd ();
use IPC::Open3 'open3';
use Symbol 'gensym';
use Test2::API 'context';
use Test2::Tools::Compare;

use base 'Exporter';
our @EXPORT = qw(command);

our @command;           # prefixed on each run, followed by any ->{args}
our $timeout = 3600;    # seconds, for alarm()

sub _command ($) {
    my $orig_dir;       # see also File::chdir
    if ( defined $_[0]->{chdir} ) {
        $orig_dir = Cwd::getcwd or die "getcwd failed: $!\n";
        chdir $_[0]->{chdir}    or die "chdir failed '$orig_dir': $!\n";
    }
    local @ENV{ keys %{ $_[0]->{env} } } = values %{ $_[0]->{env} };
    my $pid = open3( my $in, my $out, my $err = gensym,
        @command, exists $_[0]->{args} ? @{ $_[0]->{args} } : () );
    if ( defined $_[0]->{binmode} ) {
        for my $fh ( $in, $out, $err ) { binmode $fh, $_[0]->{binmode} }
    }
    if ( exists $_[0]->{stdin} ) {
        print $in $_[0]->{stdin};
        close $in;
    }
    if ( defined $_[0]->{chdir} ) {
        chdir $orig_dir or die "chdir failed '$orig_dir': $!\n";
    }
    return $pid, $in, $out, $err;
}

sub command ($) {
    my ( $pid, $in, $out, $err, $stdout, $stderr );
    eval {
        local $SIG{ALRM} = sub { die "timeout\n" };
        alarm( $_[0]->{timeout} || $timeout );

        ( $pid, $in, $out, $err ) = &_command;

        # some tests might want the filehandles to poke at directly?
        if ( $_[0]->{want_fh} ) {
            ( $stdout, $stderr ) = ( $out, $err );
        } else {
            # NOTE these are references as the scalars could be pretty big
            $stdout = \( do { local $/; readline $out } // '');
            $stderr = \( do { local $/; readline $err } // '');
        }
        waitpid $pid, 0;
        alarm 0;
        1;
    } or die $@;
    my $orig_status = $?;
    my $status      = {
        code   => $? >> 8,
        signal => $? & 127,
        iscore => $? & 128 ? 1 : 0
    };
    $status->{code} = $status->{code} ? 1 : 0 if $_[0]->{munge_status};

    # default exit status word is 0, but need it in hashref form
    if ( exists $_[0]->{status} ) {
        if ( !defined $_[0]->{status} ) {
            $_[0]->{status} = { code => 0, signal => 0, iscore => 0 };
        } elsif ( ref $_[0]->{status} eq '' ) {
            $_[0]->{status} = { code => $_[0]->{status}, signal => 0, iscore => 0 };
        }
        # assume that ->{status} is a hashref
    } else {
        $_[0]->{status} = { code => 0, signal => 0, iscore => 0 };
    }

    my $ctx = context();
    is( $status, $_[0]->{status}, "exit status word" );
    unless ( $_[0]->{want_fh} ) {
        like $$stdout, $_[0]->{stdout} // qr/^$/;
        like $$stderr, $_[0]->{stderr} // qr/^$/;
    }
    $ctx->release;

    return $stdout, $stderr, $orig_status;
}

1;
__END__

=head1 NAME

Test2::Tools::Command - run unix commands

=head1 SYNOPSIS

  use Test2::V0;
  use Test2::Tools::Command;

  command { args   => [ 'perl', '-E', q{say "out"; exit 42} ],
            chdir  => '/some/dir',
            stdin  => "printed to program\n",
            stdout => qr/out/,
            status => 42 };

  # subsequent args are prefixed with this command
  local @Test2::Tools::Command::command = ( 'perl', '-E' );

  like dies { command { args    => [ 'sleep 99' ],
                        timeout => 1 }
            }, qr/timeout/;

=head1 DESCRIPTION

This module tests that commands given particular arguments result in
particular outputs by way of the exit status word, standard output, and
standard error. Various parameters to the B<command> function alter
exactly how this is done, in addition to variables that can be set.

=head1 VARIABLES

=over 4

=item B<@command>

Custom command to prefix any commands run by B<command> with, for
example to specify a test program that will be used in many
subsequent tests

  local @Test2::Tools::Command::command = ($^X, '--', 'bin/foo');
  command { args => [ 'bar', '-c', 'baz' ] };

will result in C<perl -- bin/foo bar -c baz> being run.

If I<chdir> is used, a command that uses a relative path may need to be
fully qualified, e.g. with C<rel2abs> of L<File::Spec::Functions>.

=item B<$timeout>

Seconds after which commands will be timed out via C<alarm> if a
C<timeout> is not given to B<command>. 3600 by default.

=back

=head1 FUNCTIONS

B<command> is exported by default.

=over 4

=item B<command> I<hashref>

Runs a command and executes one or more tests on the results, depending
on the contents of I<hashref>, which may contain:

=over 4

=item I<args> => I<arrayref>

List of arguments to run the command with. The argument list will be
prefixed by the B<@command> variable, if that is set.

=item I<binmode> => I<layer>

If set, I<layer> will be set on the filehandles wired to the command via
the C<binmode> function. See also L<open>.

=item I<chdir> => I<directory>

Attempt to C<chdir> into I<directory> or failing that (or failing to
restore the previous directory) will throw an exception.

A command that uses a relative path may need to be fully qualified, e.g.
with C<rel2abs> of L<File::Spec::Functions>.

=item I<env> => I<hashref>

Set the local environment to the keys and values present in I<hashref>.
This is additive only; environment variables that must not be set must
be deleted from C<%ENV> prior, or the command wrapped with a command
that can reset the environment, possibly such as L<env(1)>.

=item I<munge_status> => I<boolean>

If the exit code of the exit status word is not zero, it will be munged
to have the value of C<1>. Use this where the program being tested is
unpredictable as to what (non-zero, non-signal) exit code it will use.

=item I<status> => I<code-or-hashref>

Expect the given value as the exit status word. By default C<0> for the
exit code is assumed. This can be specified in two different forms; the
following two are equivalent:

  status => 42
  status => { code => 42, iscore => 0, signal => 0 }

If the program is instead expected to exit by a SIGPIPE, one might use:

  status => { code => 0, iscore => 0, signal => 13 }

See also I<munge_status>.

=item I<stdin> => I<data>

If present, I<data> will be printed to the command and then standard
input will be closed.

=item I<timeout> => I<seconds>

Set a custom timeout for the C<alarm> call that wraps the command to be
run. The variable B<$timeout> will be used if this is unset.

=item I<want_fh> => I<boolean>

If true, filehandles will be returned from B<command> and the usual
stdin and stderr tests will not be run.

=back

B<command> returns stdout, stderr, and the exit status word. stdout and
stderr will either be filehandles (if I<want_fh> is true) or scalar
references to strings that contain all of standard output and standard
error from the program.

=back

=head1 BUGS

None known. There are probably portability problems if you stray from
the unix path.

=head1 SEE ALSO

L<Test2::Suite>

L<IPC::Open3> is used to run programs; this may run into portability
problems on systems that stray from the way of unix?

L<Test::UnixCmdWrap> is older and has similar functionality; probably
more portable at the cost of probably being slower.

L<Test::UnixExit> has specific tests for the unix exit status word;
similar functionality is present in this module.

=head1 COPYRIGHT AND LICENSE

Copyright 2022 Jeremy Mates

This program is distributed under the (Revised) BSD License:
L<https://opensource.org/licenses/BSD-3-Clause>

=cut
