Filename | /usr/local/lib/perl5/site_perl/Net/CIDR/Lite.pm |
Statements | Executed 12 statements in 6.70ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 54µs | 81µs | BEGIN@3 | Net::CIDR::Lite::
1 | 1 | 1 | 26µs | 164µs | BEGIN@357 | Net::CIDR::Lite::Span::
1 | 1 | 1 | 23µs | 102µs | BEGIN@4 | Net::CIDR::Lite::
1 | 1 | 1 | 19µs | 157µs | BEGIN@5 | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | _in_range | Net::CIDR::Lite::Span::
0 | 0 | 0 | 0s | 0s | add | Net::CIDR::Lite::Span::
0 | 0 | 0 | 0s | 0s | bin_find | Net::CIDR::Lite::Span::
0 | 0 | 0 | 0s | 0s | clean | Net::CIDR::Lite::Span::
0 | 0 | 0 | 0s | 0s | find | Net::CIDR::Lite::Span::
0 | 0 | 0 | 0s | 0s | new | Net::CIDR::Lite::Span::
0 | 0 | 0 | 0s | 0s | prep_find | Net::CIDR::Lite::Span::
0 | 0 | 0 | 0s | 0s | _add_bit | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | _compress_ipv6 | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | _init | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | _minus_one | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | _pack_ipv4 | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | _pack_ipv6 | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | _packer | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | _ranges | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | _unpack_ipv4 | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | _unpack_ipv6 | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | _unpacker | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | add | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | add_any | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | add_cidr | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | add_ip | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | add_range | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | bin_find | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | clean | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | find | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | list | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | list_range | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | list_short_range | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | new | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | prep_find | Net::CIDR::Lite::
0 | 0 | 0 | 0s | 0s | spanner | Net::CIDR::Lite::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Net::CIDR::Lite; | ||||
2 | |||||
3 | 2 | 91µs | 2 | 108µs | # spent 81µs (54+27) within Net::CIDR::Lite::BEGIN@3 which was called:
# once (54µs+27µs) by Net::Patricia::BEGIN@108 at line 3 # spent 81µs making 1 call to Net::CIDR::Lite::BEGIN@3
# spent 27µs making 1 call to strict::import |
4 | 2 | 73µs | 2 | 181µs | # spent 102µs (23+79) within Net::CIDR::Lite::BEGIN@4 which was called:
# once (23µs+79µs) by Net::Patricia::BEGIN@108 at line 4 # spent 102µs making 1 call to Net::CIDR::Lite::BEGIN@4
# spent 79µs making 1 call to vars::import |
5 | 2 | 4.62ms | 2 | 295µs | # spent 157µs (19+138) within Net::CIDR::Lite::BEGIN@5 which was called:
# once (19µs+138µs) by Net::Patricia::BEGIN@108 at line 5 # spent 157µs making 1 call to Net::CIDR::Lite::BEGIN@5
# spent 138µs making 1 call to Exporter::import |
6 | |||||
7 | 1 | 2µs | $VERSION = '0.21'; | ||
8 | |||||
9 | 1 | 2µs | my %masks; | ||
10 | 1 | 4µs | my @fields = qw(PACK UNPACK NBITS MASKS); | ||
11 | |||||
12 | # Preloaded methods go here. | ||||
13 | |||||
14 | sub new { | ||||
15 | my $proto = shift; | ||||
16 | my $class = ref($proto) || $proto; | ||||
17 | my $self = bless {}, $class; | ||||
18 | $self->add_any($_) for @_; | ||||
19 | $self; | ||||
20 | } | ||||
21 | |||||
22 | sub add_any { | ||||
23 | my $self = shift; | ||||
24 | for (@_) { | ||||
25 | tr|/|| && do { $self->add($_); next }; | ||||
26 | tr|-|| && do { $self->add_range($_); next }; | ||||
27 | UNIVERSAL::isa($_, 'Net::CIDR::Lite') && do { | ||||
28 | $self->add_cidr($_); next | ||||
29 | }; | ||||
30 | $self->add_ip($_), next; | ||||
31 | } | ||||
32 | $self; | ||||
33 | } | ||||
34 | |||||
35 | sub add { | ||||
36 | my $self = shift; | ||||
37 | my ($ip, $mask) = split "/", shift; | ||||
38 | $self->_init($ip) || confess "Can't determine ip format" unless %$self; | ||||
39 | confess "Bad mask $mask" | ||||
40 | unless $mask =~ /^\d+$/ and $mask <= $self->{NBITS}-8; | ||||
41 | $mask += 8; | ||||
42 | my $start = $self->{PACK}->($ip) & $self->{MASKS}[$mask] | ||||
43 | or confess "Bad ip address: $ip"; | ||||
44 | my $end = $self->_add_bit($start, $mask); | ||||
45 | ++$$self{RANGES}{$start} || delete $$self{RANGES}{$start}; | ||||
46 | --$$self{RANGES}{$end} || delete $$self{RANGES}{$end}; | ||||
47 | $self; | ||||
48 | } | ||||
49 | |||||
50 | sub clean { | ||||
51 | my $self = shift; | ||||
52 | return $self unless $self->{RANGES}; | ||||
53 | my $ranges = $$self{RANGES}; | ||||
54 | my $total; | ||||
55 | $$self{RANGES} = { | ||||
56 | map { $total ? ($total+=$$ranges{$_})? () : ($_=>-1) | ||||
57 | : do { $total+=$$ranges{$_}; ($_=>1) } | ||||
58 | } sort keys %$ranges | ||||
59 | }; | ||||
60 | $self; | ||||
61 | } | ||||
62 | |||||
63 | sub list { | ||||
64 | my $self = shift; | ||||
65 | return unless $self->{NBITS}; | ||||
66 | my $nbits = $$self{NBITS}; | ||||
67 | my ($start, $total); | ||||
68 | my @results; | ||||
69 | for my $ip (sort keys %{$$self{RANGES}}) { | ||||
70 | $start = $ip unless $total; | ||||
71 | $total += $$self{RANGES}{$ip}; | ||||
72 | unless ($total) { | ||||
73 | while ($start lt $ip) { | ||||
74 | my ($end, $bits); | ||||
75 | my $sbit = $nbits-1; | ||||
76 | # Find the position of the last 1 bit | ||||
77 | $sbit-- while !vec($start, $sbit^7, 1) and $sbit>0; | ||||
78 | for my $pos ($sbit+1..$nbits) { | ||||
79 | $end = $self->_add_bit($start, $pos); | ||||
80 | $bits = $pos-8, last if $end le $ip; | ||||
81 | } | ||||
82 | push @results, $self->{UNPACK}->($start) . "/$bits"; | ||||
83 | $start = $end; | ||||
84 | } | ||||
85 | } | ||||
86 | } | ||||
87 | wantarray ? @results : \@results; | ||||
88 | } | ||||
89 | |||||
90 | sub list_range { | ||||
91 | my $self = shift; | ||||
92 | my ($start, $total); | ||||
93 | my @results; | ||||
94 | for my $ip (sort keys %{$$self{RANGES}}) { | ||||
95 | $start = $ip unless $total; | ||||
96 | $total += $$self{RANGES}{$ip}; | ||||
97 | unless ($total) { | ||||
98 | $ip = $self->_minus_one($ip); | ||||
99 | push @results, | ||||
100 | $self->{UNPACK}->($start) . "-" . $self->{UNPACK}->($ip); | ||||
101 | } | ||||
102 | } | ||||
103 | wantarray ? @results : \@results; | ||||
104 | } | ||||
105 | |||||
106 | sub list_short_range { | ||||
107 | my $self = shift; | ||||
108 | |||||
109 | my $start; | ||||
110 | my $total; | ||||
111 | my @results; | ||||
112 | |||||
113 | for my $ip (sort keys %{$$self{RANGES}}) { | ||||
114 | # we begin new range when $total is zero | ||||
115 | $start = $ip if not $total; | ||||
116 | |||||
117 | # add to total (1 for start of the range or -1 for end of the range) | ||||
118 | $total += $$self{RANGES}{$ip}; | ||||
119 | |||||
120 | # in case of end of range | ||||
121 | if (not $total) { | ||||
122 | while ($ip gt $start) { | ||||
123 | $ip = $self->_minus_one($ip); | ||||
124 | |||||
125 | # in case of single ip not a range | ||||
126 | if ($ip eq $start) { | ||||
127 | push @results, | ||||
128 | $self->{UNPACK}->($start); | ||||
129 | next; | ||||
130 | } | ||||
131 | |||||
132 | # get the last ip octet number | ||||
133 | my $to_octet = ( unpack('C5', $ip) )[4]; | ||||
134 | |||||
135 | # next ip end will be current end masked by c subnet mask 255.255.255.0 - /24 | ||||
136 | $ip = $ip & $self->{MASKS}[32]; | ||||
137 | |||||
138 | # if the ip range is in the same c subnet | ||||
139 | if ($ip eq ($start & $self->{MASKS}[32])) { | ||||
140 | push @results, | ||||
141 | $self->{UNPACK}->($start) . "-" . $to_octet; | ||||
142 | } | ||||
143 | # otherwise the range start is .0 (end of range masked by c subnet mask) | ||||
144 | else { | ||||
145 | push @results, | ||||
146 | $self->{UNPACK}->($ip & $self->{MASKS}[32]) . "-" . $to_octet; | ||||
147 | } | ||||
148 | }; | ||||
149 | } | ||||
150 | } | ||||
151 | wantarray ? @results : \@results; | ||||
152 | } | ||||
153 | |||||
154 | sub _init { | ||||
155 | my $self = shift; | ||||
156 | my $ip = shift; | ||||
157 | my ($nbits, $pack, $unpack); | ||||
158 | if (_pack_ipv4($ip)) { | ||||
159 | $nbits = 40; | ||||
160 | $pack = \&_pack_ipv4; | ||||
161 | $unpack = \&_unpack_ipv4; | ||||
162 | } elsif (_pack_ipv6($ip)) { | ||||
163 | $nbits = 136; | ||||
164 | $pack = \&_pack_ipv6; | ||||
165 | $unpack = \&_unpack_ipv6; | ||||
166 | } else { | ||||
167 | return; | ||||
168 | } | ||||
169 | $$self{PACK} = $pack; | ||||
170 | $$self{UNPACK} = $unpack; | ||||
171 | $$self{NBITS} = $nbits; | ||||
172 | $$self{MASKS} = $masks{$nbits} ||= [ | ||||
173 | map { pack("B*", substr("1" x $_ . "0" x $nbits, 0, $nbits)) | ||||
174 | } 0..$nbits | ||||
175 | ]; | ||||
176 | $$self{RANGES} = {}; | ||||
177 | $self; | ||||
178 | } | ||||
179 | |||||
180 | sub _pack_ipv4 { | ||||
181 | my @nums = split /\./, shift(), -1; | ||||
182 | return unless @nums == 4; | ||||
183 | for (@nums) { | ||||
184 | return unless /^\d{1,3}$/ and $_ <= 255; | ||||
185 | } | ||||
186 | pack("CC*", 0, @nums); | ||||
187 | } | ||||
188 | |||||
189 | sub _unpack_ipv4 { | ||||
190 | join(".", unpack("xC*", shift)); | ||||
191 | } | ||||
192 | |||||
193 | sub _pack_ipv6 { | ||||
194 | my $ip = shift; | ||||
195 | $ip =~ s/^::$/::0/; | ||||
196 | return if $ip =~ /^:/ and $ip !~ s/^::/:/; | ||||
197 | return if $ip =~ /:$/ and $ip !~ s/::$/:/; | ||||
198 | my @nums = split /:/, $ip, -1; | ||||
199 | return unless @nums <= 8; | ||||
200 | my ($empty, $ipv4, $str) = (0,'',''); | ||||
201 | for (@nums) { | ||||
202 | return if $ipv4; | ||||
203 | $str .= "0" x (4-length) . $_, next if /^[a-fA-F\d]{1,4}$/; | ||||
204 | do { return if $empty++ }, $str .= "X", next if $_ eq ''; | ||||
205 | next if $ipv4 = _pack_ipv4($_); | ||||
206 | return; | ||||
207 | } | ||||
208 | return if $ipv4 and @nums > 6; | ||||
209 | $str =~ s/X/"0" x (($ipv4 ? 25 : 33)-length($str))/e if $empty; | ||||
210 | pack("H*", "00" . $str).$ipv4; | ||||
211 | } | ||||
212 | |||||
213 | sub _unpack_ipv6 { | ||||
214 | _compress_ipv6(join(":", unpack("xH*", shift) =~ /..../g)), | ||||
215 | } | ||||
216 | |||||
217 | # Replace longest run of null blocks with a double colon | ||||
218 | sub _compress_ipv6 { | ||||
219 | my $ip = shift; | ||||
220 | if (my @runs = $ip =~ /((?:(?:^|:)(?:0000))+:?)/g ) { | ||||
221 | my $max = $runs[0]; | ||||
222 | for (@runs[1..$#runs]) { | ||||
223 | $max = $_ if length($max) < length; | ||||
224 | } | ||||
225 | $ip =~ s/$max/::/; | ||||
226 | } | ||||
227 | $ip =~ s/:0{1,3}/:/g; | ||||
228 | $ip; | ||||
229 | } | ||||
230 | |||||
231 | # Add a single IP address | ||||
232 | sub add_ip { | ||||
233 | my $self = shift; | ||||
234 | my $ip = shift; | ||||
235 | $self->_init($ip) || confess "Can't determine ip format" unless %$self; | ||||
236 | my $start = $self->{PACK}->($ip) or confess "Bad ip address: $ip"; | ||||
237 | my $end = $self->_add_bit($start, $self->{NBITS}); | ||||
238 | ++$$self{RANGES}{$start} || delete $$self{RANGES}{$start}; | ||||
239 | --$$self{RANGES}{$end} || delete $$self{RANGES}{$end}; | ||||
240 | $self; | ||||
241 | } | ||||
242 | |||||
243 | # Add a hyphenated range of IP addresses | ||||
244 | sub add_range { | ||||
245 | my $self = shift; | ||||
246 | local $_ = shift; | ||||
247 | my ($ip_start, $ip_end, $crud) = split /\s*-\s*/; | ||||
248 | confess "Only one hyphen allowed in range" if defined $crud; | ||||
249 | $self->_init($ip_start) || confess "Can't determine ip format" | ||||
250 | unless %$self; | ||||
251 | my $start = $self->{PACK}->($ip_start) | ||||
252 | or confess "Bad ip address: $ip_start"; | ||||
253 | my $end = $self->{PACK}->($ip_end) | ||||
254 | or confess "Bad ip address: $ip_end"; | ||||
255 | confess "Start IP is greater than end IP" if $start gt $end; | ||||
256 | $end = $self->_add_bit($end, $$self{NBITS}); | ||||
257 | ++$$self{RANGES}{$start} || delete $$self{RANGES}{$start}; | ||||
258 | --$$self{RANGES}{$end} || delete $$self{RANGES}{$end}; | ||||
259 | $self; | ||||
260 | } | ||||
261 | |||||
262 | # Add ranges from another Net::CIDR::Lite object | ||||
263 | sub add_cidr { | ||||
264 | my $self = shift; | ||||
265 | my $cidr = shift; | ||||
266 | confess "Not a CIDR object" unless UNIVERSAL::isa($cidr, 'Net::CIDR::Lite'); | ||||
267 | unless (%$self) { | ||||
268 | @$self{@fields} = @$cidr{@fields}; | ||||
269 | } | ||||
270 | $$self{RANGES}{$_} += $$cidr{RANGES}{$_} for keys %{$$cidr{RANGES}}; | ||||
271 | $self; | ||||
272 | } | ||||
273 | |||||
274 | # Increment the ip address at the given bit position | ||||
275 | # bit position is in range 1 to # of bits in ip | ||||
276 | # where 1 is high order bit, # of bits is low order bit | ||||
277 | sub _add_bit { | ||||
278 | my $self= shift; | ||||
279 | my $base= shift(); | ||||
280 | my $bits= shift()-1; | ||||
281 | while (vec($base, $bits^7, 1)) { | ||||
282 | vec($base, $bits^7, 1) = 0; | ||||
283 | $bits--; | ||||
284 | return $base if $bits < 0; | ||||
285 | } | ||||
286 | vec($base, $bits^7, 1) = 1; | ||||
287 | return $base; | ||||
288 | } | ||||
289 | |||||
290 | # Subtract one from an ip address | ||||
291 | sub _minus_one { | ||||
292 | my $self = shift; | ||||
293 | my $nbits = $self->{NBITS}; | ||||
294 | my $ip = shift; | ||||
295 | $ip = ~$ip; | ||||
296 | $ip = $self->_add_bit($ip, $nbits); | ||||
297 | $ip = $self->_add_bit($ip, $nbits); | ||||
298 | $self->_add_bit(~$ip, $nbits); | ||||
299 | } | ||||
300 | |||||
301 | sub find { | ||||
302 | my $self = shift; | ||||
303 | $self->prep_find unless $self->{FIND}; | ||||
304 | return $self->bin_find(@_) unless @{$self->{FIND}} < $self->{PCT}; | ||||
305 | return 0 unless $self->{PACK}; | ||||
306 | my $this_ip = $self->{PACK}->(shift); | ||||
307 | my $ranges = $self->{RANGES}; | ||||
308 | my $last = -1; | ||||
309 | for my $ip (@{$self->{FIND}}) { | ||||
310 | last if $this_ip lt $ip; | ||||
311 | $last = $ranges->{$ip}; | ||||
312 | } | ||||
313 | $last > 0; | ||||
314 | } | ||||
315 | |||||
316 | sub bin_find { | ||||
317 | my $self = shift; | ||||
318 | my $ip = $self->{PACK}->(shift); | ||||
319 | $self->prep_find unless $self->{FIND}; | ||||
320 | my $find = $self->{FIND}; | ||||
321 | my ($start, $end) = (0, $#$find); | ||||
322 | return unless $ip ge $find->[$start] and $ip lt $find->[$end]; | ||||
323 | while ($end - $start > 0) { | ||||
324 | my $mid = int(($start+$end)/2); | ||||
325 | if ($start == $mid) { | ||||
326 | if ($find->[$end] eq $ip) { | ||||
327 | $start = $end; | ||||
328 | } else { $end = $start } | ||||
329 | } else { | ||||
330 | ($find->[$mid] lt $ip ? $start : $end) = $mid; | ||||
331 | } | ||||
332 | } | ||||
333 | $self->{RANGES}{$find->[$start]} > 0; | ||||
334 | } | ||||
335 | |||||
336 | sub prep_find { | ||||
337 | my $self = shift; | ||||
338 | $self->clean; | ||||
339 | $self->{PCT} = shift || 20; | ||||
340 | my $aref = $self->{FIND} = []; | ||||
341 | push @$aref, $_ for sort keys %{$self->{RANGES}}; | ||||
342 | $self; | ||||
343 | } | ||||
344 | |||||
345 | sub spanner { | ||||
346 | Net::CIDR::Lite::Span->new(@_); | ||||
347 | } | ||||
348 | |||||
349 | sub _ranges { | ||||
350 | sort keys %{shift->{RANGES}}; | ||||
351 | } | ||||
352 | |||||
353 | sub _packer { shift->{PACK} } | ||||
354 | sub _unpacker { shift->{UNPACK} } | ||||
355 | |||||
356 | package Net::CIDR::Lite::Span; | ||||
357 | 2 | 1.90ms | 2 | 301µs | # spent 164µs (26+138) within Net::CIDR::Lite::Span::BEGIN@357 which was called:
# once (26µs+138µs) by Net::Patricia::BEGIN@108 at line 357 # spent 164µs making 1 call to Net::CIDR::Lite::Span::BEGIN@357
# spent 138µs making 1 call to Exporter::import |
358 | |||||
359 | sub new { | ||||
360 | my $proto = shift; | ||||
361 | my $class = ref($proto) || $proto; | ||||
362 | my $self = bless {RANGES=>{}}, $class; | ||||
363 | $self->add(@_); | ||||
364 | } | ||||
365 | |||||
366 | sub add { | ||||
367 | my $self = shift; | ||||
368 | my $ranges = $self->{RANGES}; | ||||
369 | if (@_ && !$self->{PACK}) { | ||||
370 | my $cidr = $_[0]; | ||||
371 | $cidr = Net::CIDR::Lite->new($cidr) unless ref($cidr); | ||||
372 | $self->{PACK} = $cidr->_packer; | ||||
373 | $self->{UNPACK} = $cidr->_unpacker; | ||||
374 | } | ||||
375 | while (@_) { | ||||
376 | my ($cidr, $label) = (shift, shift); | ||||
377 | $cidr = Net::CIDR::Lite->new($cidr) unless ref($cidr); | ||||
378 | $cidr->clean; | ||||
379 | for my $ip ($cidr->_ranges) { | ||||
380 | push @{$ranges->{$ip}}, $label; | ||||
381 | } | ||||
382 | } | ||||
383 | $self; | ||||
384 | } | ||||
385 | |||||
386 | sub find { | ||||
387 | my $self = shift; | ||||
388 | my $pack = $self->{PACK}; | ||||
389 | my $unpack = $self->{UNPACK}; | ||||
390 | my %results; | ||||
391 | my $in_range; | ||||
392 | $self->prep_find unless $self->{FIND}; | ||||
393 | return {} unless @_; | ||||
394 | return { map { $_ => {} } @_ } unless @{$self->{FIND}}; | ||||
395 | return $self->bin_find(@_) if @_/@{$self->{FIND}} < $self->{PCT}; | ||||
396 | my @ips = sort map { $pack->($_) || confess "Bad IP: $_" } @_; | ||||
397 | my $last; | ||||
398 | for my $ip (@{$self->{FIND}}) { | ||||
399 | if ($ips[0] lt $ip) { | ||||
400 | $results{$unpack->(shift @ips)} = $self->_in_range($last) | ||||
401 | while @ips and $ips[0] lt $ip; | ||||
402 | } | ||||
403 | last unless @ips; | ||||
404 | $last = $ip; | ||||
405 | } | ||||
406 | if (@ips) { | ||||
407 | my $no_range = $self->_in_range({}); | ||||
408 | $results{$unpack->(shift @ips)} = $no_range while @ips; | ||||
409 | } | ||||
410 | \%results; | ||||
411 | } | ||||
412 | |||||
413 | sub bin_find { | ||||
414 | my $self = shift; | ||||
415 | return {} unless @_; | ||||
416 | $self->prep_find unless $self->{FIND}; | ||||
417 | return { map { $_ => {} } @_ } unless @{$self->{FIND}}; | ||||
418 | my $pack = $self->{PACK}; | ||||
419 | my $unpack = $self->{UNPACK}; | ||||
420 | my $find = $self->{FIND}; | ||||
421 | my %results; | ||||
422 | for my $ip ( map { $pack->($_) || confess "Bad IP: $_" } @_) { | ||||
423 | my ($start, $end) = (0, $#$find); | ||||
424 | $results{$unpack->($ip)} = $self->_in_range, next | ||||
425 | unless $ip ge $find->[$start] and $ip lt $find->[$end]; | ||||
426 | while ($start < $end) { | ||||
427 | my $mid = int(($start+$end)/2); | ||||
428 | if ($start == $mid) { | ||||
429 | if ($find->[$end] eq $ip) { | ||||
430 | $start = $end; | ||||
431 | } else { $end = $start } | ||||
432 | } else { | ||||
433 | ($find->[$mid] lt $ip ? $start : $end) = $mid; | ||||
434 | } | ||||
435 | } | ||||
436 | $results{$unpack->($ip)} = $self->_in_range($find->[$start]); | ||||
437 | } | ||||
438 | \%results; | ||||
439 | } | ||||
440 | |||||
441 | sub _in_range { | ||||
442 | my $self = shift; | ||||
443 | my $ip = shift || ''; | ||||
444 | my $aref = $self->{PREPPED}{$ip} || []; | ||||
445 | my $key = join "|", sort @$aref; | ||||
446 | $self->{CACHE}{$key} ||= { map { $_ => 1 } @$aref }; | ||||
447 | } | ||||
448 | |||||
449 | sub prep_find { | ||||
450 | my $self = shift; | ||||
451 | my $pct = shift || 4; | ||||
452 | $self->{PCT} = $pct/100; | ||||
453 | $self->{FIND} = [ sort keys %{$self->{RANGES}} ]; | ||||
454 | $self->{PREPPED} = {}; | ||||
455 | $self->{CACHE} = {}; | ||||
456 | my %cache; | ||||
457 | my %in_range; | ||||
458 | for my $ip (@{$self->{FIND}}) { | ||||
459 | my $keys = $self->{RANGES}{$ip}; | ||||
460 | $_ = !$_ for @in_range{@$keys}; | ||||
461 | my @keys = grep $in_range{$_}, keys %in_range; | ||||
462 | my $key_str = join "|", @keys; | ||||
463 | $self->{PREPPED}{$ip} = $cache{$key_str} ||= \@keys; | ||||
464 | } | ||||
465 | $self; | ||||
466 | } | ||||
467 | |||||
468 | sub clean { | ||||
469 | my $self = shift; | ||||
470 | unless ($self->{PACK}) { | ||||
471 | my $ip = shift; | ||||
472 | my $cidr = Net::CIDR::Lite->new($ip); | ||||
473 | return $cidr->clean($ip); | ||||
474 | } | ||||
475 | my $ip = $self->{PACK}->(shift) || return; | ||||
476 | $self->{UNPACK}->($ip); | ||||
477 | } | ||||
478 | |||||
479 | 1 | 14µs | 1; | ||
480 | __END__ |