view release on metacpan or  search on metacpan

lib/VS/RuleEngine/Declare.pm  view on Meta::CPAN

package VS::RuleEngine::Declare;

use strict;
use warnings;

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

use VS::RuleEngine::Engine;

use VS::RuleEngine::Action::Perl;
use VS::RuleEngine::Hook::Perl;
use VS::RuleEngine::Input::Perl;
use VS::RuleEngine::Output::Perl;
use VS::RuleEngine::Rule::Perl;

use VS::RuleEngine::Util qw(is_existing_package);

require Exporter;

our @ISA = qw(Exporter);

our @EXPORT = qw(
    action
    as
    defaults
    does
    engine 
    input 
    instanceof
    load_module
    output
    posthook
    prehook
    rule
    run
    when
    with_args
    with_defaults
);

our $current_engine;

sub engine(&) {
    my ($sub, $name) = @_;

    my $engine = VS::RuleEngine::Engine->new();

    local $current_engine = $engine;
    $sub->();
    
    if (defined $name) {
        VS::RuleEngine::Engine->register_engine($name => $engine);
    }
    
    return $engine;
}

sub as($) {
    return $_[0];
}

sub does(&) {
    my $cv = shift;
    my $does = bless [$cv], "_Does";
    return $does;
}

{
    my %Classes;
    sub load_module($) {
        my $class = shift;
        if (!exists $Classes{$class}) {
            eval "require $class;";
            croak $@ if $@;
            $Classes{$class} = 1;
        }
        
        1;        
    }
}

sub instanceof($) {
    my $class = shift;
    load_module($class) if !is_existing_package($class);
    my $instanceof = bless [$class], "_InstanceOf";
    return $instanceof;
}

sub with_args($) {
    my $args = shift;
    croak "Arguments must be a hash reference" if ref $args ne 'HASH';
    my $with_args = bless $args, "_WithArgs";
    return $with_args;
}

sub with_defaults($) {
    my $defaults = shift;
    croak "Arguments must be a single string or an array reference" if ref $defaults && ref $defaults ne 'ARRAY';
    $defaults = [$defaults] if ref $defaults ne 'ARRAY';
    
    my $with_defaults = bless [@$defaults], "_WithDefaults";
    return $with_defaults;
}

sub when(@) {
    for (@_) {
        croak "Rule '$_' does not exist" if !$current_engine->has_rule($_);
    }
    my $rules = bless [@_], "_When";
    return $rules;
}

sub run(@) {
    my @when = grep { blessed $_ && $_->isa('_When') } @_;
    my @actions = grep { !(blessed $_ && $_->isa('_When')) } @_;
    
    croak "Unkown input for 'run'" if @_ > @when + @actions;