File Coverage

blib/lib/Algorithm/Closest/NetworkAddress.pm
Criterion Covered Total %
statement 41 41 100.0
branch 7 8 87.5
condition 7 8 87.5
subroutine 8 8 100.0
pod 1 2 50.0
total 64 67 95.5


line stmt bran cond sub pod time code
1             package Algorithm::Closest::NetworkAddress;
2              
3 2     2   43142 use 5.008004;
  2         7  
  2         75  
4 2     2   11 use strict;
  2         3  
  2         63  
5 2     2   19 use warnings;
  2         8  
  2         59  
6 2     2   10 use Carp;
  2         3  
  2         203  
7              
8             our $VERSION = '0.1';
9              
10 2     2   2835 use Class::Struct;
  2         5737  
  2         14  
11             struct 'Algorithm::Closest::NetworkAddress' => {
12             network_address_list => '@',
13             };
14              
15              
16             sub measure {
17 61     61 0 3501 my $self = shift;
18 61         73 my ($a, $b) = @_;
19 61         169 my @a = split('\.', $a);
20 61         143 my @b = split('\.', $b);
21 61 100       184 if ($a =~ /^\d+\.\d+\.\d+\.\d+$/) {
22 23         44 return _recursive_match(\@a, \@b, 0);
23             } else {
24 38         43 @a = reverse @a;
25 38         32 @b = reverse @b;
26 38         73 return _recursive_match(\@a, \@b, 0);
27             }
28             }
29              
30             sub _recursive_match {
31 102     102   126 my ($y, $z, $level) = @_;
32 102         128 my $a = shift @$y;
33 102         132 my $b = shift @$z;
34 102 100 66     559 if (defined $a && defined $b && $a eq $b) {
      100        
35 41         98 return _recursive_match($y, $z, $level+1);
36             } else {
37 61         163 return $level;
38             }
39             }
40              
41              
42             =head1 NAME
43              
44             Algorithm::Closest::NetworkAddress - finds the closest network address from a defined list
45              
46             =head1 DESCRIPTION
47              
48             Given a network address (IP address or fully qualified DNS name) and a list of other
49             addresses, will return the name with the closest match. "Closest" is
50             defined as exactly the same tuple from the back (for DNS names) or
51             from the front (for IP addresses).
52              
53             =head1 METHODS
54              
55             =head2 Algorithm::Closest::NetworkAddress->new(network_address_list => ["mon.der.altinity", "mon.lon.altinity", "mon.ny.altinity", "10.20.30.40"]);
56              
57             Creates an object containing the list of addresses to compare against
58              
59             =head2 $self->compare($network_address)
60              
61             Will find the best match in the network_address_list for the network_address specified.
62             Returns the network address that best matches.
63              
64             =cut
65              
66             sub compare {
67 10     10 1 3113 my ($self, $target) = @_;
68 10 50       22 carp "Must specify a target" unless defined $target;
69 10         9 my $best_na;
70 10         10 my $best_level = 0;
71 10         11 foreach my $na (@{$self->network_address_list}) {
  10         203  
72 50         133 my $r = $self->measure($na, $target);
73 50 100       145 if ($r > $best_level) {
74 11         10 $best_level = $r;
75 11         23 $best_na = $na;
76             }
77             }
78 10   100     36 return $best_na || 0;
79             }
80              
81             =head1 AUTHOR
82              
83             Ton Voon C
84              
85             =head1 COPYRIGHT
86              
87             Copyright 2006 Altinity Limited
88              
89             =head1 LICENSE
90              
91             GPL
92              
93             =cut
94              
95             1;