use t::boilerplate;

use Test::More;
use File::Spec::Functions qw( catdir catfile tmpdir );
use English qw( -no_match_vars );
use File::Basename;

{  package Logger;

   sub new   { return bless {}, __PACKAGE__ }
   sub alert { warn '[ALERT] '.$_[ 1 ]."\n" }
   sub debug { }
   sub error { warn '[ERROR] '.$_[ 1 ]."\n" }
   sub fatal { warn '[ALERT] '.$_[ 1 ]."\n" }
   sub info  { warn '[ALERT] '.$_[ 1 ]."\n" }
   sub warn  { warn '[WARNING] '.$_[ 1 ]."\n" }
}

use Class::Usul::Programs;
use Class::Usul::Constants qw(EXCEPTION_CLASS);
use Class::Usul::Functions qw( io );

my $osname = lc $OSNAME;
my $perl   = $EXECUTABLE_NAME;
my $prog   = Class::Usul::Programs->new( appclass => 'Class::Usul',
                                         config   => { cache_ttys => 0,
                                                       logsdir    => 't',
                                                       rundir     => 't',
                                                       tempdir    => 't', },
                                         log      => Logger->new,
                                         method   => 'dump_self',
                                         noask    => 1,
                                         quiet    => 1, );

SKIP: {
   $ENV{AUTHOR_TESTING} or skip 'Proc::ProcessTable to flakey to test', 1;
   eval { require Proc::ProcessTable };
   $EVAL_ERROR and skip 'Proc::ProcessTable not installed', 1;

   is $prog->ipc->process_exists( pid => $PID ), 1, 'process exists';

   my @pids = $prog->ipc->child_list( $PID );

   is $pids[ 0 ], $PID, 'child list - first pid';

   my $table = $prog->ipc->process_table;

   ok $table->count > 0, 'process table';
}

sub popen_test {
   my $want = shift; my $r = eval { $prog->ipc->popen( @_ ) };

   $EVAL_ERROR    and return $EVAL_ERROR;
   $want eq 'err' and return $r->stderr;
   $want eq 'out' and return $r->out;
   $want eq 'rv'  and return $r->rv;
   return $r;
}

my $cmd = "${perl} -v"; my $r;

like popen_test( 'out', $cmd ), qr{ larry \s+ wall }imsx,
   'popen - captures stdout';

$cmd = "${perl} -e \"exit 2\""; $r = popen_test( 'out', $cmd );

is ref $r, EXCEPTION_CLASS, 'popen - exception is right class';

like $r, qr{ Unknown \s+ error }msx, 'popen - default error string';

is popen_test( 'rv', $cmd, { expected_rv => 2 } ), 2, 'popen - expected rv';

$cmd = "${perl} -e \"die q(In a pit of fire)\"";

like popen_test( 'out', $cmd ), qr{ pit \s+ of \s+ fire }msx,
   'popen - expected error string';

$cmd = "${perl} -e\"warn 'danger'\"";

like popen_test( 'err', $cmd ), qr{ \A danger }mx, 'popen - captures stderr';

$cmd = "${perl} -e\"sleep 5\"";

is popen_test( q(), $cmd, { timeout => 1 } )->class, 'TimeOut',
   'popen - timeout';

SKIP: {
   $osname eq 'mswin32' and skip 'popen capture stdin - not on MSWin32', 1;
   $cmd = "${perl} -e 'print <>'";

   is popen_test( 'out', $cmd, { in => [ 'some text' ] } ), 'some text',
      'popen - captures stdin';
}

sub run_cmd_test {
   my $want = shift; my $r = eval { $prog->run_cmd( @_ ) };

   $EVAL_ERROR    and return $EVAL_ERROR;
   $want eq 'err' and return $r->stderr;
   $want eq 'out' and return $r->out;
   $want eq 'rv'  and return $r->rv;
   return $r;
}

SKIP: {
   $osname eq 'mswin32' and skip 'system test - not on MSWin32', 5;

   $cmd = "${perl} -v"; $r = run_cmd_test( 'out', $cmd, { use_system => 1 } );

   like $r, qr{ larry \s+ wall }imsx, 'system - captures stdout';

   $cmd = "${perl} -e \"exit 2\"";
   $r   = run_cmd_test( q(), $cmd, { use_system => 1 } );

   is ref $r, EXCEPTION_CLASS, 'system - exception is right class';

   like $r, qr{ Unknown \s+ error }msx, 'system - default error string';

   is run_cmd_test( 'rv', $cmd, { expected_rv => 2, use_system => 1 } ), 2,
      'system - expected rv';

   $r = run_cmd_test( q(), $cmd, { async => 1 } );

   like $r->out, qr{ background }msx, 'system - async';

   $cmd = "${perl} -e \"sleep 5\"";

   is run_cmd_test( q(), $cmd, { timeout => 1, use_system => 1 } )->class,
      'TimeOut', 'system - timeout';
   wait;

   $cmd = "${perl} -e \"print <>\"";

   my $args = { in => 'test', use_system => 1 };

   is run_cmd_test( 'out', $cmd, $args ), 'test', 'system - captures stdin';
}

