File Coverage

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

Criterion	Covered	Total	%
statement	24	24	100.0
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	32	32	100.0

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

package Net::Radius::Server::Dump;

use 5.008;
use strict;
use warnings;
use IO::File;
use File::Spec;
use Time::HiRes qw/gettimeofday/;

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

use Net::Radius::Server::Base qw/:set/;
use base qw/Net::Radius::Server::Set/;
__PACKAGE__->mk_accessors(qw/basepath basename result/);

sub set_basepath
{
    my $self = shift;
    my $r_data = shift;

    $self->basename('packet-') unless $self->basename;
    my $time = join('-', gettimeofday);
    my $file = File::Spec->catfile($self->basepath, $self->basename . $time);

    if (-f $file)
    {
	$self->log(2, "$file already exists. Won't overwrite");
	return;
    }

    my $fh = new IO::File($file, "w");

    unless ($fh)
    {
	$self->log(2, "Can't create $file: $!");
	return;
    }

    print $fh "*** RADIUS Request:\n";
    print $fh $r_data->{request}->str_dump, "\n\n";
    print $fh "*** RADIUS Response:\n";
    print $fh $r_data->{response}->str_dump, "\n\n";
    close $fh;
    $self->log(4, "Packet dump stored at $file");
}

42;

__END__