File Coverage

blib/lib/Net/IP/LPM.pm

Criterion	Covered	Total	%
statement	51	68	75.0
branch	8	14	57.1
condition			n/a
subroutine	16	20	80.0
pod	7	10	70.0
total	82	112	73.2

package Net::IP::LPM;

#use 5.010001;
use strict;
use warnings;
use Carp;

require Exporter;
#use AutoLoader;

use Socket qw( AF_INET );
use Socket6 qw( inet_ntop inet_pton AF_INET6 );
use Data::Dumper;

#our @ISA = qw(DB_File);
our @ISA = qw();

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Net::IP::LPM ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '1.06';
sub AUTOLOAD {
	# This AUTOLOAD is used to 'autoload' constants from the constant()
	# XS function.

    my $constname;
    our $AUTOLOAD;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "&Net::NfDump::constant not defined" if $constname eq 'constant';
    my ($error, $val) = constant($constname);
    if ($error) { croak $error; }
    {
    no strict 'refs';
    # Fixed between 5.005_53 and 5.005_61

#XXX    if ($] >= 5.00561) {
#XXX        *$AUTOLOAD = sub () { $val };
#XXX    }
#XXX    else {
		*$AUTOLOAD = sub { $val };
#XXX    }
	}
	goto &$AUTOLOAD;
}

require XSLoader;
XSLoader::load('Net::IP::LPM', $VERSION);

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

# Below is stub documentation for your module. You'd better edit it!

=head1 NAME

Net::IP::LPM - Perl implementation of Longest Prefix Match algorithm

=head1 SYNOPSIS

  use Net::IP::LPM;

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

  # add prefixes
  $lpm->add('0.0.0.0/0', 'default');
  $lpm->add('::/0', 'defaultv6');
  $lpm->add('147.229.0.0/16', 'net1');
  $lpm->add('147.229.3.0/24', 'net2');
  $lpm->add('147.229.3.10/32', 'host3');
  $lpm->add('147.229.3.11', 'host4');
  $lpm->add('2001:67c:1220::/32', 'net16');
  $lpm->add('2001:67c:1220:f565::/64', 'net26');
  $lpm->add('2001:67c:1220:f565::1235/128', 'host36');
  $lpm->add('2001:67c:1220:f565::1236', 'host46');


  printf $lpm->lookup('147.229.100.100'); # returns net1
  printf $lpm->lookup('147.229.3.10');    # returns host3
  printf $lpm->lookup('2001:67c:1220::1');# returns net16


=head1 DESCRIPTION

The module Net::IP::LPM implements the Longest Prefix Match algorithm
to both protocols, IPv4 and IPv6.  The module uses Trie algo.

=head1 PERFORMANCE

The module is able to match  ~ 1 mln. lookups
per second to a complete Internet BGP table (approx. 500,000 prefixes) using a common
hardware (2.4GHz Xeon CPU). For more detail, make a test on the module source
to check its performance on your system. Module supports both, IPv4 and IPv6 protocols.

=head1 CLASS METHODS


=head2  new - Class Constructor


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

Constructs a new Net::IP::LPM object.

=cut
sub new {
	my ($class, $dbfile) = @_;
	my %h;
	my $self = {};

	$self->{handle} = lpm_init();

	bless $self, $class;
	return $self;
}

# converts IPv4 and IPv6 address into common format
sub format_addr {
	my ($addr) = @_;

	if ((my $addr_bin = inet_pton(AF_INET, $addr))) {
		return $addr_bin;
	} else {
		return inet_pton(AF_INET6, $addr);
	}

}

=head1 OBJECT METHODS

=head2 add - Add Prefix

   $code = $lpm->add( $prefix, $value );

Adds a prefix B<$prefix> into the database with value B<$value>. Returns 1 if
the prefix was added successfully. Returns 0 when an error occurs (typically the wrong address formating).

=cut
sub add {
	my ($self, $prefix, $value) = @_;

#	printf "PPP: %s %s %s\n", $self->{handle}, $prefix, $value;
	my ($prefix_bin, $prefix_len);

	($prefix, $prefix_len) = split('/', $prefix);

	if (! ($prefix_bin = inet_pton(AF_INET, $prefix)) ) {
		$prefix_bin = inet_pton(AF_INET6, $prefix);
	}

	if (!defined($prefix_len)) {
		if (length($prefix_bin) == 4) {
			$prefix_len = 32;
		} else {
			$prefix_len = 128;
		}
	}

	return lpm_add_raw($self->{handle}, $prefix_bin, $prefix_len, $value);
}

# legacy code
sub rebuild {
}

=head2  lookup - Lookup Address


  $value = $lpm->$lookup( $address );

Looks up the prefix in the database and returns the value. If the prefix is
not found or an error occured, the undef value is returned.

Before lookups are performed the database has to be rebuilt by C<$lpm-Erebuild()> operation.

=cut

sub lookup {
	my ($self, $addr) = @_;
	my $addr_bin;

	if (! ($addr_bin = inet_pton(AF_INET, $addr)) ) {
		$addr_bin = inet_pton(AF_INET6, $addr);
	}

	return lpm_lookup_raw($self->{handle}, $addr_bin);
#	return lpm_lookup($self->{handle}, $addr);
}

=head2  lookup_raw - Lookup Address in raw format


  $value = $lpm->lookup_raw( $address );

The same case as C<$lpm-Elookup> but it takes $address in raw format (result of the inet_ntop function). It is
more effective than C<$lpm-Elookup>, because the conversion from text format is not
necessary.

=cut

sub lookup_raw {
#	my ($self, $addr_bin) = @_;

	return lpm_lookup_raw($_[0]->{handle}, $_[1]);
}

# legacy code

sub lookup_cache_raw {
#	my ($self, $addr_bin) = @_;

	return lpm_lookup_raw($_[0]->{handle}, $_[1]);

}

=head2  info - Returns information about the built trie

  $ref = $lpm->info();

Returns following items

  ipv4_nodes_total - total number of allocated nodes in trie
  ipv4_nodes_value - number of allocated nodes in trie that have stored some value
  ipv4_trie_bytes - number of bytes allocated for trie nodes (without data)
  ipv6_ - the same for IPv6

=cut

sub info {
	my ($self) = @_;

	return lpm_info($self->{handle});
}

=head2  dump - Return hash array reference containg all stored prefixes in the trie

  $ref = $lpm->dump();

=cut

sub dump {
	my ($self) = @_;

	return lpm_dump($self->{handle});
}

=head2  finish - Release all data in object


  $lpm->finish();

=cut
sub finish {
	my ($self) = @_;

	lpm_finish($self->{handle});
}

sub DESTROY {
	my ($self) = @_;

	lpm_destroy($self->{handle});
}

=head1 SEE ALSO

There are also other implementations of the Longest Prefix Match in Perl. However,
most of them have some disadvantages (poor performance, lack of support for IPv6
or require a lot of time for initial database building). However, in some cases
it might be usefull:

L

L

L

L

L

L

=head1 AUTHOR

Tomas Podermanski [e-mail], Martin Ministr [e-mail], Brno University of Technology

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2012, Brno University of Technology

This library is a free software; you can redistribute it and/or modify
it under the same terms as Perl itself.


=cut

1;
__END__