File Coverage

blib/lib/FSM/Tiny.pm

Criterion	Covered	Total	%
statement	71	82	86.5
branch	16	28	57.1
condition	4	4	100.0
subroutine	16	18	88.8
pod	4	5	80.0
total	111	137	81.0

package FSM::Tiny;

# http://www.crsr.net/Programming_Languages/PerlAutomata.html
use strict;
use warnings;

our $VERSION = '0.03';
our $DEBUG = 0;

use Class::Accessor::Lite;

my %Defaults = (
    current  => '',
    (map { $_ => {} } qw/rules context/),
    (map { $_ => sub {} } qw/on_enter on_exit on_transition/)
);

Class::Accessor::Lite->mk_accessors(keys %Defaults);

sub new {
    my $package = shift;
    my %args = $_[1] ? %{ @_ } : %{ $_[0] };
    my $self = bless +{ %Defaults, %args }, $package;

    for my $key (keys %{ $self->rules }) {
        my $s = $self->rules->{$key};
        if (my $r = ref $s) {
            if ($r eq 'ARRAY') {
                $self->register($key, @$s);
            }
            elsif ($r eq 'CODE') {
                $self->register($key, $s);
            }
        }
        else {
            delete $self->rules->{$key};
        }
    }

    return $self;
}

sub _log { warn "[FSM::Simele DEBUG] ".join(' ', @_) . "\n" if $DEBUG }

sub register {
    my $self = shift;
    my ($key, $code, $guards) = @_;
    $self->current($key) unless $self->current;
    $guards ||= [];
    _log("register: ${key}");
    $self->rules->{$key} = FSM::Tiny::State->new(
        code   => $code,
        guards => $guards
    );
}

sub unregister {
    my ($self, $key) = @_;
    _log("unregister: ${key}");
    delete $self->rules->{$key};
}

sub step {
    my $self = shift;
    my $st = $self->rules->{$self->current} or return;
    $st->run($self->context);
    my $next = $st->next($self->context) or return;
    $self->current($next);
    _log("next -> " . $self->current);
    return 1;
}

sub run {
    my $self = shift;
    $self->context(+{ %{ $self->context }, %{ $_[0] || {} } });
    local $_ = $self->context;
    $self->on_enter->($self->context);
    while (1) {
        if (!@{$self->rules->{$self->current}{guards}}) {
            $self->step;
            last;
        }
        $self->step or last;
        $self->on_transition->($self->context);
    }
    $self->on_exit->($self->context);
    $self;
}

package FSM::Tiny::State;

sub new {
    my $package = shift;
    my %args = @_;
    my @guards = @{ $args{guards} || [] };
    my @list;
    while (@guards) {
        my ($key, $code) = splice @guards, 0, 2;
        push @list, FSM::Tiny::Guard->new(
            key  => $key,
            code => (ref($code) || '') ne 'CODE' ? sub { $code } : $code
        );
    }
    $args{guards} = \@list;
    bless \%args, $package;
}

sub next {
    my ($self, $context) = @_;
    for my $guard (@{ $self->{guards} }) {
        return $guard->key if $guard->check($context);
    }
    return '';
}

sub run {
    my ($self, $context) = @_;
    local $_ = $context;
    $self->{code}->($context);
}

package FSM::Tiny::Guard;

sub key { shift->{key} }

sub code { shift->{code} }

sub new {
    my $package = shift;
    my %args = @_;
    bless +{ key  => '', code => sub { 1 }, %args }, $package;
}

sub check {
    my ($self, $context) = @_;
    return $self->code->($context);
}

1;
__END__