Acme-FSM

 view release on metacpan or  search on metacpan

lib/FSM.pm  view on Meta::CPAN

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};

lib/FSM.pm  view on Meta::CPAN

=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

t/process/parse.t  view on Meta::CPAN

    $bb->action eq q|fail|                                         and return;
    $bb->{fail} = q|no right|           if $bb->{op} && !defined $bb->{right};
    $bb->{fail}                                                    and return;
    $bb->{left} = eval qq|$bb->{left} $bb->{op} $bb->{right}|               if
      $bb->{op} && defined $bb->{right};
    $bb->{left} = eval qq|$bb->{left}|                 if defined $bb->{left};
    delete $bb->{right};
    delete $bb->{op} }

while( my $input = shift @inbase )                                {
    @input = split m{}, $input->[0];
    AFSMTS_wrap;
    do_stuff;
    until( $bb->state eq q|STOP| ) { AFSMTS_method_wrap q|process|; do_stuff }
    is_deeply
    [ $bb->action, @$bb{qw| fail left |} ], [ q|finish|, @$input[1 .. 2] ],
      sprintf q|(%s) (%s) (%s)|,
        $input->[0], $bb->{left} // q|(undef)|, $bb->{fail} // q|| }

# vim: set filetype=perl

t/process/quadratic.t  view on Meta::CPAN

 [ q|45 95 1 |,     q|two|,        '',    45,  95, 1, -2.10053, -0.01058 ],
 [ q|95 89 75 1|,  q|fail|,      q|1|,    95,    89,    75, undef, undef ],
 [ q|6 69 17 -|,   q|fail|,      q|-|,     6,    69,    17, undef, undef ],
 [ q|64 92 77 v|,  q|fail|,      q|v|,    64,    92,    77, undef, undef ],
 [ q| -13 21 38 |,  q|two|,        '',   -13, 21,  38, 2.69858, -1.08319 ],
 [ q|  -24  81  84  |, q|two|,     '',   -24,  81, 84, 4.20696, -0.83196 ] );

plan tests => scalar @inbase;

while( my $input = shift @inbase )                          {
    @input = split m{}, $input->[0];
    AFSMTS_wrap;
    is_deeply
    [ $rc->[0], @$bb{qw| fail coeff0 coeff1 coeff2 |},
      (defined $input->[6]                            ?
        abs( $input->[6] - $bb->{root}[0] ) < 0.00001 : undef) ],
    [ @$input[ 1 .. 5 ], (defined $input->[6] ? !0 : undef) ],
      sprintf q|(%s) (%s) (%s:%s) (%s:%s)|,
        $input->[0] // q|(undef)|, $bb->{fail} // q||,
        $bb->{root}[0] // q|(undef)|, $bb->{root}[1] // q|(undef)|,
        $input->[6] // q|(undef)|, $input->[7] // q|(undef)| }