sessions.perl

#!/usr/bin/perl -w
# $Id$

# 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;