| Filename | /usr/lib/perl5/NetAddr/IP/Lite.pm |
| Statements | Executed 1578152 statements in 2.11s |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 47820 | 1 | 1 | 1.57s | 2.85s | NetAddr::IP::Lite::_xnew |
| 334735 | 5 | 1 | 252ms | 252ms | NetAddr::IP::Lite::CORE:match (opcode) |
| 47820 | 4 | 2 | 86.4ms | 86.4ms | NetAddr::IP::Lite::new |
| 1 | 1 | 1 | 4.35ms | 8.47ms | NetAddr::IP::Lite::BEGIN@9 |
| 1 | 1 | 1 | 1.15ms | 2.84ms | NetAddr::IP::Lite::BEGIN@18 |
| 1 | 1 | 1 | 1.14ms | 1.83ms | NetAddr::IP::Lite::BEGIN@224 |
| 1 | 1 | 1 | 19µs | 129µs | NetAddr::IP::Lite::import |
| 1 | 1 | 1 | 11µs | 43µs | NetAddr::IP::Lite::BEGIN@5 |
| 1 | 1 | 1 | 8µs | 79µs | NetAddr::IP::Lite::BEGIN@33 |
| 1 | 1 | 1 | 7µs | 20µs | NetAddr::IP::Lite::BEGIN@170 |
| 8 | 3 | 1 | 7µs | 7µs | NetAddr::IP::Lite::Ones |
| 9 | 4 | 1 | 6µs | 6µs | NetAddr::IP::Lite::Zeros |
| 1 | 1 | 1 | 6µs | 17µs | NetAddr::IP::Lite::BEGIN@6 |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::AUTOLOAD |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::DESTROY |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::V4mask |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::V4net |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::__ANON__[:234] |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::__ANON__[:240] |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::__ANON__[:246] |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::__ANON__[:251] |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::__ANON__[:256] |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::__ANON__[:260] |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::__ANON__[:264] |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::__ANON__[:268] |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::__ANON__[:272] |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::_biRef |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::_bi_fake |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::_bi_stfy |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::_fakebi2strg |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::_force_bi_emu |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::_loadMBI |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::_new |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::_no_octal |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::_obits |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::_retMBIstring |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::addr |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::aton |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::bigint |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::bits |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::broadcast |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::cidr |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::comp_addr_mask |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::contains |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::copy |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::first |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::is_rfc1918 |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::last |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::mask |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::masklen |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::minus |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::minusminus |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::network |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::new4 |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::new6 |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::new6FFFF |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::new_cis |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::new_cis6 |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::new_from_aton |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::new_no |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::nth |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::num |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::numeric |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::plus |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::plusplus |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::range |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::version |
| 0 | 0 | 0 | 0s | 0s | NetAddr::IP::Lite::within |
| 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 # 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 # 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 # 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 # 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 # 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 # 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 | ||||
| 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 | ||||
| 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 | ||||
| 225 | |||||
| 226 | '-' => \&minus, | ||||
| 227 | |||||
| 228 | '++' => \&plusplus, | ||||
| 229 | |||||
| 230 | '--' => \&minusminus, | ||||
| 231 | |||||
| 232 | "=" => \©, | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 |