The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!./perl
use strict;
use Test;
use Event qw(loop unloop);
use Event::type qw(tcplisten tcpsession);

my $debug=0;
if ($debug) {
    require NetServer::ProcessTop;
}

my $port = 7000 + int rand 2000;
my $pid;
if (($pid=fork) == 0) { # SERVER (child)
    'NetServer::ProcessTop'->import()
	if $debug;
    #sleep 1;

    my $finishing;
    my $api = [
	   { name => 'hello', reply=>'', code => sub { 'world' } },
	   {
	    name => 'tickle', req => 'n', reply => '', code => sub {
		'he' x $_[1]
	    }
	   },
	   { name => 'finishing', code => sub {
		 my ($o) = @_;
		 $finishing=1;
		 $o->rpc('ok', 1);
	     } },
	      ];

    Event->tcplisten(port => $port, cb => sub {
			 my ($w, $sock) = @_;
			 # warn "client on ".fileno($sock);
			 my $o = Event->tcpsession(desc => 'server',
						   fd => $sock, api => $api);
		     });

    Event->timer(desc => 'shutdown', interval => 1, cb => sub {
		     my $c = grep { ref eq 'Event::tcpsession' } Event::all_watchers;
		     unloop(0) if ($finishing and $c == 0);
		 });

    exit loop();

} else {  # CLIENT
    'NetServer::ProcessTop'->import()
	if $debug;
    # $Event::DebugLevel = 4;
    my $Tests = 14;
    plan test => $Tests;

    my $api = [
	   { name => 'ok', req => 'n', code => sub { ok $_[1] } },
	      ];

    my $c = Event->tcpsession(desc => 'client', port => $port, api => $api,
			      cb => sub {
				  my ($w) = @_;
				  $_[2] ||= 'ok';
				  my $fn = $w->fd? fileno($w->fd) : 'undef';
				  # warn "Status: fd=$fn $_[1], $_[2]\n";
			      });
    ok ref $c, 'Event::tcpsession';
    
    Event->timer(desc => 'break connection', after => 4, cb => sub {
		     $c->fd(undef);  # (oops! :-)
		     # $c->debug(1);
		     $c->now;        # otherwise wont notice
		     #warn "Broke connection in order to test recovery...\n";
		     $c->rpc('finishing');
		 });

    $c->rpc('hello', sub{ ok $_[1], 'world'; });

    my $tickled=1;
    Event->timer(interval => 1, cb => sub {
		     shift->w->cancel
			 if ++$tickled > 10;
		     my $expect = $tickled;
		     $c->rpc('tickle', sub {
				 my ($o,$got) = @_; 
				 ok $got, 'he' x $expect;
			     }, $tickled);
		 });

    Event->timer(desc => 'shutdown', interval => .5, cb => sub {
		     unloop if $Test::ntest > $Tests-1
		 });

    loop();
    $c->fd(undef);

    #warn "Waiting for $pid...";
    wait; ok !$?;
}