← Index
NYTProf Performance Profile   « line view »
For examples/benchmark4.pl
  Run on Thu Aug 28 19:01:43 2014
Reported on Thu Aug 28 19:02:42 2014

Filename/usr/lib/perl5/NetAddr/IP.pm
StatementsExecuted 46 statements in 1.37ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1116.53ms21.1msNetAddr::IP::::BEGIN@8NetAddr::IP::BEGIN@8
22230µs139µsNetAddr::IP::::importNetAddr::IP::import
11114µs152µsNetAddr::IP::::BEGIN@9NetAddr::IP::BEGIN@9
11110µs21µsNetAddr::IP::::BEGIN@5NetAddr::IP::BEGIN@5
1118µs26µsNetAddr::IP::::BEGIN@218NetAddr::IP::BEGIN@218
1118µs170µsNetAddr::IP::::BEGIN@23NetAddr::IP::BEGIN@23
1117µs43µsNetAddr::IP::::BEGIN@7NetAddr::IP::BEGIN@7
1117µs69µsNetAddr::IP::::BEGIN@25NetAddr::IP::BEGIN@25
1113µs3µsNetAddr::IP::::CORE:matchNetAddr::IP::CORE:match (opcode)
0000s0sNetAddr::IP::::CoalesceNetAddr::IP::Coalesce
0000s0sNetAddr::IP::::DESTROYNetAddr::IP::DESTROY
0000s0sNetAddr::IP::::__ANON__[:220]NetAddr::IP::__ANON__[:220]
0000s0sNetAddr::IP::::__ANON__[:362]NetAddr::IP::__ANON__[:362]
0000s0sNetAddr::IP::::__ANON__[:374]NetAddr::IP::__ANON__[:374]
0000s0sNetAddr::IP::::compactNetAddr::IP::compact
0000s0sNetAddr::IP::::fullNetAddr::IP::full
0000s0sNetAddr::IP::::full6NetAddr::IP::full6
0000s0sNetAddr::IP::::hostenumrefNetAddr::IP::hostenumref
0000s0sNetAddr::IP::::netlimitNetAddr::IP::netlimit
0000s0sNetAddr::IP::::rsplitNetAddr::IP::rsplit
0000s0sNetAddr::IP::::rsplitrefNetAddr::IP::rsplitref
0000s0sNetAddr::IP::::splitNetAddr::IP::split
0000s0sNetAddr::IP::::splitrefNetAddr::IP::splitref
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1#!/usr/bin/perl -w
2
3package NetAddr::IP;
4
5224µs233µs
# spent 21µs (10+11) within NetAddr::IP::BEGIN@5 which was called: # once (10µs+11µs) by NetAddr::IP::FastNew::BEGIN@5 at line 5
use strict;
# spent 21µs making 1 call to NetAddr::IP::BEGIN@5 # spent 12µs making 1 call to strict::import
6#use diagnostics;
7236µs278µs
# spent 43µs (7+35) within NetAddr::IP::BEGIN@7 which was called: # once (7µs+35µs) by NetAddr::IP::FastNew::BEGIN@5 at line 7
use Carp;
# spent 43µs making 1 call to NetAddr::IP::BEGIN@7 # spent 36µs making 1 call to Exporter::import
83147µs321.2ms
# spent 21.1ms (6.53+14.5) within NetAddr::IP::BEGIN@8 which was called: # once (6.53ms+14.5ms) by NetAddr::IP::FastNew::BEGIN@5 at line 8
use NetAddr::IP::Lite 1.51 qw(Zero Zeros Ones V4mask V4net);
# spent 21.1ms making 1 call to NetAddr::IP::BEGIN@8 # spent 129µs making 1 call to NetAddr::IP::Lite::import # spent 10µs making 1 call to UNIVERSAL::VERSION
915µs1130µs
# spent 152µs (14+139) within NetAddr::IP::BEGIN@9 which was called: # once (14µs+139µs) by NetAddr::IP::FastNew::BEGIN@5 at line 21
use NetAddr::IP::Util 1.50 qw(
# spent 130µs making 1 call to NetAddr::IP::Util::import
10 sub128
11 inet_aton
12 inet_any2n
13 ipv6_aton
14 isIPv4
15 ipv4to6
16 mask4to6
17 shiftleft
18 addconst
19 hasbits
20 notcontiguous
21246µs2162µs);
# spent 152µs making 1 call to NetAddr::IP::BEGIN@9 # spent 9µs making 1 call to UNIVERSAL::VERSION
22
23233µs2331µs
# spent 170µs (8+161) within NetAddr::IP::BEGIN@23 which was called: # once (8µs+161µs) by NetAddr::IP::FastNew::BEGIN@5 at line 23
use AutoLoader qw(AUTOLOAD);
# spent 170µs making 1 call to NetAddr::IP::BEGIN@23 # spent 161µs making 1 call to AutoLoader::import
24
2514µs162µs
# spent 69µs (7+62) within NetAddr::IP::BEGIN@25 which was called: # once (7µs+62µs) by NetAddr::IP::FastNew::BEGIN@5 at line 32
use vars qw(
# spent 62µs making 1 call to vars::import
26 @EXPORT_OK
27 @EXPORT_FAIL
28 @ISA
29 $VERSION
30 $_netlimit
31 $rfc3021
321228µs169µs);
# spent 69µs making 1 call to NetAddr::IP::BEGIN@25
331500nsrequire Exporter;
34
3512µs@EXPORT_OK = qw(Compact Coalesce Zero Zeros Ones V4mask V4net netlimit);
361300ns@EXPORT_FAIL = qw($_netlimit);
37
3818µs@ISA = qw(Exporter NetAddr::IP::Lite);
39
40212µs13µs$VERSION = do { sprintf " %d.%03d", (q$Revision: 4.71 $ =~ /\d+/g) };
# spent 3µs making 1 call to NetAddr::IP::CORE:match
41
421200ns$rfc3021 = 0;
43
44=pod
45
46=encoding UTF-8
47
48=head1 NAME
49
50NetAddr::IP - Manages IPv4 and IPv6 addresses and subnets
51
52=head1 SYNOPSIS
53
54 use NetAddr::IP qw(
55 Compact
56 Coalesce
57 Zeros
58 Ones
59 V4mask
60 V4net
61 netlimit
62 :aton DEPRECATED
63 :lower
64 :upper
65 :old_storable
66 :old_nth
67 :rfc3021
68 );
69
70 NOTE: NetAddr::IP::Util has a full complement of network address
71 utilities to convert back and forth between binary and text.
72
73 inet_aton, inet_ntoa, ipv6_aton, ipv6_ntoa
74 ipv6_n2x, ipv6_n2d inet_any2d, inet_n2dx,
75 inet_n2ad, inetanyto6, ipv6to4
76
77See L<NetAddr::IP::Util>
78
79
80 my $ip = new NetAddr::IP '127.0.0.1';
81 or if you prefer
82 my $ip = NetAddr::IP->new('127.0.0.1);
83 or from a packed IPv4 address
84 my $ip = new_from_aton NetAddr::IP (inet_aton('127.0.0.1'));
85 or from an octal filtered IPv4 address
86 my $ip = new_no NetAddr::IP '127.012.0.0';
87
88 print "The address is ", $ip->addr, " with mask ", $ip->mask, "\n" ;
89
90 if ($ip->within(new NetAddr::IP "127.0.0.0", "255.0.0.0")) {
91 print "Is a loopback address\n";
92 }
93
94 # This prints 127.0.0.1/32
95 print "You can also say $ip...\n";
96
97* The following four functions return ipV6 representations of:
98
99 :: = Zeros();
100 FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF = Ones();
101 FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:: = V4mask();
102 ::FFFF:FFFF = V4net();
103
104
105###### DEPRECATED, will be remove in version 5 ############
106
107 * To accept addresses in the format as returned by
108 inet_aton, invoke the module as:
109
110 use NetAddr::IP qw(:aton);
111
112###### USE new_from_aton instead ##########################
113
114* To enable usage of legacy data files containing NetAddr::IP
115objects stored using the L<Storable> module.
116
117 use NetAddr::IP qw(:old_storable);
118
119* To compact many smaller subnets (see: C<$me-E<gt>compact($addr1,$addr2,...)>
120
121 @compacted_object_list = Compact(@object_list)
122
123* Return a reference to list of C<NetAddr::IP> subnets of
124C<$masklen> mask length, when C<$number> or more addresses from
125C<@list_of_subnets> are found to be contained in said subnet.
126
127 $arrayref = Coalesce($masklen, $number, @list_of_subnets)
128
129* By default B<NetAddr::IP> functions and methods return string IPv6
130addresses in uppercase. To change that to lowercase:
131
132NOTE: the AUGUST 2010 RFC5952 states:
133
134 4.3. Lowercase
135
136 The characters "a", "b", "c", "d", "e", and "f" in an IPv6
137 address MUST be represented in lowercase.
138
139It is recommended that all NEW applications using NetAddr::IP be
140invoked as shown on the next line.
141
142 use NetAddr::IP qw(:lower);
143
144* To ensure the current IPv6 string case behavior even if the default changes:
145
146 use NetAddr::IP qw(:upper);
147
148* To set a limit on the size of B<nets> processed or returned by NetAddr::IP.
149
150Set the maximum number of nets beyond which NetAddr::IP will return
151an error as a power of 2 (default 16 or 65536 nets). Each 2**16
152consumes approximately 4 megs of memory. A 2**20 consumes 64 megs of
153memory, A 2**24 consumes 1 gigabyte of memory.
154
155 use NetAddr::IP qw(netlimit);
156 netlimit 20;
157
158The maximum B<netlimit> allowed is 2**24. Attempts to set limits below
159the default of 16 or above the maximum of 24 are ignored.
160
161Returns true on success, otherwise C<undef>.
162
163=cut
164
1651100ns$_netlimit = 2 ** 16; # default
166
167sub netlimit($) {
168 return undef unless $_[0];
169 return undef if $_[0] =~ /\D/;
170 return undef if $_[0] < 16;
171 return undef if $_[0] > 24;
172 $_netlimit = 2 ** $_[0];
173};
174
175=head1 INSTALLATION
176
177Un-tar the distribution in an appropriate directory and type:
178
179 perl Makefile.PL
180 make
181 make test
182 make install
183
184B<NetAddr::IP> depends on B<NetAddr::IP::Util> which installs by
185default with its primary functions compiled using Perl's XS extensions
186to build a C library. If you do not have a C complier available or
187would like the slower Pure Perl version for some other reason, then
188type:
189
190 perl Makefile.PL -noxs
191 make
192 make test
193 make install
194
195=head1 DESCRIPTION
196
197This module provides an object-oriented abstraction on top of IP
198addresses or IP subnets that allows for easy manipulations. Version
1994.xx of NetAddr::IP will work with older versions of Perl and is
200compatible with Math::BigInt.
201
202The internal representation of all IP objects is in 128 bit IPv6 notation.
203IPv4 and IPv6 objects may be freely mixed.
204
205=head2 Overloaded Operators
206
207Many operators have been overloaded, as described below:
208
209=cut
210
211 #############################################
212 # These are the overload methods, placed here
213 # for convenience.
214 #############################################
215
216use overload
217
218
# spent 26µs (8+18) within NetAddr::IP::BEGIN@218 which was called: # once (8µs+18µs) by NetAddr::IP::FastNew::BEGIN@5 at line 220
'@{}' => sub {
219 return [ $_[0]->hostenum ];
2202789µs244µs };
# spent 26µs making 1 call to NetAddr::IP::BEGIN@218 # spent 18µs making 1 call to overload::import
221
222=pod
223
224=over
225
226=item B<Assignment (C<=>)>
227
228Has been optimized to copy one NetAddr::IP object to another very quickly.
229
230=item B<C<-E<gt>copy()>>
231
232The B<assignment (C<=>)> operation is only put in to operation when the
233copied object is further mutated by another overloaded operation. See
234L<overload> B<SPECIAL SYMBOLS FOR "use overload"> for details.
235
236B<C<-E<gt>copy()>> actually creates a new object when called.
237
238=item B<Stringification>
239
240An object can be used just as a string. For instance, the following code
241
242 my $ip = new NetAddr::IP '192.168.1.123';
243 print "$ip\n";
244
245Will print the string 192.168.1.123/32.
246
247=item B<Equality>
248
249You can test for equality with either C<eq> or C<==>. C<eq> allows
250comparison with arbitrary strings as well as NetAddr::IP objects. The
251following example:
252
253 if (NetAddr::IP->new('127.0.0.1','255.0.0.0') eq '127.0.0.1/8')
254 { print "Yes\n"; }
255
256will print out "Yes".
257
258Comparison with C<==> requires both operands to be NetAddr::IP objects.
259
260In both cases, a true value is returned if the CIDR representation of
261the operands is equal.
262
263=item B<Comparison via E<gt>, E<lt>, E<gt>=, E<lt>=, E<lt>=E<gt> and C<cmp>>
264
265Internally, all network objects are represented in 128 bit format.
266The numeric representation of the network is compared through the
267corresponding operation. Comparisons are tried first on the address portion
268of the object and if that is equal then the NUMERIC cidr portion of the
269masks are compared. This leads to the counterintuitive result that
270
271 /24 > /16
272
273Comparison should not be done on netaddr objects with different CIDR as
274this may produce indeterminate - unexpected results,
275rather the determination of which netblock is larger or smaller should be
276done by comparing
277
278 $ip1->masklen <=> $ip2->masklen
279
280=item B<Addition of a constant (C<+>)>
281
282Add a 32 bit signed constant to the address part of a NetAddr object.
283This operation changes the address part to point so many hosts above the
284current objects start address. For instance, this code:
285
286 print NetAddr::IP->new('127.0.0.1/8') + 5;
287
288will output 127.0.0.6/8. The address will wrap around at the broadcast
289back to the network address. This code:
290
291 print NetAddr::IP->new('10.0.0.1/24') + 255;
292
293 outputs 10.0.0.0/24.
294
295Returns the the unchanged object when the constant is missing or out of
296range.
297
298 2147483647 <= constant >= -2147483648
299
300=item B<Subtraction of a constant (C<->)>
301
302The complement of the addition of a constant.
303
304=item B<Difference (C<->)>
305
306Returns the difference between the address parts of two NetAddr::IP
307objects address parts as a 32 bit signed number.
308
309Returns B<undef> if the difference is out of range.
310
311(See range restrictions on Addition above)
312
313=item B<Auto-increment>
314
315Auto-incrementing a NetAddr::IP object causes the address part to be
316adjusted to the next host address within the subnet. It will wrap at
317the broadcast address and start again from the network address.
318
319=item B<Auto-decrement>
320
321Auto-decrementing a NetAddr::IP object performs exactly the opposite
322of auto-incrementing it, as you would expect.
323
324=cut
325
326 #############################################
327 # End of the overload methods.
328 #############################################
329
330
331# Preloaded methods go here.
332
333=pod
334
335=back
336
337=head2 Serializing and Deserializing
338
339This module defines hooks to collaborate with L<Storable> for
340serializing C<NetAddr::IP> objects, through compact and human readable
341strings. You can revert to the old format by invoking this module as
342
343 use NetAddr::IP ':old_storable';
344
345You must do this if you have legacy data files containing NetAddr::IP
346objects stored using the L<Storable> module.
347
348=cut
349
3501300nsmy $full_format = "%04X:%04X:%04X:%04X:%04X:%04X:%D.%D.%D.%D";
3511200nsmy $full6_format = "%04X:%04X:%04X:%04X:%04X:%04X:%04X:%04X";
352
353sub import
354
# spent 139µs (30+109) within NetAddr::IP::import which was called 2 times, avg 70µs/call: # once (16µs+60µs) by NetAddr::IP::FastNew::BEGIN@5 at line 5 of lib/NetAddr/IP/FastNew.pm # once (15µs+48µs) by main::BEGIN@6 at line 6 of examples/benchmark4.pl
{
35523µs if (grep { $_ eq ':old_storable' } @_) {
356 @_ = grep { $_ ne ':old_storable' } @_;
357 } else {
358 *{STORABLE_freeze} = sub
359 {
360 my $self = shift;
361 return $self->cidr(); # use stringification
36226µs };
363 *{STORABLE_thaw} = sub
364 {
365 my $self = shift;
366 my $cloning = shift; # Not used
367 my $serial = shift;
368
369 my $ip = new NetAddr::IP $serial;
370 $self->{addr} = $ip->{addr};
371 $self->{mask} = $ip->{mask};
372 $self->{isv6} = $ip->{isv6};
373 return;
37425µs };
375 }
376
37721µs if (grep { $_ eq ':aton' } @_)
378 {
379 $NetAddr::IP::Lite::Accept_Binary_IP = 1;
380 @_ = grep { $_ ne ':aton' } @_;
381 }
3822700ns if (grep { $_ eq ':old_nth' } @_)
383 {
384 $NetAddr::IP::Lite::Old_nth = 1;
385 @_ = grep { $_ ne ':old_nth' } @_;
386 }
3872700ns if (grep { $_ eq ':lower' } @_)
388 {
389 $full_format = lc($full_format);
390 $full6_format = lc($full6_format);
391 NetAddr::IP::Util::lower();
392 @_ = grep { $_ ne ':lower' } @_;
393 }
3942600ns if (grep { $_ eq ':upper' } @_)
395 {
396 $full_format = uc($full_format);
397 $full6_format = uc($full6_format);
398 NetAddr::IP::Util::upper();
399 @_ = grep { $_ ne ':upper' } @_;
400 }
4012700ns if (grep { $_ eq ':rfc3021' } @_)
402 {
403 $rfc3021 = 1;
404 @_ = grep { $_ ne ':rfc3021' } @_;
405 }
40629µs229µs NetAddr::IP->export_to_level(1, @_);
# spent 29µs making 2 calls to Exporter::export_to_level, avg 14µs/call
407}
408
409sub compact {
410 return (ref $_[0] eq 'ARRAY')
411 ? compactref($_[0]) # Compact(\@list)
412 : @{compactref(\@_)}; # Compact(@list) or ->compact(@list)
413}
414
41511µs*Compact = \&compact;
416
417sub Coalesce {
418 return &coalesce;
419}
420
421sub hostenumref($) {
422 my $r = _splitref(0,$_[0]);
423 unless ((notcontiguous($_[0]->{mask}))[1] == 128 ||
424 ($rfc3021 && $_[0]->masklen == 31) ) {
425 splice(@$r, 0, 1);
426 splice(@$r, scalar @$r - 1, 1);
427 }
428 return $r;
429}
430
431sub splitref {
432 unshift @_, 0; # mark as no reverse
433# perl 5.8.4 fails with this operation. see perl bug [ 23429]
434# goto &_splitref;
435 &_splitref;
436}
437
438sub rsplitref {
439 unshift @_, 1; # mark as reversed
440# perl 5.8.4 fails with this operation. see perl bug [ 23429]
441# goto &_splitref;
442 &_splitref;
443}
444
445sub split {
446 unshift @_, 0; # mark as no reverse
447 my $rv = &_splitref;
448 return $rv ? @$rv : ();
449}
450
451sub rsplit {
452 unshift @_, 1; # mark as reversed
453 my $rv = &_splitref;
454 return $rv ? @$rv : ();
455}
456
457sub full($) {
458 if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) {
459 my @hex = (unpack("n8",$_[0]->{addr}));
460 $hex[9] = $hex[7] & 0xff;
461 $hex[8] = $hex[7] >> 8;
462 $hex[7] = $hex[6] & 0xff;
463 $hex[6] >>= 8;
464 return sprintf($full_format,@hex);
465 } else {
466 &full6;
467 }
468}
469
470sub full6($) {
471 my @hex = (unpack("n8",$_[0]->{addr}));
472 return sprintf($full6_format,@hex);
473}
474
475sub DESTROY {};
476
47717µs1;
478__END__
 
# spent 3µs within NetAddr::IP::CORE:match which was called: # once (3µs+0s) by NetAddr::IP::FastNew::BEGIN@5 at line 40
sub NetAddr::IP::CORE:match; # opcode