← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Tue Nov 7 05:38:10 2017
Reported on Tue Nov 7 06:16:02 2017

Filename/usr/local/lib/perl5/site_perl/Net/DNS/Domain.pm
StatementsExecuted 76071 statements in 654ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
393622310ms420msNet::DNS::Domain::::newNet::DNS::Domain::new
196811134ms202msNet::DNS::Domain::::nameNet::DNS::Domain::name
10391156.3ms66.4msNet::DNS::Domain::::_encode_utf8Net::DNS::Domain::_encode_utf8
158425142.6ms42.6msNet::DNS::Domain::::CORE:substNet::DNS::Domain::CORE:subst (opcode)
10381128.6ms37.6msNet::DNS::Domain::::_decode_asciiNet::DNS::Domain::_decode_ascii
56272118.5ms18.5msNet::DNS::Domain::::CORE:matchNet::DNS::Domain::CORE:match (opcode)
773511.53ms1.53msNet::DNS::Domain::::CORE:packNet::DNS::Domain::CORE:pack (opcode)
1111.49ms3.51msNet::DNS::Domain::::BEGIN@53Net::DNS::Domain::BEGIN@53
111888µs2.60msNet::DNS::Domain::::BEGIN@54Net::DNS::Domain::BEGIN@54
11181µs269µsNet::DNS::Domain::::BEGIN@56Net::DNS::Domain::BEGIN@56
11154µs305µsNet::DNS::Domain::::BEGIN@44Net::DNS::Domain::BEGIN@44
11145µs66µsNet::DNS::Domain::::BEGIN@38Net::DNS::Domain::BEGIN@38
11138µs258µsNet::DNS::Domain::::BEGIN@49Net::DNS::Domain::BEGIN@49
11123µs32µsNet::DNS::Domain::::BEGIN@40Net::DNS::Domain::BEGIN@40
11122µs57µsNet::DNS::Domain::::BEGIN@39Net::DNS::Domain::BEGIN@39
11120µs208µsNet::DNS::Domain::::BEGIN@41Net::DNS::Domain::BEGIN@41
0000s0sNet::DNS::Domain::::__ANON__[:274]Net::DNS::Domain::__ANON__[:274]
0000s0sNet::DNS::Domain::::__ANON__[:284]Net::DNS::Domain::__ANON__[:284]
0000s0sNet::DNS::Domain::::_wireNet::DNS::Domain::_wire
0000s0sNet::DNS::Domain::::fqdnNet::DNS::Domain::fqdn
0000s0sNet::DNS::Domain::::labelNet::DNS::Domain::label
0000s0sNet::DNS::Domain::::originNet::DNS::Domain::origin
0000s0sNet::DNS::Domain::::stringNet::DNS::Domain::string
0000s0sNet::DNS::Domain::::xnameNet::DNS::Domain::xname
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Net::DNS::Domain;
2
3#
4# $Id: Domain.pm 1603 2017-10-17 14:45:45Z willem $
5#
613µsour $VERSION = (qw$LastChangedRevision: 1603 $)[1];
7
8
9=head1 NAME
10
11Net::DNS::Domain - DNS domains
12
13=head1 SYNOPSIS
14
15 use Net::DNS::Domain;
16
17 $domain = new Net::DNS::Domain('example.com');
18 $name = $domain->name;
19
20=head1 DESCRIPTION
21
22The Net::DNS::Domain module implements a class of abstract DNS
23domain objects with associated class and instance methods.
24
25Each domain object instance represents a single DNS domain which
26has a fixed identity throughout its lifetime.
27
28Internally, the primary representation is a (possibly empty) list
29of ASCII domain name labels, and optional link to an arbitrary
30origin domain object topologically closer to the DNS root.
31
32The computational expense of Unicode character-set conversion is
33partially mitigated by use of caches.
34
35=cut
36
37
38270µs288µs
# spent 66µs (45+22) within Net::DNS::Domain::BEGIN@38 which was called: # once (45µs+22µs) by Net::DNS::RR::BEGIN@42 at line 38
use strict;
# spent 66µs making 1 call to Net::DNS::Domain::BEGIN@38 # spent 22µs making 1 call to strict::import
39271µs292µs
# spent 57µs (22+35) within Net::DNS::Domain::BEGIN@39 which was called: # once (22µs+35µs) by Net::DNS::RR::BEGIN@42 at line 39
use warnings;
# spent 57µs making 1 call to Net::DNS::Domain::BEGIN@39 # spent 35µs making 1 call to warnings::import
40270µs240µs
# spent 32µs (23+8) within Net::DNS::Domain::BEGIN@40 which was called: # once (23µs+8µs) by Net::DNS::RR::BEGIN@42 at line 40
use integer;
# spent 32µs making 1 call to Net::DNS::Domain::BEGIN@40 # spent 8µs making 1 call to integer::import
41298µs2395µs
# spent 208µs (20+188) within Net::DNS::Domain::BEGIN@41 which was called: # once (20µs+188µs) by Net::DNS::RR::BEGIN@42 at line 41
use Carp;
# spent 208µs making 1 call to Net::DNS::Domain::BEGIN@41 # spent 188µs making 1 call to Exporter::import
42
43
4412µs
# spent 305µs (54+251) within Net::DNS::Domain::BEGIN@44 which was called: # once (54µs+251µs) by Net::DNS::RR::BEGIN@42 at line 47
use constant ASCII => ref eval {
45114µs require Encode;
4617µs143µs Encode::find_encoding('ascii');
# spent 43µs making 1 call to Encode::find_encoding
471145µs2512µs};
# spent 305µs making 1 call to Net::DNS::Domain::BEGIN@44 # spent 207µs making 1 call to constant::import
48
4912µs
# spent 258µs (38+220) within Net::DNS::Domain::BEGIN@49 which was called: # once (38µs+220µs) by Net::DNS::RR::BEGIN@42 at line 51
use constant UTF8 => scalar eval { ## not UTF-EBCDIC [see UTR#16 3.6]
50122µs254µs Encode::encode_utf8( chr(182) ) eq pack( 'H*', 'C2B6' );
# spent 35µs making 1 call to Encode::encode_utf8 # spent 18µs making 1 call to main::CORE:pack
51186µs2443µs};
# spent 258µs making 1 call to Net::DNS::Domain::BEGIN@49 # spent 185µs making 1 call to constant::import
52
532159µs23.71ms
# spent 3.51ms (1.49+2.02) within Net::DNS::Domain::BEGIN@53 which was called: # once (1.49ms+2.02ms) by Net::DNS::RR::BEGIN@42 at line 53
use constant LIBIDN => defined eval 'require Net::LibIDN';
# spent 3.51ms making 1 call to Net::DNS::Domain::BEGIN@53 # spent 204µs making 1 call to constant::import
# spent 240µs executing statements in string eval
542165µs22.82ms
# spent 2.60ms (888µs+1.71) within Net::DNS::Domain::BEGIN@54 which was called: # once (888µs+1.71ms) by Net::DNS::RR::BEGIN@42 at line 54
use constant LIBIDN2 => ref eval 'require Net::LibIDN2; Net::LibIDN2->can("idn2_to_ascii_8")';
# spent 2.60ms making 1 call to Net::DNS::Domain::BEGIN@54 # spent 220µs making 1 call to constant::import
# spent 282µs executing statements in string eval
55
5622.98ms2456µs
# spent 269µs (81+187) within Net::DNS::Domain::BEGIN@56 which was called: # once (81µs+187µs) by Net::DNS::RR::BEGIN@42 at line 56
use constant IDN2FLAG => eval 'Net::LibIDN2::IDN2_NFC_INPUT + Net::LibIDN2::IDN2_NONTRANSITIONAL';
# spent 269µs making 1 call to Net::DNS::Domain::BEGIN@56 # spent 188µs making 1 call to constant::import
# spent 5µs executing statements in string eval
57
58# perlcc: address of encoding objects must be determined at runtime
5919µs148µsmy $ascii = ASCII ? Encode::find_encoding('ascii') : undef; # Osborn's Law:
# spent 48µs making 1 call to Encode::find_encoding
6016µs142µsmy $utf8 = UTF8 ? Encode::find_encoding('utf8') : undef; # Variables won't; constants aren't.
# spent 42µs making 1 call to Encode::find_encoding
61
62
63=head1 METHODS
64
65=head2 new
66
67 $object = new Net::DNS::Domain('example.com');
68
69Creates a domain object which represents the DNS domain specified
70by the character string argument. The argument consists of a
71sequence of labels delimited by dots.
72
73A character preceded by \ represents itself, without any special
74interpretation.
75
76Arbitrary 8-bit codes can be represented by \ followed by exactly
77three decimal digits.
78Character code points are ASCII, irrespective of the character
79coding scheme employed by the underlying platform.
80
81Argument string literals should be delimited by single quotes to
82avoid escape sequences being interpreted as octal character codes
83by the Perl compiler.
84
85The character string presentation format follows the conventions
86for zone files described in RFC1035.
87
88Users should be aware that non-ASCII domain names will be transcoded
89to NFC before encoding, which is an irreversible process.
90
91=cut
92
9311µsmy ( %escape, %unescape ); ## precalculated ASCII escape tables
94
95our $ORIGIN;
9618µsmy ( $cache1, $cache2, $limit ) = ( {}, {}, 100 );
97
98
# spent 420ms (310+110) within Net::DNS::Domain::new which was called 3936 times, avg 107µs/call: # 1968 times (274ms+110ms) by Net::DNS::Question::new at line 80 of Net/DNS/Question.pm, avg 195µs/call # 1968 times (35.9ms+42µs) by Net::DNS::RR::owner at line 424 of Net/DNS/RR.pm, avg 18µs/call
sub new {
99393617.5ms my ( $class, $s ) = @_;
10039366.75ms croak 'domain identifier undefined' unless defined $s;
101
102393616.6ms my $k = join '', $s, $class, $ORIGIN || ''; # cache key
103393627.9ms my $cache = $$cache1{$k} ||= $$cache2{$k}; # two layer cache
104393640.4ms return $cache if defined $cache;
105
10610392.65ms ( $cache1, $cache2, $limit ) = ( {}, $cache1, 500 ) unless $limit--; # recycle cache
107
10810394.57ms my $self = bless {}, $class;
109
110103910.8ms10393.11ms $s =~ s/\\\\/\\092/g; # disguise escaped escape
# spent 3.11ms making 1039 calls to Net::DNS::Domain::CORE:subst, avg 3µs/call
11110399.84ms10392.74ms $s =~ s/\\\./\\046/g; # disguise escaped dot
# spent 2.74ms making 1039 calls to Net::DNS::Domain::CORE:subst, avg 3µs/call
112
113103929.4ms103966.4ms my $label = $self->{label} = ( $s eq '@' ) ? [] : [split /\056/, _encode_utf8($s)];
# spent 66.4ms making 1039 calls to Net::DNS::Domain::_encode_utf8, avg 64µs/call
114
115103920.3ms foreach (@$label) {
116
117458843.9ms458812.7ms if ( LIBIDN2 && UTF8 && /[^\000-\177]/ ) {
# spent 12.7ms making 4588 calls to Net::DNS::Domain::CORE:match, avg 3µs/call
118 my $rc = 0;
119 s/\134/\357\277\275/; # disallow escapes
120 $_ = Net::LibIDN2::idn2_to_ascii_8( $_, IDN2FLAG, $rc );
121 croak Net::LibIDN2::idn2_strerror($rc) unless $_;
122 }
123
124 if ( !LIBIDN2 && LIBIDN && UTF8 && /[^\000-\177]/ ) {
125 s/\134/\357\277\275/; # disallow escapes
126 $_ = Net::LibIDN::idn_to_ascii( $_, 'utf-8' );
127 croak 'name contains disallowed character' unless $_;
128 }
129
130458849.3ms45889.43ms s/\134([\060-\071]{3})/$unescape{$1}/eg; # numeric escape
# spent 9.43ms making 4588 calls to Net::DNS::Domain::CORE:subst, avg 2µs/call
131458849.5ms45889.83ms s/\134(.)/$1/g; # character escape
# spent 9.83ms making 4588 calls to Net::DNS::Domain::CORE:subst, avg 2µs/call
132458810.0ms croak 'empty domain label' unless length;
133458810.9ms next unless length > 63;
134 substr( $_, 63 ) = '';
135 carp 'domain label truncated';
136 }
137
13810393.34ms $$cache1{$k} = $self; # cache object reference
139
140103930.3ms10395.83ms return $self if $s =~ /\.$/; # fully qualified name
# spent 5.83ms making 1039 calls to Net::DNS::Domain::CORE:match, avg 6µs/call
141 $self->{origin} = $ORIGIN || return $self; # dynamically scoped $ORIGIN
142 return $self;
143}
144
145
146=head2 name
147
148 $name = $domain->name;
149
150Returns the domain name as a character string corresponding to the
151"common interpretation" to which RFC1034, 3.1, paragraph 9 alludes.
152
153Character escape sequences are used to represent a dot inside a
154domain name label and the escape character itself.
155
156Any non-printable code point is represented using the appropriate
157numerical escape sequence.
158
159=cut
160
161
# spent 202ms (134+68.4) within Net::DNS::Domain::name which was called 1968 times, avg 103µs/call: # 1968 times (134ms+68.4ms) by Net::DNS::Question::qname at line 215 of Net/DNS/Question.pm, avg 103µs/call
sub name {
16219683.82ms my ($self) = @_;
163
164196816.3ms return $self->{name} if defined $self->{name};
16510382.06ms return unless defined wantarray;
166
1671021490.4ms562630.8ms my @label = map { s/([^\055\101-\132\141-\172\060-\071])/$escape{$1}/eg; $_ } $self->_wire;
# spent 17.5ms making 4588 calls to Net::DNS::Domain::CORE:subst, avg 4µs/call # spent 13.3ms making 1038 calls to Net::DNS::DomainName::_wire, avg 13µs/call
168
16910382.04ms return $self->{name} = '.' unless scalar @label;
170103823.7ms103837.6ms $self->{name} = _decode_ascii( join chr(46), @label );
# spent 37.6ms making 1038 calls to Net::DNS::Domain::_decode_ascii, avg 36µs/call
171}
172
173
174=head2 fqdn
175
176 @fqdn = $domain->fqdn;
177
178Returns a character string containing the fully qualified domain
179name, including the trailing dot.
180
181=cut
182
183sub fqdn {
184 my $name = &name;
185 return $name =~ /[.]$/ ? $name : $name . '.'; # append trailing dot
186}
187
188
189=head2 xname
190
191 $xname = $domain->xname;
192
193Interprets an extended name containing Unicode domain name labels
194encoded as Punycode A-labels.
195
196If decoding is not possible, the ACE encoded name is returned.
197
198=cut
199
200sub xname {
201 my $name = &name;
202
203 if ( LIBIDN2 && UTF8 && $name =~ /xn--/i ) {
204 my $self = shift;
205 return $self->{xname} if defined $self->{xname};
206 my $u8 = Net::LibIDN2::idn2_to_unicode_88($name);
207 return $self->{xname} = $u8 ? $utf8->decode($u8) : $name;
208 }
209
210 if ( !LIBIDN2 && LIBIDN && UTF8 && $name =~ /xn--/i ) {
211 my $self = shift;
212 return $self->{xname} if defined $self->{xname};
213 return $self->{xname} = $utf8->decode( Net::LibIDN::idn_to_unicode $name, 'utf-8' );
214 }
215 return $name;
216}
217
218
219=head2 label
220
221 @label = $domain->label;
222
223Identifies the domain by means of a list of domain labels.
224
225=cut
226
227sub label {
228 map {
229 s/([^\055\101-\132\141-\172\060-\071])/$escape{$1}/eg;
230 _decode_ascii($_)
231 } shift->_wire;
232}
233
234
235sub _wire {
236 my $self = shift;
237
238 my $label = $self->{label};
239 my $origin = $self->{origin} || return (@$label);
240 return ( @$label, $origin->_wire );
241}
242
243
244=head2 string
245
246 $string = $object->string;
247
248Returns a character string containing the fully qualified domain
249name as it appears in a zone file.
250
251Characters which are recognised by RFC1035 zone file syntax are
252represented by the appropriate escape sequence.
253
254=cut
255
256sub string {
257 ( my $name = &name ) =~ s/(["'\$();@])/\\$1/; # escape special char
258 return $name =~ /[.]$/ ? $name : $name . '.'; # append trailing dot
259}
260
261
262=head2 origin
263
264 $create = origin Net::DNS::Domain( $ORIGIN );
265 $result = &$create( sub{ new Net::DNS::RR( 'mx MX 10 a' ); } );
266 $expect = new Net::DNS::RR( "mx.$ORIGIN. MX 10 a.$ORIGIN." );
267
268Class method which returns a reference to a subroutine wrapper
269which executes a given constructor in a dynamically scoped context
270where relative names become descendents of the specified $ORIGIN.
271
272=cut
273
27416µsmy $placebo = sub { my $constructor = shift; &$constructor; };
275
276sub origin {
277 my ( $class, $name ) = @_;
278 my $domain = defined $name ? new Net::DNS::Domain($name) : return $placebo;
279
280 return sub { # closure w.r.t. $domain
281 my $constructor = shift;
282 local $ORIGIN = $domain; # dynamically scoped $ORIGIN
283 &$constructor;
284 }
285}
286
287
288########################################
289
290
# spent 37.6ms (28.6+8.98) within Net::DNS::Domain::_decode_ascii which was called 1038 times, avg 36µs/call: # 1038 times (28.6ms+8.98ms) by Net::DNS::Domain::name at line 170, avg 36µs/call
sub _decode_ascii { ## ASCII to perl internal encoding
29110383.41ms local $_ = shift;
292
293 # partial transliteration for non-ASCII character encodings
294 tr
295 [\040-\176\000-\377]
296 [ !"#$%&'()*+,\-./0-9:;<=>?@A-Z\[\\\]^_`a-z{|}~?] unless ASCII;
297
29810384.35ms my $z = length($_) - length($_); # pre-5.18 taint workaround
299103841.1ms10388.98ms ASCII ? substr( $ascii->decode($_), $z ) : $_;
# spent 8.98ms making 1038 calls to Encode::XS::decode, avg 9µs/call
300}
301
302
303
# spent 66.4ms (56.3+10.2) within Net::DNS::Domain::_encode_utf8 which was called 1039 times, avg 64µs/call: # 1039 times (56.3ms+10.2ms) by Net::DNS::Domain::new at line 113, avg 64µs/call
sub _encode_utf8 { ## perl internal encoding to UTF8
30410395.64ms local $_ = shift;
305
306 # partial transliteration for non-ASCII character encodings
307 tr
308 [ !"#$%&'()*+,\-./0-9:;<=>?@A-Z\[\\\]^_`a-z{|}~\000-\377]
309 [\040-\176\077] unless ASCII;
310
31110395.59ms my $z = length($_) - length($_); # pre-5.18 taint workaround
312103953.1ms103910.2ms ASCII ? substr( ( UTF8 ? $utf8 : $ascii )->encode($_), $z ) : $_;
# spent 10.2ms making 1039 calls to Encode::utf8::encode_xs, avg 10µs/call
313}
314
315
3161127µs%escape = eval { ## precalculated ASCII escape table
31712µs my %table;
318
31915µs foreach ( 33 .. 126 ) { # ASCII printable
320942.40ms188332µs $table{pack( 'C', $_ )} = pack 'C', $_;
# spent 332µs making 188 calls to Net::DNS::Domain::CORE:pack, avg 2µs/call
321 }
322
323 # minimal character escapes
32413µs foreach ( 46, 92 ) { # \. \\
325248µs418µs $table{pack( 'C', $_ )} = pack 'C*', 92, $_;
# spent 18µs making 4 calls to Net::DNS::Domain::CORE:pack, avg 4µs/call
326 }
327
328112µs foreach my $n ( 0 .. 32, 127 .. 255 ) { # \ddd
329162385µs my $codepoint = sprintf( '%03u', $n );
330
331 # partial transliteration for non-ASCII character encodings
332162303µs $codepoint =~ tr [0-9] [\060-\071];
333
3341624.49ms324667µs $table{pack( 'C', $n )} = pack 'C a3', 92, $codepoint;
# spent 667µs making 324 calls to Net::DNS::Domain::CORE:pack, avg 2µs/call
335 }
336
3371201µs return %table;
338};
339
340
3411108µs%unescape = eval { ## precalculated numeric escape table
34211µs my %table;
343
344114µs foreach my $n ( 0 .. 255 ) {
345256582µs my $key = sprintf( '%03u', $n );
346
347 # partial transliteration for non-ASCII character encodings
348256529µs $key =~ tr [0-9] [\060-\071];
349
3502564.12ms256512µs $table{$key} = pack 'C', $n;
# spent 512µs making 256 calls to Net::DNS::Domain::CORE:pack, avg 2µs/call
351256845µs12µs $table{$key} = pack 'C2', 92, $n if $n == 92; # escaped escape
# spent 2µs making 1 call to Net::DNS::Domain::CORE:pack
352 }
353
3541175µs return %table;
355};
356
357
358155µs1;
359__END__
 
# spent 18.5ms within Net::DNS::Domain::CORE:match which was called 5627 times, avg 3µs/call: # 4588 times (12.7ms+0s) by Net::DNS::Domain::new at line 117, avg 3µs/call # 1039 times (5.83ms+0s) by Net::DNS::Domain::new at line 140, avg 6µs/call
sub Net::DNS::Domain::CORE:match; # opcode
# spent 1.53ms within Net::DNS::Domain::CORE:pack which was called 773 times, avg 2µs/call: # 324 times (667µs+0s) by Net::DNS::RR::BEGIN@42 at line 334, avg 2µs/call # 256 times (512µs+0s) by Net::DNS::RR::BEGIN@42 at line 350, avg 2µs/call # 188 times (332µs+0s) by Net::DNS::RR::BEGIN@42 at line 320, avg 2µs/call # 4 times (18µs+0s) by Net::DNS::RR::BEGIN@42 at line 325, avg 4µs/call # once (2µs+0s) by Net::DNS::RR::BEGIN@42 at line 351
sub Net::DNS::Domain::CORE:pack; # opcode
# spent 42.6ms within Net::DNS::Domain::CORE:subst which was called 15842 times, avg 3µs/call: # 4588 times (17.5ms+0s) by Net::DNS::Domain::name at line 167, avg 4µs/call # 4588 times (9.83ms+0s) by Net::DNS::Domain::new at line 131, avg 2µs/call # 4588 times (9.43ms+0s) by Net::DNS::Domain::new at line 130, avg 2µs/call # 1039 times (3.11ms+0s) by Net::DNS::Domain::new at line 110, avg 3µs/call # 1039 times (2.74ms+0s) by Net::DNS::Domain::new at line 111, avg 3µs/call
sub Net::DNS::Domain::CORE:subst; # opcode
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.