|
0
|
1 #-----------------------------------------------------------------
|
|
|
2 # $Id: AbstractStateMachine.pm,v 1.9 2002/10/22 07:38:49 lapp Exp $
|
|
|
3 #
|
|
|
4 # BioPerl module Bio::Tools::StateMachine::AbstractStateMachine
|
|
|
5 #
|
|
|
6 # Cared for by Steve Chervitz <sac@bioperl.org>
|
|
|
7 #
|
|
|
8 # You may distribute this module under the same terms as perl itself
|
|
|
9 #-----------------------------------------------------------------
|
|
|
10
|
|
|
11 =head1 NAME
|
|
|
12
|
|
|
13 Bio::Tools::StateMachine::AbstractStateMachine - Abstract state machine object
|
|
|
14
|
|
|
15 =head1 SYNOPSIS
|
|
|
16
|
|
|
17 Here is a portion of an implementation. For the full example, see
|
|
|
18 examples/state-machine.pl in the Bioperl distribution.
|
|
|
19
|
|
|
20 package SimpleStateMachine;
|
|
|
21
|
|
|
22 use Bio::Root::Root;
|
|
|
23 use Bio::Tools::StateMachine::AbstractStateMachine qw($INITIAL_STATE
|
|
|
24 $FINAL_STATE);
|
|
|
25 use vars qw( @ISA );
|
|
|
26
|
|
|
27 @ISA = qw( Bio::Root::Root
|
|
|
28 Bio::Tools::StateMachine::AbstractStateMachine );
|
|
|
29
|
|
|
30 my @state_transitions = ( [ $INITIAL_STATE, 'State1'],
|
|
|
31 [ 'State1', 'State2' ],
|
|
|
32 [ 'State2', $FINAL_STATE]
|
|
|
33 );
|
|
|
34 sub new {
|
|
|
35 my($caller,@args) = @_;
|
|
|
36 my $self = $caller->SUPER::new( @args);
|
|
|
37 $self->_init_state_machine( -transition_table => \@state_transitions );
|
|
|
38 return $self;
|
|
|
39 }
|
|
|
40
|
|
|
41
|
|
|
42
|
|
|
43 =head1 DESCRIPTION
|
|
|
44
|
|
|
45 B<AbstractStateMachine> provides a generic framework for representing a
|
|
|
46 state machine. This is not an event-based framework where you register
|
|
|
47 handlers to be called when certain events occur. Instead, it provides
|
|
|
48 a set of methods that define the basic logic of an object that has
|
|
|
49 state behavior, that logic being:
|
|
|
50
|
|
|
51 =over 4
|
|
|
52
|
|
|
53 =item 1. Check for whether or not a new state has occurred in the external world.
|
|
|
54
|
|
|
55 =item 2. If so, change the state of the machine to the new state.
|
|
|
56
|
|
|
57 =item 3. Otherwise, keep checking current conditions for a new state.
|
|
|
58
|
|
|
59 =item 4. Stop checking for new states if we reach the final state, or if an error occurs.
|
|
|
60
|
|
|
61 =back
|
|
|
62
|
|
|
63 A B<state> is just a string representing the name of the state. A
|
|
|
64 state machine is initialized with a B<state transition table>
|
|
|
65 consisting of a set of allowable transitions, where each B<transition>
|
|
|
66 is a two-element array in which the first element is the B<from
|
|
|
67 state>, and the second element is the B<to state>. This table permits
|
|
|
68 the AbstractStateMachine to determine if a requested transition is
|
|
|
69 valid.
|
|
|
70
|
|
|
71 This module is flexible enough to represent both deterministic and
|
|
|
72 non-deterministic finite automata (DFAs and NFAs), but it is fairly
|
|
|
73 new and should be considered experimental.
|
|
|
74
|
|
|
75 The key methods in AbstractStateMachine that define this logic of
|
|
|
76 operation are:
|
|
|
77
|
|
|
78 =over 4
|
|
|
79
|
|
|
80 =item check_for_new_state().
|
|
|
81
|
|
|
82 Does whatever checking is necessary to determine if a state transition
|
|
|
83 should occur (for example, read a line of input from STDIN). If a
|
|
|
84 transition should occur, a string is returned containing the name of
|
|
|
85 the new state. Otherwise, it returns C<undef>.
|
|
|
86
|
|
|
87 This method B<must be implemented> as AbstractStateMachine does not
|
|
|
88 define it (and in fact will throw a NotImplemented exception if you
|
|
|
89 fail to implement it).
|
|
|
90
|
|
|
91 =item change_state( C<new_state> )
|
|
|
92
|
|
|
93 Causes the machine to change its state to the state specified in the
|
|
|
94 argument. change_state() allows you to mapping a state transition to a
|
|
|
95 particular handler method that does whatever processing is needed to
|
|
|
96 deal with the state transition.
|
|
|
97
|
|
|
98 =item run()
|
|
|
99
|
|
|
100 This method keeps calling check_for_new_state() and if that method
|
|
|
101 returns a defined value (the name of the state to change to), it then
|
|
|
102 calls change_state( $state ), where $state is the value returned by
|
|
|
103 check_for_new_state().
|
|
|
104
|
|
|
105 Before calling check_for_new_state(), the run() method checks the
|
|
|
106 current state of the machine and exits the loop if the current state
|
|
|
107 ever becomes $PAUSE_STATE, $ERROR_STATE, or $FINAL_STATE.
|
|
|
108
|
|
|
109 =item append_input_cache( C<data> )
|
|
|
110
|
|
|
111 Adds data to a buffer for processing at the next state
|
|
|
112 transition. check_for_new_state() should call
|
|
|
113 append_input_cache() passing it any data it receives while checking
|
|
|
114 for a new state that should be processed later.
|
|
|
115
|
|
|
116 =item get_input_cache()
|
|
|
117
|
|
|
118 Retrieves the data stored by calling
|
|
|
119 append_input_cache(). change_state() should call get_input_cache() to
|
|
|
120 obtain the data to be processed for the current transition.
|
|
|
121
|
|
|
122 =back
|
|
|
123
|
|
|
124 This object defines an abstract class, meaning that some but not all methods
|
|
|
125 have been implemented. Subclasses must define the methods not implemented here.
|
|
|
126 These include at a minimum:
|
|
|
127
|
|
|
128 =over 4
|
|
|
129
|
|
|
130 =item check_for_new_state()
|
|
|
131
|
|
|
132 =item change_state()
|
|
|
133
|
|
|
134 A default simple implementation of change_state() is provided, but
|
|
|
135 subclasses of AbstractStateMachine most likely will want to override
|
|
|
136 this method to do something useful according to the particular state
|
|
|
137 change.
|
|
|
138
|
|
|
139 =back
|
|
|
140
|
|
|
141 If your state machine needs to cache input while processing, you will
|
|
|
142 also need to provide implementations of these methods (which are no-op
|
|
|
143 in AbstractStateMachine):
|
|
|
144
|
|
|
145 =over 3
|
|
|
146
|
|
|
147 =item append_input_cache
|
|
|
148
|
|
|
149 =item get_input_cache
|
|
|
150
|
|
|
151 =item clear_input_cache
|
|
|
152
|
|
|
153 =back
|
|
|
154
|
|
|
155 There are some other nuances provided by AbstractStateMachine, such as
|
|
|
156 the ability to pause() and resume() the running of the machine.
|
|
|
157
|
|
|
158
|
|
|
159 =head1 EXAMPLES
|
|
|
160
|
|
|
161 To get a feel for how to use this, have look at scripts in the
|
|
|
162 examples/state-machine directory of the Bioperl distribution. Also
|
|
|
163 have a look at Bio::Tools::StateMachine::IOStateMachine which provides
|
|
|
164 a Bio::Root::IO-based implementation of
|
|
|
165 AbstractStateMachine. Bio::SearchIO::psiblast subclasses
|
|
|
166 IOStateMachine.
|
|
|
167
|
|
|
168
|
|
|
169 =head1 FEEDBACK
|
|
|
170
|
|
|
171 =head2 Mailing Lists
|
|
|
172
|
|
|
173 User feedback is an integral part of the evolution of this and other
|
|
|
174 Bioperl modules. Send your comments and suggestions preferably to one
|
|
|
175 of the Bioperl mailing lists. Your participation is much appreciated.
|
|
|
176
|
|
|
177 bioperl-l@bioperl.org - General discussion
|
|
|
178 http://bio.perl.org/MailList.html - About the mailing lists
|
|
|
179
|
|
|
180 =head2 Reporting Bugs
|
|
|
181
|
|
|
182 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
183 the bugs and their resolution. Bug reports can be submitted via email
|
|
|
184 or the web:
|
|
|
185
|
|
|
186 bioperl-bugs@bio.perl.org
|
|
|
187 http://bugzilla.bioperl.org/
|
|
|
188
|
|
|
189 =head1 AUTHOR
|
|
|
190
|
|
|
191 Steve Chervitz, E<lt>sac@bioperl.orgE<gt>
|
|
|
192
|
|
|
193 See the L<FEEDBACK | FEEDBACK> section for where to send bug reports and comments.
|
|
|
194
|
|
|
195 =head1 ACKNOWLEDGEMENTS
|
|
|
196
|
|
|
197 I would like to acknowledge my colleagues at Affymetrix for useful
|
|
|
198 feedback.
|
|
|
199
|
|
|
200 =head1 COPYRIGHT
|
|
|
201
|
|
|
202 Copyright (c) 2001 Steve Chervitz. All Rights Reserved.
|
|
|
203
|
|
|
204 This library is free software; you can redistribute it and/or modify
|
|
|
205 it under the same terms as Perl itself.
|
|
|
206
|
|
|
207 =cut
|
|
|
208
|
|
|
209 =head1 DISCLAIMER
|
|
|
210
|
|
|
211 This software is provided "as is" without warranty of any kind.
|
|
|
212
|
|
|
213 =head1 APPENDIX
|
|
|
214
|
|
|
215 The rest of the documentation details each of the object methods.
|
|
|
216 Internal methods are usually preceded with a _
|
|
|
217
|
|
|
218 =cut
|
|
|
219
|
|
|
220
|
|
|
221 # Let the code begin...
|
|
|
222
|
|
|
223 package Bio::Tools::StateMachine::AbstractStateMachine;
|
|
|
224
|
|
|
225 use strict;
|
|
|
226 use Bio::Root::RootI;
|
|
|
227 use Exporter ();
|
|
|
228
|
|
|
229 use vars qw( @ISA @EXPORT_OK $INITIAL_STATE $FINAL_STATE $PAUSE_STATE $ERROR_STATE );
|
|
|
230 @ISA = qw( Bio::Root::RootI Exporter );
|
|
|
231 @EXPORT_OK = qw( $INITIAL_STATE $FINAL_STATE $PAUSE_STATE $ERROR_STATE );
|
|
|
232
|
|
|
233 @Bio::Tools::StateMachine::StateException::ISA = qw( Bio::Root::Exception );
|
|
|
234
|
|
|
235 $INITIAL_STATE = 'Initial';
|
|
|
236 $FINAL_STATE = 'Final';
|
|
|
237 $PAUSE_STATE = 'Pause';
|
|
|
238 $ERROR_STATE = 'Error';
|
|
|
239
|
|
|
240 sub _init_state_machine {
|
|
|
241 my ($self, @args ) = @_;
|
|
|
242 my ($transition_table) = $self->_rearrange( [qw(TRANSITION_TABLE)], @args);
|
|
|
243
|
|
|
244 $self->verbose and print STDERR "Initializing State Machine...\n";
|
|
|
245
|
|
|
246 if($transition_table) {
|
|
|
247 $self->_set_transition_table( $transition_table );
|
|
|
248 }
|
|
|
249
|
|
|
250 $self->add_transition( $INITIAL_STATE, $FINAL_STATE );
|
|
|
251 $self->_set_current_state( $INITIAL_STATE );
|
|
|
252 }
|
|
|
253
|
|
|
254 sub reset {
|
|
|
255 my $self = shift;
|
|
|
256 $self->verbose and print STDERR "Resetting state machine\n";
|
|
|
257 $self->_set_current_state( $INITIAL_STATE );
|
|
|
258 }
|
|
|
259
|
|
|
260 sub _set_current_state {
|
|
|
261 my ($self, $state) = @_;
|
|
|
262 if( defined $state) {
|
|
|
263 $self->verbose and print STDERR " setting current state to $state\n";
|
|
|
264 $self->{'_current_state'} = $state;
|
|
|
265 }
|
|
|
266 }
|
|
|
267
|
|
|
268 sub current_state { shift->{'_current_state'} }
|
|
|
269
|
|
|
270 sub initial_state { $INITIAL_STATE }
|
|
|
271
|
|
|
272 sub final_state { $FINAL_STATE }
|
|
|
273
|
|
|
274 sub pause_state { $PAUSE_STATE }
|
|
|
275
|
|
|
276 sub error_state { $ERROR_STATE }
|
|
|
277
|
|
|
278 sub resume_state {
|
|
|
279 my ($self, $state) = @_;
|
|
|
280 if( $state ) {
|
|
|
281 $self->{'_resume_state'} = $state;
|
|
|
282 }
|
|
|
283 $self->{'_resume_state'};
|
|
|
284 }
|
|
|
285
|
|
|
286 sub _clear_resume_state {
|
|
|
287 my $self = shift;
|
|
|
288 undef $self->{'_resume_state'};
|
|
|
289 }
|
|
|
290
|
|
|
291 =head2 running
|
|
|
292
|
|
|
293 The machine is either running or not running.
|
|
|
294 Once the machine has stopped running, it cannot be re-started.
|
|
|
295 Use pause() to temporarily halt a machine without exiting the run state.
|
|
|
296
|
|
|
297 =cut
|
|
|
298
|
|
|
299 sub running { shift->{'_running'} }
|
|
|
300
|
|
|
301 sub _set_running {
|
|
|
302 my $self = shift;
|
|
|
303 $self->{'_running'} = shift;
|
|
|
304 }
|
|
|
305
|
|
|
306 sub run {
|
|
|
307 my ($self, @args) = @_;
|
|
|
308
|
|
|
309 my $verbose = $self->verbose;
|
|
|
310 my $curr_state = $self->current_state;
|
|
|
311 $self->_set_running( 1 );
|
|
|
312
|
|
|
313 while( not ($curr_state eq $PAUSE_STATE ||
|
|
|
314 $curr_state eq $ERROR_STATE ||
|
|
|
315 $curr_state eq $FINAL_STATE )) {
|
|
|
316
|
|
|
317 $verbose and print STDERR "Current state (run): ${\$self->current_state}\n";
|
|
|
318
|
|
|
319 if( my $state = $self->check_for_new_state()) {
|
|
|
320 $self->change_state( $state );
|
|
|
321 }
|
|
|
322
|
|
|
323 $curr_state = $self->current_state;
|
|
|
324 }
|
|
|
325
|
|
|
326 # Handle EOF situations
|
|
|
327 if( not ($curr_state eq $PAUSE_STATE ||
|
|
|
328 $curr_state eq $FINAL_STATE )) {
|
|
|
329
|
|
|
330 $self->change_state( $FINAL_STATE );
|
|
|
331 $self->_set_running( 0 );
|
|
|
332 }
|
|
|
333
|
|
|
334 $verbose and print STDERR "StateMachine Run complete ($curr_state).\n";
|
|
|
335 }
|
|
|
336
|
|
|
337 # The pause() and resume() methods don't go through change_state()
|
|
|
338 sub pause {
|
|
|
339 my ($self) = @_;
|
|
|
340 # print "PAUSING...\n";
|
|
|
341 $self->resume_state( $self->current_state );
|
|
|
342 $self->_set_current_state( $PAUSE_STATE );
|
|
|
343 # print "After pause(): Current state: ${\$self->current_state}\n";
|
|
|
344 }
|
|
|
345
|
|
|
346 sub paused {
|
|
|
347 my ($self) = @_;
|
|
|
348 return $self->current_state eq $PAUSE_STATE;
|
|
|
349 }
|
|
|
350
|
|
|
351 sub throw{
|
|
|
352 my ($self,@args) = @_;
|
|
|
353 $self->_set_current_state( $ERROR_STATE );
|
|
|
354 $self->_set_running( 0 );
|
|
|
355 $self->SUPER::throw( @args );
|
|
|
356 }
|
|
|
357
|
|
|
358 sub error {
|
|
|
359 my ($self, $err) = @_;
|
|
|
360 return $self->current_state eq $ERROR_STATE;
|
|
|
361 }
|
|
|
362
|
|
|
363 sub resume {
|
|
|
364 my ($self) = @_;
|
|
|
365
|
|
|
366 # Don't resume if we're done.
|
|
|
367 return if $self->current_state eq $FINAL_STATE;
|
|
|
368
|
|
|
369 # print "RESUMING...\n";
|
|
|
370 $self->_set_current_state( $self->resume_state );
|
|
|
371 $self->_clear_resume_state;
|
|
|
372 $self->run();
|
|
|
373 }
|
|
|
374
|
|
|
375 =head2 transition_table
|
|
|
376
|
|
|
377 Arg : n/a
|
|
|
378 Returns : An array of array references to two-element arrays.
|
|
|
379 Each array ref defines a single transition where
|
|
|
380 the first element is the name of the "from" state and
|
|
|
381 the second element is the name of the "to" state.
|
|
|
382
|
|
|
383 Example : $sm->transition_table( [ $INITIAL_STATE, 'State1'],
|
|
|
384 [ 'State1', 'State2' ],
|
|
|
385 [ 'State2', 'State3' ],
|
|
|
386 [ 'State3', $FINAL_STATE]
|
|
|
387 );
|
|
|
388
|
|
|
389 =cut
|
|
|
390
|
|
|
391 sub transition_table {
|
|
|
392 my ($self) = @_;
|
|
|
393
|
|
|
394 return @{$self->{'_transition_table'}};
|
|
|
395 }
|
|
|
396
|
|
|
397 sub _set_transition_table {
|
|
|
398 my ($self, $table_ref) = @_;
|
|
|
399
|
|
|
400 my $verbose = $self->verbose;
|
|
|
401 $verbose and print STDERR "Setting state transition table:\n";
|
|
|
402
|
|
|
403 if( not ref($table_ref) eq 'ARRAY') {
|
|
|
404 $self->throw( -class => 'Bio::Root::BadParameter',
|
|
|
405 -text => "Can't set state transition table: Arg wasn't an array reference."
|
|
|
406 );
|
|
|
407 }
|
|
|
408
|
|
|
409 foreach my $t (@$table_ref) {
|
|
|
410 if( ref($t) and scalar(@$t) == 2 ) {
|
|
|
411 push @{$self->{'_transition_table'}->{$t->[0]}}, $t->[1];
|
|
|
412 $verbose and print STDERR " adding: $t->[0] -> $t->[1]\n";
|
|
|
413 }
|
|
|
414 else {
|
|
|
415 $self->throw( -class => 'Bio::Root::BadParameter',
|
|
|
416 -text => "Can't add state transition from table: Not a 2-element array reference ($t)"
|
|
|
417 );
|
|
|
418 }
|
|
|
419 }
|
|
|
420 }
|
|
|
421
|
|
|
422 =head2 add_transition
|
|
|
423
|
|
|
424 Arg : Two string arguments where:
|
|
|
425 First string = name of the "from" state.
|
|
|
426 Second string = name of the "to" state.
|
|
|
427 Throws : A Bio::Root::BadParameter exception if two arguments
|
|
|
428 are not provided.
|
|
|
429
|
|
|
430 =cut
|
|
|
431
|
|
|
432 sub add_transition {
|
|
|
433 my ($self, $from, $to) = @_;
|
|
|
434
|
|
|
435 if( defined($from) and defined($to) ) {
|
|
|
436 push @{$self->{'_transition_table'}->{$from}}, $to;
|
|
|
437 }
|
|
|
438 else {
|
|
|
439 $self->throw( -class => 'Bio::Root::BadParameter',
|
|
|
440 -text => "Can't add state transition: Insufficient arguments."
|
|
|
441 );
|
|
|
442 }
|
|
|
443 }
|
|
|
444
|
|
|
445
|
|
|
446 =head2 change_state
|
|
|
447
|
|
|
448 Purpose : To cause the machine to change its state.
|
|
|
449 Argument : A String containing the name of the the new state.
|
|
|
450 Returns : n/a
|
|
|
451 Throws : A Bio::Tools::StateMachine::StateException exception if the
|
|
|
452 state transition cannot be carried out.
|
|
|
453
|
|
|
454 This is a default implementation that simply validates the state change
|
|
|
455 (by calling validate_transition) and then calls finalize_state_change()
|
|
|
456 if the transition is valid.
|
|
|
457
|
|
|
458 Subclasses of AbstractStateMachine most likely will want to override this
|
|
|
459 method to do something useful according to the particular state change.
|
|
|
460
|
|
|
461 =cut
|
|
|
462
|
|
|
463 sub change_state {
|
|
|
464 my ($self, $new_state) = @_;
|
|
|
465
|
|
|
466 $self->verbose and print STDERR " changing state to $new_state\n";
|
|
|
467
|
|
|
468 if ( $self->validate_transition( $self->current_state, $new_state, 1 ) ) {
|
|
|
469 $self->finalize_state_change( $new_state, 1 );
|
|
|
470 }
|
|
|
471
|
|
|
472 }
|
|
|
473
|
|
|
474
|
|
|
475 =head2 get_transitions_from
|
|
|
476
|
|
|
477 Purpose : Returns a list array references that have the indicated state
|
|
|
478 in their 'from' slot.
|
|
|
479
|
|
|
480 =cut
|
|
|
481
|
|
|
482 sub get_transitions_from {
|
|
|
483 my ($self, $state) = @_;
|
|
|
484
|
|
|
485 my @trans = ();
|
|
|
486 if( ref $self->{'_transition_table'}->{$state}) {
|
|
|
487 @trans = @{$self->{'_transition_table'}->{$state}};
|
|
|
488 }
|
|
|
489
|
|
|
490 return @trans;
|
|
|
491 }
|
|
|
492
|
|
|
493 =head2 validate_transition
|
|
|
494
|
|
|
495 Purpose : Determines if the desired state change is defined within
|
|
|
496 the set of registered transitions for this StateMachine.
|
|
|
497 Arg : Two required arguments:
|
|
|
498 [0] string defining the name of the "from" state (case sensitive)
|
|
|
499 [1] string defining the name of the "to" state (case sensitive)
|
|
|
500 Returns : True if the transition is valid.
|
|
|
501 If not valid, throws an exception.
|
|
|
502 Throws : A Bio::Tools::StateMachine::StateException if the desired
|
|
|
503 transition does not exist with the registered transitions
|
|
|
504 for this machine.
|
|
|
505 Throws : A Bio::Root::BadParameter if insufficient arguments are given.
|
|
|
506
|
|
|
507 =cut
|
|
|
508
|
|
|
509 sub validate_transition {
|
|
|
510 my ($self, $from_state, $to_state ) = @_;
|
|
|
511
|
|
|
512 #print STDERR " validating transition $from_state -> $to_state\n";
|
|
|
513
|
|
|
514 if( not( defined($from_state) and defined($to_state))) {
|
|
|
515 $self->throw( -class => 'Bio::Root::BadParameter',
|
|
|
516 -text => "Can't validate state transition: Insufficient arguments.");
|
|
|
517 }
|
|
|
518
|
|
|
519 my $is_valid = 0;
|
|
|
520
|
|
|
521 foreach my $t ( $self->get_transitions_from( $from_state ) ) {
|
|
|
522 if( $t eq $to_state ) {
|
|
|
523 # if( $t->[1] eq $to_state ) {
|
|
|
524 $is_valid = 1;
|
|
|
525 last;
|
|
|
526 }
|
|
|
527 }
|
|
|
528
|
|
|
529 if( not $is_valid ) {
|
|
|
530 $self->throw( -class => 'Bio::Tools::StateMachine::StateException',
|
|
|
531 -text => "The desired state change is not valid for this machine: $from_state -> $to_state");
|
|
|
532 }
|
|
|
533
|
|
|
534 #print STDERR " valid!\n";
|
|
|
535
|
|
|
536 return $to_state;
|
|
|
537 }
|
|
|
538
|
|
|
539 =head2 check_for_new_state
|
|
|
540
|
|
|
541 Purpose : To do whatever checking is necessary to determine if
|
|
|
542 a state transition should occur.
|
|
|
543 Argument : Any necessary data required to determine if the state
|
|
|
544 machine should change to a new state.
|
|
|
545 Returns : A string containing the name of the new state if the
|
|
|
546 state machine should change to a new state.
|
|
|
547 Otherwise returns undef.
|
|
|
548
|
|
|
549 This is a virtual method and must be implemented by a subclass to do
|
|
|
550 whatever checking is necessary to determine if a state transition should occur.
|
|
|
551 If not implemented, calling this method will result in a
|
|
|
552 Bio::Root::NotImplemented exception.
|
|
|
553
|
|
|
554 =cut
|
|
|
555
|
|
|
556 sub check_for_new_state {
|
|
|
557 my ($self, $data) = @_;
|
|
|
558 $self->throw_not_implemented;
|
|
|
559 }
|
|
|
560
|
|
|
561 sub append_input_cache {
|
|
|
562 my ($self, $data) = @_;
|
|
|
563 }
|
|
|
564
|
|
|
565 sub get_input_cache {
|
|
|
566 my $self = shift;
|
|
|
567 }
|
|
|
568
|
|
|
569 sub clear_input_cache {
|
|
|
570 my $self = shift;
|
|
|
571 }
|
|
|
572
|
|
|
573 sub state_change_cache {
|
|
|
574 my ($self, $data) = @_;
|
|
|
575 if( defined $data ) {
|
|
|
576 $self->{'_state_change_cache'} = $data;
|
|
|
577 }
|
|
|
578 return $self->{'_state_change_cache'};
|
|
|
579 }
|
|
|
580
|
|
|
581 sub clear_state_change_cache {
|
|
|
582 my ($self, $data) = @_;
|
|
|
583 $self->{'_state_change_cache'} = undef;
|
|
|
584 }
|
|
|
585
|
|
|
586
|
|
|
587 =head2 finalize_state_change
|
|
|
588
|
|
|
589 Purpose : Performs routine operations to finish changing state.
|
|
|
590 This method should be called at the end of change_state().
|
|
|
591 Usage : finalize_state_change( $new_state, $clear_input_cache );
|
|
|
592 Argument : $new_state = the name of the state to change to.
|
|
|
593 $clear_input_cache = boolean whether or not to zap whatever
|
|
|
594 was in the input cache. Depends on
|
|
|
595 the logic of your state machine.
|
|
|
596
|
|
|
597 =cut
|
|
|
598
|
|
|
599 sub finalize_state_change {
|
|
|
600 my ($self, $to_state, $clear_input_cache ) = @_;
|
|
|
601
|
|
|
602 if( $self->paused ) {
|
|
|
603 $self->resume_state( $to_state );
|
|
|
604 }
|
|
|
605 else {
|
|
|
606 $self->_set_current_state( $to_state );
|
|
|
607 }
|
|
|
608 $self->clear_input_cache() if $clear_input_cache;
|
|
|
609 $self->append_input_cache( $self->state_change_cache );
|
|
|
610 $self->clear_state_change_cache();
|
|
|
611 }
|
|
|
612
|
|
|
613
|
|
|
614 1;
|
|
|
615
|
|
|
616
|
