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