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