File Coverage

blib/lib/Net/Subnet/Count.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Net::Subnet::Count;
2            
3 1     1   622 use strict;
  1         1  
  1         31  
4 1     1   5 use vars qw($VERSION @ISA $cache_num);
  1         2  
  1         61  
5 1     1   5 use Carp;
  1         5  
  1         83  
6 1     1   1268 use IP::Address;
  0            
  0            
7            
8             require Exporter;
9            
10             @ISA = qw();
11             $VERSION = '1.20';
12            
13             # Preloaded methods go here.
14            
15             sub new {
16             my $type = shift;
17             my $class = ref($type) || $type || "Net::Subnet::Count";
18             my $self = { 'subnets' => {},
19             'count' => {},
20             'cache' => [],
21             'cache_num' => 5,
22             };
23             bless $self, $class;
24             my %data = @_;
25             foreach my $subnet (keys %data) {
26             $self->add($subnet, $data{$subnet});
27             }
28             return $self;
29             }
30            
31             sub cache {
32             my $self = shift;
33             my $ret = $self->{'cache_num'};
34             $self->{'cache_num'} = shift if (@_ and $_[0] >= 0);
35             $ret;
36             }
37            
38             sub add {
39             my $self = shift;
40             my $subnet = shift;
41             if (ref($_[0]) eq 'ARRAY') {
42             $self->_add_entry($subnet, @{$_[0]});
43             }
44             else {
45             $self->_add_entry($subnet, @_);
46             }
47             }
48            
49             sub _add_entry {
50             my $self = shift;
51             my $name = shift;
52             if (not exists $self->{'subnets'}->{$name}) {
53             $self->{'subnets'}->{$name} = [];
54             $self->{'count'}->{$name} = 0;
55             }
56             push @{$self->{'subnets'}->{$name}}, @_;
57             }
58            
59             sub _add_cache {
60             my $self = shift;
61             my ($label, $ip) = (shift, shift);
62             unshift @{$self->{'cache'}}, [$label, $ip];
63             while (@{$self->{'cache'}} > $self->{'cache_num'}) {
64             pop @{$self->{'cache'}};
65             }
66             }
67            
68             sub count {
69             my $self = shift;
70             IP:
71             while (my $ip = shift) {
72             foreach my $r_pair (@{$self->{'cache'}}) {
73             my ($subnet, $ip_net) = @{$r_pair};
74             if ($ip_net->contains($ip)) { # Match
75             ++$self->{'count'}->{$subnet};
76             next IP;
77             }
78             }
79             foreach my $subnet (keys %{$self->{'subnets'}}) {
80             foreach my $ip_net (@{$self->{'subnets'}->{$subnet}}) {
81             if ($ip_net->contains($ip)) { # Match
82             $self->_add_cache($subnet, $ip_net);
83             ++$self->{'count'}->{$subnet};
84             next IP;
85             }
86             }
87             }
88             }
89             }
90            
91             sub valcount {
92             my $self = shift;
93             IP:
94             while (my $ip = shift) {
95             my $value = shift;
96             foreach my $r_pair (@{$self->{'cache'}}) {
97             my ($subnet, $ip_net) = @{$r_pair};
98             if ($ip_net->contains($ip)) { # Match
99             $self->{'count'}->{$subnet} += $value;
100             next IP;
101             }
102             }
103             foreach my $subnet (keys %{$self->{'subnets'}}) {
104             foreach my $ip_net (@{$self->{'subnets'}->{$subnet}}) {
105             if ($ip_net->contains($ip)) { # Match
106             $self->_add_cache($subnet, $ip_net);
107             $self->{'count'}->{$subnet} += $value;
108             next IP;
109             }
110             }
111             }
112             }
113             }
114            
115             sub result {
116             my $self = shift;
117             my %res;
118             foreach my $subnet (keys %{$self->{'count'}}) {
119             $res{$subnet} = $self->{'count'}->{$subnet};
120             }
121             return \%res;
122             }
123            
124             1;
125             __END__