Hook::Filter::Rule - A hook filter rule

Hook-Filter documentation

Contained in the Hook-Filter distribution.

Index

NAME
DESCRIPTION
SYNOPSIS
INTERFACE
- subname
- arg
- from
DIAGNOSTICS
BUGS AND LIMITATIONS
SEE ALSO
VERSION
AUTHOR
LICENSE

Code Index:

package Hook::Filter::Rule
- new
- rule
- source
- eval
__END__
EOF

NAME

Hook::Filter::Rule - A hook filter rule

DESCRIPTION

A filter rule is a string containing a perl expression that evaluates to either true or false.

A rule may contain calls to functions exported by any module under Hook::Filter::Plugins::.

SYNOPSIS

    use Hook::Filter::Rule;

    my $rule = Hook::Filter::Rule->new("1");
    if ($rule->eval) {
	print "just now, the rule [".$rule->rule."] is true\n";
    }

INTERFACE

my $r = new($rule)

Return a new Hook::Filter::Rule created from the string $rule. $rule is a valid line of perl code that should return either true or false when eval-ed. It can contain calls to any of the functions exported by the plugin modules located under Hook::Filter::Plugins::.

$r->eval()

Eval this rule. Return 0 if the rule eval-ed to false. Return 1 if the rule eval-ed to true, or if the rule died/croaked.

If the rule dies/croaks/confesses while being eval-ed, a perl warning is thrown and the rule is assumed to return true (fail-safe). The warning contains details about the error message, the rule itself and where it comes from (as specified with source()).

$r->source($message)

Specify the origin of this rule. If the rule was parsed from a rule file, $message should be the path to this file. This is used in the warning message emitted when a rule dies during eval().

$r->rule()

Return the rule's string ($rule in new()).

The following functions are exported by the default plugin library Hook::Filter::Plugin::Library:

subname
arg
from

DIAGNOSTICS

use Hook::Filter::Rule croaks if a plugin module tries to export a function name that is already exported by an other plugin.
Hook::Filter::Rule->new($rule) croaks if $rule is not a scalar.
$rule->eval() will emit a perl warning if the rule dies when eval-ed.
$rule->source($text) croaks if $text is not a scalar.

BUGS AND LIMITATIONS

See Hook::Filter

SEE ALSO

See Hook::Filter, Hook::Filter::RulePool, Hook::Filter::Hooker, Hook::Filter::Plugins::Library.

VERSION

$Id: Rule.pm,v 1.7 2008/06/09 21:04:08 erwan_lemonnier Exp $

AUTHOR

Erwan Lemonnier <erwan@cpan.org>

LICENSE

See Hook::Filter.

Hook-Filter documentation

Contained in the Hook-Filter distribution.

#################################################################
#
#   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__