#!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. States are
#  advanced sequentially until the final condition becomes true. At that point,
#  the state is reset to the implicit 'waiting for somthing to do' state.
#  @param $c0 Condition. If a reference, evaluated when waiting to enter 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?