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;

use lib qw(blib/lib blib/arch);

use POE qw(Session);
use POE::Component::IKC::Server;
use POE::Component::IKC::Specifier;

# Very simple time pulse session
# Foreign sessions connect to it via 'connect' events and
# disconect with 'disconnect'.
# Every 10 seconds, a 'pulse' event is sent to connected sessions.


POE::Component::IKC::Server->spawn(
    port=>31336,                # elite--
    name=>'Pulse2');       

POE::Session->new
(
    _start=>\&time_start,
#    _stop=>\&time_stop,
    'connect'=>\&time_connect,
    'disconnect'=>\&time_disconnect,    
    'pulse'=>\&time_pulse,
);

print "Running server...\n";
$poe_kernel->run();
print "Server exited...\n";

#############################################
sub time_start
{
    my($kernel, $session, $heap)=@_[KERNEL, SESSION, HEAP];
    $heap->{listeners}={};
    $kernel->alias_set('timeserver');
    $kernel->delay('pulse', 10-(time%10));
    $kernel->call('IKC', 'publish', 'timeserver',
            [qw(connect disconnect)]);
#    $session->option(default=>1);
}

#############################################
sub time_stop
{
    my($heap)=$_[HEAP];
    $heap->{listeners}={};
}

#############################################
sub time_connect
{
    my($kernel, $heap, $dest)=@_[KERNEL, HEAP, ARG0];
    my $name=specifier_name($dest);
    print "Connected $name\n";
    $heap->{listeners}->{$name}=$dest;
}

#############################################
sub time_disconnect
{
    my($kernel, $heap, $dest)=@_[KERNEL, HEAP, ARG0];
    my $name=specifier_name($dest);
    print "Disconnected $name\n";
    delete $heap->{listeners}->{$name};
}

#############################################
sub time_pulse
{
    my($kernel, $heap)=@_[KERNEL, HEAP];
    my $now=localtime;
    $kernel->delay('pulse', 10-(time%10));

    while(my($name, $dest)=each %{$heap->{listeners}})
    {
        print "$name -- $now\n";
        $kernel->call('IKC', 'post', $dest, $now)
                or $kernel->yield('disconnect', $dest);
    }
    return;
}