note
tye
<p>
OK, here is my version (which also handles IPv6). It does the famous nm5.in in just under 3 seconds (your original code takes about 3.5 seconds and you new more-than-4-octets code takes over a minute -- no, I don't know why so slow for me), on one computer. It also appears to handle ranges that include 255.255.255.255 which it doesn't appear either of your versions do properly (see nm3.in).
</p><p>
The major differences are that I "clean as I go" and I use single bitwise operations on strings when possible. This is so much faster and smaller than [cpan://Net::CIDR], that I'm tempted to make a drop-in replacement for that module based on this (though I'll probably get side-tracked before that happens).
<code>package CIDR_Lite;
use strict;
use vars qw($VERSION);
$VERSION= '0.03';
my $cache;
sub _setCache {
my $nBytes= shift;
my $nBits= 8*$nBytes;
my $h= $cache->[$nBytes];
if( ! $h ) {
$h= {};
$h->{zero}= my $zero= "\0" x $nBytes;
@{ $h->{mask} }= (
map {
pack( "B*", "0" x $_ . "1" x ($nBits-$_) )
} 0..$nBits,
);
@{ $h->{width} }= (
$zero,
map {
pack( "B*", "0" x ($_-1) . "1" . "0" x ($nBits-$_-2) )
} 1..$nBits,
);
$cache->[$nBytes]= $h;
}
return $h;
}
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $nBytes= shift || 4;
my $self= {};
@{$self}{qw( mask width zero )}=
@{_setCache($nBytes)}{qw( mask width zero )};
$self->{nBytes}= $nBytes;
$self->{nBits}= 8*$nBytes;
bless $self, $class;
}
sub _plus {
my $self= shift;
my $base= shift;
my $bits= shift;
my $res= $base | $self->{width}[$bits];
while( $res le $base ) {
$res &= ~$self->{width}[$bits--];
return "\xff"x(1+length($base)) if $bits < 0;
$res |= $self->{width}[$bits];
}
return $res;
}
sub add {
my $self= shift;
my $input = shift;
my( $ip, $bits )= split "/", $input;
my $start= pack( "C*", split /\./, $ip ) & ~$self->{mask}[$bits];
my $end= $self->_plus( $start, $bits );
++($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= 0;
for my $key ( sort keys %$ranges ) {
if( 0 == $total ) {
die "Impossible"
if $ranges->{$key} <= 0;
$total += $ranges->{$key};
$ranges->{$key}= 1;
} elsif( 0 == ( $total += $ranges->{$key} ) ) {
die "Impossible"
if 0 <= $ranges->{$key};
$ranges->{$key}= -1;
} else {
delete $ranges->{$key};
}
}
}
sub list {
my $self= shift;
my( $start, $total );
my @results;
my $zero= $self->{zero};
for my $ip ( sort keys %{ $self->{ranges} } ) {
$start= $ip unless $total;
$total += $self->{ranges}{$ip};
if( 0 == $total ) {
my $end= $ip;
my $bits= $self->{nBits};
while( 1 ) {
$bits-- while $zero eq ( $start & $self->{mask}[$bits] );
my $next= $self->_plus( $start, ++$bits );
last if $end lt $next;
push @results,
join(".",unpack"C*",$start)."/".$bits;
$start= $next;
}
my @temp;
$bits= $self->{nBits};
while( 1 ) {
$bits-- while $zero eq ( $end & $self->{mask}[$bits] );
my $next= ~ $self->_plus( ~$end, ++$bits );
last if $next lt $start;
push @temp,
join(".",unpack"C*",$next)."/".$bits;
$end= $next;
}
push @results, reverse @temp;
}
}
wantarray ? @results : \@results;
}
1;
</code>
<b>Updated</b>: Thanks to [runrig] for catching a couple of hard-coded 32s that got left in.
</p><p>
-
<a href="/index.pl?node=tye&lastnode_id=1072">tye</a>
(but my friends call me "Tye")
</p>
119206
119206