Here's an update which works on IPv4, IPv6, and heck even IPvN
addresses. Its a bit slower (benchmark on the sample file
increased from ~10 to ~16 seconds), but it helps to call clean() before you call list if there was alot of merges (which took the benchmark back down to ~12 seconds). I'm
not sure I'm happy with everything, but tye will probably
post a better answer soon anyway (who gave me ideas about
how to produce this version) (: package Net::CIDR::Lite;
use strict;
use vars qw($VERSION $DEBUG);
use Carp qw(confess);
$VERSION = '0.02';
my %masks;
my @fields = qw(PACK UNPACK NBITS ZERO MASKS);
# Preloaded methods go here.
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
bless {}, $class;
}
sub add {
my $self = shift;
my ($ip, $mask) = split "/", shift;
$self->_init($ip) || confess "Can't determine ip format" unless %$
+self;
my $start = $self->{PACK}->($ip) & $self->{MASKS}[$mask]
or confess "Bad ip address: $ip";
my $end = _add_bit($start, $mask);
++$$self{RANGES}{$start} || delete $$self{RANGES}{$start};
--$$self{RANGES}{$end} || delete $$self{RANGES}{$end};
}
sub clean {
my $self = shift;
my $ranges = $$self{RANGES};
my $total;
$$self{RANGES} = {
map { $total ? ($total+=$$ranges{$_})? () : ($_=>1)
: do { $total+=$$ranges{$_}; ($_=>-1) }
} sort keys %$ranges
};
}
sub list {
my $self = shift;
my $nbits = $$self{NBITS};
my ($start, $total);
my @results;
for my $ip (sort keys %{$$self{RANGES}}) {
$start = $ip unless $total;
$total += $$self{RANGES}{$ip};
unless ($total) {
while ($start lt $ip) {
my ($end, $bits);
(my $zeros = unpack("B*", $start)) =~ s/.*1//;
for my $mask ($nbits-length($zeros)..$nbits) {
$end = _add_bit($start, $mask) or next;
$bits = $mask, last if $end le $ip;
}
push @results, $self->{UNPACK}->($start) . "/$bits";
$start = $end;
}
}
}
wantarray ? @results : \@results;
}
sub _init {
my $self = shift;
my $ip = shift;
my ($nbits, $pack, $unpack);
if (_pack_ipv4($ip)) {
$nbits = 32;
$pack = \&_pack_ipv4;
$unpack = \&_unpack_ipv4;
} elsif (_pack_ipv6($ip)) {
$nbits = 128;
$pack = \&_pack_ipv6;
$unpack = \&_unpack_ipv6;
} else {
return;
}
$$self{PACK} = $pack;
$$self{UNPACK} = $unpack;
$$self{NBITS} = $nbits;
$$self{ZERO} = "0" x $nbits;
$$self{MASKS} = $masks{$nbits} ||= [
map { pack("B*", substr("1" x $_ . "0" x $nbits, 0, $nbits))
} 0..$nbits
];
}
sub _pack_ipv4 {
my @nums = split /\./, shift(), -1;
return unless @nums == 4;
for (@nums) {
return unless /^\d{1,3}$/ and $_ <= 255;
}
pack("C*", @nums);
}
sub _unpack_ipv4 {
join(".", unpack("C*", shift));
}
sub _pack_ipv6 {
my $ip = shift;
return if $ip =~ /^:/ and $ip !~ s/^::/:/;
return if $ip =~ /:$/ and $ip !~ s/::$/:/;
my @nums = split /:/, $ip, -1;
return unless @nums <= 8;
my ($empty, $ipv4, $str) = (0,'','');
for (@nums) {
return if $ipv4;
$str .= "0" x (4-length) . $_, next if /^[a-fA-F\d]{1,4}$/;
do { return if $empty++ }, $str .= "X", next if $_ eq '';
next if $ipv4 = _pack_ipv4($_);
return;
}
return if $ipv4 and @nums > 6;
$str =~ s/X/"0" x (($ipv4 ? 25 : 33)-length($str))/e if $empty;
pack("H*", $str).$ipv4;
}
sub _unpack_ipv6 {
_compress_ipv6(join(":", (unpack("H*", shift)) =~ /..../g)),
}
sub _compress_ipv6 {
my $ip = shift;
if (my @runs = $ip =~ /((?:(?:^|:)(?:0000))+:?)/g ) {
my $max = $runs[0];
for (@runs[1..$#runs]) {
$max = $_ if length($max) < length;
}
$ip =~ s/$max/::/;
}
$ip;
}
sub add_range {
my $self = shift;
local $_ = shift;
my ($ip_start, $ip_end) = split "-";
$self->_init($ip_start) || confess "Can't determine ip format"
unless %$self;
my $start = $self->{PACK}->($ip_start)
or confess "Bad ip address: $ip_start";
my $end = $self->{PACK}->($ip_end)
or confess "Bad ip address: $ip_end";
my $end = _add_bit($start, $$self{NBITS});
$$self{RANGES}{$start}++;
$$self{RANGES}{$end}--;
}
sub add_cidr {
my $self = shift;
my $cidr = shift;
unless (%$self) {
@$self{@fields} = @$cidr{@fields};
}
$$self{RANGES}{$_} += $$cidr{RANGES}{$_} for keys %{$$cidr{RANGES}
+};
}
sub _add_bit {
my ($start, $add) = @_;
$add--;
my $end = unpack("B*", $start);
{
if ($add < 0) {
return "\xFF" x (length($start)+1) if $end eq "0" x length
+($end);
return;
}
if (substr($end, $add, 1) eq "0") {
substr($end, $add, 1) = "1";
last;
}
substr($end, $add, 1) = "0";
$add--;
redo;
}
pack("B*", $end);
}
1;
__END__
Update: Stole tye's idea of "cleaning as you go" which shaved off a few seconds. I don't get anywhere near the benchmarks he does. I get 10-11 seconds on his version versus 12-13 on mine.
Another Update: Ought to actually work on real IPv6 addresses now (now that I know what they are...not very tested yet, though). If you're curious about what IPv6 is here's a good tutorial. This took the benchmark from ~11-12 seconds up to ~18. Still pretty reasonable I think, especially since there's more validation. Enjoy :-) | 