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