File Coverage

blib/lib/Trigger.pm

Criterion	Covered	Total	%
statement	50	52	96.1
branch	13	18	72.2
condition	1	3	33.3
subroutine	6	7	85.7
pod	2	2	100.0
total	72	82	87.8

package Trigger;

use strict;
use 5.8.1;
our $VERSION = '0.02';

use base qw(Class::Accessor::Fast);

sub new {
    my $class = shift;
    my $self = $class->SUPER::new();
    $self->mk_accessors(qw/heap _process _trigger _action _trigger_and_action _end/);

    my $args  = {
        #inline_states => {},
        @_
    };

    if( my $inline_states = delete $args->{inline_states} ){
        $args = {
            heap    => {},
            init    => undef,
            process => sub { 1 },
            trigger_and_action  => [],
            end     => undef,
            %{$inline_states}
        };
    }

    $self->heap($args->{heap}) if defined $args->{heap};
    $self->_process($args->{process});
    $self->_trigger([]);
    $self->_action([]);
    $self->_end($args->{end});
    $self->_trigger_and_action( scalar @{$args->{trigger_and_action}} );
    $self->_trigger_and_action % 2 and die ;
    while( @{$args->{trigger_and_action}} ){
        my($trigger, $action) = splice @{$args->{trigger_and_action}}, 0, 2;
        push @{$self->_trigger}, $trigger;
        push @{$self->_action} , $action;
    }
    $self->_trigger_and_action( $self->_trigger_and_action / 2 - 1);
    $args->{init}->($self) if defined $args->{init} and ref $args->{init};
    return $self;
}

sub eval{
    my $self = shift;
    my @action_re;
    my @process_re = $self->_process->($self => @_);
    for ( 0 .. $self->_trigger_and_action ){
        if( my @trigger_re = $self->_trigger->[$_]->($self => @process_re) ){
            if( ref $self->_action->[$_] eq 'CODE' ){
                @action_re = $self->_action->[$_]->($self => @trigger_re) ;
            }elsif( ref $self->_action->[$_] eq 'ARRAY' ){
                for my $code( @{$self->_action->[$_]} ){
                    @action_re = $code->($self => @trigger_re);
                }
            }else{
                die ref $self->_action->[$_];
            }
        }
    }
    @action_re ? return @action_re : return @process_re;
}

sub DESTROY{
    my $self = shift;
    $self->_end->($self) if $self->_end;
    delete $self->{$_} for (keys %{$self});
}

1;
__END__