The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl Net-IP-LPM.t'

#########################

# change 'tests => 1' to 'tests => last_test_to_print';

use Test::More tests => 5;
BEGIN { use_ok('Net::IP::LPM') };

use Socket qw( AF_INET );
use Socket6 qw( inet_ntop inet_pton AF_INET6 );

#########################

# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.

my $lpm = Net::IP::LPM->new();

isa_ok($lpm, 'Net::IP::LPM', 'Constructor');

# list of prefixes to test
my @prefixes = ( 
		'0.0.0.0/0', 
		'147.229.3.1', '147.229.3.2/32', '147.229.3.0/24', '147.229.0.0/16',
		'10.255.3.0/24', '10.255.3.0/32',
		'::/0',
		'2001:67c:1220:f565::1234', '2001:67c:1220:f565::1235/128', 
		'2001:67c:1220:f565::/64', '2001:67c:1220::/32'
		);


foreach (@prefixes) {
	$lpm->add($_, $_);
}

$lpm->rebuild();

#use DB_File;
#my $x = $lpm->{DB};
#my $value = undef;
#my $key = undef;
#for ($st = $x->seq($key, $value, R_FIRST) ; $st == 0 ; $st = $x->seq($key, $value, R_NEXT) ) {
#    diag sprintf "%s  -> $value\n", unpack("H*", $key);
#}

my %tests = ( 
		'147.229.3.0'	=> '147.229.3.0/24',
		'147.229.3.1'	=> '147.229.3.1',
		'147.229.3.2'	=> '147.229.3.2/32',
		'147.229.3.3'	=> '147.229.3.0/24',
		'147.229.3.10'	=> '147.229.3.0/24',
		'147.229.3.254'	=> '147.229.3.0/24',
		'147.229.3.255'	=> '147.229.3.0/24',
		'147.229.4.0'	=> '147.229.0.0/16',
		'147.229.4.1'	=> '147.229.0.0/16',
		'147.228.255.255'	=> '0.0.0.0/0',
		'147.229.0.0'	=> '147.229.0.0/16',
		'147.229.255.255'	=> '147.229.0.0/16',
		'147.230.0.0'	=> '0.0.0.0/0',
		'147.230.0.1'	=> '0.0.0.0/0',
		'10.255.3.0'	=> '10.255.3.0/32',
		'0.0.0.0'		=> '0.0.0.0/0',
		'0.0.0.1'		=> '0.0.0.0/0',
		'255.255.255.254'	=> '0.0.0.0/0',
		'255.255.255.255'	=> '0.0.0.0/0',
		'2001:67c:1220::1'			=> '2001:67c:1220::/32',
		'2001:67c:1220:f565::1234'	=> '2001:67c:1220:f565::1234',
		'2001:67c:1220:f565::'		=> '2001:67c:1220:f565::/64',
		'2001:67c:1220:f565::1'		=> '2001:67c:1220:f565::/64',
		'2001:67c:1220:f565:FFFF:FFFF:FFFF:FFFF'	=> '2001:67c:1220:f565::/64',
		'2001:67c:1220:f566::'	=> '2001:67c:1220::/32',
		'2001:67c:1220:f566::1'	=> '2001:67c:1220::/32',
		'2001:67c:2325:f566::1'	=> '2001:67c:1220::/32',
		'2001:67b:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF'	=> '::/0',
		'2001:67d::1'			=> '::/0',
		'2001::1'				=> '::/0',
		'FFFF:FFFF:FFFF:FFF:FFFF:FFFF:FFFF:FFFF'	=> '::/0',
		'FFFF:FFFF:FFFF:FFF:FFFF:FFFF:FFFF:FFFE'	=> '::/0',
		'::0.0.0.0'	=> '::/0',
		'0001::'	=> '::/0',
		'2001::1'	=> '::/0',
		);

# std lookup
my %results = ();
#diag "\n";
while ( my ($a, $p) = each %tests ) {
	my $res = $lpm->lookup($a);
	if ($p ne $res) {
		diag sprintf "FAIL %s \t-> \t%s =%s %s\n", $a, $p, $p eq $res ? '=' : '!', $res;
	}
	$results{$a} = $res;
}

ok( eq_hash(\%tests, \%results) );

# std raw lookup
%results = ();
#diag "\n";
while ( my ($a, $p) = each %tests ) {
	my $ab ;
	if ($a =~ /:/) {
		$ab = inet_pton(AF_INET6, $a);
	} else {
		$ab = inet_pton(AF_INET, $a);
	}
	my $res = $lpm->lookup_raw($ab);
	if ($p ne $res) {
		diag sprintf "FAIL RAW %s \t-> \t%s =%s %s\n", $a, $p, $p eq $res ? '=' : '!', $res;
	}
	$results{$a} = $res;
}

ok( eq_hash(\%tests, \%results) );

# std cache raw lookup
%results = ();
#diag "\n";
while ( my ($a, $p) = each %tests ) {
	my $ab ;
	if ($a =~ /:/) {
		$ab = inet_pton(AF_INET6, $a);
	} else {
		$ab = inet_pton(AF_INET, $a);
	}
	my $res = $lpm->lookup_cache_raw($ab);
	if ($p ne $res) {
		diag sprintf "FAIL CACHE RAW %s \t-> \t%s =%s %s\n", $a, $p, $p eq $res ? '=' : '!', $res;
	}
	$results{$a} = $res;
}

ok( eq_hash(\%tests, \%results) );