File Coverage

blib/lib/Net/IP/Identifier/Regex.pm
Criterion Covered Total %
statement 12 89 13.4
branch 0 8 0.0
condition 0 3 0.0
subroutine 4 25 16.0
pod 17 17 100.0
total 33 142 23.2


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2             #===============================================================================
3             # PODNAME: Net::IP::Identifier::Regex
4             # ABSTRACT: Some regular expressions used by Net::IP::Identifier
5             # Tries to use use Regexp::Common qw /net/, but if not
6             # available, creates the regexes by hand.
7             #
8             # AUTHOR: Reid Augustin
9             # EMAIL: reid@LucidPort.com
10             # CREATED: 11/20/2014 10:06:21 AM
11             #===============================================================================
12              
13 3     3   88 use 5.008;
  3         42  
  3         123  
14 3     3   18 use strict;
  3         6  
  3         134  
15 3     3   16 use warnings;
  3         4  
  3         168  
16              
17             package Net::IP::Identifier::Regex;
18 3     3   17 use Try::Tiny;
  3         5  
  3         6688  
19              
20             our $VERSION = '0.111'; # VERSION
21              
22             sub new {
23 0     0 1   my ($class, %opts) = @_;
24              
25 0           my $self = {};
26 0   0       bless $self, (ref $class || $class);
27              
28 0           return $self;
29             }
30              
31             # IPv4/6 single IP
32             sub IP {
33 0     0 1   my ($self) = @_;
34              
35 0           my $IPv4 = $self->IPv4;
36 0           my $IPv6 = $self->IPv6;
37 0           return qr{(?:$IPv4|$IPv6)};
38             }
39              
40             # IPv4/6 any netblock format, but not single IPs
41             sub netblock {
42 0     0 1   my ($self) = @_;
43              
44 0           my $range = $self->range; # IPv4/6 range
45 0           my $cidr = $self->cidr; # IPv4/6 cidr
46 0           my $plus = $self->plus; # IPv4/6 plus notation range
47 0           return qr{(?:$range|$plus|$cidr)};
48             }
49              
50             sub range {
51 0     0 1   my ($self) = @_;
52              
53 0           my $IPv4_range = $self->IPv4_range;
54 0           my $IPv6_range = $self->IPv6_range;
55 0           return qr{(?:$IPv4_range|$IPv6_range)};
56             }
57              
58             sub cidr {
59 0     0 1   my ($self) = @_;
60              
61 0           my $IPv4_cidr = $self->IPv4_cidr;
62 0           my $IPv6_cidr = $self->IPv6_cidr;
63 0           return qr{(?:$IPv4_cidr|$IPv6_cidr)};
64             }
65              
66             sub plus {
67 0     0 1   my ($self) = @_;
68              
69 0           my $IPv4_plus = $self->IPv4_plus;
70 0           my $IPv6_plus = $self->IPv6_plus;
71 0           return qr{(?:$IPv4_plus|$IPv6_plus)};
72             }
73              
74             sub IPv4_cidr {
75 0     0 1   my ($self) = @_;
76              
77 0           my $IPv4 = $self->IPv4;
78 0           return qr{$IPv4\s*/\s*\d\d?};
79             }
80             sub IPv4_range {
81 0     0 1   my ($self) = @_;
82              
83 0           my $IPv4 = $self->IPv4;
84 0           return qr{$IPv4\s*-\s*$IPv4};
85             }
86             sub IPv4_plus {
87 0     0 1   my ($self) = @_;
88              
89 0           my $IPv4 = $self->IPv4;
90 0           return qr{$IPv4\s*\+\s*\d+};
91             }
92             sub IPv4_any {
93 0     0 1   my ($self) = @_;
94              
95 0           my $IPv4 = $self->IPv4;
96 0           return qr{$IPv4(?:\s*/\s*\d\d?|\s*-\s*$IPv4|\s*\+\s*\d+)?};
97             }
98              
99             sub IPv6_cidr {
100 0     0 1   my ($self) = @_;
101              
102 0           my $IPv6 = $self->IPv6;
103 0           return qr{$IPv6\s*/\s*\d+};
104             }
105             sub IPv6_range {
106 0     0 1   my ($self) = @_;
107              
108 0           my $IPv6 = $self->IPv6;
109 0           return qr{$IPv6\s*-\s*$IPv6};
110             }
111             sub IPv6_plus {
112 0     0 1   my ($self) = @_;
113              
114 0           my $IPv6 = $self->IPv6;
115 0           return qr{$IPv6\s*\+\s*\d+};
116             }
117             sub IPv6_any {
118 0     0 1   my ($self) = @_;
119              
120 0           my $IPv6 = $self->IPv6;
121 0           return qr{$IPv6(?:\s*/\s*\d+|\s*-\s*$IPv6|\s*\+\s*\d+)?};
122             }
123              
124             sub IP_any {
125 0     0 1   my ($self) = @_;
126              
127 0           my $IPv4_any = $self->IPv4_any;
128 0           my $IPv6_any = $self->IPv6_any;
129 0           return qr{$IPv4_any|$IPv6_any};
130             }
131              
132             sub IPv4 {
133 0     0 1   my ($self, $new) = @_;
134              
135 0 0         if (@_ > 1) {
136 0           $self->{IPv4} = $new;
137             }
138 0 0         if (not $self->{IPv4}) {
139             try {
140 0     0     require Regexp::Common;
141 0           Regexp::Common->import(qw /net/);
142 0           $self->IPv4($Regexp::Common::RE{net}{IPv4});
143 0           $self->IPv6($Regexp::Common::RE{net}{IPv6});
144             }
145             catch {
146             # I need this to work with an older version of perl, so I have
147             # copied some regexes from Regexp::Common::net:
148 0     0     $self->IPv4( qr/\b(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))\b/ );
149 0           $self->IPv6( qr/\s*-\s*(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4})|(?::(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?::(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?::(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?::(?:)(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?::(?:)(?:)(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?::(?:)(?:)(?:)(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}))|(?::(?:)(?:)(?:)(?:)(?:)(?:)(?:)(?:):)|(?:(?:[0-9a-fA-F]{1,4}):(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:)(?:)(?:)(?:):)|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:)(?:)(?:):)|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:)(?:):)|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:):)|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:):)|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:):))/ );
150             # vim users: expect syntax coloring to be messed up from here on
151 0           };
152             }
153 0           $self->{IPv4};
154             }
155              
156             sub IPv6 {
157 0     0 1   my ($self, $new) = @_;
158              
159 0 0         if (@_ > 1) {
160 0           $self->{IPv6} = $new;
161             }
162 0 0         if (not $self->{IPv6}) {
163             try {
164 0     0     require Regexp::Common;
165 0           Regexp::Common->import(qw /net/);
166 0           $self->IPv4($Regexp::Common::RE{net}{IPv4});
167 0           $self->IPv6($Regexp::Common::RE{net}{IPv6});
168             }
169             catch {
170             # I need this to work with an older version of perl, so I have
171             # copied some regexes from Regexp::Common::net:
172 0     0     $self->IPv4( qr/\b(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))\b/ );
173 0           $self->IPv6( qr/\s*-\s*(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4})|(?::(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?::(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?::(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?::(?:)(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?::(?:)(?:)(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?::(?:)(?:)(?:)(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}))|(?::(?:)(?:)(?:)(?:)(?:)(?:)(?:)(?:):)|(?:(?:[0-9a-fA-F]{1,4}):(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:)(?:)(?:)(?:):)|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:)(?:)(?:):)|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:)(?:):)|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:)(?:):)|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:):(?:[0-9a-fA-F]{1,4}))|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:)(?:):)|(?:(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:[0-9a-fA-F]{1,4}):(?:)(?:):))/ );
174             # vim users: expect syntax coloring to be messed up from here on
175 0           };
176             }
177 0           $self->{IPv6};
178             }
179              
180             1;
181              
182             __END__