The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Tests for Connector::Proxy::Proc::SafeExec
#
# Sooooo... this is a trick one. We found that in our Net::Server
# environment, Proc::SafeExec returns STDOUT from the child
# command correctly when our daemon starts. After forking and
# switching the effective user ID, however, the STDOUT was empty.
#
# In this test script, we try to see if we can reproduce the problem
# to be able to pinpoint the bug.
#

use strict;
use warnings;
use English;
use Try::Tiny;

use Test::More tests => 17;

#diag "LOAD MODULE\n";

our $req_err_ps;
our $req_err_ns;

BEGIN {
    eval 'require Proc::SafeExec;';
    our $req_err_ps = $@;

    #    use_ok( 'Connector::Proxy::Proc::SafeExec' );
    eval 'require Net::Server;';
    our $req_err_ns = $@;
}

package MyTestServer;

if ( not $req_err_ns and not $req_err_ps ) {
    eval 'use base qw( Net::Server::MultiType );'
        or die "Error using Net::Server::MultiType: $@";
    eval 'use Net::Server::Daemonize qw( set_uid set_gid );'
        or die "Error using Net::Server::Daemonize: $@";

    sub new {
        my $that  = shift;
        my $class = ref($that) || $that;
        my $self  = {};
        bless $self, $class;
        # mask isn't available by default, so let's postpone this
        eval '$self->{umask} = mask 0007;';
    }
}

package main;

#diag "Connector::Proxy::Proc::SafeExec\n";
###########################################################################
SKIP: {
    skip "Proc::SafeExec not installed", 17 if $req_err_ps;
    skip "Net::Server not installed",    17 if $req_err_ns;

    require_ok('Connector::Proxy::Proc::SafeExec');

    my $conn = Connector::Proxy::Proc::SafeExec->new(
        {   LOCATION => 't/config/test.sh',
            args     => ['foo'],
            timeout  => 2,
        }
    );

    ok( defined $conn );

    is( $conn->get(), 'foo', 'Simple invocation' );

    $conn->args( [ '--quote-character', '**', 'foo' ] );
    is( $conn->get(), '**foo**', 'Multiple arguments and options' );

    my $exception;
    $conn->args( [ '--exit-with-error', '1' ] );

    undef $exception;
    try {
        $conn->get();
    }
    catch {
        $exception = $_;
    };
    like(
        $exception,
        qr/^System command exited with return code/,
        'Error code handling'
    );

    $conn->args( [ '--sleep', '1', 'foo' ] );
    is( $conn->get(), 'foo', 'Timeout: not triggered' );

    $conn->args( [ '--sleep', '3', 'foo' ] );
    undef $exception;
    try {
        $conn->get();
    }
    catch {
        $exception = $_;
    };
    like( $exception, qr/^System command timed out/, 'Timeout: triggered' );

    ####
    # argument passing tests
    $conn->args( ['abc[% ARG.0 %]123'] );
    is( $conn->get('foo'), 'abcfoo123',
        'Passing parameters from get arguments' );

    $conn->args( ['abc[% ARG.0 %]123[% ARG.1 %]xyz'] );
    is( $conn->get( 'foo', 'bar' ),
        'abcfoo123barxyz', 'Multiple parameters from get arguments' );

    ###
    # environment tests
    $ENV{MYVAR} = '';
    $conn->args( [ '--printenv', 'MYVAR' ] );
    is( $conn->get('foo'), '', 'Environment variable test: no value' );

    $ENV{MYVAR} = 'bar';
    is( $conn->get('foo'), 'bar',
        'Environment variable test: externally set' );

    $ENV{MYVAR} = '';
    $conn->env( { MYVAR => '1234', } );
    is( $conn->get('foo'), '1234',
        'Environment variable test: internally set to static value' );

    $conn->env( { MYVAR => '1234[% ARG.0 %]', } );
    is( $conn->get('foo'), '1234foo',
        'Environment variable test: internally set with template' );

    ###
    # stdin tests
    $conn->stdin('54321');
    $conn->args( ['--'] );
    is( $conn->get('foo'), '54321', 'Passing scalar data via STDIN 1/2' );
    is( $conn->get('bar'), '54321', 'Passing scalar data via STDIN 2/2' );

    $conn->stdin('54321[% ARG.0 %]abc');
    is( $conn->get('foo'), '54321fooabc',
        'Passing data via STDIN with template' );

    $conn->stdin( [ '1234[% ARG.0 %]abc', '4321[% ARG.1 %]def' ] );
    is( $conn->get( 'foo', 'bar' ), '1234fooabc
4321bardef', 'Passing multiple lines via STDIN'
    );

}