Net-IP-Match-Bin
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/Net/IP/Match/Bin/Perl.pm view on Meta::CPAN
package Net::IP::Match::Bin::Perl;
require Exporter;
use vars qw (@ISA @EXPORT $VERSION);
@ISA = qw(Exporter);
@EXPORT = qw( match_ip );
$VERSION = '0.01';
our @BITS = (
0x80000000, 0x40000000, 0x20000000, 0x10000000, 0x08000000, 0x04000000,
0x02000000, 0x01000000, 0x00800000, 0x00400000, 0x00200000, 0x00100000,
0x00080000, 0x00040000, 0x00020000, 0x00010000, 0x00008000, 0x00004000,
0x00002000, 0x00001000, 0x00000800, 0x00000400, 0x00000200, 0x00000100,
0x00000080, 0x00000040, 0x00000020, 0x00000010, 0x00000008, 0x00000004,
0x00000002, 0x00000001,
);
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $self = {};
bless $self => $class;
my $tree = [];
$self->{Tree} = $tree;
return $self;
}
sub add {
my $self = shift;
my @ipranges = @_;
# If an argument is a hash or array ref, flatten it
# If an argument is a scalar, make it a key and give it a value of 1
my @map
= map { ! ref $_ ? ( $_ => -1 )
: ref $_ eq 'ARRAY' ? map { $_ => -1 } @{$_}
: %{$_} } @ipranges;
# The tree is a temporary construct. It has three possible
# properties: 0, 1, and code. The code is the return value for a
# match.
for ( my $i = 0; $i < @map; $i += 2 ) {
my $range = $map[ $i ];
my $match = $map[ $i + 1 ];
if ($match eq "-1") {
$match = "$range";
}
my ( $ip, $mask ) = split m/\//xms, $range;
if (! defined $mask) {
$mask = 32; ## no critic(MagicNumbers)
}
my $tree = $self->{Tree}; # root
my $addr = unpack 'N', pack 'C4', split /[.]/, $ip;
for (my $i = 0; $i < $mask; $i++) {
my $bit = $addr & $BITS[$i] ? 1 : 0;
unless (defined $tree->[$bit]) {
$tree->[$bit] ||= [];
}
$tree = $tree->[$bit]; # Follow one branch
}
# Our $tree is now a leaf node of @$tree. Set its value
# If the code is already set, it's a non-fatal error (redundant data)
$tree->[2] ||= $match;
}
return $self;
}
sub match_ip {
my $self = shift;
my $ip;
if (! ref $self) {
$ip = $self;
$self = Net::IP::Match::Bin::Perl->new();
} else {
$ip = shift;
view all matches for this distributionview release on metacpan - search on metacpan
( run in 1.295 second using v1.00-cache-2.02-grep-82fe00e-cpan-f5108d614456 )