#!/usr/bin/perl -w

#
#   POE::Component::Child - Test suite
#   Copyright (C) 2001-2003 Erick Calder
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#

$, = " "; $\ = $/;

my $t1 = 5;    		# number of
my $t2 = 5;    		# tests per
my $t3 = 2;         # section
my $t4 = 3;

# $t1 = $t2 = $t3 = 0;

use Cwd; $CWD = cwd();
$SRV = "$CWD/echosrv";
eval "use File::Temp qw/tempdir/";
$t3 = 0 if $@;

eval "use Test::Simple tests => 4 + $t1 + $t2 + $t3 + $t4";

my $debug = $ENV{DEBUG} || 0;
sub POE::Kernel::TRACE_GARBAGE ()  { 1 }
sub POE::Kernel::ASSERT_DEFAULT () { 1 }

use POE qw(Component::Child Filter::Stream);
ok(1, 'use PoCo::Child'); # If we made it this far, we're ok.

my %t1 = (    				# tests a non-interactive client
    stdout	=> "t1_out",
    stderr	=> "t1_err",
    error	=> "t1_error",
    done	=> "t1_done",
    died	=> "t1_died",
    );

my %t2 = (    				# tests interactive client
    stderr	=> "t2_err",
    error	=> "t2_error",
    died	=> "t2_died",
    );

my %t3 = (
    stdout  => "t3_out",
    );

my %t4 = (
    stderr  => "t4_error",
    died    => "t4_died",
    done    => "t4_done",
    );

my %t = reverse(%t1, %t2, %t3, %t4);

# test non-interactive child

if ($t1) {
    $t1 = POE::Component::Child->new(
    	events => \%t1, debug => $debug
    	);
    ok(defined $t1 && $t1->isa('POE::Component::Child'), "[1] init - non-interactive");
    $t1->run($^X, $SRV, "--stdout");
    }

# test interactive child

if ($t2) {
    $t2 = POE::Component::Child->new(
    	writemap => { quit => "bye" },
    	events => { %t2, done => \&t2_done },
    	debug => $debug
    	);
    ok(defined $t2 && $t2->isa('POE::Component::Child'), "[2] init - interactive");
    $t2->run($^X, $SRV);
    }

# test other stuff

if ($t3) {
    $TMPDIR = tempdir(DIR => cwd(), CLEANUP => 1);
    $t3 = POE::Component::Child->new(
    	events => \%t3, debug => $debug, chdir => $TMPDIR,
    	);
    ok(defined $t3 && $t3->isa('POE::Component::Child'), "[3] init - other");
    $t3->run("pwd");
    }

if ($t4) {
    $t4 = POE::Component::Child->new(
    	events => \%t4, debug => $debug
    	);
    ok(defined $t4 && $t4->isa('POE::Component::Child'), "[4] init - pipe close");
    $t4->run($^X, $SRV);
    }

# create main session

$r = POE::Session->create(
    package_states => [
        main => [ keys %t ]
        ],
    inline_states => {
    	_start => sub {
            $_[KERNEL]->alias_set("main");
            $t2->write("hej");
            $t4->write('hello');
            },
    	_stop => sub { print "_stop" if $debug; },
    	_default => \&_default,
    	}
    );

ok(defined($r), "session created");

# POEtry in motion

POE::Kernel->run();

ok(cwd() eq $CWD, "dir change restored");
ok(1, "all tests successful");

# --- event handlers - non-interactive child ----------------------------------

sub t1_out {
    my ($self, $args) = @_[ARG0 .. $#_];
    local $_ = $args->{out};

    ok(/server/, "[1]: standard output");
    }

sub t1_err {
    my ($self, $args) = @_[ARG0 .. $#_];
    my $err = $args->{out} =~ /server/;
    ok($err, $err ? "[1]: standard error" : "[1]: $args->{out}");
    }

BEGIN { $t1n = 0; }
sub t1_done {
    my ($self, $args) = @_[ARG0 .. $#_];

    if ($t1n++ == 0) {
    	$t1->run($^X, $SRV, "--stderr");
    	}

    else {
    	ok(1, "[1]: done event");
    	$t1->run($^X, $SRV, "--die");
    	}
    }

sub t1_died {
    ok(1, "[1]: died tested");
    }

sub t1_error {
    my ($self, $args) = @_[ARG0 .. $#_];
    ok(0, "[1]: unexpected error: $args->{error}");
    }

# --- event handlers - interactive child --------------------------------------

sub t2_err {
    my ($self, $args) = @_[ARG0 .. $#_];
    ok($args->{out} eq "hej", "[2]: client write tested");
    $t2->quit();
    }

BEGIN { $t2n = 0; }
sub t2_done {
    my ($self, $args) = @_[ARG0 .. $#_];

    if ($t2n++) {
    	ok(0, "[2]: kill problem");
    	return;
    	}

    ok(1, "[2]: callback references");
    ok(1, "[2]: quit method");
    $t2->run($^X, $SRV);
    $t2->kill();
    }

sub t2_died {
    my ($kernel, $self, $args) = @_[KERNEL, ARG0 .. $#_];
    ok(1, "[2]: killed");
    }
    
sub t2_error {
    my ($self, $args) = @_[ARG0 .. $#_];
    ok(0, "[2]: unexpected error: $args->{error}");
    }

sub t3_out {
    my ($self, $args) = @_[ARG0 .. $#_];
    ok($args->{out} eq $TMPDIR, "[3]: dir change");
    }

sub t4_error {
    my ($self, $args) = @_[ARG0 .. $#_];
    ok($args->{out} eq "hello", "[4]: child talks");
    $self->quit();
    }

sub t4_died {
    ok(1, "[4]: stdout closed");
    }

sub t4_done {
    ok(1, "[5]: done");
    }

sub _default {
    return unless $debug;
    print qq/> _default: "$_[ARG0]" event, args: @{$_[ARG1]}/;
    exit if $_[ARG1][0] eq "INT";
    }