File Coverage

blib/lib/Data/Semantic/Net/IPAddress/IPv4.pm
Criterion Covered Total %
statement 26 26 100.0
branch 6 8 75.0
condition 3 5 60.0
subroutine 9 9 100.0
pod 3 3 100.0
total 47 51 92.1


line stmt bran cond sub pod time code
1 1     1   1899 use 5.008;
  1         7  
  1         46  
2 1     1   6 use strict;
  1         2  
  1         43  
3 1     1   5 use warnings;
  1         2  
  1         53  
4              
5             package Data::Semantic::Net::IPAddress::IPv4;
6             BEGIN {
7 1     1   28 $Data::Semantic::Net::IPAddress::IPv4::VERSION = '1.101760';
8             }
9             # ABSTRACT: Semantic data class for IPv4 addresses
10 1     1   1368 use Net::IP qw(ip_is_ipv4 ip_iptype ip_iptobin);
  1         51974  
  1         207  
11 1     1   13 use parent qw(Data::Semantic::Net::IPAddress);
  1         2  
  1         11  
12              
13             # update RESERVED IPv4 ranges according to RFC 5737
14             my @ranges = qw(198.51.100.0/24 203.0.113.0/24);
15             for my $range (@ranges) {
16             my $ip = Net::IP->new($range) or die Net::IP::Error();
17             my $prefix = substr $ip->binip, 0, $ip->prefixlen;
18             $Net::IP::IPv4ranges{ $prefix } = 'RESERVED';
19             }
20              
21             sub is_valid_normalized_value {
22 26     26 1 478 my ($self, $value) = @_;
23              
24             # Net::IP has a "nice" DWIM feature which
25             # autocompletes IPs with less than 4 octets, so check for that
26 26 100 66     105 $self->SUPER::is_valid_normalized_value($value)
27             && ip_is_ipv4($value)
28             && (my @dummy = split(/\./, $value)) == 4;
29             }
30              
31             sub is_internal {
32 13     13 1 125 my ($self, $value) = @_;
33 13 50       30 return unless defined $value;
34              
35             # Net::IP::ip_iptype needs the IP in binary, although this is not
36             # documented.
37 13   50     39 my $type = ip_iptype(ip_iptobin($value, 4), 4) || 'PUBLIC';
38 13         1972 $type ne 'PUBLIC';
39             }
40              
41             sub normalize {
42 30     30 1 17204 my ($self, $value) = @_;
43 30 100       186 return undef unless (my @dummy = split(/\./, $value)) == 4;
44             # omit leading zeroes in octets, e.g., 213.160.065.064 -> 213.160.65.64
45 27 50       98 my $ip = Net::IP->new($value) or die Net::IP::Error();
46 27         19355 $ip->ip;
47             }
48              
49             1;
50              
51              
52             __END__