SKIP: {
   ($osname eq 'mswin32' or $osname eq 'cygwin')
      and skip 'IPC::Run test - not on MSWin32 or Cygwin', 6;

   eval { require IPC::Run }; $EVAL_ERROR
      and skip 'IPC::Run test - not installed', 6;

   $cmd = [ $perl, '-v' ];

   like run_cmd_test( 'out', $cmd, { use_ipc_run => 1 } ),
      qr{ larry \s+ wall }imsx, 'IPC::Run - captures stdout';

   $cmd = [ $perl, '-e', 'exit 1' ];

   like run_cmd_test( q(), $cmd, { use_ipc_run => 1 } ),
      qr{ Unknown \s+ error }msx, 'IPC::Run - default error string';

   is run_cmd_test( 'rv', $cmd, { expected_rv => 1, use_ipc_run => 1 } ), 1,
      'IPC::Run - expected rv';

   $cmd = [ $perl, '-v' ];
   $r   = run_cmd_test( q(), $cmd, { async => 1, use_ipc_run => 1 } );

   like $r->out, qr{ background }msx, 'IPC::Run - async';

   $cmd = [ sub { print 'Hello World' } ];
   $r   = run_cmd_test( q(), $cmd, { async => 1, use_ipc_run => 1 } );

   like   $r->out, qr{ background }msx, 'IPC::Run - async coderef';
   unlike $r->rv,  qr{ \(-1\) }msx,     'IPC::Run - async coderef captures pid';

   $cmd = [ $perl, '-e', 'sleep 5' ];

   is run_cmd_test( q(), $cmd, { timeout => 1, use_ipc_run => 1 } )->class,
      'TimeOut', 'IPC::Run - timeout';
   wait;

   $cmd = [ $perl, '-e', 'print <>' ];

   my $args = { in => 'test', partition_cmd => 0, use_ipc_run => 1 };

   is run_cmd_test( 'out', $cmd, $args ), 'test', 'IPC::Run - captures stdin';
}

SKIP: {
   $osname eq 'mswin32' and skip 'fork and exec - not on MSWin32', 1;
   $cmd = [ $perl, '-v' ];

   like run_cmd_test( 'out', $cmd ), qr{ larry \s+ wall }imsx,
      'fork and exec - captures stdout';

   my $path = io [ qw( t outfile ) ];

   run_cmd_test( q(), $cmd, { out => $path } );

   like $path->slurp, qr{ larry \s+ wall }imsx,
      'fork and exec - captures stdout to file';

   $path->exists and $path->unlink;
   $cmd = [ $perl, '-e', 'warn "danger"' ];

   like run_cmd_test( 'err', $cmd ), qr{ danger }mx,
      'fork and exec - captures stderr';

   like run_cmd_test( 'out', $cmd, { err => 'out' } ), qr{ danger }mx,
      'fork and exec - dups stderr on stdout';

   $cmd = [ $perl, '-e', 'exit 1' ];

   like run_cmd_test( q(), $cmd ),
      qr{ Unknown \s+ error }msx, 'fork and exec - default error string';

   is run_cmd_test( 'rv', $cmd, { expected_rv => 1 } ), 1,
      'fork and exec - expected rv';

   $cmd = [ $perl, '-v' ];

   like run_cmd_test( 'out', $cmd, { async => 1 } ),
      qr{ background }msx, 'fork and exec - async';

   $cmd = [ sub { print 'Hello World' } ];
   $r   = run_cmd_test( q(), $cmd, { async => 1, out => $path } );

   like    $r->out, qr{ background }msx, 'fork and exec - async coderef';
   unlike  $r->rv,  qr{ \(-1\) }msx,
      'fork and exec - async coderef captures pid';
   waitpid $r->pid, 0;
   is $path->slurp, 'Hello World', 'fork and exec - async coderef writes file';

   $path->exists and $path->unlink;
   $cmd = [ $perl, '-e', 'sleep 5' ];

   is run_cmd_test( q(), $cmd, { timeout => 1 } )->class,
      'TimeOut', 'fork and exec - timeout';

   if (-x '/bin/sleep') {
      $cmd = [ '/bin/sleep', '2' ];
      $r   = run_cmd_test( q(), $cmd, { expected_rv => 255 } );
      is $r->rv, 0, 'fork and exec - external command expected rv';
   }

   $r = run_cmd_test( q(), [ $perl, '-v' ], { detach => 1, out => $path } );

   like $r->out, qr{ background }imsx, 'fork and exec - detaches';
   waitpid $r->pid, 0;

   if ($osname ne 'solaris') {
      like $path->slurp, qr{ larry \s+ wall }imsx,
         'fork and exec - detaches and writes file';
   }
   else {
      my $stat = $path->stat;

      diag sprintf 'File %s size %d mode %o',
         $path, $stat->{size}, $stat->{mode} & 0777;
   }

   $path->exists and $path->unlink;

   is run_cmd_test( 'out', [ $perl, '-e', 'print <>' ], { in => 'test' } ),
      'test', 'fork and exec - captures stdin';

   $r = run_cmd_test( q(), [ '/bin/not_found' ], { expected_rv => 255 } );

   $ENV{AUTHOR_TESTING} and like "${r}", qr{ \Qfailed to exec\E }imx,
      'fork and exec - traps exec failure';
}

# This fails on some platforms. The stderr is not redirected as expected
#eval { $prog->run_cmd( "unknown_command_xa23sd3", { debug => 1 } ) };

#ok $EVAL_ERROR =~ m{ unknown_command }mx, 'unknown command';

done_testing;

# Local Variables:
# mode: perl
# tab-width: 3
# End: