Profile of NetAddr/IP/Lite.pm

← 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/Lite.pm
Statements | Executed 1578152 statements in 2.11s

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
47820 | 1 | 1 | 1.57s | 2.85s | NetAddr::IP::Lite::::_xnewNetAddr::IP::Lite::_xnew
334735 | 5 | 1 | 252ms | 252ms | NetAddr::IP::Lite::::CORE:matchNetAddr::IP::Lite::CORE:match (opcode)
47820 | 4 | 2 | 86.4ms | 86.4ms | NetAddr::IP::Lite::::newNetAddr::IP::Lite::new
1 | 1 | 1 | 4.35ms | 8.47ms | NetAddr::IP::Lite::::BEGIN@9NetAddr::IP::Lite::BEGIN@9
1 | 1 | 1 | 1.15ms | 2.84ms | NetAddr::IP::Lite::::BEGIN@18NetAddr::IP::Lite::BEGIN@18
1 | 1 | 1 | 1.14ms | 1.83ms | NetAddr::IP::Lite::::BEGIN@224NetAddr::IP::Lite::BEGIN@224
1 | 1 | 1 | 19µs | 129µs | NetAddr::IP::Lite::::importNetAddr::IP::Lite::import
1 | 1 | 1 | 11µs | 43µs | NetAddr::IP::Lite::::BEGIN@5NetAddr::IP::Lite::BEGIN@5
1 | 1 | 1 | 8µs | 79µs | NetAddr::IP::Lite::::BEGIN@33NetAddr::IP::Lite::BEGIN@33
1 | 1 | 1 | 7µs | 20µs | NetAddr::IP::Lite::::BEGIN@170NetAddr::IP::Lite::BEGIN@170
8 | 3 | 1 | 7µs | 7µs | NetAddr::IP::Lite::::OnesNetAddr::IP::Lite::Ones
9 | 4 | 1 | 6µs | 6µs | NetAddr::IP::Lite::::ZerosNetAddr::IP::Lite::Zeros
1 | 1 | 1 | 6µs | 17µs | NetAddr::IP::Lite::::BEGIN@6NetAddr::IP::Lite::BEGIN@6
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::AUTOLOADNetAddr::IP::Lite::AUTOLOAD
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::DESTROYNetAddr::IP::Lite::DESTROY
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::V4maskNetAddr::IP::Lite::V4mask
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::V4netNetAddr::IP::Lite::V4net
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::__ANON__[:234]NetAddr::IP::Lite::__ANON__[:234]
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::__ANON__[:240]NetAddr::IP::Lite::__ANON__[:240]
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::__ANON__[:246]NetAddr::IP::Lite::__ANON__[:246]
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::__ANON__[:251]NetAddr::IP::Lite::__ANON__[:251]
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::__ANON__[:256]NetAddr::IP::Lite::__ANON__[:256]
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::__ANON__[:260]NetAddr::IP::Lite::__ANON__[:260]
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::__ANON__[:264]NetAddr::IP::Lite::__ANON__[:264]
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::__ANON__[:268]NetAddr::IP::Lite::__ANON__[:268]
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::__ANON__[:272]NetAddr::IP::Lite::__ANON__[:272]
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::_biRefNetAddr::IP::Lite::_biRef
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::_bi_fakeNetAddr::IP::Lite::_bi_fake
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::_bi_stfyNetAddr::IP::Lite::_bi_stfy
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::_fakebi2strgNetAddr::IP::Lite::_fakebi2strg
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::_force_bi_emuNetAddr::IP::Lite::_force_bi_emu
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::_loadMBINetAddr::IP::Lite::_loadMBI
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::_newNetAddr::IP::Lite::_new
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::_no_octalNetAddr::IP::Lite::_no_octal
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::_obitsNetAddr::IP::Lite::_obits
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::_retMBIstringNetAddr::IP::Lite::_retMBIstring
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::addrNetAddr::IP::Lite::addr
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::atonNetAddr::IP::Lite::aton
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::bigintNetAddr::IP::Lite::bigint
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::bitsNetAddr::IP::Lite::bits
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::broadcastNetAddr::IP::Lite::broadcast
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::cidrNetAddr::IP::Lite::cidr
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::comp_addr_maskNetAddr::IP::Lite::comp_addr_mask
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::containsNetAddr::IP::Lite::contains
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::copyNetAddr::IP::Lite::copy
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::firstNetAddr::IP::Lite::first
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::is_rfc1918NetAddr::IP::Lite::is_rfc1918
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::lastNetAddr::IP::Lite::last
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::maskNetAddr::IP::Lite::mask
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::masklenNetAddr::IP::Lite::masklen
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::minusNetAddr::IP::Lite::minus
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::minusminusNetAddr::IP::Lite::minusminus
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::networkNetAddr::IP::Lite::network
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::new4NetAddr::IP::Lite::new4
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::new6NetAddr::IP::Lite::new6
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::new6FFFFNetAddr::IP::Lite::new6FFFF
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::new_cisNetAddr::IP::Lite::new_cis
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::new_cis6NetAddr::IP::Lite::new_cis6
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::new_from_atonNetAddr::IP::Lite::new_from_aton
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::new_noNetAddr::IP::Lite::new_no
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::nthNetAddr::IP::Lite::nth
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::numNetAddr::IP::Lite::num
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::numericNetAddr::IP::Lite::numeric
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::plusNetAddr::IP::Lite::plus
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::plusplusNetAddr::IP::Lite::plusplus
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::rangeNetAddr::IP::Lite::range
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::versionNetAddr::IP::Lite::version
0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::::withinNetAddr::IP::Lite::within

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
2 |  |  |  |  |
3 |  |  |  |  | package NetAddr::IP::Lite;
4 |  |  |  |  |
5 | 2 | 26µs | 2 | 75µs | # spent 43µs (11+32) within NetAddr::IP::Lite::BEGIN@5 which was called: # once (11µs+32µs) by NetAddr::IP::BEGIN@8 at line 5 use Carp; # spent 43µs making 1 call to NetAddr::IP::Lite::BEGIN@5 # spent 32µs making 1 call to Exporter::import
6 | 2 | 31µs | 2 | 28µs | # spent 17µs (6+11) within NetAddr::IP::Lite::BEGIN@6 which was called: # once (6µs+11µs) by NetAddr::IP::BEGIN@8 at line 6 use strict; # spent 17µs making 1 call to NetAddr::IP::Lite::BEGIN@6 # spent 11µs making 1 call to strict::import
7 |  |  |  |  | #use diagnostics;
8 |  |  |  |  | #use warnings;
9 | 1 | 5µs | 1 | 154µs | # spent 8.47ms (4.35+4.12) within NetAddr::IP::Lite::BEGIN@9 which was called: # once (4.35ms+4.12ms) by NetAddr::IP::BEGIN@8 at line 17 use NetAddr::IP::InetBase qw( # spent 154µs making 1 call to NetAddr::IP::InetBase::import
10 |  |  |  |  | inet_any2n
11 |  |  |  |  | isIPv4
12 |  |  |  |  | inet_n2dx
13 |  |  |  |  | inet_aton
14 |  |  |  |  | ipv6_aton
15 |  |  |  |  | ipv6_n2x
16 |  |  |  |  | fillIPv4
17 | 1 | 123µs | 1 | 8.47ms | ); # spent 8.47ms making 1 call to NetAddr::IP::Lite::BEGIN@9
18 | 1 | 4µs | 1 | 212µs | # spent 2.84ms (1.15+1.69) within NetAddr::IP::Lite::BEGIN@18 which was called: # once (1.15ms+1.69ms) by NetAddr::IP::BEGIN@8 at line 31 use NetAddr::IP::Util qw( # spent 212µs making 1 call to NetAddr::IP::Util::import
19 |  |  |  |  | addconst
20 |  |  |  |  | sub128
21 |  |  |  |  | ipv6to4
22 |  |  |  |  | notcontiguous
23 |  |  |  |  | shiftleft
24 |  |  |  |  | hasbits
25 |  |  |  |  | bin2bcd
26 |  |  |  |  | bcd2bin
27 |  |  |  |  | mask4to6
28 |  |  |  |  | ipv4to6
29 |  |  |  |  | naip_gethostbyname
30 |  |  |  |  | havegethostbyname2
31 | 1 | 114µs | 1 | 2.84ms | ); # spent 2.84ms making 1 call to NetAddr::IP::Lite::BEGIN@18
32 |  |  |  |  |
33 | 2 | 152µs | 2 | 149µs | # spent 79µs (8+71) within NetAddr::IP::Lite::BEGIN@33 which was called: # once (8µs+71µs) by NetAddr::IP::BEGIN@8 at line 33 use vars qw(@ISA @EXPORT_OK $VERSION $Accept_Binary_IP $Old_nth $AUTOLOAD *Zero); # spent 79µs making 1 call to NetAddr::IP::Lite::BEGIN@33 # spent 71µs making 1 call to vars::import
34 |  |  |  |  |
35 | 3 | 16µs | 1 | 4µs | $VERSION = do { my @r = (q$Revision: 1.51 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # spent 4µs making 1 call to NetAddr::IP::Lite::CORE:match
36 |  |  |  |  |
37 | 1 | 600ns |  |  | require Exporter;
38 |  |  |  |  |
39 | 1 | 7µs |  |  | @ISA = qw(Exporter);
40 |  |  |  |  |
41 | 1 | 900ns |  |  | @EXPORT_OK = qw(Zeros Zero Ones V4mask V4net);
42 |  |  |  |  |
43 |  |  |  |  | # Set to true, to enable recognizing of ipV4 && ipV6 binary notation IP
44 |  |  |  |  | # addresses. Thanks to Steve Snodgrass for reporting. This can be done
45 |  |  |  |  | # at the time of use-ing the module. See docs for details.
46 |  |  |  |  |
47 | 1 | 200ns |  |  | $Accept_Binary_IP = 0;
48 | 1 | 100ns |  |  | $Old_nth = 0;
49 | 1 | 1µs |  |  | *Zero = \&Zeros;
50 |  |  |  |  |
51 |  |  |  |  | =pod
52 |  |  |  |  |
53 |  |  |  |  | =encoding UTF-8
54 |  |  |  |  |
55 |  |  |  |  | =head1 NAME
56 |  |  |  |  |
57 |  |  |  |  | NetAddr::IP::Lite - Manages IPv4 and IPv6 addresses and subnets
58 |  |  |  |  |
59 |  |  |  |  | =head1 SYNOPSIS
60 |  |  |  |  |
61 |  |  |  |  | use NetAddr::IP::Lite qw(
62 |  |  |  |  | Zeros
63 |  |  |  |  | Ones
64 |  |  |  |  | V4mask
65 |  |  |  |  | V4net
66 |  |  |  |  | :aton DEPRECATED !
67 |  |  |  |  | :old_nth
68 |  |  |  |  | :upper
69 |  |  |  |  | :lower
70 |  |  |  |  | );
71 |  |  |  |  |
72 |  |  |  |  | my $ip = new NetAddr::IP::Lite '127.0.0.1';
73 |  |  |  |  | or if your prefer
74 |  |  |  |  | my $ip = NetAddr::IP::Lite->new('127.0.0.1);
75 |  |  |  |  | or from a packed IPv4 address
76 |  |  |  |  | my $ip = new_from_aton NetAddr::IP::Lite (inet_aton('127.0.0.1'));
77 |  |  |  |  | or from an octal filtered IPv4 address
78 |  |  |  |  | my $ip = new_no NetAddr::IP::Lite '127.012.0.0';
79 |  |  |  |  |
80 |  |  |  |  | print "The address is ", $ip->addr, " with mask ", $ip->mask, "\n" ;
81 |  |  |  |  |
82 |  |  |  |  | if ($ip->within(new NetAddr::IP::Lite "127.0.0.0", "255.0.0.0")) {
83 |  |  |  |  | print "Is a loopback address\n";
84 |  |  |  |  | }
85 |  |  |  |  |
86 |  |  |  |  | # This prints 127.0.0.1/32
87 |  |  |  |  | print "You can also say $ip...\n";
88 |  |  |  |  |
89 |  |  |  |  | The following four functions return ipV6 representations of:
90 |  |  |  |  |
91 |  |  |  |  | :: = Zeros();
92 |  |  |  |  | FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF = Ones();
93 |  |  |  |  | FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:: = V4mask();
94 |  |  |  |  | ::FFFF:FFFF = V4net();
95 |  |  |  |  |
96 |  |  |  |  | =head1 INSTALLATION
97 |  |  |  |  |
98 |  |  |  |  | Un-tar the distribution in an appropriate directory and type:
99 |  |  |  |  |
100 |  |  |  |  | perl Makefile.PL
101 |  |  |  |  | make
102 |  |  |  |  | make test
103 |  |  |  |  | make install
104 |  |  |  |  |
105 |  |  |  |  | B<NetAddr::IP::Lite> depends on B<NetAddr::IP::Util> which installs by default with its primary functions compiled
106 |  |  |  |  | using Perl's XS extensions to build a 'C' library. If you do not have a 'C'
107 |  |  |  |  | complier available or would like the slower Pure Perl version for some other
108 |  |  |  |  | reason, then type:
109 |  |  |  |  |
110 |  |  |  |  | perl Makefile.PL -noxs
111 |  |  |  |  | make
112 |  |  |  |  | make test
113 |  |  |  |  | make install
114 |  |  |  |  |
115 |  |  |  |  | =head1 DESCRIPTION
116 |  |  |  |  |
117 |  |  |  |  | This module provides an object-oriented abstraction on top of IP
118 |  |  |  |  | addresses or IP subnets, that allows for easy manipulations. Most of the
119 |  |  |  |  | operations of NetAddr::IP are supported. This module will work with older
120 |  |  |  |  | versions of Perl and is compatible with Math::BigInt.
121 |  |  |  |  |
122 |  |  |  |  | * By default B<NetAddr::IP> functions and methods return string IPv6
123 |  |  |  |  | addresses in uppercase. To change that to lowercase:
124 |  |  |  |  |
125 |  |  |  |  | NOTE: the AUGUST 2010 RFC5952 states:
126 |  |  |  |  |
127 |  |  |  |  | 4.3. Lowercase
128 |  |  |  |  |
129 |  |  |  |  | The characters "a", "b", "c", "d", "e", and "f" in an IPv6
130 |  |  |  |  | address MUST be represented in lowercase.
131 |  |  |  |  |
132 |  |  |  |  | It is recommended that all NEW applications using NetAddr::IP::Lite be
133 |  |  |  |  | invoked as shown on the next line.
134 |  |  |  |  |
135 |  |  |  |  | use NetAddr::IP::Lite qw(:lower);
136 |  |  |  |  |
137 |  |  |  |  | * To ensure the current IPv6 string case behavior even if the default changes:
138 |  |  |  |  |
139 |  |  |  |  | use NetAddr::IP::Lite qw(:upper);
140 |  |  |  |  |
141 |  |  |  |  |
142 |  |  |  |  | The internal representation of all IP objects is in 128 bit IPv6 notation.
143 |  |  |  |  | IPv4 and IPv6 objects may be freely mixed.
144 |  |  |  |  |
145 |  |  |  |  | The supported operations are described below:
146 |  |  |  |  |
147 |  |  |  |  | =cut
148 |  |  |  |  |
149 |  |  |  |  | # in the off chance that NetAddr::IP::Lite objects are created
150 |  |  |  |  | # and the caller later loads NetAddr::IP and expects to use
151 |  |  |  |  | # those objects, let the AUTOLOAD routine find and redirect
152 |  |  |  |  | # NetAddr::IP::Lite method and subroutine calls to NetAddr::IP.
153 |  |  |  |  | #
154 |  |  |  |  |
155 | 1 | 300ns |  |  | my $parent = 'NetAddr::IP';
156 |  |  |  |  |
157 |  |  |  |  | # test function
158 |  |  |  |  | #
159 |  |  |  |  | # input: subroutine name in NetAddr::IP
160 |  |  |  |  | # output: t/f if sub name exists in NetAddr::IP namespace
161 |  |  |  |  | #
162 |  |  |  |  | #sub sub_exists {
163 |  |  |  |  | # my $other = $parent .'::';
164 |  |  |  |  | # return exists ${$other}{$_[0]};
165 |  |  |  |  | #}
166 |  |  |  |  |
167 |  |  |  |  | sub DESTROY {};
168 |  |  |  |  |
169 |  |  |  |  | sub AUTOLOAD {
170 | 2 | 642µs | 2 | 32µs | # spent 20µs (7+12) within NetAddr::IP::Lite::BEGIN@170 which was called: # once (7µs+12µs) by NetAddr::IP::BEGIN@8 at line 170 no strict; # spent 20µs making 1 call to NetAddr::IP::Lite::BEGIN@170 # spent 12µs making 1 call to strict::unimport
171 |  |  |  |  | my ($pkg,$func) = ($AUTOLOAD =~ /(.*)::([^:]+)$/);
172 |  |  |  |  | my $other = $parent .'::';
173 |  |  |  |  |
174 |  |  |  |  | if ($pkg =~ /^$other/o && exists ${$other}{$func}) {
175 |  |  |  |  | $other .= $func;
176 |  |  |  |  | goto &{$other};
177 |  |  |  |  | }
178 |  |  |  |  |
179 |  |  |  |  | my @stack = caller(0);
180 |  |  |  |  |
181 |  |  |  |  | if ( $pkg eq ref $_[0] ) {
182 |  |  |  |  | $other = qq|Can't locate object method "$func" via|;
183 |  |  |  |  | }
184 |  |  |  |  | else {
185 |  |  |  |  | $other = qq|Undefined subroutine \&$AUTOLOAD not found in|;
186 |  |  |  |  | }
187 |  |  |  |  | die $other . qq| package "$parent" or "$pkg" (did you forgot to load a module?) at $stack[1] line $stack[2].\n|;
188 |  |  |  |  | }
189 |  |  |  |  |
190 |  |  |  |  | =head2 Overloaded Operators
191 |  |  |  |  |
192 |  |  |  |  | =cut
193 |  |  |  |  |
194 |  |  |  |  | # these really should be packed in Network Long order but since they are
195 |  |  |  |  | # symmetrical, that extra internal processing can be skipped
196 |  |  |  |  |
197 | 1 | 200ns | 1 | 1µs | my $_v4zero = pack('L',0); # spent 1µs making 1 call to main::CORE:pack
198 | 1 | 100ns | 1 | 900ns | my $_zero = pack('L4',0,0,0,0); # spent 900ns making 1 call to main::CORE:pack
199 | 1 | 400ns |  |  | my $_ones = ~$_zero;
200 | 1 | 200ns | 1 | 700ns | my $_v4mask = pack('L4',0xffffffff,0xffffffff,0xffffffff,0); # spent 700ns making 1 call to main::CORE:pack
201 | 1 | 300ns |  |  | my $_v4net = ~ $_v4mask;
202 | 1 | 200ns | 1 | 1µs | my $_ipv4FFFF = pack('N4',0,0,0xffff,0); # spent 1µs making 1 call to main::CORE:pack
203 |  |  |  |  |
204 |  |  |  |  | # spent 6µs within NetAddr::IP::Lite::Zeros which was called 9 times, avg 711ns/call: # 3 times (2µs+0s) by NetAddr::IP::BEGIN@8 at line 671, avg 833ns/call # 2 times (2µs+0s) by NetAddr::IP::BEGIN@8 at line 655, avg 900ns/call # 2 times (1µs+0s) by NetAddr::IP::BEGIN@8 at line 679, avg 600ns/call # 2 times (900ns+0s) by NetAddr::IP::BEGIN@8 at line 662, avg 450ns/call sub Zeros() {
205 | 9 | 94µs |  |  | return $_zero;
206 |  |  |  |  | }
207 |  |  |  |  | # spent 7µs within NetAddr::IP::Lite::Ones which was called 8 times, avg 888ns/call: # 3 times (4µs+0s) by NetAddr::IP::Lite::_xnew at line 893, avg 1µs/call # 3 times (2µs+0s) by NetAddr::IP::BEGIN@8 at line 679, avg 567ns/call # 2 times (1µs+0s) by NetAddr::IP::BEGIN@8 at line 662, avg 550ns/call sub Ones() {
208 | 8 | 15µs |  |  | return $_ones;
209 |  |  |  |  | }
210 |  |  |  |  | sub V4mask() {
211 |  |  |  |  | return $_v4mask;
212 |  |  |  |  | }
213 |  |  |  |  | sub V4net() {
214 |  |  |  |  | return $_v4net;
215 |  |  |  |  | }
216 |  |  |  |  |
217 |  |  |  |  | #############################################
218 |  |  |  |  | # These are the overload methods, placed here
219 |  |  |  |  | # for convenience.
220 |  |  |  |  | #############################################
221 |  |  |  |  |
222 |  |  |  |  | use overload
223 |  |  |  |  |
224 |  |  |  |  | # spent 1.83ms (1.14+695µs) within NetAddr::IP::Lite::BEGIN@224 which was called: # once (1.14ms+695µs) by NetAddr::IP::BEGIN@8 at line 276 '+' => \&plus,
225 |  |  |  |  |
226 |  |  |  |  | '-' => \&minus,
227 |  |  |  |  |
228 |  |  |  |  | '++' => \&plusplus,
229 |  |  |  |  |
230 |  |  |  |  | '--' => \&minusminus,
231 |  |  |  |  |
232 |  |  |  |  | "=" => \&copy,
233 |  |  |  |  |
234 |  |  |  |  | '""' => sub { $_[0]->cidr(); },
235 |  |  |  |  |
236 |  |  |  |  | 'eq' => sub {
237 |  |  |  |  | my $a = (UNIVERSAL::isa($_[0],__PACKAGE__)) ? $_[0]->cidr : $_[0];
238 |  |  |  |  | my $b = (UNIVERSAL::isa($_[1],__PACKAGE__)) ? $_[1]->cidr : $_[1];
239 |  |  |  |  | $a eq $b;
240 |  |  |  |  | },
241 |  |  |  |  |
242 |  |  |  |  | 'ne' => sub {
243 |  |  |  |  | my $a = (UNIVERSAL::isa($_[0],__PACKAGE__)) ? $_[0]->cidr : $_[0];
244 |  |  |  |  | my $b = (UNIVERSAL::isa($_[1],__PACKAGE__)) ? $_[1]->cidr : $_[1];
245 |  |  |  |  | $a ne $b;
246 |  |  |  |  | },
247 |  |  |  |  |
248 |  |  |  |  | '==' => sub {
249 |  |  |  |  | return 0 unless UNIVERSAL::isa($_[0],__PACKAGE__) && UNIVERSAL::isa($_[1],__PACKAGE__);
250 |  |  |  |  | $_[0]->cidr eq $_[1]->cidr;
251 |  |  |  |  | },
252 |  |  |  |  |
253 |  |  |  |  | '!=' => sub {
254 |  |  |  |  | return 1 unless UNIVERSAL::isa($_[0],__PACKAGE__) && UNIVERSAL::isa($_[1],__PACKAGE__);
255 |  |  |  |  | $_[0]->cidr ne $_[1]->cidr;
256 |  |  |  |  | },
257 |  |  |  |  |
258 |  |  |  |  | '>' => sub {
259 |  |  |  |  | return &comp_addr_mask > 0 ? 1 : 0;
260 |  |  |  |  | },
261 |  |  |  |  |
262 |  |  |  |  | '<' => sub {
263 |  |  |  |  | return &comp_addr_mask < 0 ? 1 : 0;
264 |  |  |  |  | },
265 |  |  |  |  |
266 |  |  |  |  | '>=' => sub {
267 |  |  |  |  | return &comp_addr_mask < 0 ? 0 : 1;
268 |  |  |  |  | },
269 |  |  |  |  |
270 |  |  |  |  | '<=' => sub {
271 |  |  |  |  | return &comp_addr_mask > 0 ? 0 : 1;
272 |  |  |  |  | },
273 |  |  |  |  |
274 | 1 | 20µs | 1 | 59µs | '<=>' => \&comp_addr_mask, # spent 59µs making 1 call to overload::import
275 |  |  |  |  |
276 | 1 | 5.82ms | 1 | 1.83ms | 'cmp' => \&comp_addr_mask; # spent 1.83ms making 1 call to NetAddr::IP::Lite::BEGIN@224
277 |  |  |  |  |
278 |  |  |  |  | sub comp_addr_mask {
279 |  |  |  |  | my($c,$rv) = sub128($_[0]->{addr},$_[1]->{addr});
280 |  |  |  |  | return -1 unless $c;
281 |  |  |  |  | return 1 if hasbits($rv);
282 |  |  |  |  | ($c,$rv) = sub128($_[0]->{mask},$_[1]->{mask});
283 |  |  |  |  | return -1 unless $c;
284 |  |  |  |  | return hasbits($rv) ? 1 : 0;
285 |  |  |  |  | }
286 |  |  |  |  |
287 |  |  |  |  | #sub comp_addr {
288 |  |  |  |  | # my($c,$rv) = sub128($_[0]->{addr},$_[1]->{addr});
289 |  |  |  |  | # return -1 unless $c;
290 |  |  |  |  | # return hasbits($rv) ? 1 : 0;
291 |  |  |  |  | #}
292 |  |  |  |  |
293 |  |  |  |  | =pod
294 |  |  |  |  |
295 |  |  |  |  | =over
296 |  |  |  |  |
297 |  |  |  |  | =item B<Assignment (C<=>)>
298 |  |  |  |  |
299 |  |  |  |  | Has been optimized to copy one NetAddr::IP::Lite object to another very quickly.
300 |  |  |  |  |
301 |  |  |  |  | =item B<C<-E<gt>copy()>>
302 |  |  |  |  |
303 |  |  |  |  | The B<assignment (C<=>)> operation is only put in to operation when the
304 |  |  |  |  | copied object is further mutated by another overloaded operation. See
305 |  |  |  |  | L<overload> B<SPECIAL SYMBOLS FOR "use overload"> for details.
306 |  |  |  |  |
307 |  |  |  |  | B<C<-E<gt>copy()>> actually creates a new object when called.
308 |  |  |  |  |
309 |  |  |  |  | =cut
310 |  |  |  |  |
311 |  |  |  |  | sub copy {
312 |  |  |  |  | return _new($_[0],$_[0]->{addr}, $_[0]->{mask});
313 |  |  |  |  | }
314 |  |  |  |  |
315 |  |  |  |  | =item B<Stringification>
316 |  |  |  |  |
317 |  |  |  |  | An object can be used just as a string. For instance, the following code
318 |  |  |  |  |
319 |  |  |  |  | my $ip = new NetAddr::IP::Lite '192.168.1.123';
320 |  |  |  |  | print "$ip\n";
321 |  |  |  |  |
322 |  |  |  |  | Will print the string 192.168.1.123/32.
323 |  |  |  |  |
324 |  |  |  |  | my $ip = new6 NetAddr::IP::Lite '192.168.1.123';
325 |  |  |  |  | print "$ip\n";
326 |  |  |  |  |
327 |  |  |  |  | Will print the string 0:0:0:0:0:0:C0A8:17B/128
328 |  |  |  |  |
329 |  |  |  |  | =item B<Equality>
330 |  |  |  |  |
331 |  |  |  |  | You can test for equality with either C<eq>, C<ne>, C<==> or C<!=>. C<eq>, C<ne> allows the
332 |  |  |  |  | comparison with arbitrary strings as well as NetAddr::IP::Lite objects. The
333 |  |  |  |  | following example:
334 |  |  |  |  |
335 |  |  |  |  | if (NetAddr::IP::Lite->new('127.0.0.1','255.0.0.0') eq '127.0.0.1/8')
336 |  |  |  |  | { print "Yes\n"; }
337 |  |  |  |  |
338 |  |  |  |  | Will print out "Yes".
339 |  |  |  |  |
340 |  |  |  |  | Comparison with C<==> and C<!=> requires both operands to be NetAddr::IP::Lite objects.
341 |  |  |  |  |
342 |  |  |  |  | =item B<Comparison via E<gt>, E<lt>, E<gt>=, E<lt>=, E<lt>=E<gt> and C<cmp>>
343 |  |  |  |  |
344 |  |  |  |  | Internally, all network objects are represented in 128 bit format.
345 |  |  |  |  | The numeric representation of the network is compared through the
346 |  |  |  |  | corresponding operation. Comparisons are tried first on the address portion
347 |  |  |  |  | of the object and if that is equal then the NUMERIC cidr portion of the
348 |  |  |  |  | masks are compared. This leads to the counterintuitive result that
349 |  |  |  |  |
350 |  |  |  |  | /24 > /16
351 |  |  |  |  |
352 |  |  |  |  | Comparison should not be done on netaddr objects with different CIDR as
353 |  |  |  |  | this may produce indeterminate - unexpected results,
354 |  |  |  |  | rather the determination of which netblock is larger or smaller should be
355 |  |  |  |  | done by comparing
356 |  |  |  |  |
357 |  |  |  |  | $ip1->masklen <=> $ip2->masklen
358 |  |  |  |  |
359 |  |  |  |  | =item B<Addition of a constant (C<+>)>
360 |  |  |  |  |
361 |  |  |  |  | Add a 32 bit signed constant to the address part of a NetAddr object.
362 |  |  |  |  | This operation changes the address part to point so many hosts above the
363 |  |  |  |  | current objects start address. For instance, this code:
364 |  |  |  |  |
365 |  |  |  |  | print NetAddr::IP::Lite->new('127.0.0.1/8') + 5;
366 |  |  |  |  |
367 |  |  |  |  | will output 127.0.0.6/8. The address will wrap around at the broadcast
368 |  |  |  |  | back to the network address. This code:
369 |  |  |  |  |
370 |  |  |  |  | print NetAddr::IP::Lite->new('10.0.0.1/24') + 255;
371 |  |  |  |  |
372 |  |  |  |  | outputs 10.0.0.0/24.
373 |  |  |  |  |
374 |  |  |  |  | Returns the the unchanged object when the constant is missing or out of range.
375 |  |  |  |  |
376 |  |  |  |  | 2147483647 <= constant >= -2147483648
377 |  |  |  |  |
378 |  |  |  |  | =cut
379 |  |  |  |  |
380 |  |  |  |  | sub new4 {
381 |  |  |  |  | my $proto = shift;
382 |  |  |  |  | my $ip = shift;
383 |  |  |  |  | my $class = ref $proto || $proto || __PACKAGE__;
384 |  |  |  |  |
385 |  |  |  |  | my $self = {
386 |  |  |  |  | addr => ipv4to6(inet_aton($ip)),
387 |  |  |  |  | mask => &Ones,
388 |  |  |  |  | isv6 => 0,
389 |  |  |  |  | };
390 |  |  |  |  | return bless $self, $class;
391 |  |  |  |  |
392 |  |  |  |  | }
393 |  |  |  |  |
394 |  |  |  |  |
395 |  |  |  |  | sub plus {
396 |  |  |  |  | my $ip = shift;
397 |  |  |  |  | my $const = shift;
398 |  |  |  |  |
399 |  |  |  |  | return $ip unless $const &&
400 |  |  |  |  | $const < 2147483648 &&
401 |  |  |  |  | $const > -2147483649;
402 |  |  |  |  |
403 |  |  |  |  | my $a = $ip->{addr};
404 |  |  |  |  | my $m = $ip->{mask};
405 |  |  |  |  |
406 |  |  |  |  | my $lo = $a & ~$m;
407 |  |  |  |  | my $hi = $a & $m;
408 |  |  |  |  |
409 |  |  |  |  | my $new = ((addconst($lo,$const))[1] & ~$m) | $hi;
410 |  |  |  |  |
411 |  |  |  |  | return _new($ip,$new,$m);
412 |  |  |  |  | }
413 |  |  |  |  |
414 |  |  |  |  | =item B<Subtraction of a constant (C<->)>
415 |  |  |  |  |
416 |  |  |  |  | The complement of the addition of a constant.
417 |  |  |  |  |
418 |  |  |  |  | =item B<Difference (C<->)>
419 |  |  |  |  |
420 |  |  |  |  | Returns the difference between the address parts of two NetAddr::IP::Lite
421 |  |  |  |  | objects address parts as a 32 bit signed number.
422 |  |  |  |  |
423 |  |  |  |  | Returns B<undef> if the difference is out of range.
424 |  |  |  |  |
425 |  |  |  |  | =cut
426 |  |  |  |  |
427 | 1 | 100ns | 1 | 2µs | my $_smsk = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0x80000000); # spent 2µs making 1 call to main::CORE:pack
428 |  |  |  |  |
429 |  |  |  |  | sub minus {
430 |  |  |  |  | my $ip = shift;
431 |  |  |  |  | my $arg = shift;
432 |  |  |  |  | unless (ref $arg) {
433 |  |  |  |  | return plus($ip, -$arg);
434 |  |  |  |  | }
435 |  |  |  |  | my($carry,$dif) = sub128($ip->{addr},$arg->{addr});
436 |  |  |  |  | if ($carry) { # value is positive
437 |  |  |  |  | return undef if hasbits($dif & $_smsk); # all sign bits should be 0's
438 |  |  |  |  | return (unpack('L3N',$dif))[3];
439 |  |  |  |  | } else {
440 |  |  |  |  | return undef if hasbits(($dif & $_smsk) ^ $_smsk); # sign is 1's
441 |  |  |  |  | return (unpack('L3N',$dif))[3] - 4294967296;
442 |  |  |  |  | }
443 |  |  |  |  | }
444 |  |  |  |  |
445 |  |  |  |  | # Auto-increment an object
446 |  |  |  |  |
447 |  |  |  |  | =item B<Auto-increment>
448 |  |  |  |  |
449 |  |  |  |  | Auto-incrementing a NetAddr::IP::Lite object causes the address part to be
450 |  |  |  |  | adjusted to the next host address within the subnet. It will wrap at
451 |  |  |  |  | the broadcast address and start again from the network address.
452 |  |  |  |  |
453 |  |  |  |  | =cut
454 |  |  |  |  |
455 |  |  |  |  | sub plusplus {
456 |  |  |  |  | my $ip = shift;
457 |  |  |  |  |
458 |  |  |  |  | my $a = $ip->{addr};
459 |  |  |  |  | my $m = $ip->{mask};
460 |  |  |  |  |
461 |  |  |  |  | my $lo = $a & ~ $m;
462 |  |  |  |  | my $hi = $a & $m;
463 |  |  |  |  |
464 |  |  |  |  | $ip->{addr} = ((addconst($lo,1))[1] & ~ $m) | $hi;
465 |  |  |  |  | return $ip;
466 |  |  |  |  | }
467 |  |  |  |  |
468 |  |  |  |  | =item B<Auto-decrement>
469 |  |  |  |  |
470 |  |  |  |  | Auto-decrementing a NetAddr::IP::Lite object performs exactly the opposite
471 |  |  |  |  | of auto-incrementing it, as you would expect.
472 |  |  |  |  |
473 |  |  |  |  | =cut
474 |  |  |  |  |
475 |  |  |  |  | sub minusminus {
476 |  |  |  |  | my $ip = shift;
477 |  |  |  |  |
478 |  |  |  |  | my $a = $ip->{addr};
479 |  |  |  |  | my $m = $ip->{mask};
480 |  |  |  |  |
481 |  |  |  |  | my $lo = $a & ~$m;
482 |  |  |  |  | my $hi = $a & $m;
483 |  |  |  |  |
484 |  |  |  |  | $ip->{addr} = ((addconst($lo,-1))[1] & ~$m) | $hi;
485 |  |  |  |  | return $ip;
486 |  |  |  |  | }
487 |  |  |  |  |
488 |  |  |  |  | #############################################
489 |  |  |  |  | # End of the overload methods.
490 |  |  |  |  | #############################################
491 |  |  |  |  |
492 |  |  |  |  | # Preloaded methods go here.
493 |  |  |  |  |
494 |  |  |  |  | # This is a variant to ->new() that
495 |  |  |  |  | # creates and blesses a new object
496 |  |  |  |  | # without the fancy parsing of
497 |  |  |  |  | # IP formats and shorthands.
498 |  |  |  |  |
499 |  |  |  |  | # return a blessed IP object without parsing
500 |  |  |  |  | # input: prototype, naddr, nmask
501 |  |  |  |  | # returns: blessed IP object
502 |  |  |  |  | #
503 |  |  |  |  | sub _new ($$$) {
504 |  |  |  |  | my $proto = shift;
505 |  |  |  |  | my $class = ref($proto) || die "reference required";
506 |  |  |  |  | $proto = $proto->{isv6};
507 |  |  |  |  | my $self = {
508 |  |  |  |  | addr => $_[0],
509 |  |  |  |  | mask => $_[1],
510 |  |  |  |  | isv6 => $proto,
511 |  |  |  |  | };
512 |  |  |  |  | return bless $self, $class;
513 |  |  |  |  | }
514 |  |  |  |  |
515 |  |  |  |  | =pod
516 |  |  |  |  |
517 |  |  |  |  | =back
518 |  |  |  |  |
519 |  |  |  |  | =head2 Methods
520 |  |  |  |  |
521 |  |  |  |  | =over
522 |  |  |  |  |
523 |  |  |  |  | =item C<-E<gt>new([$addr, [ $mask|IPv6 ]])>
524 |  |  |  |  |
525 |  |  |  |  | =item C<-E<gt>new6([$addr, [ $mask]])>
526 |  |  |  |  |
527 |  |  |  |  | =item C<-E<gt>new6FFFF([$addr, [ $mask]])>
528 |  |  |  |  |
529 |  |  |  |  | =item C<-E<gt>new_no([$addr, [ $mask]])>
530 |  |  |  |  |
531 |  |  |  |  | =item C<-E<gt>new_from_aton($netaddr)>
532 |  |  |  |  |
533 |  |  |  |  | =item new_cis and new_cis6 are DEPRECATED
534 |  |  |  |  |
535 |  |  |  |  | =item C<-E<gt>new_cis("$addr $mask)>
536 |  |  |  |  |
537 |  |  |  |  | =item C<-E<gt>new_cis6("$addr $mask)>
538 |  |  |  |  |
539 |  |  |  |  | The first three methods create a new address with the supplied address in
540 |  |  |  |  | C<$addr> and an optional netmask C<$mask>, which can be omitted to get
541 |  |  |  |  | a /32 or /128 netmask for IPv4 / IPv6 addresses respectively.
542 |  |  |  |  |
543 |  |  |  |  | new6FFFF specifically returns an IPv4 address in IPv6 format according to RFC4291
544 |  |  |  |  |
545 |  |  |  |  | new6 ::xxxx:xxxx
546 |  |  |  |  | new6FFFF ::FFFF:xxxx:xxxx
547 |  |  |  |  |
548 |  |  |  |  | The third method C<new_no> is exclusively for IPv4 addresses and filters
549 |  |  |  |  | improperly formatted
550 |  |  |  |  | dot quad strings for leading 0's that would normally be interpreted as octal
551 |  |  |  |  | format by NetAddr per the specifications for inet_aton.
552 |  |  |  |  |
553 |  |  |  |  | B<new_from_aton> takes a packed IPv4 address and assumes a /32 mask. This
554 |  |  |  |  | function replaces the DEPRECATED :aton functionality which is fundamentally
555 |  |  |  |  | broken.
556 |  |  |  |  |
557 |  |  |  |  | The last two methods B<new_cis> and B<new_cis6> differ from B<new> and
558 |  |  |  |  | B<new6> only in that they except the common Cisco address notation for
559 |  |  |  |  | address/mask pairs with a B<space> as a separator instead of a slash (/)
560 |  |  |  |  |
561 |  |  |  |  | These methods are DEPRECATED because the functionality is now included
562 |  |  |  |  | in the other "new" methods
563 |  |  |  |  |
564 |  |  |  |  | i.e. ->new_cis('1.2.3.0 24')
565 |  |  |  |  | or
566 |  |  |  |  | ->new_cis6('::1.2.3.0 120')
567 |  |  |  |  |
568 |  |  |  |  | C<-E<gt>new6> and
569 |  |  |  |  | C<-E<gt>new_cis6> mark the address as being in ipV6 address space even
570 |  |  |  |  | if the format would suggest otherwise.
571 |  |  |  |  |
572 |  |  |  |  | i.e. ->new6('1.2.3.4') will result in ::102:304
573 |  |  |  |  |
574 |  |  |  |  | addresses submitted to ->new in ipV6 notation will
575 |  |  |  |  | remain in that notation permanently. i.e.
576 |  |  |  |  | ->new('::1.2.3.4') will result in ::102:304
577 |  |  |  |  | whereas new('1.2.3.4') would print out as 1.2.3.4
578 |  |  |  |  |
579 |  |  |  |  | See "STRINGIFICATION" below.
580 |  |  |  |  |
581 |  |  |  |  | C<$addr> can be almost anything that can be resolved to an IP address
582 |  |  |  |  | in all the notations I have seen over time. It can optionally contain
583 |  |  |  |  | the mask in CIDR notation. If the OPTIONAL perl module Socket6 is
584 |  |  |  |  | available in the local library it will autoload and ipV6 host6
585 |  |  |  |  | names will be resolved as well as ipV4 hostnames.
586 |  |  |  |  |
587 |  |  |  |  | B<prefix> notation is understood, with the limitation that the range
588 |  |  |  |  | specified by the prefix must match with a valid subnet.
589 |  |  |  |  |
590 |  |  |  |  | Addresses in the same format returned by C<inet_aton> or
591 |  |  |  |  | C<gethostbyname> can also be understood, although no mask can be
592 |  |  |  |  | specified for them. The default is to not attempt to recognize this
593 |  |  |  |  | format, as it seems to be seldom used.
594 |  |  |  |  |
595 |  |  |  |  | ###### DEPRECATED, will be remove in version 5 ############
596 |  |  |  |  | To accept addresses in that format, invoke the module as in
597 |  |  |  |  |
598 |  |  |  |  | use NetAddr::IP::Lite ':aton'
599 |  |  |  |  |
600 |  |  |  |  | ###### USE new_from_aton instead ##########################
601 |  |  |  |  |
602 |  |  |  |  | If called with no arguments, 'default' is assumed.
603 |  |  |  |  |
604 |  |  |  |  | If called with an empty string as the argument, returns 'undef'
605 |  |  |  |  |
606 |  |  |  |  | C<$addr> can be any of the following and possibly more...
607 |  |  |  |  |
608 |  |  |  |  | n.n
609 |  |  |  |  | n.n/mm
610 |  |  |  |  | n.n mm
611 |  |  |  |  | n.n.n
612 |  |  |  |  | n.n.n/mm
613 |  |  |  |  | n.n.n mm
614 |  |  |  |  | n.n.n.n
615 |  |  |  |  | n.n.n.n/mm 32 bit cidr notation
616 |  |  |  |  | n.n.n.n mm
617 |  |  |  |  | n.n.n.n/m.m.m.m
618 |  |  |  |  | n.n.n.n m.m.m.m
619 |  |  |  |  | loopback, localhost, broadcast, any, default
620 |  |  |  |  | x.x.x.x/host
621 |  |  |  |  | 0xABCDEF, 0b111111000101011110, (or a bcd number)
622 |  |  |  |  | a netaddr as returned by 'inet_aton'
623 |  |  |  |  |
624 |  |  |  |  |
625 |  |  |  |  | Any RFC1884 notation
626 |  |  |  |  |
627 |  |  |  |  | ::n.n.n.n
628 |  |  |  |  | ::n.n.n.n/mmm 128 bit cidr notation
629 |  |  |  |  | ::n.n.n.n/::m.m.m.m
630 |  |  |  |  | ::x:x
631 |  |  |  |  | ::x:x/mmm
632 |  |  |  |  | x:x:x:x:x:x:x:x
633 |  |  |  |  | x:x:x:x:x:x:x:x/mmm
634 |  |  |  |  | x:x:x:x:x:x:x:x/m:m:m:m:m:m:m:m any RFC1884 notation
635 |  |  |  |  | loopback, localhost, unspecified, any, default
636 |  |  |  |  | ::x:x/host
637 |  |  |  |  | 0xABCDEF, 0b111111000101011110 within the limits
638 |  |  |  |  | of perl's number resolution
639 |  |  |  |  | 123456789012 a 'big' bcd number (bigger than perl likes)
640 |  |  |  |  | and Math::BigInt
641 |  |  |  |  |
642 |  |  |  |  | If called with no arguments, 'default' is assumed.
643 |  |  |  |  |
644 |  |  |  |  | If called with and empty string as the argument, 'undef' is returned;
645 |  |  |  |  |
646 |  |  |  |  | =cut
647 |  |  |  |  |
648 | 1 | 2µs | 1 | 65µs | my $lbmask = inet_aton('255.0.0.0'); # spent 65µs making 1 call to NetAddr::IP::InetBase::inet_aton
649 | 1 | 3µs | 1 | 173µs | my $_p4broad = inet_any2n('255.255.255.255'); # spent 173µs making 1 call to AutoLoader::AUTOLOAD
650 | 1 | 1µs | 1 | 58µs | my $_p4loop = inet_any2n('127.0.0.1'); # spent 58µs making 1 call to NetAddr::IP::InetBase::inet_any2n
651 | 1 | 1µs | 1 | 22µs | my $_p4mloop = inet_aton('255.0.0.0'); # spent 22µs making 1 call to NetAddr::IP::InetBase::inet_aton
652 | 1 | 7µs | 1 | 3µs | $_p4mloop = mask4to6($_p4mloop); # spent 3µs making 1 call to NetAddr::IP::Util::mask4to6
653 | 1 | 1µs | 1 | 44µs | my $_p6loop = inet_any2n('::1'); # spent 44µs making 1 call to NetAddr::IP::InetBase::inet_any2n
654 |  |  |  |  |
655 | 1 | 4µs | 2 | 2µs | my %fip4 = ( # spent 2µs making 2 calls to NetAddr::IP::Lite::Zeros, avg 900ns/call
656 |  |  |  |  | default => Zeros,
657 |  |  |  |  | any => Zeros,
658 |  |  |  |  | broadcast => $_p4broad,
659 |  |  |  |  | loopback => $_p4loop,
660 |  |  |  |  | unspecified => undef,
661 |  |  |  |  | );
662 | 1 | 4µs | 4 | 2µs | my %fip4m = ( # spent 1µs making 2 calls to NetAddr::IP::Lite::Ones, avg 550ns/call # spent 900ns making 2 calls to NetAddr::IP::Lite::Zeros, avg 450ns/call
663 |  |  |  |  | default => Zeros,
664 |  |  |  |  | any => Zeros,
665 |  |  |  |  | broadcast => Ones,
666 |  |  |  |  | loopback => $_p4mloop,
667 |  |  |  |  | unspecified => undef, # not applicable for ipV4
668 |  |  |  |  | host => Ones,
669 |  |  |  |  | );
670 |  |  |  |  |
671 | 1 | 5µs | 3 | 2µs | my %fip6 = ( # spent 2µs making 3 calls to NetAddr::IP::Lite::Zeros, avg 833ns/call
672 |  |  |  |  | default => Zeros,
673 |  |  |  |  | any => Zeros,
674 |  |  |  |  | broadcast => undef, # not applicable for ipV6
675 |  |  |  |  | loopback => $_p6loop,
676 |  |  |  |  | unspecified => Zeros,
677 |  |  |  |  | );
678 |  |  |  |  |
679 | 1 | 4µs | 5 | 3µs | my %fip6m = ( # spent 2µs making 3 calls to NetAddr::IP::Lite::Ones, avg 567ns/call # spent 1µs making 2 calls to NetAddr::IP::Lite::Zeros, avg 600ns/call
680 |  |  |  |  | default => Zeros,
681 |  |  |  |  | any => Zeros,
682 |  |  |  |  | broadcast => undef, # not applicable for ipV6
683 |  |  |  |  | loopback => Ones,
684 |  |  |  |  | unspecified => Ones,
685 |  |  |  |  | host => Ones,
686 |  |  |  |  | );
687 |  |  |  |  |
688 | 1 | 300ns | 1 | 2µs | my $ff000000 = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0xFF000000); # spent 2µs making 1 call to main::CORE:pack
689 | 1 | 200ns | 1 | 800ns | my $ffff0000 = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0xFFFF0000); # spent 800ns making 1 call to main::CORE:pack
690 | 1 | 200ns | 1 | 800ns | my $ffffff00 = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0xFFFFFF00); # spent 800ns making 1 call to main::CORE:pack
691 |  |  |  |  |
692 |  |  |  |  | sub _obits ($$) {
693 |  |  |  |  | my($lo,$hi) = @_;
694 |  |  |  |  |
695 |  |  |  |  | return 0xFF if $lo == $hi;
696 |  |  |  |  | return (~ ($hi ^ $lo)) & 0xFF;
697 |  |  |  |  | }
698 |  |  |  |  |
699 |  |  |  |  | sub new_no($;$$) {
700 |  |  |  |  | unshift @_, -1;
701 |  |  |  |  | goto &_xnew;
702 |  |  |  |  | }
703 |  |  |  |  |
704 |  |  |  |  | # spent 86.4ms within NetAddr::IP::Lite::new which was called 47820 times, avg 2µs/call: # 47817 times (86.4ms+0s) by main::__ANON__[examples/benchmark4.pl:9] at line 9 of examples/benchmark4.pl, avg 2µs/call # once (3µs+0s) by NetAddr::IP::BEGIN@8 at line 1379 # once (2µs+0s) by NetAddr::IP::BEGIN@8 at line 1383 # once (2µs+0s) by NetAddr::IP::BEGIN@8 at line 1387 sub new($;$$) {
705 | 47820 | 36.3ms |  |  | unshift @_, 0;
706 | 47820 | 142ms | 47820 | 2.85s | goto &_xnew; # spent 2.85s making 47820 calls to NetAddr::IP::Lite::_xnew, avg 60µs/call
707 |  |  |  |  | }
708 |  |  |  |  |
709 |  |  |  |  | sub new_from_aton($$) {
710 |  |  |  |  | my $proto = shift;
711 |  |  |  |  | my $class = ref $proto || $proto || __PACKAGE__;
712 |  |  |  |  | my $ip = shift;
713 |  |  |  |  | return undef unless defined $ip;
714 |  |  |  |  | my $addrlen = length($ip);
715 |  |  |  |  | return undef unless $addrlen == 4;
716 |  |  |  |  | my $self = {
717 |  |  |  |  | addr => ipv4to6($ip),
718 |  |  |  |  | mask => &Ones,
719 |  |  |  |  | isv6 => 0,
720 |  |  |  |  | };
721 |  |  |  |  | return bless $self, $class;
722 |  |  |  |  | }
723 |  |  |  |  |
724 |  |  |  |  | sub new6($;$$) {
725 |  |  |  |  | unshift @_, 1;
726 |  |  |  |  | goto &_xnew;
727 |  |  |  |  | }
728 |  |  |  |  |
729 |  |  |  |  | sub new6FFFF($;$$) {
730 |  |  |  |  | my $ip = _xnew(1,@_);
731 |  |  |  |  | $ip->{addr} |= $_ipv4FFFF;
732 |  |  |  |  | return $ip;
733 |  |  |  |  | }
734 |  |  |  |  |
735 |  |  |  |  | sub new_cis($;$$) {
736 |  |  |  |  | my @in = @_;
737 |  |  |  |  | if ( $in[1] && $in[1] =~ m!^(.+)\s+(.+)$! ) {
738 |  |  |  |  | $in[1] = $1 .'/'. $2;
739 |  |  |  |  | }
740 |  |  |  |  | @_ = (0,@in);
741 |  |  |  |  | goto &_xnew;
742 |  |  |  |  | }
743 |  |  |  |  |
744 |  |  |  |  | sub new_cis6($;$$) {
745 |  |  |  |  | my @in = @_;
746 |  |  |  |  | if ( $in[1] && $in[1] =~ m!^(.+)\s+(.+)$! ) {
747 |  |  |  |  | $in[1] = $1 .'/'. $2;
748 |  |  |  |  | }
749 |  |  |  |  | @_ = (1,@in);
750 |  |  |  |  | goto &_xnew;
751 |  |  |  |  | }
752 |  |  |  |  |
753 |  |  |  |  | sub _no_octal {
754 |  |  |  |  | $_[0] =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/;
755 |  |  |  |  | return sprintf("%d.%d.%d.%d",$1,$2,$3,$4);
756 |  |  |  |  | }
757 |  |  |  |  |
758 |  |  |  |  | # spent 2.85s (1.57+1.28) within NetAddr::IP::Lite::_xnew which was called 47820 times, avg 60µs/call: # 47820 times (1.57s+1.28s) by NetAddr::IP::BEGIN@8 or main::__ANON__[examples/benchmark4.pl:9] at line 706, avg 60µs/call sub _xnew($$;$$) {
759 | 47820 | 8.69ms |  |  | my $noctal = 0;
760 | 47820 | 11.0ms |  |  | my $isV6 = shift;
761 | 47820 | 8.79ms |  |  | if ($isV6 < 0) { # flag for no octal?
762 |  |  |  |  | $isV6 = 0;
763 |  |  |  |  | $noctal = 1;
764 |  |  |  |  | }
765 | 47820 | 11.4ms |  |  | my $proto = shift;
766 | 47820 | 10.3ms |  |  | my $class = ref $proto || $proto || __PACKAGE__;
767 | 47820 | 6.86ms |  |  | my $ip = shift;
768 |  |  |  |  |
769 |  |  |  |  | # fix for bug #75976
770 | 47820 | 12.5ms |  |  | return undef if defined $ip && $ip eq '';
771 |  |  |  |  |
772 | 47820 | 5.41ms |  |  | $ip = 'default' unless defined $ip;
773 | 47820 | 5.11ms |  |  | $ip = _retMBIstring($ip) # treat as big bcd string
774 |  |  |  |  | if ref $ip && ref $ip eq 'Math::BigInt'; # can /CIDR notation
775 | 47820 | 5.67ms |  |  | my $hasmask = 1;
776 | 47820 | 4.40ms |  |  | my($mask,$tmp);
777 |  |  |  |  |
778 |  |  |  |  | # IP to lower case AFTER ref test for Math::BigInt. 'lc' strips blessing
779 |  |  |  |  |
780 | 47820 | 12.5ms |  |  | $ip = lc $ip;
781 |  |  |  |  |
782 | 47820 | 6.35ms |  |  | while (1) {
783 |  |  |  |  | # process IP's with no CIDR or that have the CIDR as part of the IP argument string
784 | 47820 | 21.6ms |  |  | unless (@_) {
785 |  |  |  |  | # if ($ip =~ m!^(.+)/(.+)$!) {
786 | 47820 | 500ms | 143457 | 155ms | if ($ip !~ /\D/) { # binary number notation # spent 155ms making 143457 calls to NetAddr::IP::Lite::CORE:match, avg 1µs/call
787 |  |  |  |  | $ip = bcd2bin($ip);
788 |  |  |  |  | $mask = Ones;
789 |  |  |  |  | last;
790 |  |  |  |  | }
791 |  |  |  |  | elsif ($ip =~ m!^([a-z0-9.:-]+)(?:/|\s+)([a-z0-9.:-]+)$! ||
792 |  |  |  |  | $ip =~ m!^[\[]{1}([a-z0-9.:-]+)(?:/|\s+)([a-z0-9.:-]+)[\]]{1}$!) {
793 | 3 | 3µs |  |  | $ip = $1;
794 | 3 | 2µs |  |  | $mask = $2;
795 |  |  |  |  | } elsif (grep($ip eq $_,(qw(default any broadcast loopback unspecified)))) {
796 |  |  |  |  | $isV6 = 1 if $ip eq 'unspecified';
797 |  |  |  |  | if ($isV6) {
798 |  |  |  |  | $mask = $fip6m{$ip};
799 |  |  |  |  | return undef unless defined ($ip = $fip6{$ip});
800 |  |  |  |  | } else {
801 |  |  |  |  | $mask = $fip4m{$ip};
802 |  |  |  |  | return undef unless defined ($ip = $fip4{$ip});
803 |  |  |  |  | }
804 |  |  |  |  | last;
805 |  |  |  |  | }
806 |  |  |  |  | }
807 |  |  |  |  | # process "ipv6" token and default IP's
808 |  |  |  |  | elsif (defined $_[0]) {
809 |  |  |  |  | if ($_[0] =~ /ipv6/i || $isV6) {
810 |  |  |  |  | if (grep($ip eq $_,(qw(default any loopback unspecified)))) {
811 |  |  |  |  | $mask = $fip6m{$ip};
812 |  |  |  |  | $ip = $fip6{$ip};
813 |  |  |  |  | last;
814 |  |  |  |  | } else {
815 |  |  |  |  | return undef unless $isV6;
816 |  |  |  |  | # add for ipv6 notation "12345, 1"
817 |  |  |  |  | }
818 |  |  |  |  | # $mask = lc $_[0];
819 |  |  |  |  | # } else {
820 |  |  |  |  | # $mask = lc $_[0];
821 |  |  |  |  | }
822 |  |  |  |  | # extract mask
823 |  |  |  |  | $mask = $_[0];
824 |  |  |  |  | }
825 |  |  |  |  | ###
826 |  |  |  |  | ### process mask
827 | 47820 | 11.2ms |  |  | unless (defined $mask) {
828 | 47817 | 9.14ms |  |  | $hasmask = 0;
829 | 47817 | 9.79ms |  |  | $mask = 'host';
830 |  |  |  |  | }
831 |  |  |  |  |
832 |  |  |  |  | # two kinds of IP's can turn on the isV6 flag
833 |  |  |  |  | # 1) big digits that are over the IPv4 boundry
834 |  |  |  |  | # 2) IPv6 IP syntax
835 |  |  |  |  | #
836 |  |  |  |  | # check these conditions and set isV6 as appropriate
837 |  |  |  |  | #
838 | 47820 | 4.66ms |  |  | my $try;
839 | 47820 | 173ms | 47820 | 21.4ms | $isV6 = 1 if # check big bcd and IPv6 rfc1884 # spent 21.4ms making 47820 calls to NetAddr::IP::Lite::CORE:match, avg 448ns/call
840 |  |  |  |  | ( $ip !~ /\D/ && # ip is all decimal
841 |  |  |  |  | (length($ip) > 3 || $ip > 255) && # exclude a single digit in the range of zero to 255, could be funny IPv4
842 |  |  |  |  | ($try = bcd2bin($ip)) && ! isIPv4($try)) || # precedence so $try is not corrupted
843 |  |  |  |  | (index($ip,':') >= 0 && ($try = ipv6_aton($ip))); # fails if not an rfc1884 address
844 |  |  |  |  |
845 |  |  |  |  | # if either of the above conditions is true, $try contains the NetAddr 128 bit address
846 |  |  |  |  |
847 |  |  |  |  | # checkfor Math::BigInt mask
848 | 47820 | 5.36ms |  |  | $mask = _retMBIstring($mask) # treat as big bcd string
849 |  |  |  |  | if ref $mask && ref $mask eq 'Math::BigInt';
850 |  |  |  |  |
851 |  |  |  |  | # MASK to lower case AFTER ref test for Math::BigInt, 'lc' strips blessing
852 |  |  |  |  |
853 | 47820 | 12.3ms |  |  | $mask = lc $mask;
854 |  |  |  |  |
855 | 47820 | 234ms | 95637 | 23.3ms | if ($mask !~ /\D/) { # bcd or CIDR notation # spent 23.3ms making 95637 calls to NetAddr::IP::Lite::CORE:match, avg 243ns/call
856 | 3 | 3µs |  |  | my $isCIDR = length($mask) < 4 && $mask < 129;
857 | 3 | 2µs |  |  | if ($isV6) {
858 |  |  |  |  | if ($isCIDR) {
859 |  |  |  |  | my($dq1,$dq2,$dq3,$dq4);
860 |  |  |  |  | if ($ip =~ /^(\d+)(?:|\.(\d+)(?:|\.(\d+)(?:|\.(\d+))))$/ &&
861 |  |  |  |  | do {$dq1 = $1;
862 |  |  |  |  | $dq2 = $2 || 0;
863 |  |  |  |  | $dq3 = $3 || 0;
864 |  |  |  |  | $dq4 = $4 || 0;
865 |  |  |  |  | 1;
866 |  |  |  |  | } &&
867 |  |  |  |  | $dq1 >= 0 && $dq1 < 256 &&
868 |  |  |  |  | $dq2 >= 0 && $dq2 < 256 &&
869 |  |  |  |  | $dq3 >= 0 && $dq3 < 256 &&
870 |  |  |  |  | $dq4 >= 0 && $dq4 < 256
871 |  |  |  |  | ) { # corner condition of IPv4 with isV6
872 |  |  |  |  | $ip = join('.',$dq1,$dq2,$dq3,$dq4);
873 |  |  |  |  | $try = ipv4to6(inet_aton($ip));
874 |  |  |  |  | if ($mask < 32) {
875 |  |  |  |  | $mask = shiftleft(Ones,32 -$mask);
876 |  |  |  |  | }
877 |  |  |  |  | elsif ($mask == 32) {
878 |  |  |  |  | $mask = Ones;
879 |  |  |  |  | } else {
880 |  |  |  |  | return undef; # undoubtably an error
881 |  |  |  |  | }
882 |  |  |  |  | }
883 |  |  |  |  | elsif ($mask < 128) {
884 |  |  |  |  | $mask = shiftleft(Ones,128 -$mask); # small cidr
885 |  |  |  |  | } else {
886 |  |  |  |  | $mask = Ones();
887 |  |  |  |  | }
888 |  |  |  |  | } else {
889 |  |  |  |  | $mask = bcd2bin($mask);
890 |  |  |  |  | }
891 |  |  |  |  | }
892 |  |  |  |  | elsif ($isCIDR && $mask < 33) { # is V4
893 | 3 | 19µs | 6 | 12µs | if ($mask < 32) { # spent 8µs making 3 calls to NetAddr::IP::Util::shiftleft, avg 3µs/call # spent 4µs making 3 calls to NetAddr::IP::Lite::Ones, avg 1µs/call
894 |  |  |  |  | $mask = shiftleft(Ones,32 -$mask);
895 |  |  |  |  | }
896 |  |  |  |  | elsif ( $mask == 32) {
897 |  |  |  |  | $mask = Ones;
898 |  |  |  |  | } else {
899 |  |  |  |  | $mask = bcd2bin($mask);
900 |  |  |  |  | $mask |= $_v4mask; # v4 always
901 |  |  |  |  | }
902 |  |  |  |  | } else { # also V4
903 |  |  |  |  | $mask = bcd2bin($mask);
904 |  |  |  |  | $mask |= $_v4mask;
905 |  |  |  |  | }
906 | 3 | 900ns |  |  | if ($try) { # is a big number
907 |  |  |  |  | $ip = $try;
908 |  |  |  |  | last;
909 |  |  |  |  | }
910 |  |  |  |  | } elsif ($mask =~ m/^\d+\.\d+\.\d+\.\d+$/) { # ipv4 form of mask
911 |  |  |  |  | $mask = _no_octal($mask) if $noctal; # filter for octal
912 |  |  |  |  | return undef unless defined ($mask = inet_aton($mask));
913 |  |  |  |  | $mask = mask4to6($mask);
914 |  |  |  |  | } elsif (grep($mask eq $_,qw(default any broadcast loopback unspecified host))) {
915 |  |  |  |  | if (index($ip,':') < 0 && ! $isV6) {
916 |  |  |  |  | return undef unless defined ($mask = $fip4m{$mask});
917 |  |  |  |  | } else {
918 |  |  |  |  | return undef unless defined ($mask = $fip6m{$mask});
919 |  |  |  |  | }
920 |  |  |  |  | } else {
921 |  |  |  |  | return undef unless defined ($mask = ipv6_aton($mask)); # try ipv6 form of mask
922 |  |  |  |  | }
923 |  |  |  |  |
924 |  |  |  |  | # process remaining IP's
925 |  |  |  |  |
926 | 47820 | 10.6ms |  |  | if (index($ip,':') < 0) { # ipv4 address
927 | 47820 | 184ms | 47820 | 52.1ms | if ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { # spent 52.1ms making 47820 calls to NetAddr::IP::Lite::CORE:match, avg 1µs/call
928 |  |  |  |  | ; # the common case
929 |  |  |  |  | }
930 |  |  |  |  | elsif (grep($ip eq $_,(qw(default any broadcast loopback)))) {
931 |  |  |  |  | return undef unless defined ($ip = $fip4{$ip});
932 |  |  |  |  | last;
933 |  |  |  |  | }
934 |  |  |  |  | elsif ($ip =~ m/^(\d+)\.(\d+)$/) {
935 |  |  |  |  | $ip = ($hasmask)
936 |  |  |  |  | ? "${1}.${2}.0.0"
937 |  |  |  |  | : "${1}.0.0.${2}";
938 |  |  |  |  | }
939 |  |  |  |  | elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
940 |  |  |  |  | $ip = ($hasmask)
941 |  |  |  |  | ? "${1}.${2}.${3}.0"
942 |  |  |  |  | : "${1}.${2}.0.${3}";
943 |  |  |  |  | }
944 |  |  |  |  | elsif ($ip =~ /^(\d+)$/ && $hasmask && $1 >= 0 and $1 < 256) { # pure numeric
945 |  |  |  |  | $ip = sprintf("%d.0.0.0",$1);
946 |  |  |  |  | }
947 |  |  |  |  | # elsif ($ip =~ /^\d+$/ && !$hasmask) { # a big integer
948 |  |  |  |  | elsif ($ip =~ /^\d+$/ ) { # a big integer
949 |  |  |  |  | $ip = bcd2bin($ip);
950 |  |  |  |  | last;
951 |  |  |  |  | }
952 |  |  |  |  | # these next three might be broken??? but they have been in the code a long time and no one has complained
953 |  |  |  |  | elsif ($ip =~ /^0[xb]\d+$/ && $hasmask &&
954 |  |  |  |  | (($tmp = eval "$ip") || 1) &&
955 |  |  |  |  | $tmp >= 0 && $tmp < 256) {
956 |  |  |  |  | $ip = sprintf("%d.0.0.0",$tmp);
957 |  |  |  |  | }
958 |  |  |  |  | elsif ($ip =~ /^-?\d+$/) {
959 |  |  |  |  | $ip += 2 ** 32 if $ip < 0;
960 |  |  |  |  | $ip = pack('L3N',0,0,0,$ip);
961 |  |  |  |  | last;
962 |  |  |  |  | }
963 |  |  |  |  | elsif ($ip =~ /^-?0[xb]\d+$/) {
964 |  |  |  |  | $ip = eval "$ip";
965 |  |  |  |  | $ip = pack('L3N',0,0,0,$ip);
966 |  |  |  |  | last;
967 |  |  |  |  | }
968 |  |  |  |  |
969 |  |  |  |  | # notations below include an implicit mask specification
970 |  |  |  |  |
971 |  |  |  |  | elsif ($ip =~ m/^(\d+)\.$/) {
972 |  |  |  |  | $ip = "${1}.0.0.0";
973 |  |  |  |  | $mask = $ff000000;
974 |  |  |  |  | }
975 |  |  |  |  | elsif ($ip =~ m/^(\d+)\.(\d+)-(\d+)\.?$/ && $2 <= $3 && $3 < 256) {
976 |  |  |  |  | $ip = "${1}.${2}.0.0";
977 |  |  |  |  | $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,255,_obits($2,$3),0,0);
978 |  |  |  |  | }
979 |  |  |  |  | elsif ($ip =~ m/^(\d+)-(\d+)\.?$/ and $1 <= $2 && $2 < 256) {
980 |  |  |  |  | $ip = "${1}.0.0.0";
981 |  |  |  |  | $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,_obits($1,$2),0,0,0)
982 |  |  |  |  | }
983 |  |  |  |  | elsif ($ip =~ m/^(\d+)\.(\d+)\.$/) {
984 |  |  |  |  | $ip = "${1}.${2}.0.0";
985 |  |  |  |  | $mask = $ffff0000;
986 |  |  |  |  | }
987 |  |  |  |  | elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)-(\d+)\.?$/ && $3 <= $4 && $4 < 256) {
988 |  |  |  |  | $ip = "${1}.${2}.${3}.0";
989 |  |  |  |  | $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,255,255,_obits($3,$4),0);
990 |  |  |  |  | }
991 |  |  |  |  | elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.$/) {
992 |  |  |  |  | $ip = "${1}.${2}.${3}.0";
993 |  |  |  |  | $mask = $ffffff00;
994 |  |  |  |  | }
995 |  |  |  |  | elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)-(\d+)$/ && $4 <= $5 && $5 < 256) {
996 |  |  |  |  | $ip = "${1}.${2}.${3}.${4}";
997 |  |  |  |  | $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,255,255,255,_obits($4,$5));
998 |  |  |  |  | }
999 |  |  |  |  | elsif ($ip =~ m/^(\d+\.\d+\.\d+\.\d+)
1000 |  |  |  |  | \s*-\s*(\d+\.\d+\.\d+\.\d+)$/x) {
1001 |  |  |  |  | if ($noctal) {
1002 |  |  |  |  | return undef unless ($ip = inet_aton(_no_octal($1)));
1003 |  |  |  |  | return undef unless ($tmp = inet_aton(_no_octal($2)));
1004 |  |  |  |  | } else {
1005 |  |  |  |  | return undef unless ($ip = inet_aton($1));
1006 |  |  |  |  | return undef unless ($tmp = inet_aton($2));
1007 |  |  |  |  | }
1008 |  |  |  |  | # check for left side greater than right side
1009 |  |  |  |  | # save numeric difference in $mask
1010 |  |  |  |  | return undef if ($tmp = unpack('N',$tmp) - unpack('N',$ip)) < 0;
1011 |  |  |  |  | $ip = ipv4to6($ip);
1012 |  |  |  |  | $tmp = pack('L3N',0,0,0,$tmp);
1013 |  |  |  |  | $mask = ~$tmp;
1014 |  |  |  |  | return undef if notcontiguous($mask);
1015 |  |  |  |  | # check for non-aligned left side
1016 |  |  |  |  | return undef if hasbits($ip & $tmp);
1017 |  |  |  |  | last;
1018 |  |  |  |  | }
1019 |  |  |  |  | # check for resolvable IPv4 hosts
1020 |  |  |  |  | elsif ($ip !~ /[^a-zA-Z0-9\.-]/ && ($tmp = gethostbyname(fillIPv4($ip))) && $tmp ne $_v4zero && $tmp ne $_zero ) {
1021 |  |  |  |  | $ip = ipv4to6($tmp);
1022 |  |  |  |  | last;
1023 |  |  |  |  | }
1024 |  |  |  |  | # check for resolvable IPv6 hosts
1025 |  |  |  |  | elsif ($ip !~ /[^a-zA-Z0-9\.-]/ && havegethostbyname2() && ($tmp = naip_gethostbyname($ip))) {
1026 |  |  |  |  | $ip = $tmp;
1027 |  |  |  |  | $isV6 = 1;
1028 |  |  |  |  | last;
1029 |  |  |  |  | }
1030 |  |  |  |  | elsif ($Accept_Binary_IP && ! $hasmask) {
1031 |  |  |  |  | if (length($ip) == 4) {
1032 |  |  |  |  | $ip = ipv4to6($ip);
1033 |  |  |  |  | } elsif (length($ip) == 16) {
1034 |  |  |  |  | $isV6 = 1;
1035 |  |  |  |  | } else {
1036 |  |  |  |  | return undef;
1037 |  |  |  |  | }
1038 |  |  |  |  | last;
1039 |  |  |  |  | } else {
1040 |  |  |  |  | return undef;
1041 |  |  |  |  | }
1042 | 47820 | 61.2ms | 47820 | 946ms | return undef unless defined ($ip = inet_aton($ip)); # spent 946ms making 47820 calls to NetAddr::IP::InetBase::inet_aton, avg 20µs/call
1043 | 47820 | 144ms | 47820 | 46.5ms | $ip = ipv4to6($ip); # spent 46.5ms making 47820 calls to NetAddr::IP::Util::ipv4to6, avg 973ns/call
1044 | 47820 | 29.3ms |  |  | last;
1045 |  |  |  |  | }
1046 |  |  |  |  | ########## continuing
1047 |  |  |  |  | else { # ipv6 address
1048 |  |  |  |  | $isV6 = 1;
1049 |  |  |  |  | $ip = $1 if $ip =~ /\[([^\]]+)\]/; # transform URI notation
1050 |  |  |  |  | if (defined ($tmp = ipv6_aton($ip))) {
1051 |  |  |  |  | $ip = $tmp;
1052 |  |  |  |  | last;
1053 |  |  |  |  | }
1054 |  |  |  |  | last if grep($ip eq $_,(qw(default any loopback unspecified))) &&
1055 |  |  |  |  | defined ($ip = $fip6{$ip});
1056 |  |  |  |  | return undef;
1057 |  |  |  |  | }
1058 |  |  |  |  | } # end while (1)
1059 | 47820 | 174ms | 47820 | 34.0ms | return undef if notcontiguous($mask); # invalid if not contiguous # spent 34.0ms making 47820 calls to NetAddr::IP::Util::notcontiguous, avg 711ns/call
1060 |  |  |  |  |
1061 | 47820 | 65.1ms |  |  | my $self = {
1062 |  |  |  |  | addr => $ip,
1063 |  |  |  |  | mask => $mask,
1064 |  |  |  |  | isv6 => $isV6,
1065 |  |  |  |  | };
1066 | 47820 | 166ms |  |  | return bless $self, $class;
1067 |  |  |  |  | }
1068 |  |  |  |  |
1069 |  |  |  |  | =item C<-E<gt>broadcast()>
1070 |  |  |  |  |
1071 |  |  |  |  | Returns a new object referring to the broadcast address of a given
1072 |  |  |  |  | subnet. The broadcast address has all ones in all the bit positions
1073 |  |  |  |  | where the netmask has zero bits. This is normally used to address all
1074 |  |  |  |  | the hosts in a given subnet.
1075 |  |  |  |  |
1076 |  |  |  |  | =cut
1077 |  |  |  |  |
1078 |  |  |  |  | sub broadcast ($) {
1079 |  |  |  |  | my $ip = _new($_[0],$_[0]->{addr} | ~$_[0]->{mask},$_[0]->{mask});
1080 |  |  |  |  | $ip->{addr} &= V4net unless $ip->{isv6};
1081 |  |  |  |  | return $ip;
1082 |  |  |  |  | }
1083 |  |  |  |  |
1084 |  |  |  |  | =item C<-E<gt>network()>
1085 |  |  |  |  |
1086 |  |  |  |  | Returns a new object referring to the network address of a given
1087 |  |  |  |  | subnet. A network address has all zero bits where the bits of the
1088 |  |  |  |  | netmask are zero. Normally this is used to refer to a subnet.
1089 |  |  |  |  |
1090 |  |  |  |  | =cut
1091 |  |  |  |  |
1092 |  |  |  |  | sub network ($) {
1093 |  |  |  |  | return _new($_[0],$_[0]->{addr} & $_[0]->{mask},$_[0]->{mask});
1094 |  |  |  |  | }
1095 |  |  |  |  |
1096 |  |  |  |  | =item C<-E<gt>addr()>
1097 |  |  |  |  |
1098 |  |  |  |  | Returns a scalar with the address part of the object as an IPv4 or IPv6 text
1099 |  |  |  |  | string as appropriate. This is useful for printing or for passing the address
1100 |  |  |  |  | part of the NetAddr::IP::Lite object to other components that expect an IP
1101 |  |  |  |  | address. If the object is an ipV6 address or was created using ->new6($ip)
1102 |  |  |  |  | it will be reported in ipV6 hex format otherwise it will be reported in dot
1103 |  |  |  |  | quad format only if it resides in ipV4 address space.
1104 |  |  |  |  |
1105 |  |  |  |  | =cut
1106 |  |  |  |  |
1107 |  |  |  |  | sub addr ($) {
1108 |  |  |  |  | return ($_[0]->{isv6})
1109 |  |  |  |  | ? ipv6_n2x($_[0]->{addr})
1110 |  |  |  |  | : inet_n2dx($_[0]->{addr});
1111 |  |  |  |  | }
1112 |  |  |  |  |
1113 |  |  |  |  | =item C<-E<gt>mask()>
1114 |  |  |  |  |
1115 |  |  |  |  | Returns a scalar with the mask as an IPv4 or IPv6 text string as
1116 |  |  |  |  | described above.
1117 |  |  |  |  |
1118 |  |  |  |  | =cut
1119 |  |  |  |  |
1120 |  |  |  |  | sub mask ($) {
1121 |  |  |  |  | return ipv6_n2x($_[0]->{mask}) if $_[0]->{isv6};
1122 |  |  |  |  | my $mask = isIPv4($_[0]->{addr})
1123 |  |  |  |  | ? $_[0]->{mask} & V4net
1124 |  |  |  |  | : $_[0]->{mask};
1125 |  |  |  |  | return inet_n2dx($mask);
1126 |  |  |  |  | }
1127 |  |  |  |  |
1128 |  |  |  |  | =item C<-E<gt>masklen()>
1129 |  |  |  |  |
1130 |  |  |  |  | Returns a scalar the number of one bits in the mask.
1131 |  |  |  |  |
1132 |  |  |  |  | =cut
1133 |  |  |  |  |
1134 |  |  |  |  | sub masklen ($) {
1135 |  |  |  |  | my $len = (notcontiguous($_[0]->{mask}))[1];
1136 |  |  |  |  | return 0 unless $len;
1137 |  |  |  |  | return $len if $_[0]->{isv6};
1138 |  |  |  |  | return isIPv4($_[0]->{addr})
1139 |  |  |  |  | ? $len -96
1140 |  |  |  |  | : $len;
1141 |  |  |  |  | }
1142 |  |  |  |  |
1143 |  |  |  |  | =item C<-E<gt>bits()>
1144 |  |  |  |  |
1145 |  |  |  |  | Returns the width of the address in bits. Normally 32 for v4 and 128 for v6.
1146 |  |  |  |  |
1147 |  |  |  |  | =cut
1148 |  |  |  |  |
1149 |  |  |  |  | sub bits {
1150 |  |  |  |  | return $_[0]->{isv6} ? 128 : 32;
1151 |  |  |  |  | }
1152 |  |  |  |  |
1153 |  |  |  |  | =item C<-E<gt>version()>
1154 |  |  |  |  |
1155 |  |  |  |  | Returns the version of the address or subnet. Currently this can be
1156 |  |  |  |  | either 4 or 6.
1157 |  |  |  |  |
1158 |  |  |  |  | =cut
1159 |  |  |  |  |
1160 |  |  |  |  | sub version {
1161 |  |  |  |  | my $self = shift;
1162 |  |  |  |  | return $self->{isv6} ? 6 : 4;
1163 |  |  |  |  | }
1164 |  |  |  |  |
1165 |  |  |  |  | =item C<-E<gt>cidr()>
1166 |  |  |  |  |
1167 |  |  |  |  | Returns a scalar with the address and mask in CIDR notation. A
1168 |  |  |  |  | NetAddr::IP::Lite object I<stringifies> to the result of this function.
1169 |  |  |  |  | (see comments about ->new6() and ->addr() for output formats)
1170 |  |  |  |  |
1171 |  |  |  |  | =cut
1172 |  |  |  |  |
1173 |  |  |  |  | sub cidr ($) {
1174 |  |  |  |  | return $_[0]->addr . '/' . $_[0]->masklen;
1175 |  |  |  |  | }
1176 |  |  |  |  |
1177 |  |  |  |  | =item C<-E<gt>aton()>
1178 |  |  |  |  |
1179 |  |  |  |  | Returns the address part of the NetAddr::IP::Lite object in the same format
1180 |  |  |  |  | as the C<inet_aton()> or C<ipv6_aton> function respectively. If the object
1181 |  |  |  |  | was created using ->new6($ip), the address returned will always be in ipV6
1182 |  |  |  |  | format, even for addresses in ipV4 address space.
1183 |  |  |  |  |
1184 |  |  |  |  | =cut
1185 |  |  |  |  |
1186 |  |  |  |  | sub aton {
1187 |  |  |  |  | return $_[0]->{addr} if $_[0]->{isv6};
1188 |  |  |  |  | return isIPv4($_[0]->{addr})
1189 |  |  |  |  | ? ipv6to4($_[0]->{addr})
1190 |  |  |  |  | : $_[0]->{addr};
1191 |  |  |  |  | }
1192 |  |  |  |  |
1193 |  |  |  |  | =item C<-E<gt>range()>
1194 |  |  |  |  |
1195 |  |  |  |  | Returns a scalar with the base address and the broadcast address
1196 |  |  |  |  | separated by a dash and spaces. This is called range notation.
1197 |  |  |  |  |
1198 |  |  |  |  | =cut
1199 |  |  |  |  |
1200 |  |  |  |  | sub range ($) {
1201 |  |  |  |  | return $_[0]->network->addr . ' - ' . $_[0]->broadcast->addr;
1202 |  |  |  |  | }
1203 |  |  |  |  |
1204 |  |  |  |  | =item C<-E<gt>numeric()>
1205 |  |  |  |  |
1206 |  |  |  |  | When called in a scalar context, will return a numeric representation
1207 |  |  |  |  | of the address part of the IP address. When called in an array
1208 |  |  |  |  | context, it returns a list of two elements. The first element is as
1209 |  |  |  |  | described, the second element is the numeric representation of the
1210 |  |  |  |  | netmask.
1211 |  |  |  |  |
1212 |  |  |  |  | This method is essential for serializing the representation of a
1213 |  |  |  |  | subnet.
1214 |  |  |  |  |
1215 |  |  |  |  | =cut
1216 |  |  |  |  |
1217 |  |  |  |  | sub numeric ($) {
1218 |  |  |  |  | if (wantarray) {
1219 |  |  |  |  | if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) {
1220 |  |  |  |  | return ( sprintf("%u",unpack('N',ipv6to4($_[0]->{addr}))),
1221 |  |  |  |  | sprintf("%u",unpack('N',ipv6to4($_[0]->{mask}))));
1222 |  |  |  |  | }
1223 |  |  |  |  | else {
1224 |  |  |  |  | return ( bin2bcd($_[0]->{addr}),
1225 |  |  |  |  | bin2bcd($_[0]->{mask}));
1226 |  |  |  |  | }
1227 |  |  |  |  | }
1228 |  |  |  |  | return (! $_[0]->{isv6} && isIPv4($_[0]->{addr}))
1229 |  |  |  |  | ? sprintf("%u",unpack('N',ipv6to4($_[0]->{addr})))
1230 |  |  |  |  | : bin2bcd($_[0]->{addr});
1231 |  |  |  |  | }
1232 |  |  |  |  |
1233 |  |  |  |  | =item C<-E<gt>bigint()>
1234 |  |  |  |  |
1235 |  |  |  |  | When called in a scalar context, will return a Math::BigInt representation
1236 |  |  |  |  | of the address part of the IP address. When called in an array
1237 |  |  |  |  | contest, it returns a list of two elements. The first element is as
1238 |  |  |  |  | described, the second element is the Math::BigInt representation of the
1239 |  |  |  |  | netmask.
1240 |  |  |  |  |
1241 |  |  |  |  | =cut
1242 |  |  |  |  |
1243 | 1 | 100ns |  |  | my $biloaded;
1244 | 1 | 100ns |  |  | my $bi2strng;
1245 | 1 | 200ns |  |  | my $no_mbi_emu = 1;
1246 |  |  |  |  |
1247 |  |  |  |  | # function to force into test development mode
1248 |  |  |  |  | #
1249 |  |  |  |  | sub _force_bi_emu {
1250 |  |  |  |  | undef $biloaded;
1251 |  |  |  |  | undef $bi2strng;
1252 |  |  |  |  | $no_mbi_emu = 0;
1253 |  |  |  |  | print STDERR "\n\n\tWARNING: test development mode, this
1254 |  |  |  |  | \tmessage SHOULD NEVER BE SEEN IN PRODUCTION!
1255 |  |  |  |  | set my \$no_mbi_emu = 1 in t/bigint.t to remove this warning\n\n";
1256 |  |  |  |  | }
1257 |  |  |  |  |
1258 |  |  |  |  | # function to stringify various flavors of Math::BigInt objects
1259 |  |  |  |  | # tests to see if the object is a hash or a signed scalar
1260 |  |  |  |  |
1261 |  |  |  |  | sub _bi_stfy {
1262 |  |  |  |  | "$_[0]" =~ /(\d+)/; # stringify and remove '+' if present
1263 |  |  |  |  | $1;
1264 |  |  |  |  | }
1265 |  |  |  |  |
1266 |  |  |  |  | sub _fakebi2strg {
1267 |  |  |  |  | ${$_[0]} =~ /(\d+)/;
1268 |  |  |  |  | $1;
1269 |  |  |  |  | }
1270 |  |  |  |  |
1271 |  |  |  |  | # fake new from bi string Math::BigInt 0.01
1272 |  |  |  |  | #
1273 |  |  |  |  | sub _bi_fake {
1274 |  |  |  |  | bless \('+'. $_[1]), 'Math::BigInt';
1275 |  |  |  |  | }
1276 |  |  |  |  |
1277 |  |  |  |  | # as of this writing there are three known flavors of Math::BigInt
1278 |  |  |  |  | # v0.01 MBI::new returns a scalar ref
1279 |  |  |  |  | # v1.?? - 1.69 CALC::_new takes a reference to a scalar, returns an array, MBI returns a hash ref
1280 |  |  |  |  | # v1.70 and up CALC::_new takes a scalar, returns and array, MBI returns a hash ref
1281 |  |  |  |  |
1282 |  |  |  |  | sub _loadMBI { # load Math::BigInt on demand
1283 |  |  |  |  | if (eval {$no_mbi_emu && require Math::BigInt}) { # any version should work, three known
1284 |  |  |  |  | import Math::BigInt;
1285 |  |  |  |  | $biloaded = \&Math::BigInt::new;
1286 |  |  |  |  | $bi2strng = \&_bi_stfy;
1287 |  |  |  |  | } else {
1288 |  |  |  |  | $biloaded = \&_bi_fake;
1289 |  |  |  |  | $bi2strng = \&_fakebi2strg;
1290 |  |  |  |  | }
1291 |  |  |  |  | }
1292 |  |  |  |  |
1293 |  |  |  |  | sub _retMBIstring {
1294 |  |  |  |  | _loadMBI unless $biloaded; # load Math::BigInt on demand
1295 |  |  |  |  | $bi2strng->(@_);
1296 |  |  |  |  | }
1297 |  |  |  |  |
1298 |  |  |  |  | sub _biRef {
1299 |  |  |  |  | _loadMBI unless $biloaded; # load Math::BigInt on demand
1300 |  |  |  |  | $biloaded->('Math::BigInt',$_[0]);
1301 |  |  |  |  | }
1302 |  |  |  |  |
1303 |  |  |  |  | sub bigint($) {
1304 |  |  |  |  | my($addr,$mask);
1305 |  |  |  |  | if (wantarray) {
1306 |  |  |  |  | if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) {
1307 |  |  |  |  | $addr = $_[0]->{addr}
1308 |  |  |  |  | ? sprintf("%u",unpack('N',ipv6to4($_[0]->{addr})))
1309 |  |  |  |  | : 0;
1310 |  |  |  |  | $mask = $_[0]->{mask}
1311 |  |  |  |  | ? sprintf("%u",unpack('N',ipv6to4($_[0]->{mask})))
1312 |  |  |  |  | : 0;
1313 |  |  |  |  | }
1314 |  |  |  |  | else {
1315 |  |  |  |  | $addr = $_[0]->{addr}
1316 |  |  |  |  | ? bin2bcd($_[0]->{addr})
1317 |  |  |  |  | : 0;
1318 |  |  |  |  | $mask = $_[0]->{mask}
1319 |  |  |  |  | ? bin2bcd($_[0]->{mask})
1320 |  |  |  |  | : 0;
1321 |  |  |  |  | }
1322 |  |  |  |  | (_biRef($addr),_biRef($mask));
1323 |  |  |  |  |
1324 |  |  |  |  | } else { # not wantarray
1325 |  |  |  |  |
1326 |  |  |  |  | if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) {
1327 |  |  |  |  | $addr = $_[0]->{addr}
1328 |  |  |  |  | ? sprintf("%u",unpack('N',ipv6to4($_[0]->{addr})))
1329 |  |  |  |  | : 0;
1330 |  |  |  |  | } else {
1331 |  |  |  |  | $addr = $_[0]->{addr}
1332 |  |  |  |  | ? bin2bcd($_[0]->{addr})
1333 |  |  |  |  | : 0;
1334 |  |  |  |  | }
1335 |  |  |  |  | _biRef($addr);
1336 |  |  |  |  | }
1337 |  |  |  |  | }
1338 |  |  |  |  |
1339 |  |  |  |  | =item C<$me-E<gt>contains($other)>
1340 |  |  |  |  |
1341 |  |  |  |  | Returns true when C<$me> completely contains C<$other>. False is
1342 |  |  |  |  | returned otherwise and C<undef> is returned if C<$me> and C<$other>
1343 |  |  |  |  | are not both C<NetAddr::IP::Lite> objects.
1344 |  |  |  |  |
1345 |  |  |  |  | =cut
1346 |  |  |  |  |
1347 |  |  |  |  | sub contains ($$) {
1348 |  |  |  |  | return within(@_[1,0]);
1349 |  |  |  |  | }
1350 |  |  |  |  |
1351 |  |  |  |  | =item C<$me-E<gt>within($other)>
1352 |  |  |  |  |
1353 |  |  |  |  | The complement of C<-E<gt>contains()>. Returns true when C<$me> is
1354 |  |  |  |  | completely contained within C<$other>, undef if C<$me> and C<$other>
1355 |  |  |  |  | are not both C<NetAddr::IP::Lite> objects.
1356 |  |  |  |  |
1357 |  |  |  |  | =cut
1358 |  |  |  |  |
1359 |  |  |  |  | sub within ($$) {
1360 |  |  |  |  | return 1 unless hasbits($_[1]->{mask}); # 0x0 contains everything
1361 |  |  |  |  | my $netme = $_[0]->{addr} & $_[0]->{mask};
1362 |  |  |  |  | my $brdme = $_[0]->{addr} | ~ $_[0]->{mask};
1363 |  |  |  |  | my $neto = $_[1]->{addr} & $_[1]->{mask};
1364 |  |  |  |  | my $brdo = $_[1]->{addr} | ~ $_[1]->{mask};
1365 |  |  |  |  | return (sub128($netme,$neto) && sub128($brdo,$brdme))
1366 |  |  |  |  | ? 1 : 0;
1367 |  |  |  |  | }
1368 |  |  |  |  |
1369 |  |  |  |  | =item C-E<gt>is_rfc1918()>
1370 |  |  |  |  |
1371 |  |  |  |  | Returns true when C<$me> is an RFC 1918 address.
1372 |  |  |  |  |
1373 |  |  |  |  | 10.0.0.0 - 10.255.255.255 (10/8 prefix)
1374 |  |  |  |  | 172.16.0.0 - 172.31.255.255 (172.16/12 prefix)
1375 |  |  |  |  | 192.168.0.0 - 192.168.255.255 (192.168/16 prefix)
1376 |  |  |  |  |
1377 |  |  |  |  | =cut
1378 |  |  |  |  |
1379 | 1 | 2µs | 1 | 3µs | my $ip_10 = NetAddr::IP::Lite->new('10.0.0.0/8'); # spent 3µs making 1 call to NetAddr::IP::Lite::new
1380 | 1 | 30µs |  |  | my $ip_10n = $ip_10->{addr}; # already the right value
1381 | 1 | 2µs |  |  | my $ip_10b = $ip_10n | ~ $ip_10->{mask};
1382 |  |  |  |  |
1383 | 1 | 2µs | 1 | 2µs | my $ip_172 = NetAddr::IP::Lite->new('172.16.0.0/12'); # spent 2µs making 1 call to NetAddr::IP::Lite::new
1384 | 1 | 900ns |  |  | my $ip_172n = $ip_172->{addr}; # already the right value
1385 | 1 | 1µs |  |  | my $ip_172b = $ip_172n | ~ $ip_172->{mask};
1386 |  |  |  |  |
1387 | 1 | 2µs | 1 | 2µs | my $ip_192 = NetAddr::IP::Lite->new('192.168.0.0/16'); # spent 2µs making 1 call to NetAddr::IP::Lite::new
1388 | 1 | 1µs |  |  | my $ip_192n = $ip_192->{addr}; # already the right value
1389 | 1 | 1µs |  |  | my $ip_192b = $ip_192n | ~ $ip_192->{mask};
1390 |  |  |  |  |
1391 |  |  |  |  | sub is_rfc1918 ($) {
1392 |  |  |  |  | my $netme = $_[0]->{addr} & $_[0]->{mask};
1393 |  |  |  |  | my $brdme = $_[0]->{addr} | ~ $_[0]->{mask};
1394 |  |  |  |  | return 1 if (sub128($netme,$ip_10n) && sub128($ip_10b,$brdme));
1395 |  |  |  |  | return 1 if (sub128($netme,$ip_192n) && sub128($ip_192b,$brdme));
1396 |  |  |  |  | return (sub128($netme,$ip_172n) && sub128($ip_172b,$brdme))
1397 |  |  |  |  | ? 1 : 0;
1398 |  |  |  |  | }
1399 |  |  |  |  |
1400 |  |  |  |  | =item C<-E<gt>first()>
1401 |  |  |  |  |
1402 |  |  |  |  | Returns a new object representing the first usable IP address within
1403 |  |  |  |  | the subnet (ie, the first host address).
1404 |  |  |  |  |
1405 |  |  |  |  | =cut
1406 |  |  |  |  |
1407 | 1 | 300ns | 1 | 2µs | my $_cidr127 = pack('N4',0xffffffff,0xffffffff,0xffffffff,0xfffffffe); # spent 2µs making 1 call to main::CORE:pack
1408 |  |  |  |  |
1409 |  |  |  |  | sub first ($) {
1410 |  |  |  |  | if (hasbits($_[0]->{mask} ^ $_cidr127)) {
1411 |  |  |  |  | return $_[0]->network + 1;
1412 |  |  |  |  | } else {
1413 |  |  |  |  | return $_[0]->network;
1414 |  |  |  |  | }
1415 |  |  |  |  | # return $_[0]->network + 1;
1416 |  |  |  |  | }
1417 |  |  |  |  |
1418 |  |  |  |  | =item C<-E<gt>last()>
1419 |  |  |  |  |
1420 |  |  |  |  | Returns a new object representing the last usable IP address within
1421 |  |  |  |  | the subnet (ie, one less than the broadcast address).
1422 |  |  |  |  |
1423 |  |  |  |  | =cut
1424 |  |  |  |  |
1425 |  |  |  |  | sub last ($) {
1426 |  |  |  |  | if (hasbits($_[0]->{mask} ^ $_cidr127)) {
1427 |  |  |  |  | return $_[0]->broadcast - 1;
1428 |  |  |  |  | } else {
1429 |  |  |  |  | return $_[0]->broadcast;
1430 |  |  |  |  | }
1431 |  |  |  |  | # return $_[0]->broadcast - 1;
1432 |  |  |  |  | }
1433 |  |  |  |  |
1434 |  |  |  |  | =item C<-E<gt>nth($index)>
1435 |  |  |  |  |
1436 |  |  |  |  | Returns a new object representing the I<n>-th usable IP address within
1437 |  |  |  |  | the subnet (ie, the I<n>-th host address). If no address is available
1438 |  |  |  |  | (for example, when the network is too small for C<$index> hosts),
1439 |  |  |  |  | C<undef> is returned.
1440 |  |  |  |  |
1441 |  |  |  |  | Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite implements
1442 |  |  |  |  | C<-E<gt>nth($index)> and C<-E<gt>num()> exactly as the documentation states.
1443 |  |  |  |  | Previous versions behaved slightly differently and not in a consistent
1444 |  |  |  |  | manner.
1445 |  |  |  |  |
1446 |  |  |  |  | To use the old behavior for C<-E<gt>nth($index)> and C<-E<gt>num()>:
1447 |  |  |  |  |
1448 |  |  |  |  | use NetAddr::IP::Lite qw(:old_nth);
1449 |  |  |  |  |
1450 |  |  |  |  | old behavior:
1451 |  |  |  |  | NetAddr::IP->new('10/32')->nth(0) == undef
1452 |  |  |  |  | NetAddr::IP->new('10/32')->nth(1) == undef
1453 |  |  |  |  | NetAddr::IP->new('10/31')->nth(0) == undef
1454 |  |  |  |  | NetAddr::IP->new('10/31')->nth(1) == 10.0.0.1/31
1455 |  |  |  |  | NetAddr::IP->new('10/30')->nth(0) == undef
1456 |  |  |  |  | NetAddr::IP->new('10/30')->nth(1) == 10.0.0.1/30
1457 |  |  |  |  | NetAddr::IP->new('10/30')->nth(2) == 10.0.0.2/30
1458 |  |  |  |  | NetAddr::IP->new('10/30')->nth(3) == 10.0.0.3/30
1459 |  |  |  |  |
1460 |  |  |  |  | Note that in each case, the broadcast address is represented in the
1461 |  |  |  |  | output set and that the 'zero'th index is alway undef except for
1462 |  |  |  |  | a point-to-point /31 or /127 network where there are exactly two
1463 |  |  |  |  | addresses in the network.
1464 |  |  |  |  |
1465 |  |  |  |  | new behavior:
1466 |  |  |  |  | NetAddr::IP->new('10/32')->nth(0) == 10.0.0.0/32
1467 |  |  |  |  | NetAddr::IP->new('10.1/32'->nth(0) == 10.0.0.1/32
1468 |  |  |  |  | NetAddr::IP->new('10/31')->nth(0) == 10.0.0.0/32
1469 |  |  |  |  | NetAddr::IP->new('10/31')->nth(1) == 10.0.0.1/32
1470 |  |  |  |  | NetAddr::IP->new('10/30')->nth(0) == 10.0.0.1/30
1471 |  |  |  |  | NetAddr::IP->new('10/30')->nth(1) == 10.0.0.2/30
1472 |  |  |  |  | NetAddr::IP->new('10/30')->nth(2) == undef
1473 |  |  |  |  |
1474 |  |  |  |  | Note that a /32 net always has 1 usable address while a /31 has exactly
1475 |  |  |  |  | two usable addresses for point-to-point addressing. The first
1476 |  |  |  |  | index (0) returns the address immediately following the network address
1477 |  |  |  |  | except for a /31 or /127 when it return the network address.
1478 |  |  |  |  |
1479 |  |  |  |  | =cut
1480 |  |  |  |  |
1481 |  |  |  |  | sub nth ($$) {
1482 |  |  |  |  | my $self = shift;
1483 |  |  |  |  | my $count = shift;
1484 |  |  |  |  |
1485 |  |  |  |  | my $slash31 = ! hasbits($self->{mask} ^ $_cidr127);
1486 |  |  |  |  | if ($Old_nth) {
1487 |  |  |  |  | return undef if $slash31 && $count != 1;
1488 |  |  |  |  | return undef if ($count < 1 or $count > $self->num ());
1489 |  |  |  |  | }
1490 |  |  |  |  | elsif ($slash31) {
1491 |  |  |  |  | return undef if ($count && $count != 1); # only index 0, 1 allowed for /31
1492 |  |  |  |  | } else {
1493 |  |  |  |  | ++$count;
1494 |  |  |  |  | return undef if ($count < 1 or $count > $self->num ());
1495 |  |  |  |  | }
1496 |  |  |  |  | return $self->network + $count;
1497 |  |  |  |  | }
1498 |  |  |  |  |
1499 |  |  |  |  | =item C<-E<gt>num()>
1500 |  |  |  |  |
1501 |  |  |  |  | As of version 4.42 of NetAddr::IP and version 1.27 of NetAddr::IP::Lite
1502 |  |  |  |  | a /31 and /127 with return a net B<num> value of 2 instead of 0 (zero)
1503 |  |  |  |  | for point-to-point networks.
1504 |  |  |  |  |
1505 |  |  |  |  | Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite
1506 |  |  |  |  | return the number of usable IP addresses within the subnet,
1507 |  |  |  |  | not counting the broadcast or network address.
1508 |  |  |  |  |
1509 |  |  |  |  | Previous versions worked only for ipV4 addresses, returned a
1510 |  |  |  |  | maximum span of 2**32 and returned the number of IP addresses
1511 |  |  |  |  | not counting the broadcast address.
1512 |  |  |  |  | (one greater than the new behavior)
1513 |  |  |  |  |
1514 |  |  |  |  | To use the old behavior for C<-E<gt>nth($index)> and C<-E<gt>num()>:
1515 |  |  |  |  |
1516 |  |  |  |  | use NetAddr::IP::Lite qw(:old_nth);
1517 |  |  |  |  |
1518 |  |  |  |  | WARNING:
1519 |  |  |  |  |
1520 |  |  |  |  | NetAddr::IP will calculate and return a numeric string for network
1521 |  |  |  |  | ranges as large as 2**128. These values are TEXT strings and perl
1522 |  |  |  |  | can treat them as integers for numeric calculations.
1523 |  |  |  |  |
1524 |  |  |  |  | Perl on 32 bit platforms only handles integer numbers up to 2**32
1525 |  |  |  |  | and on 64 bit platforms to 2**64.
1526 |  |  |  |  |
1527 |  |  |  |  | If you wish to manipulate numeric strings returned by NetAddr::IP
1528 |  |  |  |  | that are larger than 2**32 or 2**64, respectively, you must load
1529 |  |  |  |  | additional modules such as Math::BigInt, bignum or some similar
1530 |  |  |  |  | package to do the integer math.
1531 |  |  |  |  |
1532 |  |  |  |  | =cut
1533 |  |  |  |  |
1534 |  |  |  |  | sub num ($) {
1535 |  |  |  |  | if ($Old_nth) {
1536 |  |  |  |  | my @net = unpack('L3N',$_[0]->{mask} ^ Ones);
1537 |  |  |  |  | # number of ip's less broadcast
1538 |  |  |  |  | return 0xfffffffe if $net[0] || $net[1] || $net[2]; # 2**32 -1
1539 |  |  |  |  | return $net[3] if $net[3];
1540 |  |  |  |  | } else { # returns 1 for /32 /128, 2 for /31 /127 else n-2 up to 2**32
1541 |  |  |  |  | (undef, my $net) = addconst($_[0]->{mask},1);
1542 |  |  |  |  | return 1 unless hasbits($net); # ipV4/32 or ipV6/128
1543 |  |  |  |  | $net = $net ^ Ones;
1544 |  |  |  |  | return 2 unless hasbits($net); # ipV4/31 or ipV6/127
1545 |  |  |  |  | $net &= $_v4net unless $_[0]->{isv6};
1546 |  |  |  |  | return bin2bcd($net);
1547 |  |  |  |  | }
1548 |  |  |  |  | }
1549 |  |  |  |  |
1550 |  |  |  |  | # deprecated
1551 |  |  |  |  | #sub num ($) {
1552 |  |  |  |  | # my @net = unpack('L3N',$_[0]->{mask} ^ Ones);
1553 |  |  |  |  | # if ($Old_nth) {
1554 |  |  |  |  | ## number of ip's less broadcast
1555 |  |  |  |  | # return 0xfffffffe if $net[0] || $net[1] || $net[2]; # 2**32 -1
1556 |  |  |  |  | # return $net[3] if $net[3];
1557 |  |  |  |  | # } else { # returns 1 for /32 /128, 0 for /31 /127 else n-2 up to 2**32
1558 |  |  |  |  | ## number of usable IP's === number of ip's less broadcast & network addys
1559 |  |  |  |  | # return 0xfffffffd if $net[0] || $net[1] || $net[2]; # 2**32 -2
1560 |  |  |  |  | # return 1 unless $net[3];
1561 |  |  |  |  | # $net[3]--;
1562 |  |  |  |  | # }
1563 |  |  |  |  | # return $net[3];
1564 |  |  |  |  | #}
1565 |  |  |  |  |
1566 |  |  |  |  | =pod
1567 |  |  |  |  |
1568 |  |  |  |  | =back
1569 |  |  |  |  |
1570 |  |  |  |  | =cut
1571 |  |  |  |  |
1572 |  |  |  |  | # spent 129µs (19+110) within NetAddr::IP::Lite::import which was called: # once (19µs+110µs) by NetAddr::IP::BEGIN@8 at line 8 of NetAddr/IP.pm sub import {
1573 | 1 | 2µs |  |  | if (grep { $_ eq ':aton' } @_) {
1574 |  |  |  |  | $Accept_Binary_IP = 1;
1575 |  |  |  |  | @_ = grep { $_ ne ':aton' } @_;
1576 |  |  |  |  | }
1577 | 1 | 800ns |  |  | if (grep { $_ eq ':old_nth' } @_) {
1578 |  |  |  |  | $Old_nth = 1;
1579 |  |  |  |  | @_ = grep { $_ ne ':old_nth' } @_;
1580 |  |  |  |  | }
1581 | 1 | 700ns |  |  | if (grep { $_ eq ':lower' } @_)
1582 |  |  |  |  | {
1583 |  |  |  |  | NetAddr::IP::Util::lower();
1584 |  |  |  |  | @_ = grep { $_ ne ':lower' } @_;
1585 |  |  |  |  | }
1586 | 1 | 700ns |  |  | if (grep { $_ eq ':upper' } @_)
1587 |  |  |  |  | {
1588 |  |  |  |  | NetAddr::IP::Util::upper();
1589 |  |  |  |  | @_ = grep { $_ ne ':upper' } @_;
1590 |  |  |  |  | }
1591 | 1 | 12µs | 1 | 14µs | NetAddr::IP::Lite->export_to_level(1, @_); # spent 14µs making 1 call to Exporter::export_to_level
1592 |  |  |  |  | }
1593 |  |  |  |  |
1594 |  |  |  |  | =head1 EXPORT_OK
1595 |  |  |  |  |
1596 |  |  |  |  | Zeros
1597 |  |  |  |  | Ones
1598 |  |  |  |  | V4mask
1599 |  |  |  |  | V4net
1600 |  |  |  |  | :aton DEPRECATED
1601 |  |  |  |  | :old_nth
1602 |  |  |  |  | :upper
1603 |  |  |  |  | :lower
1604 |  |  |  |  |
1605 |  |  |  |  | =head1 AUTHORS
1606 |  |  |  |  |
1607 |  |  |  |  | Luis E. Muñoz E<lt>luismunoz@cpan.orgE<gt>,
1608 |  |  |  |  | Michael Robinton E<lt>michael@bizsystems.comE<gt>
1609 |  |  |  |  |
1610 |  |  |  |  | =head1 WARRANTY
1611 |  |  |  |  |
1612 |  |  |  |  | This software comes with the same warranty as perl itself (ie, none),
1613 |  |  |  |  | so by using it you accept any and all the liability.
1614 |  |  |  |  |
1615 |  |  |  |  | =head1 COPYRIGHT
1616 |  |  |  |  |
1617 |  |  |  |  | This software is (c) Luis E. Muñoz, 1999 - 2005
1618 |  |  |  |  | and (c) Michael Robinton, 2006 - 2012.
1619 |  |  |  |  |
1620 |  |  |  |  | All rights reserved.
1621 |  |  |  |  |
1622 |  |  |  |  | This program is free software; you can redistribute it and/or modify
1623 |  |  |  |  | it under the terms of either:
1624 |  |  |  |  |
1625 |  |  |  |  | a) the GNU General Public License as published by the Free
1626 |  |  |  |  | Software Foundation; either version 2, or (at your option) any
1627 |  |  |  |  | later version, or
1628 |  |  |  |  |
1629 |  |  |  |  | b) the "Artistic License" which comes with this distribution.
1630 |  |  |  |  |
1631 |  |  |  |  | This program is distributed in the hope that it will be useful,
1632 |  |  |  |  | but WITHOUT ANY WARRANTY; without even the implied warranty of
1633 |  |  |  |  | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
1634 |  |  |  |  | the GNU General Public License or the Artistic License for more details.
1635 |  |  |  |  |
1636 |  |  |  |  | You should have received a copy of the Artistic License with this
1637 |  |  |  |  | distribution, in the file named "Artistic". If not, I'll be glad to provide
1638 |  |  |  |  | one.
1639 |  |  |  |  |
1640 |  |  |  |  | You should also have received a copy of the GNU General Public License
1641 |  |  |  |  | along with this program in the file named "Copying". If not, write to the
1642 |  |  |  |  |
1643 |  |  |  |  | Free Software Foundation, Inc.,
1644 |  |  |  |  | 51 Franklin Street, Fifth Floor
1645 |  |  |  |  | Boston, MA 02110-1301 USA
1646 |  |  |  |  |
1647 |  |  |  |  | or visit their web page on the internet at:
1648 |  |  |  |  |
1649 |  |  |  |  | http://www.gnu.org/copyleft/gpl.html.
1650 |  |  |  |  |
1651 |  |  |  |  | =head1 SEE ALSO
1652 |  |  |  |  |
1653 |  |  |  |  | NetAddr::IP(3), NetAddr::IP::Util(3), NetAddr::IP::InetBase(3)
1654 |  |  |  |  |
1655 |  |  |  |  | =cut
1656 |  |  |  |  |
1657 | 1 | 25µs |  |  | 1;
|  |  |  |  | # spent 252ms within NetAddr::IP::Lite::CORE:match which was called 334735 times, avg 754ns/call: # 143457 times (155ms+0s) by NetAddr::IP::Lite::_xnew at line 786, avg 1µs/call # 95637 times (23.3ms+0s) by NetAddr::IP::Lite::_xnew at line 855, avg 243ns/call # 47820 times (52.1ms+0s) by NetAddr::IP::Lite::_xnew at line 927, avg 1µs/call # 47820 times (21.4ms+0s) by NetAddr::IP::Lite::_xnew at line 839, avg 448ns/call # once (4µs+0s) by NetAddr::IP::BEGIN@8 at line 35 sub NetAddr::IP::Lite::CORE:match; # opcode