(Realized I never posted the full, updated code. Not yet final.)
#!perl -w
package Code::MFF;
=head1 NAME
Multi Flip-Flop. Like Perl's flip-flop operator ( C<...> )
with the added feature of additional states.
=head1 SYNOPSIS
use Code::MFF;
mff(qr/regex/ => \&actionA, # trigger condition is a regex
\&testB => \&actionB, # trigger condition is a code ref
...
!! $flagN # trigger is a scalar value
);
=head1 Description
Works like the flip-flop operator ( C<...> ) with additional states
and corresponding triggers. There is a trigger condition for each
of an arbitrary number of active states, and a final trigger to
reset to the inactive state.
=head2 Trigger Conditions
Trigger conditions can be regular expressions, code refs or even
scalar values.
I<note> Unlike Flip-Flop, scalar values, including scalar valued
expressions, are evaluated in the surrounding scope, not by C<mff>.
Therefore, these are evaluated every time C<mff> is called. This
could cause problems if the expressions have side effects.
Regular expressions and code references are evaluated by C<mff> and
are only evaluated when the preceding state is active (the inactive
state for the first condition).
I<note> Because C<mff> is a function call, the conditions and actions
are evaluated in list context. If scalar context is needed, prefix
the term with C<!!> or C<+> or C<-> or C<scalar>
=head1 CAVEATS
C<mff> only (partialy) emulates the 3 dot flip-flop. Maybe it should
be called C<mfff> with C<mff> reserved for a future 2 dot flip-flop
emulation.
In exchange for its limitations, noted in a previous section, C<mff>
allows for more states than C<...> does.
=begin DoxPod
=cut
use warnings;
use strict;
use Carp;
my %states; #< Holds state based on where called from.
sub _lookupState
{
my ($f, $l) = @_[1,2];
return $states{"$f,$l"};
}
sub _saveState
{
my ($s, $x, $f, $l) = @_[0 .. 3];
$states{"$f,$l"} = $s;
}
## Multi Flip-Flop processor. A very simple state machine processor. S
+tates are
# advanced sequentially until the final condition becomes true. At th
+at point,
# the state is reset to the implicit 'waiting for somthing to do' sta
+te.
# @param $c0 Condition. If a reference, evaluated when waiting to ent
+er this state.
# Otherwise, tested for a true value.
# @param $a0 Action. Executed while in the correpsonding state.
# @param $cN Final condition.
sub mff
{
my $state = _lookupState(caller);
$state = 0 unless defined($state);
croak('Fatal: mff: Too few conditions for current state.')
if ((2 * $state) > @_);
my $type = ref($_[2 * $state]);
$type = ref(\$_[2 * $state]) if ($type eq '');
if ($type eq 'SCALAR') {
$state++ if ($_[2 * $state]);
} elsif ($type eq 'Regexp') {
$state++ if (/$_[2 * $state]/);
} elsif ($type eq 'CODE') {
$state++ if ($_[2 * $state]->($_));
} else { croak("Fatal: mff: Unsupported type: $type"); }
_saveState($state, caller);
if ((2 * $state) > @_) { # final condition was true
_saveState(0, caller);
return 0;
}
return 0 if ($state < 1); # init condition still false
return $_[(2 * $state) - 1]->($_);
}
sub _s1 { print "1:$_\n"; }
sub _s2 { print "2:$_\n"; }
sub _s3 { print "3:$_\n"; }
sub _c3 { print "Evaluating condition 3\n"; /gamma/; }
sub _c4 { print "Evaluating condition 4\n"; /omega/; }
while (<DATA>) {
chomp;
mff(qr/alpha/ => \&_s1,
qr/beta/ => \&_s2,
\&_c3 => \&_s3,
+_c4() ) or print "*:$_\n";
}
__DATA__
This is
the alpha
but not
the omega
Now the beta
progressing to
the gamma
and finally
the omega
Did this work?