File Coverage

blib/lib/VS/RuleEngine/Runloop.pm

Criterion	Covered	Total	%
statement	126	127	99.2
branch	27	32	84.3
condition	8	9	88.8
subroutine	18	18	100.0
pod	5	5	100.0
total	184	191	96.3

package VS::RuleEngine::Runloop;

use strict;
use warnings;

use Carp qw(croak);
use List::Util qw(first);
use Scalar::Util qw(refaddr blessed);

use VS::RuleEngine::Constants;

my %Engine;
my %Runloop;
my %Initialized;

sub new {
    my ($pkg) = @_;
    my $self = bless \do { my $v; }, $pkg;
    $$self = refaddr $self;

    $Engine{$$self} = [];
    $Runloop{$$self} = [];
    $Initialized{$$self} = 0;

    return $self;
}

sub DESTROY {
    my $self = shift;
    delete $Engine{$$self};
    delete $Initialized{$$self};
    delete $Runloop{$$self};
}

sub add_engine {
    my ($self, $engine, $global) = @_;

    croak "Engine is undefined" if !defined $engine;
    croak "Engine is not a VS::RuleEngine::Engine instance" if !(blessed $engine && $engine->isa("VS::RuleEngine::Engine"));

    my $engines = $Engine{$$self};
    if (!first { $_->[0] == $engine } @$engines) {
        push @$engines, [$engine, $global];
    }
    else {
        croak "Engine already exists";
    }
}

sub init {
    my ($self) = @_;

    return if $Initialized{$$self};

    for my $engine (@{$Engine{$$self}}) {
        my $runloop = _mk_runloop($engine->[0], $engine->[1]);
        $self->_register_runloop($runloop);
    }
}

sub _mk_runloop {
    my $engine = shift;
    my $global = shift;

    my @rules = @{$engine->_rule_order};

    my %action_map  = map {
        my $actions = $engine->_get_rule_actions($_);
        $_ => [@{$actions}];
    } @rules;

	my %rules       = map {
	    my $rule = $engine->_get_rule($_);
	    my $rule_obj = $rule->instantiate($engine);
	    $_ => $rule_obj;
    } @rules;

    my %actions     = map {
        my $action = $engine->_get_action($_);
        my $action_obj = $action->instantiate($engine);
        $_ => $action_obj;
    } $engine->actions;

	my @pre_hooks	= map { $_->instantiate($engine); } map { $engine->_get_hook($_) } @{$engine->_pre_hooks};
	my @post_hooks	= map { $_->instantiate($engine); } map { $engine->_get_hook($_) } @{$engine->_post_hooks};

	my $inputs		= $engine->_input_handler;
	my @outputs		= map { $_->instantiate($engine); } map { $engine->_get_output($_) } sort $engine->outputs;

	$global = $global || VS::RuleEngine::Data->new();

	$inputs->set_global($global);

	my $runloop = sub {
	    $inputs->_clear();

		my $local = VS::RuleEngine::Data->new();

		$inputs->set_local($local);

		my $skip = 0;

		# Process all pre hooks
		for my $hook (@pre_hooks) {
			my $result = $hook->invoke($inputs, $global, $local);
			$skip = 1 if $result == KV_SKIP;
			return KV_ABORT if $result == KV_ABORT;
		}

		# Run rules until we find a matching rule
		if (!$skip) {
		    my $match;

		    PROCESS_RULES: for (@rules) {
		        my $rule = $rules{$_};
			    my $result = $rule->evaluate($inputs, $global, $local);
			    $skip = 1, last PROCESS_RULES if $result == KV_SKIP;
			    $match = $_, last PROCESS_RULES if $result == KV_MATCH;
		    }

            # Run all actions
            if (!$skip && $match) {
                $local->set('VS::RuleEngine/matchingRule' => $match);
                my $actions = $action_map{$match};
                for (@$actions) {
                    my $action = $actions{$_};
                    $action->perform($inputs, $global, $local);
                }
            }
        }

        # All outputs are always called if somethings decides not to skip
        if (!$skip) {
		    PROCESS_OUTPUT: for my $output (@outputs) {
			    $output->process($inputs, $global, $local);
		    }
		}

		# Process all post hooks
		for my $hook (@post_hooks) {
			my $result = $hook->invoke($inputs, $global, $local);
			return KV_ABORT if $result == KV_ABORT;
		}

		return KV_CONTINUE;
	};

	return $runloop;
}

sub _register_runloop {
    my ($self, $runloop) = @_;

    my $runloops = $Runloop{$$self};
    if (!first { $_ == $runloop } @$runloops) {
        push @$runloops, $runloop;
    }
    else {
        croak "Runloop already registered";
    }
}

sub _unregister_runloop {
    my ($self, $runloop) = @_;

    my $runloops = $Runloop{$$self};
    my @runloops = grep { $_ != $runloop } @$runloops;
    $Runloop{$$self} = \@runloops;

}

sub step {
    my $self = shift;

    my $runloops = $Runloop{$$self};

    if (@$runloops) {
        for my $runloop (@$runloops) {
            my $status = $runloop->();
            if ($status == KV_ABORT) {
                $self->_unregister_runloop($runloop);
            }
        }
    }

    return scalar @$runloops;
}

sub run {
    my $self = shift;

    $self->init();

    RUNLOOP: while(1) {
        last RUNLOOP if $self->step() == 0;
    }
}

1;
__END__