File Coverage

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

Criterion	Covered	Total	%
statement	21	43	48.8
branch	0	12	0.0
condition	0	9	0.0
subroutine	7	10	70.0
pod			n/a
total	28	74	37.8

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

package Net::Radius::Server::Set;

use 5.008;
use strict;
use warnings;
use Carp qw/croak/;

use Net::Radius::Server::Base ':set';
use base 'Net::Radius::Server::Base';
our $VERSION = do { sprintf "%0.3f", 1+(q$Revision: 75 $ =~ /\d+/g)[0]/1000 };

sub mk
{
    my $self = shift;
    croak "->mk() cannot have arguments when in object-method mode\n"
	if ref($self) and $self->isa('UNIVERSAL') and @_;

    my $n = $self;

    if (@_)
    {
	$n = $self->new(@_);
	die "Failed to create new object\n" unless $n;
    }

    return sub { $n->_set(@_) };
}

sub _set
{
    my $self	= shift;
    my $r_args	= shift;

    for my $arg (sort keys %$self)
    {
	next if $arg =~ /^_/;
	if ($self->can('set_' . $arg))
	{
	    no strict 'refs';
	    my $m = 'set_' . $arg;
	    $self->log(4, "Invoking set method $m");
	    $self->$m($r_args, @_);
	}
    }

    if ($self->can('result') and exists $self->{result})
    {
	my $r = $self->result;
	$self->log(4, "Set returning $r");
	return $r;
    }

    $self->log(4, "Set returning CONTINUE by default");
    return NRS_SET_CONTINUE;
}

42;

__END__