This is some code Roderick wrote to validate state names. Otherwise it's trivial to mistype a state or event name and have a program stop running for mysterious reasons.

The code here also sets up constants for state names. Using the constants instead of strings gives you compile time name checking.

#!/usr/bin/perl
# State mapping and validation
#    http://poe.perl.org/?POE_Cookbook/State_Validation
#
# This is ugly.  I want to use constant subs for the state names so
# that I get compile time typo protection.  I also want to have the
# list of state names present in only one place.  I don't see how to
# do both.  I settle for writing the list twice (each state is
# mentioned once here and once when I define its sub), then validating
# that the two lists match at the end.
# Layout is `$Valid_state{$tag}{$state} = $sub_name'.  Eg:
#
#     $Valid_state{irc}{_start}  = "irc__start";
#     $Valid_state{moo}{connect} = "moo_connect";
my %Valid_state;

# All subs with these prefixes are state subs.  This is used to
# validate that they all got into %Valid_state.
my @State_prefix;

# This tag has the given states, the subs implementing them are named
# with this prefix.
sub add_patterned_states {
  my ($tag, $prefix, @state) = @_;
  for my $state (@state) {
    $Valid_state{$tag}{$state} = "$prefix$state";
  }
}

sub add_explicit_states {
  my ($tag, %map) = @_;
  @{$Valid_state{$tag}}{keys %map} = values %map;
}

BEGIN {
  push @State_prefix, 'irc', 'from_irc';

  # sub irc_<state>
  add_patterned_states 'irc', 'irc_', qw(
    _default
    _signal
    _start
    _stop
  );

  # sub from_<state>, PCI's names
  add_patterned_states 'irc', 'from_', qw(
    irc_action
    irc_connected
    irc_disconnected
    irc_join
    irc_kick
    irc_msg
    irc_nick
    irc_notice
    irc_public
    irc_quit
    irc_socketerr
    irc_topic
    irc_error
    irc_part
  );

  # explicit mapping, PCI's names
  add_explicit_states 'irc',
    irc_001 => 'from_irc_welcome',
    irc_432 => 'from_irc_bad_nick',
    irc_433 => 'from_irc_bad_nick',
    irc_332 => 'from_irc_current_topic';

  # sub <state>, my names
  add_patterned_states 'irc', '', qw(
    irc_connect
    irc_bot_emote
    irc_bot_msg
    irc_do_connect
    irc_do_keepalive
    irc_sched_keepalive
    irc_noise
  );
  push @State_prefix, 'moo';

  # sub moo_<state>
  add_patterned_states 'moo', 'moo_', qw(
    _signal
    _start
    _stop
  );

  # sub <state>
  add_patterned_states 'moo', '', qw(
    moo_bot_notice
    moo_bot_output
    moo_cmd
    moo_connect
    moo_connected
    moo_do_connect
    moo_do_keepalive
    moo_failure
    moo_login
    moo_output
    moo_read
    moo_set_topic
    moo_sched_keepalive
    moo_write_line
  );
  push @State_prefix, 'shared';

  # sub <state>
  add_patterned_states 'shared', '', qw(
    shared_connect
    shared_sched_keepalive
  );

  # Set up the ST_<NAME> state subs (eg, ST_IRC__START, ST_MOO_READ).
  foreach my $rhash (values %Valid_state) {
    my %seen;
    create_constant_subs 'ST',
      map { $seen{$_}++ ? () : ($_ => $_) } values %$rhash;
  }
}

sub package_subs {
  my ($pkg) = @_;
  no strict 'refs';
  return grep { defined \&{"${pkg}::$_"} } keys %{"${pkg}::"};
}

# Make sure that all the subs which were created which have state-like
# names are in the %Valid_state lists, and that the %Valid_state lists
# contain don't contain any states which weren't defined.
sub validate_states {
  my (%valid);
  for my $tag (keys %Valid_state) {
    while (my ($state, $sub) = each %{$Valid_state{$tag}}) {
      if ($valid{$sub} && $valid{$sub} ne $tag) {
        die "sub $sub target for states from multiple tags";
      }
      $valid{$sub} = $tag;
    }
  }
  my $prefix_pat = join '|', @State_prefix;
  for my $sub (package_subs __PACKAGE__) {
    next unless $sub =~ /^($prefix_pat)/;
    if (!delete $valid{$sub}) {
      die "state-looking sub $sub isn't in %Valid_state";
    }
  }
  if (%valid) {
    die "states in %Valid_sub which aren't defined: ", join " ", keys %valid;
  }
}

The rest of the program goes here:

# ... program ...
  < /perl> Then at the very end : <perl> BEGIN {
    validate_states;
  }