File Coverage

blib/lib/NetAddr/IP/Count.pm

Criterion	Covered	Total	%
statement	12	86	13.9
branch	0	14	0.0
condition	0	5	0.0
subroutine	4	12	33.3
pod	6	6	100.0
total	22	123	17.8

package NetAddr::IP::Count;

use strict;
use vars qw($VERSION @ISA $cache_num);
use Carp;
use NetAddr::IP;

require Exporter;

@ISA = qw();
$VERSION = '2.01';

# Preloaded methods go here.

sub new {
    my $type = shift;
    my $class = ref($type) || $type || "NetAddr::IP::Count";
    my $self = { 'subnets' => {},
		 'count' => {},
		 'cache' => [],
		 'cache_num' => 5,
		};
    bless $self, $class;
    my %data = @_;
    foreach my $subnet (keys %data) {
	$self->add($subnet, $data{$subnet});
    }
    return $self;
}

sub cache {
    my $self = shift;
    my $ret = $self->{'cache_num'};
    $self->{'cache_num'} = shift if (@_ and $_[0] >= 0);
    $ret;
}

sub add {
    my $self = shift;
    my $subnet = shift;
    if (ref($_[0]) eq 'ARRAY') {
	$self->_add_entry($subnet, @{$_[0]});
    }
    else {
	$self->_add_entry($subnet, @_);
    }
}

sub _add_entry {
    my $self = shift;
    my $name = shift;
    if (not exists $self->{'subnets'}->{$name}) {
	$self->{'subnets'}->{$name} = [];
	$self->{'count'}->{$name} = 0;
    }
    push @{$self->{'subnets'}->{$name}}, @_;
}

sub _add_cache {
    my $self = shift;
    my ($label, $ip) = (shift, shift);
    unshift @{$self->{'cache'}}, [$label, $ip];
    while (@{$self->{'cache'}} > $self->{'cache_num'}) {
	pop @{$self->{'cache'}};
    }
}

sub count {
    my $self = shift;
  IP:
    while (my $ip = shift) {
	foreach my $r_pair (@{$self->{'cache'}}) {
	    my ($subnet, $ip_net) = @{$r_pair};
	    if ($ip_net->contains($ip)) { # Match
		++$self->{'count'}->{$subnet};
		next IP;
	    }
	}
	foreach my $subnet (keys %{$self->{'subnets'}}) {
	    foreach my $ip_net (@{$self->{'subnets'}->{$subnet}}) {
		if ($ip_net->contains($ip)) { # Match
		    $self->_add_cache($subnet, $ip_net);
		    ++$self->{'count'}->{$subnet};
		    next IP;
		}
	    }
	}
    }
}

sub valcount {
    my $self = shift;
  IP:
    while (my $ip = shift) {
	my $value = shift;
	foreach my $r_pair (@{$self->{'cache'}}) {
	    my ($subnet, $ip_net) = @{$r_pair};
	    if ($ip_net->contains($ip)) { # Match
		$self->{'count'}->{$subnet} += $value;
		next IP;
	    }
	}
	foreach my $subnet (keys %{$self->{'subnets'}}) {
	    foreach my $ip_net (@{$self->{'subnets'}->{$subnet}}) {
		if ($ip_net->contains($ip)) { # Match
		    $self->_add_cache($subnet, $ip_net);
		    $self->{'count'}->{$subnet} += $value;
		    next IP;
		}
	    }
	}
    }
}

sub result {
    my $self = shift;
    my %res;
    foreach my $subnet (keys %{$self->{'count'}}) {
	$res{$subnet} = $self->{'count'}->{$subnet};
    }
    return \%res;
}

1;
__END__