#!/usr/bin/perl -w

=head1 NAME

io.t - Test suite excercising IPC::Run::IO with IPC::Run::run.

=cut

use strict ;

use Test ;

use IPC::Run qw( :filters run io ) ;
use IPC::Run::Debug qw( _map_fds );
use UNIVERSAL qw( isa ) ;

sub skip_unless_select (&) {
   if ( IPC::Run::Win32_MODE() ) {
      return sub {
         skip "$^O does not allow select() on non-sockets", 0 ;
      } ;
   }
   shift ;
}

my $text    = "Hello World\n" ;

my $emitter_script = qq{print '$text' ; print STDERR uc( '$text' )} ;
##
## $^X is the path to the perl binary.  This is used run all the subprocesses.
##
my @perl    = ( $^X ) ;
my @emitter = ( @perl, '-e', $emitter_script ) ;

my $recv ;
my $send ;

my $in_file  = 'io.t.in' ;
my $out_file = 'io.t.out' ;
my $err_file = 'io.t.err' ;

my $io ;
my $r ;

my $fd_map ;

## TODO: Test filters, etc.

sub slurp($) {
   my ( $f ) = @_ ;
   open( S, "<$f" ) or return "$! '$f'" ;
   my $r = join( '', <S> ) ;
   close S or warn "$! closing '$f'";
   return $r ;
}


sub spit($$) {
   my ( $f, $s ) = @_ ;
   open( S, ">$f" ) or die "$! '$f'" ;
   print S $s       or die "$! '$f'" ;
   close S          or die "$! '$f'" ;
}

sub wipe($) {
   my ( $f ) = @_ ;
   unlink $f or warn "$! unlinking '$f'" if -f $f ;
}



my @tests = (
##
## Parsing
##
sub {
   $io = io( 'foo', '<', \$send ) ;
   ok isa $io, 'IPC::Run::IO' ;
},

sub { ok( io( 'foo', '<',  \$send  )->mode, 'w'  ) },
sub { ok( io( 'foo', '<<', \$send  )->mode, 'wa' ) },
sub { ok( io( 'foo', '>',  \$recv  )->mode, 'r'  ) },
sub { ok( io( 'foo', '>>', \$recv  )->mode, 'ra' ) },

##
## Input from a file
##
skip_unless_select {
   spit $in_file, $text ;
   $recv = 'REPLACE ME' ;
   $fd_map = _map_fds ;
   $r = run io( $in_file, '>', \$recv ) ;
   wipe $in_file ;
   ok( $r ) ;
},
skip_unless_select { ok( ! $? ) },
skip_unless_select { ok( _map_fds, $fd_map ) },

skip_unless_select { ok( $recv, $text ) },

##
## Output to a file
##
skip_unless_select {
   wipe $out_file ;
   $send = $text ;
   $fd_map = _map_fds ;
   $r = run io( $out_file, '<', \$send ) ;
   $recv = slurp $out_file ;
   wipe $out_file ;
   ok( $r ) ;
},
skip_unless_select { ok( ! $? ) },
skip_unless_select { ok( _map_fds, $fd_map ) },

skip_unless_select { ok( $send, $text ) },
skip_unless_select { ok( $recv, $text ) },
) ;

plan tests => scalar @tests ;

$_->() for ( @tests ) ;