The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
# $Id$

#
# Test of Error feature

use strict;

use FindBin;
use lib "$FindBin::Bin/..";

use Test::More tests => 22;
use POE::Component::Generic;
use POE::Session;
use POE::Kernel;

sub DEBUG () { 0 }

my $N = 3;
if( $ENV{HARNESS_PERL_SWITCHES} ) {
    $N *= 5;
}

my $generic;

my $delayed;

POE::Session->create(
    inline_states => {
        _start => sub {
            $generic = POE::Component::Generic->spawn( 
                  alias => 'first',
                  package => 't::P10',
                  object_options => [ delay=>$N ],
                  verbose => 0,
                  debug => DEBUG,
                  error => 'generic_error'
              );
            $poe_kernel->alias_set( 'worker' );
            $poe_kernel->delay( 'autoload', 1 );
        },
        
        ############  $generic->method( {} )
        autoload => sub {
            diag( "$N seconds" );
            $generic->delay( { event=>'autoload_done', wantarray=>1 } );
            $delayed = 1;
            $poe_kernel->delay( 'autoload_during', 2 );
        },
        autoload_during => sub {
            is( $delayed, 1, "Got a POE delay while object was blocking" );
        },
        autoload_done => sub {
            my( $input ) = @_[ ARG0, ARG1 ];
            my( $before, $after ) = @{ $input->{result} };
            $delayed = 0;
            my $delay = $after - $before;
            
            is( $input->{method}, 'delay', "Callback for delay");
            is( $input->{wantarray}, 1, "Wantarray preserved");
            my $delta = abs( $delay - $N );
            ok( ($delta <= 1), "Waited $N seconds")
                or warn "before=$before after=$after delay=$delay";

            
            $poe_kernel->yield( 'post' );
        },

        ############    $poe_kernel->post( $generic => 'method', {} );
        post => sub {
            $poe_kernel->post( 'first', 
                                set_delay => { event=>'post_set' }, 1 );
        },
        post_set => sub {
            $poe_kernel->post( 'first', get_delay => { event=>'post_get' } );
        },
        post_get => sub {
            my( $input, $delay ) = @_[ARG0, ARG1];
            is( $input->{method}, 'get_delay', "Callback for get_delay");
            is( $input->{wantarray}, 0, "Wantarray set");
            is_deeply( $input->{result}, [1], "Got current delay" );
            is( $delay, 1, "Delay is 1" );
            
            $poe_kernel->post( 'first', 
                                delay => { event=>'post_done', wantarray=>1 } );
        },
        post_done => sub {
            my( $input ) = $_[ARG0];
            my( $before, $after ) = @{ $input->{result} };
            my $delay = $after - $before;
            my $delta = abs( $delay - 1 );
            ok( ($delta <= 1), "Waited 1 seconds")
                or warn "before=$before after=$after delay=$delay";
            
            $poe_kernel->yield( 'call' );
        },

        ############    $generic->call( 'method', {} );
        call => sub {
            $generic->set_delay( {}, 2*$N );
            diag( 2*$N . " seconds" );
            $generic->call( delay => { event=>'call_done', wantarray=>1 } );
        },
        call_done => sub {
            my( $input, $before, $after ) = @_[ ARG0, ARG1..$#_ ];

            my $delay = $after - $before;

            is( $input->{method}, 'delay', "Callback for delay");
            is( $input->{wantarray}, 1, "Wantarray preserved");

            is_deeply( $input->{result}, [ $before, $after ], 
                    "{result} same as ARG1, ARG2" );
            my $delta = abs( $delay - 2*$N );
            ok( ($delta <= 1), "Waited ".(2*$N)." seconds")
                or warn "before=$before after=$after delay=$delay";

            $poe_kernel->yield( 'yield' );
        },
        
        ############    $generic->yield( 'method', {} );
        yield => sub {
            $generic->yield( get_delay => { event=>'yield_back',
                                            wantarray=>0 } );
        },
        yield_back => sub {
            my( $input, $delay ) = @_[ARG0, ARG1];

            is( $input->{method}, 'get_delay', "Callback for get_delay");
            is( $input->{wantarray}, 0, "Wantarray preserved");
            is_deeply( $input->{result}, [2*$N], "Got current delay" );
            is( $delay, 2*$N, "Delay is ".(2*$N) );

            $poe_kernel->yield( 'cause_error' );
        },
        
        ############    Test error handling
        cause_error => sub {

            $generic->die_for_your_country( {event=>'got_error' }, 
                                "VIVA PERON!" );
        },

        got_error=> sub {
            my( $resp ) = $_[ARG0];
            ok( $resp->{error}, "I want an error" );
            ok( ( $resp->{error} =~ /VIVA PERON!/ ), "Right-oh" );

            $poe_kernel->yield( 'sing' );
        },

        ############    Test error handling
        sing => sub {
            $generic->sing( { }, "Froggy went a-courtin'" );
            $poe_kernel->delay( 'done', 3 );
        },

        ############    
        done => sub {
            $poe_kernel->post( first => 'shutdown' );
            $poe_kernel->alias_remove( 'worker' );
        },

        ############    
        generic_error => sub {
            my( $resp ) = $_[ARG0];
            ok( $resp->{stderr}, "Only expecting one message on stderr" );
            is( $resp->{stderr}, "Froggy went a-courtin'", "And this is it" );
        }
    }
);

$poe_kernel->run();

ok( 1, "Sane exit" );