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

use strict;
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN { $| = 1; print "1..6\n"; }
use POE::Component::IKC::Server;
use POE::Component::IKC::Channel;
use POE::Component::IKC::Client;
use POE qw(Kernel);
my $loaded = 1;
END {print "not ok 1\n" unless $loaded;}
print "ok 1\n";

######################### End of black magic.

my $Q=2;
sub DEBUG () {0}

###########
# Get a "random" port number
use IO::Socket::INET;
my $sock = IO::Socket::INET->new( LocalAddr => '127.0.0.1', Listen => 1, ReuseAddr => 1 );
our $PORT = $sock->sockport;
undef( $sock );


POE::Component::IKC::Server->spawn(
        port=>$PORT,
        name=>'Inet',
        aliases=>[qw(Ikc)],
    );

Test::Server->spawn();
Test::Client->spawn();

$poe_kernel->run();

ok(6);

###########################################################
sub ok
{
    my($n, $ok, $reason)=@_;
    my $not=(not defined($ok) or $ok) ? '' : "not ";
    if(defined $n) {
        if($n < $Q) {
            $not="not ";
        } elsif($n > $Q) {
            foreach my $i ($Q .. ($n-1)) {
                print "not ok $i\n";
            }
            $Q=$n;
        }
    }
    my $skip='';
    $skip=" # skipped: $reason" if $reason;
    print "${not}ok $Q$skip\n";
    $Q++;
}


############################################################################
package Test::Server;
use strict;
use POE::Session;

BEGIN {
    *ok=\&::ok;
    *DEBUG=\&::DEBUG;
}

###########################################################
sub spawn
{
    my($package)=@_;
    POE::Session->create(
#         args=>[$qref],
        package_states=>[
            $package=>[qw(_start _stop called shutdown)],
        ],
    );
}

###########################################################
sub _start
{
    my($kernel, $heap)=@_[KERNEL, HEAP, ARG0];
    DEBUG and warn "Server: _start\n";
    ok(2);

    $kernel->alias_set('test');
    $kernel->call(IKC=>'publish',  test=>[qw(called)]);

    $kernel->post(IKC=>'monitor', '*'=>{shutdown=>'shutdown'});
}

###########################################################
sub _stop
{
    my($kernel, $heap)=@_[KERNEL, HEAP, ARG0];
    # POE::Component::IKC::Server::__peek( 1 );

    DEBUG and warn "Server: _stop\n";
}


###########################################################
sub called
{
    my($kernel, $heap)=@_[KERNEL, HEAP, ARG0];
    DEBUG and warn "Server: _stop\n";
    ok(3);
    return 4;
}


###########################################################
sub shutdown
{
    my($kernel, $heap, $name, $alias, $is_alias, 
                            )=@_[KERNEL, HEAP, ARG0, ARG1, ARG2];
    DEBUG and warn "Server: shutdown\n";
    $kernel->alias_remove('test');
    ok(5);
}

############################################################################
package Test::Client;
use strict;
use POE::Session;

BEGIN {
    *ok=\&::ok;
    *DEBUG=\&::DEBUG;
}


###########################################################
sub spawn
{
    my($package)=@_;
    POE::Session->create(
        package_states=>[
            $package=>[qw(_start callback)],
        ],
    );
}

###########################################################
sub _start
{
    my($kernel, $heap)=@_[KERNEL, HEAP, ARG0];
    DEBUG and warn "Client: _start\n";

    $kernel->alias_set('TC');

    $kernel->post(IKC=>'call', "poe://Inet/test/called", '', "poe:callback");
}

###########################################################
sub callback
{
    my($kernel, $heap, $n)=@_[KERNEL, HEAP, ARG0];
    DEBUG and warn "Client: callback\n";
    ok($n);
    $kernel->alias_remove('TC');
    $kernel->post(IKC=>'shutdown');
}