← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 02:36:06 2017
Reported on Sun Nov 5 02:56:18 2017

Filename/usr/local/lib/perl5/site_perl/Net/CIDR/Lite.pm
StatementsExecuted 12 statements in 6.75ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11150µs67µsNet::CIDR::Lite::::BEGIN@3 Net::CIDR::Lite::BEGIN@3
11127µs186µsNet::CIDR::Lite::Span::::BEGIN@357Net::CIDR::Lite::Span::BEGIN@357
11121µs164µsNet::CIDR::Lite::::BEGIN@5 Net::CIDR::Lite::BEGIN@5
11118µs101µsNet::CIDR::Lite::::BEGIN@4 Net::CIDR::Lite::BEGIN@4
0000s0sNet::CIDR::Lite::Span::::_in_rangeNet::CIDR::Lite::Span::_in_range
0000s0sNet::CIDR::Lite::Span::::addNet::CIDR::Lite::Span::add
0000s0sNet::CIDR::Lite::Span::::bin_findNet::CIDR::Lite::Span::bin_find
0000s0sNet::CIDR::Lite::Span::::cleanNet::CIDR::Lite::Span::clean
0000s0sNet::CIDR::Lite::Span::::findNet::CIDR::Lite::Span::find
0000s0sNet::CIDR::Lite::Span::::newNet::CIDR::Lite::Span::new
0000s0sNet::CIDR::Lite::Span::::prep_findNet::CIDR::Lite::Span::prep_find
0000s0sNet::CIDR::Lite::::_add_bit Net::CIDR::Lite::_add_bit
0000s0sNet::CIDR::Lite::::_compress_ipv6 Net::CIDR::Lite::_compress_ipv6
0000s0sNet::CIDR::Lite::::_init Net::CIDR::Lite::_init
0000s0sNet::CIDR::Lite::::_minus_one Net::CIDR::Lite::_minus_one
0000s0sNet::CIDR::Lite::::_pack_ipv4 Net::CIDR::Lite::_pack_ipv4
0000s0sNet::CIDR::Lite::::_pack_ipv6 Net::CIDR::Lite::_pack_ipv6
0000s0sNet::CIDR::Lite::::_packer Net::CIDR::Lite::_packer
0000s0sNet::CIDR::Lite::::_ranges Net::CIDR::Lite::_ranges
0000s0sNet::CIDR::Lite::::_unpack_ipv4 Net::CIDR::Lite::_unpack_ipv4
0000s0sNet::CIDR::Lite::::_unpack_ipv6 Net::CIDR::Lite::_unpack_ipv6
0000s0sNet::CIDR::Lite::::_unpacker Net::CIDR::Lite::_unpacker
0000s0sNet::CIDR::Lite::::add Net::CIDR::Lite::add
0000s0sNet::CIDR::Lite::::add_any Net::CIDR::Lite::add_any
0000s0sNet::CIDR::Lite::::add_cidr Net::CIDR::Lite::add_cidr
0000s0sNet::CIDR::Lite::::add_ip Net::CIDR::Lite::add_ip
0000s0sNet::CIDR::Lite::::add_range Net::CIDR::Lite::add_range
0000s0sNet::CIDR::Lite::::bin_find Net::CIDR::Lite::bin_find
0000s0sNet::CIDR::Lite::::clean Net::CIDR::Lite::clean
0000s0sNet::CIDR::Lite::::find Net::CIDR::Lite::find
0000s0sNet::CIDR::Lite::::list Net::CIDR::Lite::list
0000s0sNet::CIDR::Lite::::list_range Net::CIDR::Lite::list_range
0000s0sNet::CIDR::Lite::::list_short_range Net::CIDR::Lite::list_short_range
0000s0sNet::CIDR::Lite::::new Net::CIDR::Lite::new
0000s0sNet::CIDR::Lite::::prep_find Net::CIDR::Lite::prep_find
0000s0sNet::CIDR::Lite::::spanner Net::CIDR::Lite::spanner
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Net::CIDR::Lite;
2
3272µs285µs
# spent 67µs (50+17) within Net::CIDR::Lite::BEGIN@3 which was called: # once (50µs+17µs) by Net::Patricia::BEGIN@108 at line 3
use strict;
# spent 67µs making 1 call to Net::CIDR::Lite::BEGIN@3 # spent 17µs making 1 call to strict::import
4279µs2184µs
# spent 101µs (18+83) within Net::CIDR::Lite::BEGIN@4 which was called: # once (18µs+83µs) by Net::Patricia::BEGIN@108 at line 4
use vars qw($VERSION);
# spent 101µs making 1 call to Net::CIDR::Lite::BEGIN@4 # spent 83µs making 1 call to vars::import
524.61ms2306µs
# spent 164µs (21+143) within Net::CIDR::Lite::BEGIN@5 which was called: # once (21µs+143µs) by Net::Patricia::BEGIN@108 at line 5
use Carp qw(confess);
# spent 164µs making 1 call to Net::CIDR::Lite::BEGIN@5 # spent 143µs making 1 call to Exporter::import
6
712µs$VERSION = '0.21';
8
912µsmy %masks;
1018µsmy @fields = qw(PACK UNPACK NBITS MASKS);
11
12# Preloaded methods go here.
13
14sub 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
22sub 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
35sub 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
50sub 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
63sub 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
90sub 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
106sub 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
154sub _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
180sub _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
189sub _unpack_ipv4 {
190 join(".", unpack("xC*", shift));
191}
192
193sub _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
213sub _unpack_ipv6 {
214 _compress_ipv6(join(":", unpack("xH*", shift) =~ /..../g)),
215}
216
217# Replace longest run of null blocks with a double colon
218sub _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
232sub 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
244sub 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
263sub 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
277sub _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
291sub _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
301sub 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
316sub 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
336sub 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
345sub spanner {
346 Net::CIDR::Lite::Span->new(@_);
347}
348
349sub _ranges {
350 sort keys %{shift->{RANGES}};
351}
352
353sub _packer { shift->{PACK} }
354sub _unpacker { shift->{UNPACK} }
355
356package Net::CIDR::Lite::Span;
35721.97ms2346µs
# spent 186µs (27+159) within Net::CIDR::Lite::Span::BEGIN@357 which was called: # once (27µs+159µs) by Net::Patricia::BEGIN@108 at line 357
use Carp qw(confess);
# spent 186µs making 1 call to Net::CIDR::Lite::Span::BEGIN@357 # spent 159µs making 1 call to Exporter::import
358
359sub new {
360 my $proto = shift;
361 my $class = ref($proto) || $proto;
362 my $self = bless {RANGES=>{}}, $class;
363 $self->add(@_);
364}
365
366sub 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
386sub 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
413sub 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
441sub _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
449sub 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
468sub 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
479112µs1;
480__END__
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.