#!/usr/bin/perl -w

use strict;

# sub POE::Kernel::TRACE_REFCNT () { 1 }

sub DEBUG () { 0 }

use Test::More tests => 19;

use POE;
use POE::Component::Generic;

my $alt_fork = 1;
my $N = 1;
if( $ENV{HARNESS_PERL_SWITCHES} ) {
    $N *= 5;
}
$alt_fork = 0 if $^O eq 'MSWin32';

my $daemon=0;
#eval "use POE::Component::Daemon; \$daemon++";

my $generic = POE::Component::Generic->spawn( 
          package   => 't::P50',
          methods   => [ qw( new buildthing ) ],
          factories => [ qw( buildthing ) ],
          alt_fork  => $alt_fork,
          verbose   => 1,
          debug     => DEBUG
      );
      
my $C1 = 0;
my $C2 = 0;
my $PID = $$;

my $subobj1;
my $number1;
my $subobj2;

POE::Session->create(
    inline_states => {
        _start => sub {
            $poe_kernel->alias_set( 'worker' );
            diag( "$N seconds" );
            $poe_kernel->delay( 'buildthing', $N );
            if( $daemon ) {
                $poe_kernel->sig( USR1=>'USR1' );
            }
        },
        USR1 => sub { Daemon->__peek( 1 ); },

        _stop => sub {
            DEBUG and warn "_stop";
        },

        #############
        buildthing => sub {
            $generic->buildthing( { event=>'builtthing' }, 
                                    ( number=>17 ) );
        },
        builtthing => sub {
            my( $res, $obj ) = @_[ ARG0, ARG1 ];

            ok( (not $res->{error}), "No errors" )
                        or die "Error = $res->{error}";
            ok( $obj, "Got first object" ); 
            ok( $obj->object_id, "Has an ID" );
            ok( ($obj->object_id =~ /poeAgenericOBJ000000/), 
                    "ID looks like we expect" ) or warn "ID=", $obj->object_id;

            $subobj1 = $obj;



            is( $obj->{package}, 'Duffus', "Nice package" );
            is_deeply( $obj->{package_map}, {new=>'Duffus', number=>'Duffus'},
                        "Nice package_map" );

            $generic->yield( buildthing => { event=>'builtthing2' }, 
                                    ( number=>42 ) );
        },
        builtthing2 => sub {
            my( $res, $obj ) = @_[ ARG0, ARG1 ];

            ok( (not $res->{error}), "No errors" )
                        or die "Error = $res->{error}";
            ok( $obj, "Got second object" ); 
            
            isnt( $obj, $subobj1, "Not the same objects" );
            isnt( $obj->object_id, $subobj1->object_id, "Not the same IDs" );
            
            $subobj2 = $obj;
            $subobj1->number( {event=>'number1'} );     ## psuedo-method
        },
        number1 => sub {
            my( $res, $number ) = @_[ ARG0, ARG1 ];
            ok( (not $res->{error}), "No errors" )
                        or die "Error = $res->{error}";

            is( $number, 17, "Got number 17" ); 
            $number1 = $number;
            $subobj2->yield( 'number', {event=>'number2'} );    ## yield
        },
        number2 => sub {
            my( $res, $number ) = @_[ ARG0, ARG1 ];
            ok( (not $res->{error}), "No errors" )
                        or die "Error = ", join "\n", @{$res->{errors}};

            isnt( $number, $number1, "Not the same number" );

            $subobj1->call( 'number', {event=>'number3'} );     ## call
        },
        number3 => sub {
            my( $res, $number ) = @_[ ARG0, ARG1 ];
            ok( (not $res->{error}), "No errors" )
                        or die "Error = ", join "\n", @{$res->{errors}};

            is( $number, $number1, "Got the same number" );

            my $id = $subobj1->object_id;

            undef( $subobj1 );
            $poe_kernel->yield( 'not_object', $id );
        },

        #############           # call a method on an unknown object
        not_object => sub {
            my $id = $_[ARG0];
            $generic->buildthing( {event=>'not_not', data=>$id,
                                  obj=>$id } );
        },

        not_not => sub {
            my( $resp, $something ) = @_[ARG0..$#_];
            my $id = $resp->{data};
            ok( $resp->{error}, "Expecting error" );
            ok( ($resp->{error} =~ /$id/), "Right-oh" ) 
                or warn "Error: $resp->{error}";

            eval {
                $subobj2->HONK();                
            };
            ok( ($@ =~ /HONK/), "AUTOLOAD error OK" );


            $poe_kernel->yield( 'done' );
        },
        
        done => sub {        

            $generic->shutdown;
        },



    },
);

$poe_kernel->run;



syntax highlighted by Code2HTML, v. 0.9.1