#!/usr/bin/perl -w
# This is the first test program written for POE. It originally was
# written to test POE's ability to dispatch events to inline sessions
# (which was the only kind of sessions at the time). It was later
# amended to test directly calling event handlers, delayed garbage
# collection, and some other things that new developers probably don't
# need to know. :)
use strict;
use lib '../lib';
# use POE always includes POE::Kernel and POE::Session, since they are
# the fundamental POE classes and universally used. POE::Kernel
# exports the $kernel global, a reference to the process' Kernel
# instance. POE::Session exports a number of constants for event
# handler parameter offsets. Some of the offsets are KERNEL, HEAP,
# SESSION, and ARG0-ARG9.
use POE;
# stupid scope trick, part 1 of 3 parts
my $session_name;
#==============================================================================
# This section defines the event handler (or state) subs for the
# sessions that this program calls "child" sessions. Each sub does
# just one thing, possibly passing execution to other event handlers
# through one of the supported event-passing mechanisms.
#------------------------------------------------------------------------------
# Newly created sessions are not ready to run until the kernel
# registers them in its internal data structures. The kernel sends
# every new session a _start event to tell them when they may begin.
sub child_start {
my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
# stupid scope trick, part 2 of 3 parts
$heap->{'name'} = $session_name;
$kernel->sig('INT', 'sigint');
my $sid = $session->ID();
print "Session $heap->{'name'} (SID $sid) started.\n";
return "i am $heap->{'name'} (SID $sid)";
}
#------------------------------------------------------------------------------
# Every session receives a _stop event just prior to being removed
# from memory. This allows sessions to perform last-minute cleanup.
sub child_stop {
my ($session, $heap) = @_[SESSION, HEAP];
my $sid = $session->ID();
print "Session $heap->{'name'} (SID $sid) stopped.\n";
}
#------------------------------------------------------------------------------
# This sub handles a developer-supplied event. It accepts a name and
# a count, increments the count, and displays some information. If
# the count is small enough, it feeds back on itself by posting
# another "increment" message.
sub child_increment {
my ($kernel, $session, $name, $count) =
@_[KERNEL, SESSION, ARG0, ARG1];
$count++;
if ($count % 2) {
$kernel->state('runtime_state', \&child_runtime_state);
}
else {
$kernel->state('runtime_state');
}
my $sid = $session->ID();
print "Session $name (SID $sid), iteration $count...\n";
my $ret = $kernel->call($session, 'display_one', $name, $count);
print "\t(display one returns: $ret)\n";
$ret = $kernel->call($session, 'display_two', $name, $count);
print "\t(display two returns: $ret)\n";
if ($count < 5) {
$kernel->post($session, 'increment', $name, $count);
$kernel->yield('runtime_state', $name, $count);
}
}
#------------------------------------------------------------------------------
# This state is added on every even count. It's removed on every odd
# one. Every count posts an event here.
sub child_runtime_state {
my ($name, $iteration) = @_[ARG0, ARG1];
print( "Session $name received a runtime_state event ",
"during iteration $iteration\n"
);
}
#------------------------------------------------------------------------------
# This sub handles a developer-supplied event. It is called (not
# posted) immediately by the "increment" event handler. It displays
# some information about its parameters, and returns a value. It is
# included to test that $kernel->call() works properly.
sub child_display_one {
my ($name, $count) = @_[ARG0, ARG1];
print "\t(display one, $name, iteration $count)\n";
return $count * 2;
}
#------------------------------------------------------------------------------
# This sub handles a developer-supplied event. It is called (not
# posted) immediately by the "increment" event handler. It displays
# some information about its parameters, and returns a value. It is
# included to test that $kernel->call() works properly.
sub child_display_two {
my ($name, $count) = @_[ARG0, ARG1];
print "\t(display two, $name, iteration $count)\n";
return $count * 3;
}
#------------------------------------------------------------------------------
# This event handler is a helper for child sessions. It returns the
# session's name. Parent sessions should call it directly.
sub child_fetch_name {
$_[HEAP]->{'name'};
}
#==============================================================================
# This section defines the event handler (or state) subs for the
# sessions that this program calls "parent" sessions. Each sub does
# just one thing, possibly passing execution to other event handlers
# through one of the supported event-passing mechanisms.
#------------------------------------------------------------------------------
# Newly created sessions are not ready to run until the kernel
# registers them in its internal data structures. The kernel sends
# every new session a _start event to tell them when they may begin.
sub main_start {
my ($kernel, $heap) = @_[KERNEL, HEAP];
# start ten child sessions
foreach my $name (qw(one two three four five six seven eight nine ten)) {
# stupid scope trick, part 3 of 3 parts
$session_name = $name;
my $session = POE::Session->create(
inline_states => {
_start => \&child_start,
_stop => \&child_stop,
increment => \&child_increment,
display_one => \&child_display_one,
display_two => \&child_display_two,
fetch_name => \&child_fetch_name,
}
);
# Normally, sessions are stopped if they have nothing to do. The
# only exception to this rule is newly created sessions. Their
# garbage collection is delayed slightly, so that parent sessions
# may send them "bootstrap" events. The following post() call is
# such a bootstrap event.
$kernel->post($session, 'increment', $name, 0);
}
}
#------------------------------------------------------------------------------
# POE's _stop events are not mandatory.
sub main_stop {
print "*** Main session stopped.\n";
}
#------------------------------------------------------------------------------
# POE sends a _child event whenever a child session is about to
# receive a _stop event (or has received a _start event). The
# direction argument is either 'gain', 'lose' or 'create', to signify
# whether the child is being given to, taken away from, or created by
# the session (respectively).
sub main_child {
my ($kernel, $session, $direction, $child, $return) =
@_[KERNEL, SESSION, ARG0, ARG1, ARG2];
my $sid = $session->ID();
print( "*** Main session (SID $sid) ${direction}s child ",
$kernel->call($child, 'fetch_name'),
(($direction eq 'create') ? " (child returns: $return)" : ''),
"\n"
);
}
#==============================================================================
# Start the main (parent) session, and begin processing events.
# Kernel::run() will continue until there is nothing left to do.
POE::Session->create(
inline_states => {
_start => \&main_start,
_stop => \&main_stop,
_child => \&main_child,
}
);
$poe_kernel->run();
exit;