Acme-FSM
view release on metacpan or search on metacpan
Drop whatever I<$item> at hands.
Request another.
If FST has such record:
somestate => { eturn => [ somestate => 'NEXT' ] }
then FSM will stay in C<somestate> as long as I<source()> callback returns
C<undef>.
Thus consuming all resources available.
No options provided to limit that consumption.
=item C<SAME>
Retains I<$item> uncoditionally.
That is, even if I<$item> isn't B<defined> it's kept anyway.
B<Beware>, if FST has such record:
somestate => { eturn => [ somestate => 'SAME' ] }
then FSM will cycle here forever.
That is, since I<source()> isn't queried for other I<$item>
(what's the purpose of this action is anyway)
there's no way to get out.
=item C<TSTL>
Check if I<$item> is B<defined>, then go as with C<SAME> or C<NEXT> otherwise.
That actually makes sense.
I<(note)> This action name is legacy of B<DMA::Misc::FSM>;
Possibly, that's C<TeST> something;
Someone can just speculate what C<L> could mean.
=back
=back
=cut
sub process {
my $self = shift @_;
my( $branch, $turn );
# XXX:202201072033:whynot: C<START> and C<CONTINUE> being handled specially is a side-effect of this extra sequence. Should be moved in the main loop with special handling. This results in there-be-dragons uncertainty.
$self->diag( 3, q|{%s}(%s): entering|, $self->state, $self->action );
$branch = $self->query_switch;
$turn = $self->turn( $self->state, $branch );
$self->diag( 5, q|{%s}(%s): switch returned: (%s)|, @$turn, $branch );
$self->state( $turn->[0] );
$self->action( $turn->[1] );
my( $item, $dump ) = $self->query_source;
$self->diag( 3, q|{%s}(%s): %s: going with|, @$turn, $dump );
# No one gets out of this loop without the state tables permission!
while ( 1 ) {
# We should never see an undefined state unless we've made a mistake.
# NOTE:202201072131:whynot: As a matter of fact, we don't now.
$self->verify( $self->fst( $self->state ),
$self->state, '', q|record|, q|HASH| );
( $branch, $item ) = $self->query_switch( $item );
$self->diag( 5, q|{%s}(%s): switch returned: (%s)|, @$turn, $branch );
$dump = $self->query_dumper( $item );
$turn = $self->turn( $self->state, $branch );
$self->diag( 3, q|{%s}(%s): %s: turning with|,
$turn->[0], $branch, $dump );
$self->state( $turn->[0] );
$self->action( $turn->[1] );
$self->diag( 5, q|{%s}(%s): going for|, @$turn );
$turn->[0] eq q|STOP| and last;
$turn->[0] eq q|BREAK| and last;
$turn->[1] eq q|SAME| and redo;
$turn->[1] eq q|NEXT| and next;
$turn->[1] eq q|TSTL| && defined $item and redo;
$turn->[1] eq q|TSTL| and next;
croak sprintf q|[process]: {%s}(%s): unknown action|, @$turn }
continue {
( $item, $dump ) = $self->query_source;
$self->diag( 5, q|{%s}(%s): %s: going with|, @$turn, $dump ) }
$self->diag( 3, q|{%s}(%s): leaving|, @$turn );
# XXX:20121231215139:whynot: Nothing to B<verify()>, leaving anyway.
$branch = $self->query_switch;
$self->diag( 5, q|{%s}(%s): switch returned: (%s)|, @$turn, $branch );
$self->diag( 3, q|{%s}(%s): changing state: (CONTINUE)|, @$turn )
->state( q|CONTINUE| ) if $turn->[0] eq q|BREAK|;
return $self->action }
=head1 METHODS AND STUFF
Access and utility methods to deal with various moves while doing The State
Flow.
These aren't forbidden for use from outside,
while being quite internal nevertheles.
=over
=cut
=item B<verify()>
$rc = $self->query_rc( @args );
$rc = $self->verify( $rc, $state, $tag, $subject, $test );
Here comes rationale.
Writing (or should I say "composing"?) correct {fst} B<A::F> style is hard
(I know what I'm talking about, I've made a dozen already).
The purpose of B<verify()> is to check if the I<{fst}> at hands isn't fubar.
Nothing more, nothing less.
B<query_rc()> is a placeholder for one of B<query_.*()> methods,
I<$test> will be matched against C<ref $rc>.
Other arguments are to fill diagnostic output (if any).
I<$state> hints from what I<{state}> I<$rc> has been queried.
I<$subject> and I<$tag> are short descriptive name and actual value of I<$rc>.
Yup, dealing with B<verify()> might be fubar too.
I<$rc> is passed through (or not).
This B<croak>s if I<$rc> isn't B<defined> or C<ref $rc> doesn't match
I<$test>.
=cut
# TODO:202202150137:whynot: Replace C<return udnef> with B<croak()>, plz.
sub verify {
my $self = shift @_;
# XXX:202202092101:whynot: Nope, needs I<$state> because sometimes I<{state}> isn't entered yet.
my( $entry, $state, $what, $manifest, $test ) = @_;
defined $entry or croak sprintf q|[verify]: {%s}(%s): %s !isa defined|,
$state, $what, $manifest;
ref $entry eq $test or croak sprintf
q|[verify]: {%s}(%s): %s isa (%s), should be (%s)|,
$state, $what, $manifest, ref $entry, $test;
return $entry }
=item B<state()>
$bb->state eq 'something' and die;
$state = $bb->state( $new_state );
Queries and sets state of B<A::F> instance.
Modes:
=over
=item no argument
Returns state of instance.
Note, Perl FALSE B<isa> parameter.
=item lone scalar
Sets I<$state> of instance.
Returns previous I<$state>.
=back
=cut
sub state {
my $self = shift @_;
unless( @_ ) {
return $self->{_}{state} }
elsif( 1 == @_ ) {
my $backup = $self->state;
$self->diag( 5, q|changing state: (%s) (%s)|, $backup, $_[0] );
$self->{_}{state} = shift @_;
return $backup }
else {
$self->carp( sprintf q|too many args (%i)|, scalar @_ );
return undef }}
=item B<fst()>
%state = %{ $bb->fst( $state ) };
%state = %{ $bb->fst( $state => \%new_state ) };
$value = $bb->fst( $state => $entry );
$value = $bb->fst( $state => $entry => $new_value );
Queries and sets records and entries in I<{fst}>.
That is, not only entire I<{state}>s
but components of I<{state}> are reachable too.
Modes:
=over
=item query specific I<{state}> of specific I<$state>
Executed if one scalar is passed in.
Returns a I<{state}> reference with whatever entries are set.
Silently returns C<undef> if I<$state> is missing from I<{fst}>.
B<(note)> In that case, B<turn()> checks for I<turns> is indeed a HASH,
nothing more
(however B<croaks> if that's not the case);
It may as well be empty;
Design legacy.
=item *
Returns C<HASH> for C<STOP> and C<BREAK> I<$state>s without any further
processing
(For those I<$state>s any I<$rule> is ignored and C<HASH> enables I<switch()>
callbacks to give more informative logs
(while that information is mangled anyway);
Probably bad idea).
=item *
C<undef> is returned if there's nothing to say --
neither I<tturn>, nor I<fturn>, nor turn map --
this record is kind of void.
The record should be studied to find out why.
B<carp>s in that case.
=back
=item query specific I<[turn]>
Two scalars are I<$state> and specially encoded I<$rule>
(refer to L<B<query_switch()> method|/query_switch()> about encoding).
If I<$rule> can't be decoded then B<croak>s.
Returns (after verification) requested I<$rule> as ARRAY.
While straightforward I<[turn]>s (such as C<tturn>, C<fturn>, and such) could
be in fact queried through L<B<fst()> method|/fst()> turn map needs bit more
sophisticated handling;
and that's what B<turn()> does;
in fact asking for C<turns> will result in B<croak>.
I<$action> of C<START> and C<CONTINUE> special states suffer implicit
defaulting to empty string.
=item anything else
No arguments or more then two is an non-fatal error.
Returns C<undef> (with B<carp>).
=back
=cut
# TODO:202202172011:whynot: As soon as supported perl is young enough change it to smartmatch, plz.
my %special_turns = map { $_ => 1 } qw| eturn uturn tturn fturn |;
# TODO:202202162030:whynot: Consider more elaborate (informative) returns.
sub turn {
my $self = shift @_;
unless( @_ ) {
$self->carp( q|no args| ); return undef }
elsif( 1 == @_ && !exists $self->{_}{fst}{$_[0]} ) {
$self->carp( qq|($_[0]): no such {fst} record| );
return undef }
elsif( 1 == @_ ) {
my $state = shift @_;
my $entry = $self->verify(
$self->{_}{fst}{$state}, $state, '', q|entry|, q|HASH| );
# WORKAROUND:201305070051:whynot: Otherwise there will be spurious B<carp>s about anyway useless turns in those entries.
$state eq q|STOP| || $state eq q|BREAK| and return q|HASH|;
exists $entry->{tturn} || exists $entry->{fturn} and return '';
unless( exists $entry->{turns} ) {
# XXX:201305071531:whynot: Should just B<croak> instead, probably.
$self->carp( qq|{$state}: none supported turn| );
return undef }
$self->verify( $entry->{turns}, $state, q|turns|, q|turn|, q|HASH| );
return q|HASH| }
elsif( 2 == @_ ) {
my( $state, $turn ) = @_;
my $entry;
$self->verify( $turn, $state, $turn, q|turn|, '' );
if( exists $special_turns{$turn} ) {
$entry = $self->{_}{fst}{$state}{$turn} }
elsif( !index $turn, q|turn%| ) {
$entry = $self->{_}{fst}{$state}{turns}{substr $turn, 5} }
else {
croak sprintf q|[turn]: {%s}(%s): unknown turn|, $state, $turn }
$self->verify( $entry, $state, $turn, q|turn|, q|ARRAY| );
$self->verify( $entry->[0], $state, $turn, q|state|, '' );
# XXX:20121230140241:whynot: {START}{turn}{action} is ignored anyway.
# XXX:201305072006:whynot: {CONTINUE}{turn}{action} is ignored too.
$entry->[1] //= '' if $state eq q|START| || $state eq q|CONTINUE|;
$self->verify( $entry->[1], $state, $turn, q|action|, '' );
return $entry }
else {
$self->carp( sprintf q|too many args (%i)|, scalar @_ );
return undef }
}
=item B<action()>
$bb->action eq $action and die;
$action = $bb->action( $new_action );
Queries and sets I<$action> of B<A::F> instance.
Modes:
=over
=item query I<$action>
No arguments -- returns current I<$action> of the instance.
Note, Perl FALSE B<isa> parameter.
=item set I<$action>
One scalar -- sets action of the instance.
Returns previous I<$action>.
=back
=cut
sub action {
my $self = shift @_;
unless( @_ ) {
return $self->{_}{action} }
elsif( 1 == @_ ) {
my $backup = $self->action;
$self->diag( 5, q|changing action: (%s) (%s)|, $backup, $_[0] );
$self->{_}{action} = shift @_;
return $backup }
else {
$self->carp( sprintf q|too many args (%i)|, scalar @_ );
return undef }}
=item B<query()>
( $alpha, $bravo ) = $self->query( $what, $name, @items );
Internal method, then it becomes complicated.
Resolves I<$what> (some callback, there multiple of them) against
I<$namespace>, if necessary.
Then invokes resolved code appropriately passing I<@items> in, if any;
Product of the callback over I<@items> is returned back to the caller.
I<$name> is used for disgnostics only.
Trust me, it all makes perfect sense.
I<$what> must be either CODE or scalar, or else.
Strategy is like this
=over
$self->diag( 5, q|[%s]: {namespace} isa (%s)|, $caller, ref $anchor );
unless( ref $anchor eq '' ) {
$self->diag( 5, q|[%s]: going for <%s>->[%s]|,
$caller, ref $anchor, $topic );
$topic = $anchor->can( $topic );
$topic or croak sprintf q|[%s]: object of <%s> can't [%s] method|,
$caller, ref $anchor, $backup;
return $anchor->$topic( @_ ) }
else {
$self->diag( 5, q|[%s]: going for <%s>::[%s]|,
$caller, $anchor, $topic );
$topic = UNIVERSAL::can( $anchor, $topic );
$topic or croak sprintf q|[%s]: <%s> package can't [%s] subroutine|,
$caller, $anchor, $backup;
return $topic->( $self, @_ ) }}
=item B<query_switch()>
( $rule, $item ) = $self->query_switch( $item );
Internal multitool.
That's the point where decisions about turns are made.
B<(note)>
B<query_switch()> converts I<$rule> (as returned by B<switch()>) to specially
encoded scalar;
it's caller's responcibility pick correct I<[turn]> later.
Strategy:
=over
=item no arguments
Special-state mode:
invoke B<switch()> with no arguments;
ignore whatever I<$item> has been possibly returned;
return I<$rule> alone.
=item I<$item> is C<undef>
EOF mode:
ignore B<switch()> completely;
return C<eturn> and C<undef>.
=item I<$item> is not C<undef>
King-size mode:
invoke B<switch()>, pass I<$item> as single argument.
return I<$rule> and I<$item>
(whatever it became after going through B<switch()>).
=back
I<$rule>, as it was returned by B<switch()>, is encoded like this:
=over
=item I<$rule> is C<undef>
Return C<uturn>.
B<(note)>
Don't verify if C<uturn> I<[turn]> exists.
=item I<$rule> is Perl TRUE and C<tturn> and/or C<fturn> are present
Return C<tturn>
B<(note)>
Don't verify if C<tturn> I<[turn]> exists.
=item I<$rule> is Perl FALSE and C<tturn> and/or C<fturn> are present
Return C<fturn>
B<(note)>
Don't verify if C<fturn> I<[turn]> exists.
=item neither C<tturn> or C<fturn> are present
Encode I<$rule> like this C<'turn%' . $rule> and return that.
B((note)>
Don't verify if turn map exists.
B<(note)>
Don't verify if C<"turn%$rule"> exists in turn map.
=back
B<switch()> is always invoked in list context even if I<$item> would be
ignored.
If I<$rule> shouldn't be paired with I<$item> it won't be
(it's safe to call B<query_switch()> in scalar context then and
there won't be any trailing C<undef>s).
=cut
sub query_switch {
my $self = shift @_;
my @turn;
# WORKAROUND:20121229000801:whynot: No B<verify()>, B<query()> does its checks by itself.
@turn = $self->query(
$self->fst( $self->state, q|switch| ),
sprintf( q|{%s}{switch}|, $self->state ),
@_ ) if !@_ || defined $_[0];
my $kind = $self->turn( $self->state );
$turn[0] =
@_ && !defined $_[0] ? q|eturn| :
# TODO:202201071700:whynot: Make C<undef> special only when C<uturn> is present, plz.
!defined $turn[0] ? q|uturn| :
# FIXME:201304230145:whynot: Defaulting to basics here looks as bad as B<croak>ing.
# TODO:202212202039:whynot: L<Default For Turn Map>.
$kind ? qq|turn%$turn[0]| :
$turn[0] ? q|tturn| : q|fturn|;
return @_ ? @turn : $turn[0] }
=item B<query_source()>
( $item, $dump ) = $self->query_source;
Seeks B<source()> callback and acquires whatever it returns.
The callback is called in scalar context.
As useful feature, also feeds I<$item> to L<dumper callback|/query_dumper()>.
L<B<query()> method|/query()> has detailed description how B<source()>
callback is acquired.
Returns I<$item> and result of L<I<dumper> callback|/dumper>.
=cut
sub query_source {
my $self = shift @_;
# WORKAROUND:20121229001530:whynot: No B<verify()>, I<{source}> can return anything.
my $item = $self->query( $self->{_}{source}, q|{source}|, @_ );
return $item, $self->query_dumper( $item ) }
=item B<query_dumper()>
$dump = $self->query_dumper( $item );
Seeks I<dumper> callback (L<configured at construction time|/dumper>).
If the callback wasn't configured uses simple hopefully informative and
C<undef> proof substitution.
Whatever the callback returns is checked to be B<defined>
(C<undef> is changed to C<"(unclear)">)
and then returned.
=cut
sub query_dumper {
my $self = shift @_;
return $self->verify(
$self->query(
# TODO:202202210258:whynot: This is inefficient, defaulting should happen in B<connect()> instead.
$self->{_}{dumper} // sub { sprintf q|(%s)|, $_[1] // q|undef| },
q|{dumper}|, @_ ) // q|(unclear)|,
# XXX:202202210304:whynot: 'source' looks like remnants of refactoring. Should investigate it deeper.
$self->state, qw| source source |, '' ) }
=item B<diag()>
$bb->diag( 3, 'going to die at %i.', __LINE__ );
Internal.
Provides unified and single-point-of-failure way to output diagnostics.
Intensity is under control of
L<I<diag_level> configuration parameter|/diag_level>.
Each object has it's own,
however it's inherited when objects are copied.
Defined levels are:
=over
=item C<0>
Nothing at all.
Even error reporting is suppressed.
=item C<1>
Default.
Errors of here-be-dragons type.
=item C<2>
Basic diagnostics for callbacks.
=item C<3>
Basic trace.
Construction, starting and leaving runs.
=item C<4>
Extended diagnostics for callbacks.
=item C<5>
Deep trace.
By the way diagnostics of I<switch> entry resolving.
=back
=cut
sub diag {
my $self = shift @_;
$self->{_}{diag_level} >= shift @_ or return $self;
# TODO:202212222141:whynot: Since something this B<sprintf> might emit warnings. And maybe it's appropriate.
printf STDERR sprintf( qq|[%s]: %s\n|,
( split m{::}, ( caller 1 )[3])[-1], shift @_ ),
=item C<< [query]: [query_source]: going for <%s>::[%s] >>
=item C<< [query]: [query_switch]: going for <%s>::[%s] >>
B<(deep trace)>, L<B<query()> method|/query()>.
Attempting to call I<%s> (the latter) subrouting of package I<%s> (the
former).
=item C<< [query]: [query_dumper]: object of <%s> can't [%s] method >>
=item C<< [query]: [query_source]: object of <%s> can't [%s] method >>
=item C<< [query]: [query_switch]: object of <%s> can't [%s] method >>
B<(croak)>, L<B<query()> method|/query()>.
The object of I<%s> (the former) class can't do I<%s> (the latter) method.
=item C<[state]: changing state: (%s) (%s)>
B<(deep trace)>, L<B<state()> method|/state()>.
Exposes change of state from previous (former I<%s>)
to current (latter I<%s>).
=item C<[state]: too many args (%i)>
B<(warning)>, L<B<state()> method|/state()>.
Obvious.
None or one argument is supposed.
B<state()> has returned C<undef> in this case,
most probably will bring havoc in a moment.
=item C<[turn]: (%s): no such {fst} record>
B<(warning)>, L<B<turn()> method|/turn()>.
Peeking for I<[turn]>s of I<%s> I<$state> yeilds nothing, there's no such
state.
=item C<[turn]: {%s}: none supported turn>
B<(warning)>, L<B<turn()> method|/turn()>.
Whatever content of I<%s> entry is FSM doesn't know how to handle it.
=item C<[turn]: {%s}(%s): unknown turn>
B<(croak)>, L<B<turn()> method|/turn()>.
There was request for I<[turn]> I<%s> (the latter) of I<$state> I<%s> (the
former).
While I<{state}> record has been found and is OK,
there is no such I<$rule>.
=item C<[turn]: no args>
B<(warning)>, L<B<turn()> method|/turn()>.
No argumets, it's an error.
=item C<[turn]: too many args (%i)>
B<(warning)>, L<B<turn()> method|/turn()>.
There's no way to handle that many (namely: I<%i>) arguments.
=item C<[verify]: {%s}{%s}: %s !isa defined>
B<(croak)>, L<B<verify()> method|/verify()>.
I<$rc> queried
from something in I<{fst}> related to I<%s> (3rd)
(value of which is I<%s> (2nd))
while in I<$state> I<%s> (1st)
isn't defined.
=item C<[verify]: {%s}{%s}: %s isa (%s), should be (%s)>
B<(croak)>, L<B<verify()> method|/verify()>.
B<ref> of I<$rc> queried
from something in I<{fst}> related to I<%s> (3rd)
(value of which is I<%s> (2nd))
while in I<$state> I<%s> (1st) is I<%s> (4th).
While it should be I<%s> (5th)
(the last one is literally I<$test>).
=back
=cut
=head1 EXAMPLES
Here are example records.
Whole I<{fst}>, honestly, might become enormous,
thus are skipped for brewity.
alpha =>
{
switch => sub {
shift % 42, ''
},
tturn => [ qw/ alpha NEXT / ],
fturn => [ qw/ STOP horay! / ]
}
B<source()> supposedly produces some numbers.
Then,
if I<$item> doesn't devide C<mod 42> then go for another number.
If I<$item> devides then break out.
Also, please note, C<STOP> (and C<BREAK>) is special --
it needs B<defined> I<$action> but it can be literally anything.
bravo =>
{
switch => sub {
my $item = shift;
$item % 15 ? 'charlie' :
$item % 5 ? 'delta' :
$item % 3 ? 'echo' :
undef, $item
},
uturn => [ qw/ bravo NEXT / ],
turns =>
{
charlie => [ qw/ charlie SAME / ],
delta => [ qw/ delta SAME / ],
echo => [ qw/ echo SAME / ]
}
}
Again, B<source()> supposedly produces some numbers.
Then some kind of FizBuzz happens.
Also, returning C<undef> as default raises questions.
However, it's acceptable for example.
Now, quick demonstration, that's how this FizzBuzz would look
using B<DMA::FSM> capabilities (and B<A::F> of I<v2.2.7> syntax).
bravo_foo =>
( run in 1.032 second using v1.01-cache-2.11-cpan-39bf76dae61 )