#!perl -w
=begin DoxPod
=pod @file
Multi Flip-Flop. Provides functionality like Perl's flip-flop operator
( C<...> ) with the added feature of additional states.
=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;
}
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"; }
while (<DATA>) {
chomp;
mff(qr/alpha/ => \&s1,
qr/beta/ => \&s2,
qr/gamma/ => \&s3,
qr/omega/) 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?
And the output:
*:This is
1:the alpha
1:but not
1:the omega
2:Now the beta
2:progressing to
3:the gamma
3:and finally
*:the omega
*:Did this work?
To do: Add tests for code and scalar based conditions.