Acme-FSM
view release on metacpan or search on metacpan
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}>.
=item set I<{state}> of specific I<$state>
Executed if one scalar and HASH are passed in.
Sets a I<{state}> with key/value pairs from HASH,
creating one if necessary.
Created record isa copy of HASH, not a reference
(not a true deep copy though)
(empty I<\%new_state> is fine too)
(copying isn't by design, it's implementation's quirk).
Returns record as it was before setting
(C<undef> is returned if there were no such I<$state> before).
=item query specific I<$entry> of specific I<$state>
Executed if two scalars are passed in.
Returns an entry from named state record.
=item set specific I<$entry> of specific I<$state>
Executed if two scalars and anything else are passed in
(no implicit intelligence about third parameter).
Sets an entry in named state record,
creating one (entry) if necessary.
State record must exist beforehand.
Entry isa exact value of least argument, not a copy.
Returns whatever value I<$entry> just had
(C<undef> is returned if there were none such I<$entry> before).
=back
None checks are made, except record must exist (for two latter uses).
=cut
sub fst {
my $self = shift @_;
unless( @_ ) {
$self->carp( q|no args| );
return undef }
elsif( 2 == @_ && ref $_[1] eq q|HASH| ) {
my $backup = $self->fst( $_[0] );
$self->diag( 3, q|%s {%s} record|,
( $backup ? q|updating| : q|creating| ), $_[0] );
# XXX:202202150056:whynot: Copy is a side-effect instead.
$self->{_}{fst}{shift @_} = {%{ pop @_ }};
return $backup }
elsif( !exists $self->{_}{fst}{$_[0]} ) {
$self->carp( qq|($_[0]): no such {fst} record| );
return undef }
elsif( 1 == @_ ) {
return $self->{_}{fst}{shift @_} }
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 --
# 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
=item I<$what> isa CODE
I<$what> is invoked with I<$self> and I<@items> as arguments.
Important, in this case I<$self> is passed as first argument,
OO isn't involved like at all.
=item I<$namespace> is empty string
Trade I<$namespace> for I<$self> (see below) and continue.
=item I<$namespace> is scalar
Treat I<$what> as a name of function in I<$namespace> namespace.
=item I<$namespace> is object reference
Treat I<$name> as a name of method of object referred by I<$namespace>.
=back
It really works.
=cut
sub query {
my( $self, $topic, $manifest ) = ( shift @_, shift @_, shift @_ );
my $caller = ( split m{::}, ( caller 1 )[3] )[-1];
defined $topic or croak sprintf q|[%s]: %s !isa defined|,
$caller, $manifest, $self->state;
$self->diag( 5, q|[%s]: %s isa (%s)|, $caller, $manifest, ref $topic );
ref $topic eq q|CODE| and return $topic->( $self, @_ );
ref $topic eq '' or croak sprintf
q|[%s]: %s isa (%s): no way to resolve this|,
$caller, $manifest, ref $topic;
defined $self->{_}{namespace} or croak
qq|[$caller]: {namespace} !isa defined|;
my $anchor = $self->{_}{namespace};
my $backup = $topic;
if( ref $anchor eq '' && $anchor eq '' ) {
$self->diag( 5, q|[%s]: defaulting %s to $self|, $caller, $manifest );
$anchor = $self }
$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.
( run in 0.678 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )