Re: Creating and shutting down POE::Sessions

#!/usr/bin/perl

use warnings;
use strict;
use 5.010;

use POE qw(Component::Server::TCP);

{
  package Counter;

  use warnings;
  use strict;
  use POE;  # For KERNEL, HEAP, ARG0, etc.

  my %counter;

  # Spawn the Counter session.

  # There may be only one due to the scoping of %counter.
  #
  # A design incorporating multiple Counter sessions would imply each
  # had its own counter namespace.  I'd use $_[HEAP]{counter} in that
  # case.
  #
  # But for now I'm using %counter in closures to simplify the code.

  sub spawn {
    POE::Session->create(
      inline_states => {
        _start => sub {
          # The alias is sufficient to keep this session
          # around as long as other sessions exist.
          $_[KERNEL]->alias_set("counter");
        },
        count => sub {
          my ($kernel, $counter_name) = @_[KERNEL, ARG0];

          # The counter was deleted in stop_counter?
          # By returning here, we stop perpetuating the recursive
          # yield() that drives this counter.

          return unless exists $counter{$counter_name};

          print "Counter $counter_name = ", ++$counter{$counter_name}, "\n";

          # The yield() here perpetuates the counter.
          $kernel->yield( count => $counter_name );
        },
        start_counter => sub {
          my ($kernel, $counter_name) = @_[KERNEL, ARG0];

          # Don't start a counter that's already running.
          return if exists $counter{$counter_name};

          $counter{$counter_name} = 0;
          $kernel->yield( count => $counter_name );
        },
        stop_counter => sub {
          my ($kernel, $counter_name) = @_[KERNEL, ARG0];

          # Don't stop a counter that's not running.
          return unless exists $counter{$counter_name};

          # Deleting the counter stops it.
          delete $counter{$counter_name};
        },
      },
    );
  }

  # These subs that follow are plain class methods.
  #
  # I've put the POE callbacks into anonymous coderefs above to keep
  # them visually distinct from plain methods.  I often also use
  # prefixes like _poe_foo() to indicate private POE callbacks.

  sub start {
    my ($class, $counter_name) = @_;

    # start() passes a message from the client connection session to
    # the counter session.  The counters run in a dedicated session
    # separate from each connection, so connections can come and go
    # independently from counters.

    $poe_kernel->post( counter => start_counter => $counter_name );
  }

  sub stop {
    my ($class, $counter_name) = @_;
    delete $counter{$counter_name};
  }

  sub list {
    return %counter;
  }
}

### Abstract the server into its own package for tidiness.

{
  package Server;

  use warnings;
  use strict;
  use POE;  # For KERNEL, HEAP, ARG0, etc.

  sub spawn {
    my ($class, $port) = @_;

    POE::Component::Server::TCP->new(
      Port            => $port,
      ClientInput     => \&_poe_client_input,
      ClientConnected => \&_poe_client_connected,
    );

    print "Counter server is listening on *:$port...\n";
  }

  sub _poe_client_input {
    my ($kernel, $heap, $input) = @_[KERNEL, HEAP, ARG0];

    print "client input: $input\n";

    if ($input =~ /^start\s+(\S+)/) {
      $heap->{client}->put("Starting counter $1...");
      Counter->start($1);
      return;
    }

    if ($input =~ /^stop\s+(\S+)/) {
      $heap->{client}->put("Stopping counter $1...");
      Counter->stop($1);
      return;
    }

    if ($input eq 'list') {
      my %counters = Counter->list();
      my @counter_names = sort keys %counters;

      if (scalar keys %counters) {
        $heap->{client}->put(
          "Known counters at " . scalar(localtime) . ": " .
          join(", ", map { "$_:$counters{$_}" } sort keys %counters)
        );
      }
      else {
        $heap->{client}->put("No known counters.");
      }

      return;
    }

    $heap->{client}->put("Invalid command '$input'");
    return;
  }

  sub _poe_client_connected {
    $_[HEAP]{client}->put("Type 'start', 'stop', or 'list':");
  }
}

### Main program.
#
# The TCP server could also be abstracted into its own package.

Counter->spawn();
Server->spawn(12345);

POE::Kernel->run();
exit;