File Coverage

blib/lib/Net/Radius/Server/Rule.pm

Criterion	Covered	Total	%
statement	15	39	38.4
branch	0	8	0.0
condition			n/a
subroutine	5	6	83.3
pod			n/a
total	20	53	37.7

#! /usr/bin/perl
#
#
# $Id: Rule.pm 75 2009-08-12 22:08:28Z lem $

package Net::Radius::Server::Rule;

use 5.008;
use strict;
use warnings;

use base qw/Net::Radius::Server::Base/;
use Net::Radius::Server::Base qw/:all/;

our $VERSION = do { sprintf "%0.3f", 1+(q$Revision: 75 $ =~ /\d+/g)[0]/1000 };

__PACKAGE__->mk_accessors(qw/match_methods set_methods/);

sub eval
{
    my $self = shift;
    $self->match_methods([]) unless $self->match_methods;
    $self->set_methods([]) unless $self->set_methods;

    $self->log(4, "Starting eval");

    my $c = 0;
    # Verify match methods
    for my $m (@{$self->match_methods})
    {
	$self->log(4, "Invoking match method $c");
	unless ($m->(@_) == NRS_MATCH_OK)
	{
	    $self->log(3, "Method $c did not match - Rule fail");
	    return;
	}
	$c++;
    }

    $self->log(4, "Rule matches");

    my $r = NRS_SET_DISCARD;	# Default retval

    $c = 0;
    # Invoke set methods
    for my $s (@{$self->set_methods})
    {
	$self->log(4, "Invoking set method $c");
	$r = $s->(@_);
	if ($r & NRS_SET_SKIP)
	{
	    $self->log(3, "Set method returned $c (skip)");
	    last;
	}
    }

    $self->log(4, "Set returning $r");
    return $r;
}


42;

__END__