Acme-FSM
view release on metacpan or search on metacpan
Refer to L<B<query_dumper()> method|/query_dumper()> documentation for
details.
Optional.
Simple stringifier is provided by L<B<query_dumper()> method|/query_dumper()>
itself.
=item I<namespace>
(scalar or object(!) B<ref>)
Sets a context for various parts of I<{fsm}> and services would be resolved.
No defaults.
Refer to L<B<query()> method|/query()> documentation for details.
=item I<source>
(scalar or C<CODE>)
Sets a source of items to process to be queried.
Required.
Refer to L<B<query_source()> method|/query_source()> documentation for
details.
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
$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 {
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.
&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 C<[query]: [query_dumper]: {namespace} isa (%s)>
=item C<[query]: [query_source]: {namespace} isa (%s)>
=item C<[query]: [query_switch]: {namespace} isa (%s)>
B<(deep trace)>, L<B<query()> method|/query()>.
C<ref $namespace> is I<%s>.
=item C<[query]: [query_dumper]: defaulting %s to $self>
=item C<[query]: [query_source]: defaulting %s to $self>
=item C<[query]: [query_switch]: defaulting %s to $self>
B<(deep trace)>, L<B<query()> method|/query()>.
I<$namespace> is an empty string.
The blackboard object will be used to resolve the callback.
=item C<< [query]: [query_dumper]: going for <%s>->[%s] >>
=item C<< [query]: [query_source]: going for <%s>->[%s] >>
=item C<< [query]: [query_switch]: going for <%s>->[%s] >>
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 =>
{
switch => sub {
my $item = shift;
$item % 15 ? !0 : !1, $item
t/base/query.t view on Meta::CPAN
like $@, qr.\Q {namespace} !isa defined., AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[(eval)]: {havoc} isa ()., qq|$tag noted|;
$tag = q|{havoc} !isa defined method, {namespace} eq (),|;
$t::TestSuite::class_cheat = q|t::TestSuite::FSM|;
AFSMTS_class_wrap { %plug, namespace => '' }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|tfihs_tfihs|, $mf;
like $@, qr.\Q <t::TestSuite::FSM> can't [tfihs_tfihs] method .,
AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[(eval)]: defaulting {havoc} to \E\x24self.,
qq|$tag defaulting noted|;
like $stderr, qr.(?m)\Q[(eval)]: {namespace} isa (t::TestSuite::FSM).,
qq|$tag defaulted noted|;
$tag = q|{havoc} isa defined method, {namespace} eq (),|;
AFSMTS_method_wrap $method, q|shift_shift|, $mf;
is_deeply
[ $bb->{bull}, exists $bb->{shambles}, $rc ],
[ q|Troller_Tanz|, '', q|Ek_Sun_Da_Zess| ],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[(eval)]: going for <t::TestSuite::FSM>->[shift_shift].,
qq|$tag noted|;
t/base/query.t view on Meta::CPAN
$tag =
q|{havoc} !isa defined method, {namespace} eq (t::TestSuite::havoc),|;
my $havoc = t::TestSuite::havoc->new;
undef $t::TestSuite::class_cheat;
AFSMTS_class_wrap { %plug, namespace => $havoc }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|tfihs_tfihs|, $mf;
like $@, qr.\Q <t::TestSuite::havoc> can't [tfihs_tfihs] method .,
AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[(eval)]: defaulting {havoc} to \E\x24self.,
qq|$tag no defaulting|;
like $stderr, qr.(?m)\Q[(eval)]: {namespace} isa (t::TestSuite::havoc).,
qq|$tag {namespace} noted|;
$tag = q|{havoc} isa defined method, {namespace} eq (t::TestSuite::havoc),|;
AFSMTS_method_wrap $method, q|shift_shift|, $mf;
is_deeply
[ $havoc->{mess}, exists $bb->{bull}, $rc ],
[ q|Do_The_Music|, '', q|Da_Zeuhl_Worts_Mekanik| ],
qq|$tag queried|;
like $stderr,
t/base/query.t view on Meta::CPAN
qq|$tag noted|;
$tag =
q|{havoc} !isa defined subroutine, {namespace} eq (t::TestSuite::havoc),|;
AFSMTS_class_wrap { %plug, namespace => q|t::TestSuite::havoc| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|tfihs_tfihs|, $mf;
like $@,
qr.(?m)\Q[(eval)]: <t::TestSuite::havoc> package can't [tfihs_tfihs].,
AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[(eval)]: defaulting {havoc} to \E\x24self.,
qq|$tag no defaulting|;
like $stderr, qr.(?m)\Q[(eval)]: {namespace} isa ().,
qq|$tag {namespace} isa scalar|;
$tag =
q|{havoc} isa defined subroutine, {namespace} eq (t::TestSuite::havoc),|;
AFSMTS_method_wrap $method, q|shift_shift|, $mf;
is_deeply
[ $bb->{mess}, exists $bb->{bull}, $rc ],
[ q|The_Last_Seven_Minutes|, '', q|Nebehr_Gudahtt| ],
qq|$tag queried|;
t/base/query_dumper.t view on Meta::CPAN
Stormbringer Hrunting |;
my $method = q|query_dumper|;
my $tag;
my %plug = ( diag_level => 5 );
$tag = q|{dumper} is missing,|;
AFSMTS_class_wrap { %plug }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is $rc, q|(undef)|, qq|$tag default dumper in action|;
$tag = q|{dumper} is missing, argument isa set,|;
AFSMTS_class_wrap { %plug }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|Grimtooth|;
is $rc, q|(Grimtooth)|, qq|$tag default dumper in action|;
$tag = q|{dumper} isa (undef),|;
AFSMTS_class_wrap { %plug, dumper => undef }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is $rc, q|(undef)|, qq|$tag default dumper in action|;
$tag = q|{dumper} isa (undef), argument isa scalar,|;
AFSMTS_class_wrap { %plug, dumper => undef }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|Schrit|;
is $rc, q|(Schrit)|, qq|$tag default dumper in action|;
$tag = q|{dumper} isa (undef), argument isa object,|;
AFSMTS_class_wrap { %plug, dumper => undef }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, $bb;
like $rc, qr.\(Acme::FSM=HASH\(0x\w+\)\)., qq|$tag default dumper in action|;
$tag = q|{dumper} isa (HASH),|;
AFSMTS_class_wrap { %plug, dumper => \$tag }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q isa (SCALAR)., AFSMTS_croakson $tag;
$tag = q|{dumper} isa (Acme::FSM),|;
AFSMTS_object_wrap $bb, { dumper => $bb };
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
t/base/query_dumper.t view on Meta::CPAN
like $@, qr.\Q {namespace} !isa defined., AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[query_dumper]: {dumper} isa ()., qq|$tag noted|;
$tag = q|{dumper} !isa defined method, {namespace} eq (),|;
$t::TestSuite::class_cheat = q|t::TestSuite::FSM|;
AFSMTS_class_wrap { %plug, namespace => '', dumper => q|tfihs_tfihs| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q <t::TestSuite::FSM> can't [tfihs_tfihs] method .,
AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[query_dumper]: defaulting {dumper} to \E\x24self.,
qq|$tag defaulting noted|;
like $stderr, qr.(?m)\Q[query_dumper]: {namespace} isa (t::TestSuite::FSM).,
qq|$tag defaulted noted|;
$tag = q|{dumper} isa defined method, {namespace} eq (),|;
AFSMTS_class_wrap { %plug, namespace => '', dumper => q|shift_shift| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{matrixone}, exists $bb->{CSSC}, $rc ],
[ q|Ekkisax|, '', q|Noralltach| ],
qq|$tag queried|;
like $stderr,
t/base/query_dumper.t view on Meta::CPAN
$tag =
q|{dumper} !isa defined method, {namespace} eq (t::TestSuite::dumper),|;
my $dumper = t::TestSuite::dumper->new;
undef $t::TestSuite::class_cheat;
AFSMTS_class_wrap
{ %plug, namespace => $dumper, dumper => q|tfihs_tfihs| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q <t::TestSuite::dumper> can't [tfihs_tfihs] method .,
AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[query_dumper]: defaulting {dumper} to \E\x24self.,
qq|$tag no defaulting|;
like $stderr,
qr.(?m)\Q[query_dumper]: {namespace} isa (t::TestSuite::dumper).,
qq|$tag {namespace} noted|;
$tag = q|{dumper} isa defined method, {namespace} eq (t::TestSuite::dumper),|;
$dumper = t::TestSuite::dumper->new;
AFSMTS_class_wrap
{ %plug, namespace => $dumper, dumper => q|shift_shift| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
t/base/query_dumper.t view on Meta::CPAN
$dumper = t::TestSuite::dumper->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::dumper|, dumper => q|tfihs_tfihs| },
\%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@,
qr.(?x)\[query_dumper\]:\h\<t::TestSuite::dumper\>\hpackage\h
can't\h\[tfihs_tfihs\].,
AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[query_dumper]: defaulting {dumper} to \E\x24self.,
qq|$tag no defaulting|;
like $stderr, qr.(?m)\Q[query_dumper]: {namespace} isa ().,
qq|$tag {namespace} isa scalar|;
$tag =
q|{dumper} isa defined subroutine, {namespace} eq (t::TestSuite::dumper),|;
$dumper = t::TestSuite::dumper->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::dumper|, dumper => q|shift_shift| },
\%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
t/base/query_source.t view on Meta::CPAN
like $@, qr.\Q {namespace} !isa defined., AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[query_source]: {source} isa ()., qq|$tag noted|;
$tag = q|{source} !isa defined method, {namespace} eq (),|;
$t::TestSuite::class_cheat = q|t::TestSuite::FSM|;
AFSMTS_class_wrap { %plug, namespace => '', source => q|tfihs_tfihs| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q <t::TestSuite::FSM> can't [tfihs_tfihs] method .,
AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[query_source]: defaulting {source} to \E\x24self.,
qq|$tag defaulting noted|;
like $stderr, qr.(?m)\Q[query_source]: {namespace} isa (t::TestSuite::FSM).,
qq|$tag defaulted noted|;
$tag = q|{source} isa defined method, {namespace} eq (),|;
AFSMTS_class_wrap { %plug, namespace => '', source => q|shift_shift| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{Ashevill_pm}, exists $bb->{Anchorage_pm}, @$rc ],
[ q|angua|, '', qw| ponder_stibbons (ponder_stibbons) |],
qq|$tag queried|;
like $stderr,
t/base/query_source.t view on Meta::CPAN
$tag =
q|{source} !isa defined method, {namespace} eq (t::TestSuite::source),|;
my $source = t::TestSuite::source->new;
undef $t::TestSuite::class_cheat;
AFSMTS_class_wrap
{ %plug, namespace => $source, source => q|tfihs_tfihs| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q <t::TestSuite::source> can't [tfihs_tfihs] method .,
AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[query_source]: defaulting {source} to \E\x24self.,
qq|$tag no defaulting|;
like $stderr,
qr.(?m)\Q[query_source]: {namespace} isa (t::TestSuite::source).,
qq|$tag {namespace} noted|;
$tag = q|{source} isa defined method, {namespace} eq (t::TestSuite::source),|;
$source = t::TestSuite::source->new;
AFSMTS_class_wrap
{ %plug, namespace => $source, source => q|shift_shift| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
t/base/query_source.t view on Meta::CPAN
$source = t::TestSuite::source->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::source|, source => q|tfihs_tfihs| },
\%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@,
qr.(?mx)\[query_source\]:\h\<t::TestSuite::source\>\hpackage\h
can't\h\[tfihs_tfihs\].,
AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[query_source]: defaulting {source} to \E\x24self.,
qq|$tag no defaulting|;
like $stderr, qr.(?m)\Q[query_source]: {namespace} isa ().,
qq|$tag {namespace} isa scalar|;
$tag =
q|{source} isa defined subroutine, {namespace} eq (t::TestSuite::source),|;
$source = t::TestSuite::source->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::source|, source => q|shift_shift| },
\%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
t/base/query_source.t view on Meta::CPAN
AFSMTS_method_wrap $method;
is_deeply $rc, [qw| windle_poons (windle_poons) |], qq|$tag queried|;
$tag = q|{source} returns one item, item isa object|;
my $obj = $bb;
AFSMTS_class_wrap { source => sub { $obj } }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is $rc->[0], $obj, qq|$tag queried|;
like $rc->[1], qr.\(Acme::FSM=HASH\(0x\w+\)\).,
qq|$tag default dumper in action|;
# vim: set filetype=perl
t/base/query_switch.t view on Meta::CPAN
[ ],
qr.\Q {namespace} !isa defined.,
{ noted => qr.(?m)\Q[query_switch]: {START}{switch} isa (). }, ],
[ q|{switch} !isa defined method, {namespace} eq ()|,
[qw| fail noise noise |],
sub {
$t::TestSuite::class_cheat = q|t::TestSuite::FSM|;
q|hsup_hsup|, { namespace => '' } },
[ ],
qr.\Q <t::TestSuite::FSM> can't [hsup_hsup] method .,
{ defaulting => qr.(?xm)\[query_switch\]:\s
defaulting\s\{START\}\{switch\}\sto\s\x24self.,
defaulted => qr.(?xm)\[query_switch\]:\s
\{namespace\}\sisa\s\(t::TestSuite::FSM\). } ],
[ q|{switch} isa defined method, {namespace} eq ()|,
[qw| pass noise |],
sub { q|push_push|, { namespace => '' } },
[ ],
sub { $bb->{MKS}, exists $bb->{CS_RCS}, $rc },
[ q|arx|, '', q|tturn| ],
{ noted => qr.(?xm)\[query_switch\]:\s
going\sfor\s<t::TestSuite::FSM>->\[push_push\]. } ],
[q|{switch} isa defined method, {namespace} eq (), argument is set|,
t/base/query_switch.t view on Meta::CPAN
going\sfor\s<t::TestSuite::FSM>->\[push_push\]. } ],
[ q|{switch} !isa defined method, | .
q|{namespace} isa (t::TestSuite::switch)|,
[qw| fail noise noise |],
sub {
$switch = t::TestSuite::switch->new;
undef $t::TestSuite::class_cheat;
q|hsup_hsup|, { namespace => $switch } },
[ ],
qr.\Q <t::TestSuite::switch> can't [hsup_hsup] method .,
{ -misdefaulting => qr.(?xm)\[query_switch\]:\s
defaulting\s\{switch\}\sto\s\x24self.,
noted => qr.(?xm)\[query_switch\]:\s
\{namespace\}\sisa\s\(t::TestSuite::switch\). } ],
[ q|{switch} isa defined method, | .
q|{namespace} isa (t::TestSuite::switch)|,
[qw| pass noise |],
sub { q|push_push|, { namespace => $switch } },
[ ],
sub {
$switch->{jedi_vcs}, exists $switch->{gat}, exists $bb->{MKS},
$rc },
t/base/query_switch.t view on Meta::CPAN
[qw| cvs serena_version_manager |, '', qw| tturn codeville |],
{ noted => qr.(?xm)\[query_switch\]:\s
going\sfor\s<t::TestSuite::switch>->\[push_push\]. } ],
[ q|{switch} !isa defined subroutine, | .
q|{namespace} eq (t::TestSuite::switch)|,
[qw| fail noise noise |],
sub { q|hsup_hsup|, { namespace => q|t::TestSuite::switch| } },
[ ],
qr.(?xm)\[query_switch\]:\s
<t::TestSuite::switch>\spackage\scan't\s\[hsup_hsup\].,
{ -misdefaulting =>
qr.(?m)\Q[query_switch]: defaulting {switch} to \E\x24self.,
scalar_noted => qr.(?m)\Q[query_switch]: {namespace} isa (). } ],
[ q|{switch} isa defined subroutine, | .
q|{namespace} eq (t::TestSuite::switch)|,
[qw| pass noise |],
sub { q|push_push|, { namespace => q|t::TestSuite::switch| } },
[ ],
sub { $bb->{jedi_vcs}, exists $bb->{MKS}, $rc },
[ q|controltier|, '', q|tturn| ],
{ noted => qr.(?xm)\[query_switch\]:\s
going\sfor\s<t::TestSuite::switch>::\[push_push\]. } ],
( run in 0.594 second using v1.01-cache-2.11-cpan-0a6323c29d9 )