libnet-radius-perl/t/packets.t

#!/usr/bin/perl

# Process each binary packet in the distribution, performing generic tests
# on it

# $Id: packets.t 73 2007-01-30 10:22:35Z lem $

no utf8;
use strict;
use warnings;

use IO::File;
use File::Find;
use Test::More;
use Test::Warn;

use Net::Radius::Packet;
use Net::Radius::Dictionary;

# Pick a default dictionary to use in case none is defined
my $def_dict = 'dicts/dictionary';

# Find all the test inputs we will be processing here
my @inputs = ();

find ({ untaint => 1, follow => 1, no_chdir => 1,
	wanted => sub 
	{
	    return unless $File::Find::name =~ m/\.p$/;
	    push @inputs, $File::Find::name;
	}, 
    }, qw!packets!);

# Provide a test plan based in how many test inputs where found
plan tests => @inputs * 13;

# Perform the tests for each test input
for my $i (@inputs)
{
  SKIP: {
      # Read the test input
      skip "$i not readable", 12 unless -r $i and -r _;

      my $fh = new IO::File $i, "r";
      my $input = '';
      our $VAR1 = undef;     # Placeholder for the recovered structure
      ok($fh, "Open test input $i for reading");
      do {
	  local $/ = undef;
	  ok ($input = <$fh>, "Read non-empty test input");
      };

      ok(close $fh, "Close the test input after reading");
      ok(length($input), "Test input is non-empty");
      like($input, qr/# Net::Radius test input/m, 
	   "Input looks like a test input");

      unless (eval "$input" and ok(!$@, "Eval errors"))
      {
	  diag $@;
	  skip "Problems with eval() of $i", 7;
      }

      ok(ref($VAR1) eq 'HASH', "Load $i: " . 
	 ($VAR1->{description} || 'No desc'));

      # Try to build a suitable dictionary for decoding the packet

      my $d;

      if ($VAR1->{dictionary})
      {
	  # Use bundled dictionary for decoding this packet
	  $d = $VAR1->{dictionary};
      }
      else
      {
	  $d = new Net::Radius::Dictionary;

	  if ($VAR1->{opts}->{dictionary})
	  {
	      # Try to load the specified dictionaries - Ignore errors
	      $d->readfile($_) for @{$VAR1->{opts}->{dictionary}};
	  }
	  else
	  {
	      # Try to load the default dictionary
	      $d->readfile($def_dict);
	  }
      }

      isa_ok($d, 'Net::Radius::Dictionary');

      my $p;
      warnings_are(sub { $p = new Net::Radius::Packet $d, $VAR1->{packet} },
		   [], "No warnings on packet decode");
      
      isa_ok($p, 'Net::Radius::Packet');

      if (exists($VAR1->{slots}))
      {
	  is $p->attr_slots, $VAR1->{slots}, "Correct number of slots";
      }
      else
      {
	SKIP: { skip "Test input provides no number of slots", 1 };
      }

      if (exists($VAR1->{identifier}))
      {
	  is $p->identifier, $VAR1->{identifier}, "Correct identifier";
      }
      else
      {
	SKIP: { skip "Test input provides no identifier", 1 };
      }

      if (exists($VAR1->{authenticator}))
      {
	  is $p->authenticator, $VAR1->{authenticator}, 
	  "Correct authenticator";
      }
      else
      {
	SKIP: { skip "Test input provides no authenticator", 1 };
      }
  };
}