Acme-FSM
view release on metacpan or search on metacpan
t/base/carp.t
t/base/connect.t
t/base/diag.t
t/base/fst.t
t/base/query.t
t/base/query_dumper.t
t/base/query_source.t
t/base/query_switch.t
t/base/state.t
t/base/turn.t
t/base/verify.t
t/process/consume.t
t/process/filter.t
t/process/parse.t
t/process/quadratic.t
t/process/sort.t
t/state/break.t
t/state/continue.t
t/state/start.t
t/state/stop.t
t/state/workload.t
This file contains message digests of all files listed in MANIFEST,
signed via the Module::Signature module, version 0.87.
To verify the content in this distribution, first make sure you have
Module::Signature installed, then type:
% cpansign -v
It will check each file's integrity, as well as the signature's
validity. If "==> Signature verified OK! <==" is not displayed,
the distribution may already have been compromised, and you should
not run its Makefile.PL or Build.PL.
-----BEGIN PGP SIGNED MESSAGE-----
SHA256 0855c632daa43cc512293c5f5448b8777b2846adbd32b5d5381a4aa62fdde2c6 t/base/carp.t
SHA256 49e44a436436c721ef32e06134362bb37c0010f16ac75f997dd42db58edb3b03 t/base/connect.t
SHA256 a6942f8e8d8b8713bd8b524ec6e1f983a5fc6cf5542748b168e42965dbd6413b t/base/diag.t
SHA256 09509db7be754b540d809aa2f93369e90bf80409b27b4843ecdb62d1bf05ca60 t/base/fst.t
SHA256 74568e63e230370d219a107670c467830ce24baf203d4b2c91c35200fb22655b t/base/query.t
SHA256 f4639f49130c0b7970e84f48c57f8b1f55acbc85bb3405cae3b27694405e2d8e t/base/query_dumper.t
SHA256 8a43c9d8d3fbe1b976c41f99f4b2df06656af358b61fc8159626d70bbcb87e0f t/base/query_source.t
SHA256 dd19bfc666091a4b784d476124685deab5f74950aad3cc60aa189f235928aae3 t/base/query_switch.t
SHA256 d35cca9ff74eea1364fb1348d1b96255ca3bc6904dc3e17b4523cf9b73d91b9b t/base/state.t
SHA256 c502a44a6bfca1c2de96d4bba8ee3004de1faf2f3ab0050d3fa220f2fbebe6af t/base/turn.t
SHA256 ae177fcdf5b30ef544d8a34a3bcb8204e2e8b02a7fb1aa9efb679f075f9ee811 t/base/verify.t
SHA256 ecafb3980eef5acb79aecf81825095606dc3f433f395eb412d49bb9ba9c25ad1 t/process/consume.t
SHA256 399c20399ef3c16ef0cc04ea23e5a2cf07bcafda728d4d9b26606ddc5e00d127 t/process/filter.t
SHA256 66a8db3d2c3fc02cb8388d0f4f1a68bac2cbccdb660c60fa65acf762e85035bd t/process/parse.t
SHA256 1c68a5a518ff018fa6744bcd4bb29a58e4e28df0230a3a8e90d72227ac1a661c t/process/quadratic.t
SHA256 2651bbcee690dce81fd1f688f166a4f5bb958e2f773868c5f68d05617107f8b7 t/process/sort.t
SHA256 fa7bafcbf024421206a487f75b7252e0fc759166791dcdc4f3bbb9c30340e34c t/state/break.t
SHA256 bf1db86c0b26300f088dc8c80ac6f31c00590aace730a666c22a2de93339df4e t/state/continue.t
SHA256 5fbc5917621ba360988e8f6fa0f2e3f660c35074ec2ed34a42520545bb116b45 t/state/start.t
SHA256 ca5302c4dbf8dc1e1476f78922cfbf3b8be9e9ed67095c4b58c776810fc8bf72 t/state/stop.t
SHA256 c9d26ec206b97c1ace954beeaa3ea7a5dff5024db8ed77d2137a753fccf696a0 t/state/workload.t
$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] );
$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:
# 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 );
=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.
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__ );
=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
t/base/verify.t view on Meta::CPAN
# $Id: verify.t 484 2013-05-09 20:56:46Z whynot $
# Copyright 2012, 2013 Eric Pozharski <whynot@pozharski.name>
# GNU GPLv3
# AS-IS, NO-WARRANTY, HOPE-TO-BE-USEFUL
use strict;
use warnings;
package main;
use version 0.77; our $VERSION = version->declare( v2.3.2 );
t/base/verify.t view on Meta::CPAN
Muh Ka_III
Zombies De_Zeuhl_Undazir
Eliphas_Levi Maneh_Fur_Da_Zess
Troller_Tanz Ek_Sun_Da_Zess
C_est_la_Vie_Qui_les_A_Menes_La Nono
Do_The_Music Da_Zeuhl_Worts_Mekanik
Thaud Wainsaht
The_Last_Seven_Minutes Nebehr_Gudahtt
Udu_Wudu Kohntarkosz |;
my $method = q|verify|;
my $tag;
my( $mf, $wt ) = qw| {Pearl} {Tanya} |;
AFSMTS_class_wrap { debug_level => -t STDOUT ? 10 : 1 }, \%st;
isa_ok $bb, q|Acme::FSM|, q|constructed object|;
$tag = q|undefined|;
AFSMTS_method_wrap $method, undef, q|Hillary|, $wt, $mf, '';
like $@, qr.\Q{Hillary}({Tanya}): {Pearl} !isa defined., AFSMTS_croakson $tag;
t/state/break.t view on Meta::CPAN
diag_level => $opts{diag_level},
namespace => undef,
source => $opts{source},
dumper => undef,
queue => [ undef ] );
my @data =
([ q|no {BREAK}|,
[qw| |],
{ START => { switch => sub { 1 }, tturn => [qw| BREAK DONE |]}},
qr.\Q[verify]: {BREAK}(): record !isa defined . ],
[ q|no workload|,
[qw| |],
{ BREAK => { }},
[ qr.\Q{BREAK}(eturn): turn !isa defined .,
qr.\Q{switch} !isa defined . ] ],
[ q|[T], no {BREAK}{switch}|,
[qw| eignore |],
{ START => { switch => sub { 1 }, tturn => [qw| workload |]},
workload =>
{ switch => sub { 1 }, tturn => [qw| BREAK DONE |] } },
t/state/start.t view on Meta::CPAN
[ q|[_](START/NEXT)|,
[qw| eignore todo |],
{ START =>
{ switch => \&AFSMTS_T, turns => { 1 => [qw| START NEXT |]}}} ],
[ q|[T](noise/noise)|,
[qw| |],
{ START =>
{ switch => \&AFSMTS_T,
eturn => [qw| agate Rilla |],
tturn => [qw| zircon Trigo |] } },
qr.\Q[verify]: {zircon}(): record !isa defined . ],
[ q|[F](noise/noise)|,
[qw| eignore |],
{ START => { switch => \&AFSMTS_F, fturn => [qw| jadeite Argo |]}},
qr.\Q[verify]: {jadeite}(): record !isa defined . ],
[ q|[U](noise/noise)|,
[qw| eignore |],
{ START => { switch => \&AFSMTS_U, uturn => [qw| turquoise Peric |]}},
qr.\Q[verify]: {turquoise}(): record !isa defined . ],
[ q|[_](noise/noise)|,
[qw| eignore |],
{ START =>
{ switch => \&AFSMTS_T, turns => { 1 => [qw| garnet Janno |]}}},
qr.\Q[verify]: {garnet}(): record !isa defined . ],
[ q|[T], trailing undef|,
[qw| |],
{ START =>
{ switch => \&AFSMTS_T, tturn => [ q|zircon|, undef, undef ]}},
qr.\Q{zircon}(): record !isa defined . ],
[ q|[F], trailing undef|,
[qw| eignore |],
{ START =>
{ switch => \&AFSMTS_F, fturn => [ q|jadeite|, undef, undef ]}},
qr.\Q{jadeite}(): record !isa defined . ],
t/state/stop.t view on Meta::CPAN
diag_level => $opts{diag_level},
namespace => undef,
source => $opts{source},
dumper => undef,
queue => [ undef ] );
my @data =
([ q|no {STOP}|,
[qw| |],
{ START => { switch => sub { 1 }, tturn => [qw| STOP DONE |]}},
qr.\Q[verify]: {STOP}(): record !isa defined . ],
[ q|no workload|,
[qw| |],
{ STOP => { }},
[ qr.\Q{STOP}(eturn): turn !isa defined .,
qr.\Q{STOP}{switch} !isa defined . ] ],
[ q|no {STOP}{switch}|,
[qw| |],
{ START =>
{ switch => sub { 1 }, tturn => [qw| workload DONE |]},
workload =>
( run in 0.661 second using v1.01-cache-2.11-cpan-5467b0d2c73 )