home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / NFA.pm < prev    next >
Encoding:
Perl POD Document  |  2004-01-05  |  29.5 KB  |  1,001 lines

  1. # $Id: NFA.pm,v 1.28 2004/01/05 22:37:36 rcaputo Exp $
  2.  
  3. package POE::NFA;
  4.  
  5. use strict;
  6.  
  7. use vars qw($VERSION);
  8. $VERSION = do {my@r=(q$Revision: 1.28 $=~/\d+/g);sprintf"%d."."%04d"x$#r,@r};
  9.  
  10. use Carp qw(carp croak);
  11.  
  12. sub SPAWN_INLINES       () { 'inline_states' }
  13. sub SPAWN_OPTIONS       () { 'options' }
  14.  
  15. sub OPT_TRACE           () { 'trace' }
  16. sub OPT_DEBUG           () { 'debug' }
  17. sub OPT_DEFAULT         () { 'default' }
  18.  
  19. sub EN_DEFAULT          () { '_default' }
  20. sub EN_START            () { '_start' }
  21. sub EN_STOP             () { '_stop' }
  22. sub EN_SIGNAL           () { '_signal' }
  23.  
  24. sub NFA_EN_GOTO_STATE   () { 'poe_nfa_goto_state' }
  25. sub NFA_EN_POP_STATE    () { 'poe_nfa_pop_state' }
  26. sub NFA_EN_PUSH_STATE   () { 'poe_nfa_push_state' }
  27. sub NFA_EN_STOP         () { 'poe_nfa_stop' }
  28.  
  29. sub SELF_RUNSTATE       () { 0 }
  30. sub SELF_OPTIONS        () { 1 }
  31. sub SELF_STATES         () { 2 }
  32. sub SELF_CURRENT        () { 3 }
  33. sub SELF_STATE_STACK    () { 4 }
  34. sub SELF_INTERNALS      () { 5 }
  35. sub SELF_CURRENT_NAME   () { 6 }
  36. sub SELF_IS_IN_INTERNAL () { 7 }
  37.  
  38. sub STACK_STATE         () { 0 }
  39. sub STACK_EVENT         () { 1 }
  40.  
  41. #------------------------------------------------------------------------------
  42.  
  43. # Shorthand for defining a trace constant.
  44. sub define_trace {
  45.   no strict 'refs';
  46.   foreach my $name (@_) {
  47.     next if defined *{"TRACE_$name"}{CODE};
  48.     if (defined *{"POE::Kernel::TRACE_$name"}{CODE}) {
  49.       eval(
  50.         "sub TRACE_$name () { " .
  51.         *{"POE::Kernel::TRACE_$name"}{CODE}->() .
  52.         "}"
  53.       );
  54.       die if $@;
  55.     }
  56.     else {
  57.       eval "sub TRACE_$name () { TRACE_DEFAULT }";
  58.       die if $@;
  59.     }
  60.   }
  61. }
  62.  
  63. #------------------------------------------------------------------------------
  64.  
  65. BEGIN {
  66.  
  67.   # ASSERT_DEFAULT changes the default value for other ASSERT_*
  68.   # constants.  It inherits POE::Kernel's ASSERT_DEFAULT value, if
  69.   # it's present.
  70.  
  71.   unless (defined &ASSERT_DEFAULT) {
  72.     if (defined &POE::Kernel::ASSERT_DEFAULT) {
  73.       eval( "sub ASSERT_DEFAULT () { " . &POE::Kernel::ASSERT_DEFAULT . " }" );
  74.     }
  75.     else {
  76.       eval 'sub ASSERT_DEFAULT () { 0 }';
  77.     }
  78.   };
  79.  
  80.   # TRACE_DEFAULT changes the default value for other TRACE_*
  81.   # constants.  It inherits POE::Kernel's TRACE_DEFAULT value, if
  82.   # it's present.
  83.  
  84.   unless (defined &TRACE_DEFAULT) {
  85.     if (defined &POE::Kernel::TRACE_DEFAULT) {
  86.       eval( "sub TRACE_DEFAULT () { " . &POE::Kernel::TRACE_DEFAULT . " }" );
  87.     }
  88.     else {
  89.       eval 'sub TRACE_DEFAULT () { 0 }';
  90.     }
  91.   };
  92.  
  93.   define_trace("DESTROY");
  94. }
  95.  
  96. #------------------------------------------------------------------------------
  97. # Export constants into calling packages.  This is evil; perhaps
  98. # EXPORT_OK instead?  The parameters NFA has in common with SESSION
  99. # (and other sessions) must be kept at the same offsets as each-other.
  100.  
  101. sub OBJECT      () {  0 }
  102. sub MACHINE     () {  1 }
  103. sub KERNEL      () {  2 }
  104. sub RUNSTATE    () {  3 }
  105. sub EVENT       () {  4 }
  106. sub SENDER      () {  5 }
  107. sub STATE       () {  6 }
  108. sub CALLER_FILE () {  7 }
  109. sub CALLER_LINE () {  8 }
  110. sub ARG0        () {  9 }
  111. sub ARG1        () { 10 }
  112. sub ARG2        () { 11 }
  113. sub ARG3        () { 12 }
  114. sub ARG4        () { 13 }
  115. sub ARG5        () { 14 }
  116. sub ARG6        () { 15 }
  117. sub ARG7        () { 16 }
  118. sub ARG8        () { 17 }
  119. sub ARG9        () { 18 }
  120.  
  121. sub import {
  122.   my $package = caller();
  123.   no strict 'refs';
  124.   *{ $package . '::OBJECT'   } = \&OBJECT;
  125.   *{ $package . '::MACHINE'  } = \&MACHINE;
  126.   *{ $package . '::KERNEL'   } = \&KERNEL;
  127.   *{ $package . '::RUNSTATE' } = \&RUNSTATE;
  128.   *{ $package . '::EVENT'    } = \&EVENT;
  129.   *{ $package . '::SENDER'   } = \&SENDER;
  130.   *{ $package . '::STATE'    } = \&STATE;
  131.   *{ $package . '::ARG0'     } = \&ARG0;
  132.   *{ $package . '::ARG1'     } = \&ARG1;
  133.   *{ $package . '::ARG2'     } = \&ARG2;
  134.   *{ $package . '::ARG3'     } = \&ARG3;
  135.   *{ $package . '::ARG4'     } = \&ARG4;
  136.   *{ $package . '::ARG5'     } = \&ARG5;
  137.   *{ $package . '::ARG6'     } = \&ARG6;
  138.   *{ $package . '::ARG7'     } = \&ARG7;
  139.   *{ $package . '::ARG8'     } = \&ARG8;
  140.   *{ $package . '::ARG9'     } = \&ARG9;
  141. }
  142.  
  143. #------------------------------------------------------------------------------
  144. # Spawn a new state machine.
  145.  
  146. sub spawn {
  147.   my ($type, @params) = @_;
  148.   my @args;
  149.  
  150.   # We treat the parameter list strictly as a hash.  Rather than dying
  151.   # here with a Perl error, we'll catch it and blame it on the user.
  152.  
  153.   croak "odd number of events/handlers (missing one or the other?)"
  154.     if @params & 1;
  155.   my %params = @params;
  156.  
  157.   croak "$type requires a working Kernel"
  158.     unless defined $POE::Kernel::poe_kernel;
  159.  
  160.   # Options are optional.
  161.   my $options = delete $params{+SPAWN_OPTIONS};
  162.   $options = { } unless defined $options;
  163.  
  164.   # States are required.
  165.   croak "$type constructor requires a SPAWN_INLINES parameter"
  166.     unless exists $params{+SPAWN_INLINES};
  167.   my $states = delete $params{+SPAWN_INLINES};
  168.  
  169.   # These are unknown.
  170.   croak( "$type constructor does not recognize these parameter names: ",
  171.          join(', ', sort(keys(%params)))
  172.        ) if keys %params;
  173.  
  174.   # Build me.
  175.   my $self =
  176.     bless [ { },        # SELF_RUNSTATE
  177.             $options,   # SELF_OPTIONS
  178.             $states,    # SELF_STATES
  179.             undef,      # SELF_CURRENT
  180.             [ ],        # SELF_STATE_STACK
  181.             { },        # SELF_INTERNALS
  182.             '(undef)',  # SELF_CURRENT_NAME
  183.             0,          # SELF_IS_IN_INTERNAL
  184.           ], $type;
  185.  
  186.   # Register the machine with the POE kernel.
  187.   $POE::Kernel::poe_kernel->session_alloc($self);
  188.  
  189.   # Return it for immediate reuse.
  190.   return $self;
  191. }
  192.  
  193. #------------------------------------------------------------------------------
  194. # Another good inheritance candidate.
  195.  
  196. sub DESTROY {
  197.   my $self = shift;
  198.  
  199.   # NFA's data structures are destroyed through Perl's usual garbage
  200.   # collection.  TRACE_DESTROY here just shows what's in the session
  201.   # before the destruction finishes.
  202.  
  203.   TRACE_DESTROY and do {
  204.     POE::Kernel::_warn(
  205.       "----- NFA $self Leak Check -----\n",
  206.       "-- Namespace (HEAP):\n"
  207.     );
  208.     foreach (sort keys (%{$self->[SELF_RUNSTATE]})) {
  209.       POE::Kernel::_warn("   $_ = ", $self->[SELF_RUNSTATE]->{$_}, "\n");
  210.     }
  211.     POE::Kernel::_warn("-- Options:\n");
  212.     foreach (sort keys (%{$self->[SELF_OPTIONS]})) {
  213.       POE::Kernel::_warn("   $_ = ", $self->[SELF_OPTIONS]->{$_}, "\n");
  214.     }
  215.     POE::Kernel::_warn("-- States:\n");
  216.     foreach (sort keys (%{$self->[SELF_STATES]})) {
  217.       POE::Kernel::_warn("   $_ = ", $self->[SELF_STATES]->{$_}, "\n");
  218.     }
  219.   };
  220. }
  221.  
  222. #------------------------------------------------------------------------------
  223.  
  224. sub _invoke_state {
  225.   my ($self, $sender, $event, $args, $file, $line) = @_;
  226.  
  227.   # Trace the state invocation if tracing is enabled.
  228.  
  229.   if ($self->[SELF_OPTIONS]->{+OPT_TRACE}) {
  230.     POE::Kernel::_warn(
  231.       $POE::Kernel::poe_kernel->ID_session_to_id($self), " -> $event\n"
  232.     );
  233.   }
  234.  
  235.   # Discard troublesome things.
  236.   return if $event eq EN_START;
  237.   return if $event eq EN_STOP;
  238.  
  239.   # Stop request has come through the queue.  Shut us down.
  240.   if ($event eq NFA_EN_STOP) {
  241.     $POE::Kernel::poe_kernel->_data_ses_stop( $self );
  242.     return;
  243.   }
  244.  
  245.   # Make a state transition.
  246.   if ($event eq NFA_EN_GOTO_STATE) {
  247.     my ($new_state, $enter_event, @enter_args) = @$args;
  248.  
  249.     # Make sure the new state exists.
  250.     POE::Kernel::_die(
  251.       $POE::Kernel::poe_kernel->ID_session_to_id($self),
  252.       " tried to enter nonexistent state '$new_state'\n"
  253.     )
  254.     unless exists $self->[SELF_STATES]->{$new_state};
  255.  
  256.     # If an enter event was specified, make sure that exists too.
  257.     POE::Kernel::_die(
  258.       $POE::Kernel::poe_kernel->ID_session_to_id($self),
  259.       " tried to invoke nonexistent enter event '$enter_event' ",
  260.       "in state '$new_state'\n"
  261.     )
  262.     unless (
  263.       not defined $enter_event or
  264.       ( length $enter_event and
  265.         exists $self->[SELF_STATES]->{$new_state}->{$enter_event}
  266.       )
  267.     );
  268.  
  269.     # Invoke the current state's leave event, if one exists.
  270.     $self->_invoke_state( $self, 'leave', [], undef, undef )
  271.       if exists $self->[SELF_CURRENT]->{leave};
  272.  
  273.     # Enter the new state.
  274.     $self->[SELF_CURRENT]      = $self->[SELF_STATES]->{$new_state};
  275.     $self->[SELF_CURRENT_NAME] = $new_state;
  276.  
  277.     # Invoke the new state's enter event, if requested.
  278.     $self->_invoke_state( $self, $enter_event, \@enter_args, undef, undef )
  279.       if defined $enter_event;
  280.  
  281.     return undef;
  282.   }
  283.  
  284.   # Push a state transition.
  285.   if ($event eq NFA_EN_PUSH_STATE) {
  286.  
  287.     my @args = @$args;
  288.     push( @{$self->[SELF_STATE_STACK]},
  289.           [ $self->[SELF_CURRENT_NAME], # STACK_STATE
  290.             shift(@args),               # STACK_EVENT
  291.           ]
  292.         );
  293.     $self->_invoke_state( $self, NFA_EN_GOTO_STATE, \@args, undef, undef );
  294.  
  295.     return undef;
  296.   }
  297.  
  298.   # Pop a state transition.
  299.   if ($event eq NFA_EN_POP_STATE) {
  300.  
  301.     POE::Kernel::_die(
  302.       $POE::Kernel::poe_kernel->ID_session_to_id($self),
  303.       " tried to pop a state from an empty stack\n"
  304.     )
  305.     unless @{ $self->[SELF_STATE_STACK] };
  306.  
  307.     my ($previous_state, $previous_event) =
  308.       @{ pop @{ $self->[SELF_STATE_STACK] } };
  309.     $self->_invoke_state( $self, NFA_EN_GOTO_STATE,
  310.                           [ $previous_state, $previous_event, @$args ],
  311.                           undef, undef
  312.                         );
  313.  
  314.     return undef;
  315.   }
  316.  
  317.   # Stop.
  318.  
  319.   # Try to find the event handler in the current state or the internal
  320.   # event handlers used by wheels and the like.
  321.   my ( $handler, $is_in_internal );
  322.  
  323.   if (exists $self->[SELF_CURRENT]->{$event}) {
  324.     $handler = $self->[SELF_CURRENT]->{$event};
  325.   }
  326.  
  327.   elsif (exists $self->[SELF_INTERNALS]->{$event}) {
  328.     $handler = $self->[SELF_INTERNALS]->{$event};
  329.     $is_in_internal = ++$self->[SELF_IS_IN_INTERNAL];
  330.   }
  331.  
  332.   # If it wasn't found in either of those, then check for _default in
  333.   # the current state.
  334.   elsif (exists $self->[SELF_CURRENT]->{+EN_DEFAULT}) {
  335.     # If we get this far, then there's a _default event to redirect
  336.     # the event to.  Trace the redirection.
  337.     if ($self->[SELF_OPTIONS]->{+OPT_TRACE}) {
  338.       POE::Kernel::_warn(
  339.         $POE::Kernel::poe_kernel->ID_session_to_id($self),
  340.         " -> $event redirected to EN_DEFAULT in state ",
  341.         "'$self->[SELF_CURRENT_NAME]'\n"
  342.       );
  343.     }
  344.  
  345.     $handler = $self->[SELF_CURRENT]->{+EN_DEFAULT};
  346.  
  347.     # Fix up ARG0.. for _default.
  348.     $args  = [ $event, $args ];
  349.     $event = EN_DEFAULT;
  350.   }
  351.  
  352.   # No external event handler, no internal event handler, and no
  353.   # external _default handler.  This is a grievous error, and now we
  354.   # must die.
  355.   elsif ($event ne EN_SIGNAL) {
  356.     POE::Kernel::_die(
  357.       "a '$event' event was sent from $file at $line to session ",
  358.       $POE::Kernel::poe_kernel->ID_session_to_id($self),
  359.       ", but session ", $POE::Kernel::poe_kernel->ID_session_to_id($self),
  360.       " has neither a handler for it nor one for _default ",
  361.       "in its current state, '$self->[SELF_CURRENT_NAME]'\n"
  362.     );
  363.   }
  364.  
  365.   # Inline event handlers are invoked this way.
  366.  
  367.   my $return;
  368.   if (ref($handler) eq 'CODE') {
  369.     $return = $handler->
  370.       ( undef,                      # OBJECT
  371.         $self,                      # MACHINE
  372.         $POE::Kernel::poe_kernel,   # KERNEL
  373.         $self->[SELF_RUNSTATE],     # RUNSTATE
  374.         $event,                     # EVENT
  375.         $sender,                    # SENDER
  376.         $self->[SELF_CURRENT_NAME], # STATE
  377.         $file,                      # CALLER_FILE_NAME
  378.         $line,                      # CALLER_FILE_LINE
  379.         @$args                      # ARG0..
  380.       );
  381.   }
  382.  
  383.   # Package and object handlers are invoked this way.
  384.  
  385.   else {
  386.     my ($object, $method) = @$handler;
  387.     $return = $object->$method      # OBJECT (package, implied)
  388.       ( $self,                      # MACHINE
  389.         $POE::Kernel::poe_kernel,   # KERNEL
  390.         $self->[SELF_RUNSTATE],     # RUNSTATE
  391.         $event,                     # EVENT
  392.         $sender,                    # SENDER
  393.         $self->[SELF_CURRENT_NAME], # STATE
  394.         $file,                      # CALLER_FILE_NAME
  395.         $line,                      # CALLER_FILE_LINE
  396.         @$args                      # ARG0..
  397.       );
  398.   }
  399.  
  400.   $self->[SELF_IS_IN_INTERNAL]-- if $is_in_internal;
  401.  
  402.   return $return;
  403. }
  404.  
  405. #------------------------------------------------------------------------------
  406. # Add, remove or replace event handlers in the session.  This is going
  407. # to be tricky since wheels need this but the event handlers can't be
  408. # limited to a single state.  I think they'll go in a hidden internal
  409. # state, or something.
  410.  
  411. sub register_state {
  412.   my ($self, $name, $handler, $method) = @_;
  413.   $method = $name unless defined $method;
  414.  
  415.   # Deprecate _signal.
  416.   if ($name eq EN_SIGNAL) {
  417.  
  418.     # Report the problem outside POE.
  419.     my $caller_level = 0;
  420.     local $Carp::CarpLevel = 1;
  421.     while ( (caller $caller_level)[0] =~ /^POE::/ ) {
  422.       $caller_level++;
  423.       $Carp::CarpLevel++;
  424.     }
  425.  
  426.     croak(
  427.       ",----- DEPRECATION ERROR -----\n",
  428.       "| The _signal event is deprecated.  Please use sig() to register\n",
  429.       "| an explicit signal handler instead.\n",
  430.       "`-----------------------------\n",
  431.    );
  432.   }
  433.   # There is a handler, so try to define the state.  This replaces an
  434.   # existing state.
  435.  
  436.   if ($handler) {
  437.  
  438.     # Coderef handlers are inline states.
  439.  
  440.     if (ref($handler) eq 'CODE') {
  441.       POE::Kernel::_carp(
  442.         "redefining handler for event($name) for session(",
  443.         $POE::Kernel::poe_kernel->ID_session_to_id($self), ")"
  444.       )
  445.       if ( $self->[SELF_OPTIONS]->{+OPT_DEBUG} &&
  446.            (exists $self->[SELF_INTERNALS]->{$name})
  447.       );
  448.       $self->[SELF_INTERNALS]->{$name} = $handler;
  449.     }
  450.  
  451.     # Non-coderef handlers may be package or object states.  See if
  452.     # the method belongs to the handler.
  453.  
  454.     elsif ($handler->can($method)) {
  455.       POE::Kernel::_carp(
  456.         "redefining handler for event($name) for session(",
  457.         $POE::Kernel::poe_kernel->ID_session_to_id($self), ")"
  458.       )
  459.       if (
  460.         $self->[SELF_OPTIONS]->{+OPT_DEBUG} &&
  461.         (exists $self->[SELF_INTERNALS]->{$name})
  462.       );
  463.       $self->[SELF_INTERNALS]->{$name} = [ $handler, $method ];
  464.     }
  465.  
  466.     # Something's wrong.  This code also seems wrong, since
  467.     # ref($handler) can't be 'CODE'.
  468.  
  469.     else {
  470.       if (
  471.         (ref($handler) eq 'CODE') and
  472.         $self->[SELF_OPTIONS]->{+OPT_TRACE}
  473.       ) {
  474.         POE::Kernel::_carp(
  475.           $self->fetch_id(),
  476.           " : handler for event($name) is not a proper ref - not registered"
  477.         )
  478.       }
  479.       else {
  480.         unless ($handler->can($method)) {
  481.           if (length ref($handler)) {
  482.             croak "object $handler does not have a '$method' method"
  483.           }
  484.           else {
  485.             croak "package $handler does not have a '$method' method";
  486.           }
  487.         }
  488.       }
  489.     }
  490.   }
  491.  
  492.   # No handler.  Delete the state!
  493.  
  494.   else {
  495.     delete $self->[SELF_INTERNALS]->{$name};
  496.   }
  497. }
  498.  
  499. #------------------------------------------------------------------------------
  500. # Return the session's ID.  This is a thunk into POE::Kernel, where
  501. # the session ID really lies.  This is a good inheritance candidate.
  502.  
  503. sub ID {
  504.   $POE::Kernel::poe_kernel->ID_session_to_id(shift);
  505. }
  506.  
  507. #------------------------------------------------------------------------------
  508. # Return the session's current state's name.
  509.  
  510. sub get_current_state {
  511.   my $self = shift;
  512.   return $self->[SELF_CURRENT_NAME];
  513. }
  514.  
  515. #------------------------------------------------------------------------------
  516.  
  517. # Fetch the session's run state.  In rare cases, libraries may need to
  518. # break encapsulation this way, probably also using
  519. # $kernel->get_current_session as an accessory to the crime.
  520.  
  521. sub get_runstate {
  522.   my $self = shift;
  523.   return $self->[SELF_RUNSTATE];
  524. }
  525.  
  526. #------------------------------------------------------------------------------
  527. # Set or fetch session options.  This is virtually identical to
  528. # POE::Session and a good inheritance candidate.
  529.  
  530. sub option {
  531.   my $self = shift;
  532.   my %return_values;
  533.  
  534.   # Options are set in pairs.
  535.  
  536.   while (@_ >= 2) {
  537.     my ($flag, $value) = splice(@_, 0, 2);
  538.     $flag = lc($flag);
  539.  
  540.     # If the value is defined, then set the option.
  541.  
  542.     if (defined $value) {
  543.  
  544.       # Change some handy values into boolean representations.  This
  545.       # clobbers the user's original values for the sake of DWIM-ism.
  546.  
  547.       ($value = 1) if ($value =~ /^(on|yes|true)$/i);
  548.       ($value = 0) if ($value =~ /^(no|off|false)$/i);
  549.  
  550.       $return_values{$flag} = $self->[SELF_OPTIONS]->{$flag};
  551.       $self->[SELF_OPTIONS]->{$flag} = $value;
  552.     }
  553.  
  554.     # Remove the option if the value is undefined.
  555.  
  556.     else {
  557.       $return_values{$flag} = delete $self->[SELF_OPTIONS]->{$flag};
  558.     }
  559.   }
  560.  
  561.   # If only one option is left, then there's no value to set, so we
  562.   # fetch its value.
  563.  
  564.   if (@_) {
  565.     my $flag = lc(shift);
  566.     $return_values{$flag} =
  567.       ( exists($self->[SELF_OPTIONS]->{$flag})
  568.         ? $self->[SELF_OPTIONS]->{$flag}
  569.         : undef
  570.       );
  571.   }
  572.  
  573.   # If only one option was set or fetched, then return it as a scalar.
  574.   # Otherwise return it as a hash of option names and values.
  575.  
  576.   my @return_keys = keys(%return_values);
  577.   if (@return_keys == 1) {
  578.     return $return_values{$return_keys[0]};
  579.   }
  580.   else {
  581.     return \%return_values;
  582.   }
  583. }
  584.  
  585. #------------------------------------------------------------------------------
  586. # This stuff is identical to the stuff in POE::Session.  Good
  587. # inheritance candidate.
  588.  
  589. # Create an anonymous sub that, when called, posts an event back to a
  590. # session.  This is highly experimental code to support Tk widgets and
  591. # maybe Event callbacks.  There's no guarantee that this code works
  592. # yet, nor is there one that it'll be here in the next version.
  593.  
  594. # This maps postback references (stringified; blessing, and thus
  595. # refcount, removed) to parent session IDs.  Members are set when
  596. # postbacks are created, and postbacks' DESTROY methods use it to
  597. # perform the necessary cleanup when they go away.  Thanks to njt for
  598. # steering me right on this one.
  599.  
  600. my %postback_parent_id;
  601.  
  602. # I assume that when the postback owner loses all reference to it,
  603. # they are done posting things back to us.  That's when the postback's
  604. # DESTROY is triggered, and referential integrity is maintained.
  605.  
  606. sub POE::NFA::Postback::DESTROY {
  607.   my $self = shift;
  608.   my $parent_id = delete $postback_parent_id{$self};
  609.   $POE::Kernel::poe_kernel->refcount_decrement( $parent_id, 'postback' );
  610. }
  611.  
  612. # Tune postbacks depending on variations in toolkit behavior.
  613.  
  614. BEGIN {
  615.   # Tk blesses its callbacks internally, so we need to wrap our
  616.   # blessed callbacks in unblessed ones.  Otherwise our postback's
  617.   # DESTROY method probably won't be called.
  618.   if (exists $INC{'Tk.pm'}) {
  619.     eval 'sub USING_TK () { 1 }';
  620.   }
  621.   else {
  622.     eval 'sub USING_TK () { 0 }';
  623.   }
  624. };
  625.  
  626. # Create a postback closure, maintaining referential integrity in the
  627. # process.  The next step is to give it to something that expects to
  628. # be handed a callback.
  629.  
  630. sub postback {
  631.   my ($self, $event, @etc) = @_;
  632.   my $id = $POE::Kernel::poe_kernel->ID_session_to_id(shift);
  633.  
  634.   my $postback = bless sub {
  635.     $POE::Kernel::poe_kernel->post( $id, $event, [ @etc ], [ @_ ] );
  636.     return 0;
  637.   }, 'POE::NFA::Postback';
  638.  
  639.   $postback_parent_id{$postback} = $id;
  640.   $POE::Kernel::poe_kernel->refcount_increment( $id, 'postback' );
  641.  
  642.   # Tk blesses its callbacks, so we must present one that isn't
  643.   # blessed.  Otherwise Tk's blessing would divert our DESTROY call to
  644.   # its own, and that's not right.
  645.  
  646.   return sub { $postback->(@_) } if USING_TK;
  647.   return $postback;
  648. }
  649.  
  650. # Create a synchronous callback closure.  The return value will be
  651. # passed to whatever is handed the callback.
  652. #
  653. # TODO - Should callbacks hold reference counts like postbacks do?
  654.  
  655. sub callback {
  656.   my ($self, $event, @etc) = @_;
  657.   my $id = $POE::Kernel::poe_kernel->ID_session_to_id($self);
  658.  
  659.   my $callback = sub {
  660.     return $POE::Kernel::poe_kernel->call( $id, $event, [ @etc ], [ @_ ] );
  661.   };
  662.  
  663.   $callback;
  664. }
  665.  
  666. #==============================================================================
  667. # New methods.
  668.  
  669. sub goto_state {
  670.   my ($self, $new_state, $entry_event, @entry_args) = @_;
  671.  
  672.   if (defined $self->[SELF_CURRENT]) {
  673.     $POE::Kernel::poe_kernel->post( $self, NFA_EN_GOTO_STATE,
  674.                                     $new_state, $entry_event, @entry_args
  675.                                   );
  676.   }
  677.   else {
  678.     $POE::Kernel::poe_kernel->call( $self, NFA_EN_GOTO_STATE,
  679.                                     $new_state, $entry_event, @entry_args
  680.                                   );
  681.   }
  682. }
  683.  
  684. sub stop {
  685.   my $self = shift;
  686.   $POE::Kernel::poe_kernel->post( $self, NFA_EN_STOP );
  687. }
  688.  
  689. sub call_state {
  690.   my ($self, $return_event, $new_state, $entry_event, @entry_args) = @_;
  691.   $POE::Kernel::poe_kernel->post( $self, NFA_EN_PUSH_STATE,
  692.                                   $return_event,
  693.                                   $new_state, $entry_event, @entry_args
  694.                                 );
  695. }
  696.  
  697. sub return_state {
  698.   my ($self, @entry_args) = @_;
  699.   $POE::Kernel::poe_kernel->post( $self, NFA_EN_POP_STATE, @entry_args );
  700. }
  701.  
  702. ###############################################################################
  703. 1;
  704.  
  705. __END__
  706.  
  707. =head1 NAME
  708.  
  709. POE::NFA - event driven nondeterministic finite automaton
  710.  
  711. =head1 SYNOPSIS
  712.  
  713.   # Import POE::NFA constants.
  714.   use POE::NFA;
  715.  
  716.   # Define a machine's states, each state's events, and the coderefs
  717.   # that handle each event.
  718.   my %states =
  719.     ( start =>
  720.       { event_one => \&handler_one,
  721.         event_two => \&handler_two,
  722.         ...,
  723.       },
  724.       other_state =>
  725.       { event_n          => \&handler_n,
  726.         event_n_plus_one => \&handler_n_plus_one,
  727.         ...,
  728.       },
  729.       ...,
  730.     );
  731.  
  732.   # Spawn an NFA and enter its initial state.
  733.   POE::NFA->spawn( inline_states => \%states
  734.                  )->goto_state( $start_state, $start_event );
  735.  
  736.   # Move to a new state.
  737.   $machine->goto_state( $new_state, $new_event, @args );
  738.  
  739.   # Put the current state on a stack, and move to a new one.
  740.   $machine->call_state( $return_event, $new_state, $new_event, @args );
  741.  
  742.   # Move to the previous state on the call stack.
  743.   $machine->return_state( @returns );
  744.  
  745.   # Forcibly stop a machine.
  746.   $machine->stop();
  747.  
  748. =head1 DESCRIPTION
  749.  
  750. POE::NFA combines a runtime context with an event driven
  751. nondeterministic finite state machine.  Its main difference from
  752. POE::Session is that it can embody many different states, and each
  753. state has a separate group of event handlers.  Events are delivered to
  754. the appropriate handlers in the current state only, and moving to a
  755. new state is an inexpensive way to change what happens when an event
  756. arrives.
  757.  
  758. This manpage only discusses POE::NFA's differences from POE::Session.
  759. It assumes a familiarity with Session's manpage, and it will refer
  760. there whenever possible.
  761.  
  762. =head1 PUBLIC METHODS
  763.  
  764. See POE::Session's documentation.
  765.  
  766. =over 2
  767.  
  768. =item ID
  769.  
  770. See POE::Session.
  771.  
  772. =item create
  773.  
  774. POE::NFA does not have a create() constructor.
  775.  
  776. =item get_current_state
  777.  
  778. C<get_current_state()> returns the name of the machine's current
  779. state.  This method is mainly used for getting the state of some other
  780. machine.  In the machine's own event handlers, it's easier to just
  781. access C<$_[STATE]>.
  782.  
  783. =item get_runstate
  784.  
  785. C<get_runstate()> returns the machine's current runstate.  This is
  786. equivalent to C<get_heap()> in POE::Session.  In the machine's own
  787. handlers, it's easier to just access C<$_[RUNSTATE]>.
  788.  
  789. =item new
  790.  
  791. POE::NFA does not have a new() constructor.
  792.  
  793. =item spawn STATE_NAME => HANDLERS_HASHREF, ...
  794.  
  795. C<spawn()> is POE::NFA's session constructor.  It reflects the idea
  796. that new state machines are spawned like threads or processes.  The
  797. machine itself is defined as a list of state names and hashrefs
  798. mapping events to handlers within each state.
  799.  
  800.   my %machine =
  801.     ( state_1 =>
  802.       { event_1 => \&handler_1,
  803.         event_2 => \&handler_2,
  804.       },
  805.       state_2 =>
  806.       { event_1 => \&handler_3,
  807.         event_2 => \&handler_4,
  808.       },
  809.     );
  810.  
  811. Each state may define the same events.  The proper handler will be
  812. called depending on the machine's current state.  For example, if
  813. C<event_1> is dispatched while the previous machine is in C<state_2>,
  814. then C<&handler_3> is called to handle the event.  It happens because
  815. the state -> event -> handler map looks like this:
  816.  
  817.   $machine{state_2}->{event_1} = \&handler_3;
  818.  
  819. The spawn() method currently only accepts C<inline_states> and
  820. C<options>.  Others will be added as necessary.
  821.  
  822. =item option
  823.  
  824. See POE::Session.
  825.  
  826. =item postback
  827.  
  828. See POE::Session.
  829.  
  830. =item callback
  831.  
  832. See POE::Session.
  833.  
  834. =item goto_state NEW_STATE
  835.  
  836. =item goto_state NEW_STATE, ENTRY_EVENT
  837.  
  838. =item goto_state NEW_STATE, ENTRY_EVENT, EVENT_ARGS
  839.  
  840. C<goto_state> puts the machine into a new state.  If an ENTRY_EVENT is
  841. specified, then that event will be dispatched when the machine enters
  842. the new state.  EVENT_ARGS, if included, will be passed to the entry
  843. event's handler via C<ARG0..$#_>.
  844.  
  845.   my $machine = $_[MACHINE];
  846.   $machine->goto_state( 'next_state' );
  847.   $machine->goto_state( 'next_state', 'call_this_event' );
  848.   $machine->goto_state( 'next_state', 'call_this_event', @with_these_args );
  849.  
  850. =item stop
  851.  
  852. C<stop()> forces a machine to stop.  It's similar to posting C<_stop>
  853. to the machine, but it performs some extra NFA cleanup.  The machine
  854. will also stop gracefully if it runs out of things to do, just like
  855. POE::Session.
  856.  
  857. C<stop()> is heavy-handed.  It will force resource cleanup.  Circular
  858. references in the machine's C<RUNSTATE> are not POE's responsibility
  859. and may cause memory leaks.
  860.  
  861.   $_[MACHINE]->stop();
  862.  
  863. =item call_state RETURN_EVENT, NEW_STATE
  864.  
  865. =item call_state RETURN_EVENT, NEW_STATE, ENTRY_EVENT
  866.  
  867. =item call_state RETURN_EVENT, NEW_STATE, ENTRY_EVENT, EVENT_ARGS
  868.  
  869. C<call_state()> is similar to C<goto_state()>, but it pushes the
  870. current state on a stack.  At some point a C<return_state()> call will
  871. pop the saved state and cause the machine to return there.
  872.  
  873. C<call_state()> accepts one parameter different from C<goto_state()>,
  874. and that is C<RETURN_EVENT>.  C<RETURN_EVENT> specifies the event to
  875. emit when the machine returns to the calling state.  That is, the
  876. called state returns to the caller's C<RETURN_EVENT> handler.  The
  877. C<RETURN_EVENT> handler receives C<return_states()>'s C<RETURN_ARGS>
  878. via C<ARG0..$#_>.
  879.  
  880.   $machine->call_state( 'return_here', 'new_state', 'entry_event' );
  881.  
  882. As with C<goto_state()>, C<ENTRY_EVENT> is the event that will be
  883. emitted once the machine enters its new state.  C<ENTRY_ARGS> are
  884. parameters passed to the C<ENTRY_EVENT> handler via C<ARG0..$#_>.
  885.  
  886. =item return_state
  887.  
  888. =item return_state RETURN_ARGS
  889.  
  890. C<return_state()> returns to the most recent state which called
  891. C<call_state()>, optionally invoking the calling state's
  892. C<RETURN_EVENT>, possibly with C<RETURN_ARGS> passed to it via
  893. C<ARG0..$#_>.
  894.  
  895.   $_[MACHINE]->return_state( );
  896.   $_[MACHINE]->return_state( 'success', $success_value );
  897.  
  898. =back
  899.  
  900. =head1 PREDEFINED EVENT FIELDS
  901.  
  902. POE::NFA's predefined event fields are the same as POE::Session's with
  903. the following three exceptions.
  904.  
  905. =over 2
  906.  
  907. =item MACHINE
  908.  
  909. C<MACHINE> is equivalent to Session's C<SESSION> field.  It hold a
  910. reference to the current state machine, and it's useful for calling
  911. methods on it.  See POE::Session's C<SESSION> field for more
  912. information.
  913.  
  914.   $_[MACHINE]->goto_state( $next_state, $next_state_entry_event );
  915.  
  916. =item RUNSTATE
  917.  
  918. C<RUNSTATE> is equivalent to Session's C<HEAP> field.  It holds an
  919. anoymous hash reference which POE is guaranteed not to touch.  See
  920. POE::Session's C<HEAP> field for more information.
  921.  
  922. =item STATE
  923.  
  924. C<STATE> contains the name of the machine's current state.  It is not
  925. equivalent to anything from POE::Session.
  926.  
  927. =item EVENT
  928.  
  929. C<EVENT> is equivalent to Session's C<STATE> field.  It holds the name
  930. of the event which invoked the current handler.  See POE::Session's
  931. C<STATE> field for more information.
  932.  
  933. =back
  934.  
  935. =head1 PREDEFINED EVENT NAMES
  936.  
  937. POE::NFA defines four events of its own.  See POE::Session's
  938. "PREDEFINED EVENT NAMES" section for more information about other
  939. predefined events.
  940.  
  941. =over 2
  942.  
  943. =item poe_nfa_goto_state
  944.  
  945. =item poe_nfa_pop_state
  946.  
  947. =item poe_nfa_push_state
  948.  
  949. =item poe_nfa_stop
  950.  
  951. POE::NFA uses these states internally to manage state transitions and
  952. stopping the machine in an orderly fashion.  There may be others in
  953. the future, and they will all follow the /^poe_nfa_/ naming
  954. convention.  To avoid conflicts, please don't define events beginning
  955. with "poe_nfa_".
  956.  
  957. =back
  958.  
  959. =head1 MISCELLANEOUS CONCEPTS
  960.  
  961. =head2 States' Return Values
  962.  
  963. See POE::Session.
  964.  
  965. =head2 Resource Tracking
  966.  
  967. See POE::Session.
  968.  
  969. =head2 Synchronous and Asynchronous Events
  970.  
  971. See POE::Session.
  972.  
  973. =head2 Postbacks
  974.  
  975. See POE::Session.
  976.  
  977. =head2 Job Control and Family Values
  978.  
  979. See POE::Session.
  980.  
  981. =head1 SEE ALSO
  982.  
  983. Many of POE::NFA's features are taken directly from POE::Session.
  984. Please see L<POE::Session> for more information.
  985.  
  986. The SEE ALSO section in L<POE> contains a table of contents covering
  987. the entire POE distribution.
  988.  
  989. =head1 BUGS
  990.  
  991. See POE::Session's documentation.
  992.  
  993. Object and package states aren't implemented.  Some other stuff is
  994. just lashed together with twine.  POE::NFA needs some more work.
  995.  
  996. =head1 AUTHORS & COPYRIGHTS
  997.  
  998. Please see L<POE> for more information about authors and contributors.
  999.  
  1000. =cut
  1001.