File Coverage

blib/lib/Hook/Filter/Rule.pm

Criterion	Covered	Total	%
statement	51	52	98.0
branch	11	12	91.6
condition	13	15	86.6
subroutine	12	12	100.0
pod	4	4	100.0
total	91	95	95.7

#################################################################
#
#   Hook::Filter::Rule - A filter rule
#
#   $Id: Rule.pm,v 1.7 2008/06/09 21:04:08 erwan_lemonnier Exp $
#
#   060301 erwan Created
#   070516 erwan Small POD and layout fixes
#   070524 erwan Used BEGIN instead of INIT
#   080609 erwan Updated POD
#

package Hook::Filter::Rule;

use 5.006;
use strict;
use warnings;
use Carp qw(croak);
use Data::Dumper;
use Symbol;
use Module::Pluggable search_path => ['Hook::Filter::Plugins'], require => 1;

our $VERSION='0.04';

#----------------------------------------------------------------
#
#   load test functions from plugins
#

BEGIN {

    my %TESTS;

    foreach my $plugin (Hook::Filter::Rule->plugins()) {
	my @tests = $plugin->register();
	# TODO: test that @tests is an array of strings. die with BUG:

	foreach my $test ($plugin->register()) {
	    if (exists $TESTS{$test}) {
		croak "invalid plugin function: test function [$test] exported by plugin [$plugin] is already exported by an other plugin.";
	    }
	    *{ qualify_to_ref($test,"Hook::Filter::Rule") } = *{ qualify_to_ref($test,$plugin) };
	    $TESTS{$test} = 1;
	}
    }
}

#----------------------------------------------------------------
#
#   new - build a new filter rule
#

sub new {
    my($pkg,$rule) = @_;
    $pkg = ref $pkg || $pkg;
    my $self = bless({},$pkg);

    if (!defined $rule || ref \$rule ne "SCALAR" || scalar @_ != 2) {
	shift @_;
	croak "invalid parameter: Hook::Filter::Rule->new expects one string describing a filter rule, but got [".Dumper(@_)."].";
    }

    $self->{RULE} = $rule;

    return $self;
}

#----------------------------------------------------------------
#
#   rule - accessor for the rule
#

sub rule {
    return $_[0]->{RULE};
}

#----------------------------------------------------------------
#
#   source - where the rule came from (used in error messages only)
#

sub source {
    my($self,$orig) = @_;

    if (!defined $orig || ref \$orig ne "SCALAR" || scalar @_ != 2) {
	shift @_;
	croak "invalid parameter: Hook::Filter::Rule->source expects one string, but got [".Dumper(@_)."].";
    }

    $self->{SOURCE} = $orig;
}

#----------------------------------------------------------------
#
#   eval - evaluate a rule. return either true or false
#

sub eval {
    my $self = shift;
    my $rule = $self->{RULE};

    my $res = eval $rule;
    if ($@) {
	# in doubt, let's assume we are not filtering anything, ie allow function calls as if we were not here
	warn "WARNING: invalid Hook::Filter rule [$rule] ".
	    ( (defined $self->{SOURCE})?"from file [".$self->{SOURCE}."] ":"")."caused error:\n".
	    "[".$@."]. Assuming this rule returned true.\n";
	return 1;
    }

    return ($res)?1:0;
}

1;

__END__