Acme-FSM
view release on metacpan or search on metacpan
=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 );
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.
=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
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
t/process/sort.t view on Meta::CPAN
Denebola Keid Meissa Rigil_Kentaurus
Scheat Skat |];
@inbase = ([ @$super ], [ reverse @$super ]);
for ( 2 .. @$super ) {
my $base = [ @{$inbase[0]} ];
push @$base, shift @$base;
unshift @inbase, $base, [ reverse @$base ] }
while( @inbase ) {
AFSMTS_wrap;
# XXX:202501120433:whynot: This is cranky.
my $backup = defined $inbase[0] ? [ $inbase[0] ] : [[ qw|***qG1k***| ]];
fail qq|@{$backup->[0]}| unless
AFSMTS_smartmatch @input, @$super }
pass q|success, you know|;
# vim: set filetype=perl
( run in 1.396 second using v1.01-cache-2.11-cpan-49f99fa48dc )