File Coverage

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

Criterion	Covered	Total	%
statement	30	42	71.4
branch	0	8	0.0
condition	0	5	0.0
subroutine	10	12	83.3
pod	2	2	100.0
total	42	69	60.8

package Net::Radius::Server::Base;

use 5.008;
use strict;
use warnings;

require Exporter;
use base qw/Net::Radius::Server Exporter/;

# These are constants useful for the "match" methods
use constant NRS_MATCH_FAIL	=> 0x0;
use constant NRS_MATCH_OK	=> 0x1;

# These constants are used for the "set" methods
use constant NRS_SET_CONTINUE	=> 0x0;
use constant NRS_SET_SKIP	=> 0x1;
use constant NRS_SET_RESPOND	=> 0x2;
use constant NRS_SET_DISCARD	=> 0x4;

our %EXPORT_TAGS = (
		     match	=>
		     [ qw(
			  NRS_MATCH_FAIL
			  NRS_MATCH_OK
			  )],
		     set	=>
		     [ qw(
			  NRS_SET_CONTINUE
			  NRS_SET_SKIP
			  NRS_SET_RESPOND
			  NRS_SET_DISCARD
			  )],
);

do
{
    my %seen = ();
    my @all = ();
    for my $k (keys %EXPORT_TAGS)
    {
	push @all, grep { ! $seen{$_}++ } @{$EXPORT_TAGS{$k}};
    }
    $EXPORT_TAGS{all} = \@all;
};

Exporter::export_ok_tags('all');

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

__PACKAGE__->mk_accessors(qw/description log_level/);

sub log
{
    my $self = shift;
    my $level = shift;

    return unless $level <= ($self->log_level || 2);
    if ($self->can('description'))
    {
	warn $self->description . ": " . join(" ", @_) . "\n";
    }
    elsif (ref($self))
    {
	warn ref($self) . ": " . join(" ", @_) . "\n";
    }
    else
    {
	warn @_, "\n";
    }
}

sub new
{
    my $class	= shift;
    my $self = $class->SUPER::new(@_);
    my @c = caller;
    $self->description((ref($class) || $class) . " ($c[1]:$c[2])")
	unless $self->description;
    return $self;
}
42;
__END__