Acme-FSM
view release on metacpan or search on metacpan
# Original Author: Dale M. Amon
# $Id: FSM.pm 564 2025-02-13 21:33:15Z whynot $
# Copyright 2012, 2013, 2022 Eric Pozharski <whynot@pozharski.name>
# Copyright 2025 Eric Pozharski <wayside.ultimate@tuta.io>
# GNU LGPLv3
# AS-IS, NO-WARRANTY, HOPE-TO-BE-USEFUL
use strict;
use warnings;
package Acme::FSM;
use version 0.77; our $VERSION = version->declare( v2.3.6 );
use Carp qw| croak |;
# TODO:202212202012:whynot: L<|/Linter>
=head1 NAME
Acme::FSM - pseudo Finite State Machine.
=cut
=head1 SYNOPSIS
my $bb = Acme::FSM->connect( { %options }, { %fst } );
$bb->process;
exit 0;
=cut
=head1 DESCRIPTION
B<(disclaimer)>
B<Acme::FSM> is currently in proof-of-concept state.
There's a plan to accompany it with B<Acme::FSM::Simple> with all diagnostics
avoided and run time checks in place.
And then with B<Acme::FSM::Tiny> with run time checks stripped.
Also, see L<B<BUGS AND CAVEATS> later in this POD|/BUGS AND CAVEATS>.
=head2 Concerning Inheritance
Through out code only methods are used to access internal state.
Supposedly, that will enable scaling some day later.
The only exception is L<B<connect()>|/connect()> for obvious reasons.
Through out code neither internal state nor FST records are cached ever.
The only one seamingly inconsistent fragment is inside main loop when next
I<$state> is already found but not yet entered.
I<$action> is processed when the next I<$state> is set
(though, in some sense, not yet entered).
(If it doesn't make sense it's fine, refer to
L<B<process()> method|/process()> description later in this POD.)
This notice seems to be useles.
Instead, it might come handy someday.
=cut
=head2 Terminology
There're some weird loaded words in this POD,
most probably, poorly choosen
(but those are going to stay anyway).
So here comes disambiguation list.
=over
=item I<$action>
Special flag associated with next I<{state}> in a I<[turn]>
(covered in details in L<B<process()>|/process()> method description).
B<(note)> It may be applied to a I<[turn]> of I<{fst}> or I<{state}>.
=item blackboard
Shamelesly stolen from B<DMA::FSM>.
Originally, it meant some opaque HASH passed around in B<DMA::FSM::FSM()>
where
user-code could store it's own ideas and such.
Now it's an object blessed into B<Acme::FSM>
(for user-code still, I<{fsm}> has nothing to do with it).
=item entry
Layout of state records (see below) isn't particularly complicated.
However it's far from being uniform.
I<entry> is a placeholder name for any component of (unspecified) state record
when any semantics is irrelevant.
See also I<[turn]> and B<switch()> below.
=item Finite State Machine
B<Acme::FSM>.
=item Finite State Table
=item I<{fst}>
Collection of state records.
=item FSM
Acronym for I<Finite State Machine>.
See above.
=item FST
Acronym for I<Finite State Table>.
See above.
=item internal state
=item I<{fsm}>
Some open-ended set of parameters dictating FSM's behaviour.
=item item
=item I<$item>
sub connect {
my( $self, $opts ) = ( shift @_, shift @_ );
ref $opts eq q|HASH| or croak sprintf
q|[connect]: {options} HASH is required, got (%s) instead|, ref $opts;
my( $trailer, $leader );
if( ref $self eq '' ) {
$trailer = ref $_[0] eq q|HASH|;
$self = bless { _ => { fst => $trailer ? shift @_ : { @_ }}}, $self;
$leader = q|clean init with| }
else {
$trailer = @_;
$self = bless { _ => { %{$self->{_}} }}, ref $self;
$leader = q|stealing| }
$self->{_}{$_} = delete $opts->{$_} // $self->{_}{$_} foreach @options;
$self->{_}{diag_level} //= 1;
$self->diag( 3, q|%s (%i) items in FST|,
$leader, scalar keys %{$self->{_}{fst}} );
$self->carp( qq|($_): unknown option, ignored| ) foreach keys %$opts;
$self->carp( q|(source): unset| ) unless defined $self->{_}{source};
$trailer = ref $_[0] eq q|HASH| ? keys %{$_[0]} : @_ if $trailer;
$self->carp( qq|ignoring ($trailer) FST items in trailer| ) if $trailer;
$self->carp( q|FST has no {START} state| ) unless
exists $self->{_}{fst}{START};
$self->carp( q|FST has no {STOP} state| ) unless
exists $self->{_}{fst}{STOP};
@{$self->{_}}{qw| state action |} = qw| START VOID |;
return $self }
=head1 B<process()>
$bb = Acme::FSM->connect( { }, \%fst );
$rc = $bb->process;
This is heart, brains, liver, and so on of B<Acme::FSM>.
B<process()> is what does actual state flow.
That state flow is steered by records in I<%fst>.
Each record consists of:
=over
=item B<switch()> callback
This is some user supplied code that
always consumes whatever B<source()> callback returns (at some point in past),
(optionally) regurgitates said input,
and decides what I<[turn]> to go next.
Except when in special I<{state}> (see below) it's supplied with one argument:
I<$item>.
In special states I<$item> is missing.
B<switch()> returns two controls: I<$rule> and processed I<$item>.
What to do with returned I<$item> is determined by I<$action> (see below).
=item various I<[turn]>s
Each I<[turn]> spec is an ARRAY with two elements (trailing elements are
ignored).
First element is I<$state> to change to.
Second is I<$action> that sets what to do with I<$item> upon changing to named
I<$state>.
Here are known I<[turn]>s in order of logical treating decreasing.
=over
=item C<eturn>
That I<[turn]> will be choosen by FSM itself when I<$item> at hands is
C<undef>
(as returned by B<source()>).
I<switch()> isn't invoked -- I<$item> is void, there's nothing to call
I<switch()> with.
However, I<$action> may change I<$item>.
=item C<uturn>
That I<[turn]> will be choosen by FSM if I<$rule> is C<undef>
(as returned by B<switch()>).
Idea behind this is to give an FST an option to bailout.
In original B<DMA::FSM> that's not possible (except B<croak>ing, you know).
Also, see L<B<BUGS AND CAVEATS>|/Perl FALSE, undef, and uturn>.
=item C<tturn> and/or C<fturn>
If any (hence 'or') is present then I<$rule> returned by B<switch()> is
treated as Perl boolean, except C<undef> it's handled by C<uturn>.
That's how it is in original B<DMA::FSM>.
If B<switch()> always returns TRUE (or FALSE) then C<fturn> (or C<tturn>) can
be missing.
Also, see L<B<BUGS AND CAVEATS>|/tturn, fturn, and switch()>.
=item C<turns>
If neither C<tturn> nor C<fturn> is present then whatever I<$rule> would be
returned by B<switch()> is treated as string.
That string is supposed to be a key in I<%$turns>.
I<$rule> returned is forced to be string (so if you dare to return objects,
such objects should have C<""> overloaded).
Also, see L<B<BUGS AND CAEATS>|/Default For Turn Map>.
=back
I<$state> is treated as a key in FST hash, except when that's a special state.
Special states (in alphabetical order):
=over
=item C<BREAK>
Basically, it's just like C<STOP> I<$state>.
All comments there (see below) apply.
It's added to enable break out from loop, do something, then get back in loop.
I<$state> is changed to C<CONTINUE> just before returning to caller
(I<switch()> is called in C<BREAK> state).
The choice where to implicitly change state to C<CONTINUE> has been completely
arbitrary;
probably wrong.
=item C<CONTINUE>
Just like C<START> state (see below, all comments apply).
While C<BREAK> is turned to C<CONTINUE> implicitly no other handling is made.
elsif( 2 == @_ ) {
return $self->{_}{fst}{shift @_}{shift @_} }
elsif( 3 == @_ ) {
my $backup = $self->fst( $_[0] => $_[1] );
$self->diag( 3, q|%s {%s}{%s} entry|,
( $backup ? q|updating| : q|creating| ), @_[0,1] );
$self->{_}{fst}{shift @_}{shift @_} = pop @_;
return $backup }
else {
$self->carp( sprintf q|too many args (%i)|, scalar @_ );
return undef }}
=item B<turn()>
$bb->turn( $state ) eq '' or die;
$bb->turn( $state => 'uturn' )->[1] eq 'NEXT' or die;
Queries I<[turn]>s of arbitrary I<{state}>s.
B<turn()> doesn't manipulate entries, use L<B<fst()> method|/fst()> instead
L<if you can|/turn() and fst()>.
Modes:
=over
=item query expected behaviour
This mode is entered if there is lone scalar.
Such scalar is believed to be I<$state>.
Returns something that describes what kind of least special states are
present.
Namely:
=over
=item *
C<undef> is returned if I<$state> isn't present in the I<{fst}>
(also B<carp>s).
Also see below.
=item *
Empty string is returned if there're I<tturn> and/or I<fturn> turns.
I<turns> hash is ignored in that case.
=item *
C<HASH> is returned if there's turn map
(and neither I<tturn> nor I<fturn> is present).
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 == @_ ) {
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 @_ ),
map $_ // q|(undef)|, @_;
return $self }
=item B<carp()>
$bb->carp( 'something wrong...' );
Internal.
B<carp>s consistently if I<{_}{diag_level}> is B<gt> C<0>.
=back
=cut
sub carp {
my $self = shift @_;
$self->{_}{diag_level} >= 1 or return;
unshift @_, sprintf q|[%s]: |, ( split m{::}, ( caller 1 )[3])[-1];
&Carp::carp }
=head1 BUGS AND CAVEATS
=over
=item Default For Turn Map
B<(missing feature)>
It's not hard to imagine application of rather limited turn map that should
default on anything else deemed irrelevant.
Right now to achieve logic like this such defaulting ought to be merged into
B<switch()>.
That's insane.
=item Diagnostics
B<(misdesign)>
Mechanics behind diagnostics isa failure.
It's messy, fragile, misguided, and (honestly) premature.
At the moment it's useless.
=item Hash vs HASH vs Acme::FSM Ref Constructors
B<(messy, probably bug)>
L<B<connect()> method description|/connect()> _declares_ that list is copied.
Of course, it's not true deep copy
({fst} might contain CODE, it's not clear how to copy it).
It's possible, one day list trailer variant of initialization may be put to
sleep.
See also L<linter below|/Linter>.
=item Linter
B<(missing feature)>
It might be hard to imagine,
but FST might get out of hands
(ie check F<t/process/quadratic.t>).
Indeed, some kind of (limited!) linter would be much desired.
It's missing.
=item Perl FALSE, C<undef>, and C<uturn>
B<(caveat)>
Back then B<DMA::FSM> treated C<undef> as any other Perl FALSE.
C<uturn> I<$rule> mech has made C<undef> special
(if B<switch()> returns C<undef> and C<uturn> I<{turn}> isn't present then
it's a B<croak>).
Thus, at the moment, C<undef> isn't FALSE (for B<A::F>).
This is counter-intuitive, actually.
=item Returning C<undef> for misuse
B<(bug)>
Why B<A::F> screws with caller,
in case of API violations (by returning C<undef>),
is beyond my understanding now.
=item B<source()> and I<$state>
B<(bug)> (also see L<B<switch()> and I<$item>|/switch() and $item>)
By design and legacy,
there is single point of input -- B<source()>.
IRL, multiple sources are normal.
Implementation wise that leads to B<source()> that on the fly figures out
current I<$state> and then somehow branches (sometimes branches out).
Such B<source()>s look horrible because they are.
=item Special handling of C<START> and C<CONTINUE>
B<(bug)>
In contrary with C<STOP> and C<BREAK> special states,
( run in 1.217 second using v1.01-cache-2.11-cpan-39bf76dae61 )