← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 03:09:29 2017
Reported on Mon Nov 6 13:20:47 2017

Filename/usr/local/lib/perl5/site_perl/Net/DNS/Domain.pm
StatementsExecuted 76071 statements in 688ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
393622339ms454msNet::DNS::Domain::::newNet::DNS::Domain::new
196811170ms259msNet::DNS::Domain::::nameNet::DNS::Domain::name
158425165.9ms65.9msNet::DNS::Domain::::CORE:substNet::DNS::Domain::CORE:subst (opcode)
10381142.8ms52.5msNet::DNS::Domain::::_decode_asciiNet::DNS::Domain::_decode_ascii
10391132.9ms42.6msNet::DNS::Domain::::_encode_utf8Net::DNS::Domain::_encode_utf8
56272124.9ms24.9msNet::DNS::Domain::::CORE:matchNet::DNS::Domain::CORE:match (opcode)
773511.41ms1.41msNet::DNS::Domain::::CORE:packNet::DNS::Domain::CORE:pack (opcode)
1111.38ms3.24msNet::DNS::Domain::::BEGIN@53Net::DNS::Domain::BEGIN@53
111811µs2.24msNet::DNS::Domain::::BEGIN@54Net::DNS::Domain::BEGIN@54
11164µs189µsNet::DNS::Domain::::BEGIN@56Net::DNS::Domain::BEGIN@56
11144µs54µsNet::DNS::Domain::::BEGIN@38Net::DNS::Domain::BEGIN@38
11137µs236µsNet::DNS::Domain::::BEGIN@44Net::DNS::Domain::BEGIN@44
11131µs181µsNet::DNS::Domain::::BEGIN@49Net::DNS::Domain::BEGIN@49
11122µs28µsNet::DNS::Domain::::BEGIN@40Net::DNS::Domain::BEGIN@40
11121µs51µsNet::DNS::Domain::::BEGIN@39Net::DNS::Domain::BEGIN@39
11120µs160µ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
38260µs265µs
# spent 54µs (44+10) within Net::DNS::Domain::BEGIN@38 which was called: # once (44µs+10µs) by Net::DNS::RR::BEGIN@42 at line 38
use strict;
# spent 54µs making 1 call to Net::DNS::Domain::BEGIN@38 # spent 10µs making 1 call to strict::import
39251µs281µs
# spent 51µs (21+30) within Net::DNS::Domain::BEGIN@39 which was called: # once (21µs+30µs) by Net::DNS::RR::BEGIN@42 at line 39
use warnings;
# spent 51µs making 1 call to Net::DNS::Domain::BEGIN@39 # spent 30µs making 1 call to warnings::import
40251µs234µs
# spent 28µs (22+6) within Net::DNS::Domain::BEGIN@40 which was called: # once (22µs+6µs) by Net::DNS::RR::BEGIN@42 at line 40
use integer;
# spent 28µs making 1 call to Net::DNS::Domain::BEGIN@40 # spent 6µs making 1 call to integer::import
41295µs2299µs
# spent 160µs (20+140) within Net::DNS::Domain::BEGIN@41 which was called: # once (20µs+140µs) by Net::DNS::RR::BEGIN@42 at line 41
use Carp;
# spent 160µs making 1 call to Net::DNS::Domain::BEGIN@41 # spent 140µs making 1 call to Exporter::import
42
43
4412µs
# spent 236µs (37+200) within Net::DNS::Domain::BEGIN@44 which was called: # once (37µs+200µs) by Net::DNS::RR::BEGIN@42 at line 47
use constant ASCII => ref eval {
4512µs require Encode;
46111µs146µs Encode::find_encoding('ascii');
# spent 46µs making 1 call to Encode::find_encoding
471118µs2390µs};
# spent 236µs making 1 call to Net::DNS::Domain::BEGIN@44 # spent 153µs making 1 call to constant::import
48
4912µs
# spent 181µs (31+151) within Net::DNS::Domain::BEGIN@49 which was called: # once (31µs+151µs) by Net::DNS::RR::BEGIN@42 at line 51
use constant UTF8 => scalar eval { ## not UTF-EBCDIC [see UTR#16 3.6]
5019µs234µs Encode::encode_utf8( chr(182) ) eq pack( 'H*', 'C2B6' );
# spent 25µs making 1 call to Encode::encode_utf8 # spent 9µs making 1 call to main::CORE:pack
51164µs2307µs};
# spent 181µs making 1 call to Net::DNS::Domain::BEGIN@49 # spent 125µs making 1 call to constant::import
52
532131µs23.40ms
# spent 3.24ms (1.38+1.86) within Net::DNS::Domain::BEGIN@53 which was called: # once (1.38ms+1.86ms) by Net::DNS::RR::BEGIN@42 at line 53
use constant LIBIDN => defined eval 'require Net::LibIDN';
# spent 3.24ms making 1 call to Net::DNS::Domain::BEGIN@53 # spent 160µs making 1 call to constant::import
# spent 258µs executing statements in string eval
542143µs22.39ms
# spent 2.24ms (811µs+1.43) within Net::DNS::Domain::BEGIN@54 which was called: # once (811µs+1.43ms) 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.24ms making 1 call to Net::DNS::Domain::BEGIN@54 # spent 146µs making 1 call to constant::import
# spent 268µs executing statements in string eval
55
5622.72ms2314µs
# spent 189µs (64+125) within Net::DNS::Domain::BEGIN@56 which was called: # once (64µs+125µs) by Net::DNS::RR::BEGIN@42 at line 56
use constant IDN2FLAG => eval 'Net::LibIDN2::IDN2_NFC_INPUT + Net::LibIDN2::IDN2_NONTRANSITIONAL';
# spent 189µs making 1 call to Net::DNS::Domain::BEGIN@56 # spent 125µ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µs145µsmy $ascii = ASCII ? Encode::find_encoding('ascii') : undef; # Osborn's Law:
# spent 45µs making 1 call to Encode::find_encoding
6016µs128µsmy $utf8 = UTF8 ? Encode::find_encoding('utf8') : undef; # Variables won't; constants aren't.
# spent 28µ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;
9613µsmy ( $cache1, $cache2, $limit ) = ( {}, {}, 100 );
97
98
# spent 454ms (339+115) within Net::DNS::Domain::new which was called 3936 times, avg 115µs/call: # 1968 times (297ms+115ms) by Net::DNS::Question::new at line 80 of Net/DNS/Question.pm, avg 210µs/call # 1968 times (41.4ms+63µs) by Net::DNS::RR::owner at line 424 of Net/DNS/RR.pm, avg 21µs/call
sub new {
99393617.3ms my ( $class, $s ) = @_;
10039366.90ms croak 'domain identifier undefined' unless defined $s;
101
102393615.8ms my $k = join '', $s, $class, $ORIGIN || ''; # cache key
103393627.0ms my $cache = $$cache1{$k} ||= $$cache2{$k}; # two layer cache
104393633.7ms return $cache if defined $cache;
105
10610392.60ms ( $cache1, $cache2, $limit ) = ( {}, $cache1, 500 ) unless $limit--; # recycle cache
107
10810395.86ms my $self = bless {}, $class;
109
110103911.2ms10393.46ms $s =~ s/\\\\/\\092/g; # disguise escaped escape
# spent 3.46ms making 1039 calls to Net::DNS::Domain::CORE:subst, avg 3µs/call
111103910.1ms10393.61ms $s =~ s/\\\./\\046/g; # disguise escaped dot
# spent 3.61ms making 1039 calls to Net::DNS::Domain::CORE:subst, avg 3µs/call
112
113103928.1ms103942.6ms my $label = $self->{label} = ( $s eq '@' ) ? [] : [split /\056/, _encode_utf8($s)];
# spent 42.6ms making 1039 calls to Net::DNS::Domain::_encode_utf8, avg 41µs/call
114
115103915.9ms foreach (@$label) {
116
117458861.7ms458817.0ms if ( LIBIDN2 && UTF8 && /[^\000-\177]/ ) {
# spent 17.0ms making 4588 calls to Net::DNS::Domain::CORE:match, avg 4µ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
130458860.7ms45889.78ms s/\134([\060-\071]{3})/$unescape{$1}/eg; # numeric escape
# spent 9.78ms making 4588 calls to Net::DNS::Domain::CORE:subst, avg 2µs/call
131458856.1ms458830.8ms s/\134(.)/$1/g; # character escape
# spent 30.8ms making 4588 calls to Net::DNS::Domain::CORE:subst, avg 7µs/call
13245889.94ms croak 'empty domain label' unless length;
133458831.1ms next unless length > 63;
134 substr( $_, 63 ) = '';
135 carp 'domain label truncated';
136 }
137
13810393.17ms $$cache1{$k} = $self; # cache object reference
139
140103921.0ms10397.93ms return $self if $s =~ /\.$/; # fully qualified name
# spent 7.93ms making 1039 calls to Net::DNS::Domain::CORE:match, avg 8µ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 259ms (170+89.4) within Net::DNS::Domain::name which was called 1968 times, avg 132µs/call: # 1968 times (170ms+89.4ms) by Net::DNS::Question::qname at line 215 of Net/DNS/Question.pm, avg 132µs/call
sub name {
16219684.16ms my ($self) = @_;
163
164196816.6ms return $self->{name} if defined $self->{name};
16510382.22ms return unless defined wantarray;
166
16710214105ms562636.9ms my @label = map { s/([^\055\101-\132\141-\172\060-\071])/$escape{$1}/eg; $_ } $self->_wire;
# spent 18.7ms making 1038 calls to Net::DNS::DomainName::_wire, avg 18µs/call # spent 18.3ms making 4588 calls to Net::DNS::Domain::CORE:subst, avg 4µs/call
168
16910382.10ms return $self->{name} = '.' unless scalar @label;
170103823.5ms103852.5ms $self->{name} = _decode_ascii( join chr(46), @label );
# spent 52.5ms making 1038 calls to Net::DNS::Domain::_decode_ascii, avg 51µ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 52.5ms (42.8+9.79) within Net::DNS::Domain::_decode_ascii which was called 1038 times, avg 51µs/call: # 1038 times (42.8ms+9.79ms) by Net::DNS::Domain::name at line 170, avg 51µs/call
sub _decode_ascii { ## ASCII to perl internal encoding
29110384.50ms 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.02ms my $z = length($_) - length($_); # pre-5.18 taint workaround
299103854.9ms10389.79ms ASCII ? substr( $ascii->decode($_), $z ) : $_;
# spent 9.79ms making 1038 calls to Encode::XS::decode, avg 9µs/call
300}
301
302
303
# spent 42.6ms (32.9+9.69) within Net::DNS::Domain::_encode_utf8 which was called 1039 times, avg 41µs/call: # 1039 times (32.9ms+9.69ms) by Net::DNS::Domain::new at line 113, avg 41µs/call
sub _encode_utf8 { ## perl internal encoding to UTF8
30410395.49ms 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.25ms my $z = length($_) - length($_); # pre-5.18 taint workaround
312103929.0ms10399.69ms ASCII ? substr( ( UTF8 ? $utf8 : $ascii )->encode($_), $z ) : $_;
# spent 9.69ms making 1039 calls to Encode::utf8::encode_xs, avg 9µs/call
313}
314
315
3161101µs%escape = eval { ## precalculated ASCII escape table
31712µs my %table;
318
31916µs foreach ( 33 .. 126 ) { # ASCII printable
320941.41ms188331µs $table{pack( 'C', $_ )} = pack 'C', $_;
# spent 331µs making 188 calls to Net::DNS::Domain::CORE:pack, avg 2µs/call
321 }
322
323 # minimal character escapes
32414µs foreach ( 46, 92 ) { # \. \\
325233µs410µs $table{pack( 'C', $_ )} = pack 'C*', 92, $_;
# spent 10µs making 4 calls to Net::DNS::Domain::CORE:pack, avg 3µs/call
326 }
327
32814µs foreach my $n ( 0 .. 32, 127 .. 255 ) { # \ddd
329162381µs my $codepoint = sprintf( '%03u', $n );
330
331 # partial transliteration for non-ASCII character encodings
332162286µs $codepoint =~ tr [0-9] [\060-\071];
333
3341622.55ms324601µs $table{pack( 'C', $n )} = pack 'C a3', 92, $codepoint;
# spent 601µs making 324 calls to Net::DNS::Domain::CORE:pack, avg 2µs/call
335 }
336
3371186µs return %table;
338};
339
340
341192µs%unescape = eval { ## precalculated numeric escape table
34211µs my %table;
343
34414µs foreach my $n ( 0 .. 255 ) {
345256587µs my $key = sprintf( '%03u', $n );
346
347 # partial transliteration for non-ASCII character encodings
348256436µs $key =~ tr [0-9] [\060-\071];
349
3502562.20ms256467µs $table{$key} = pack 'C', $n;
# spent 467µs making 256 calls to Net::DNS::Domain::CORE:pack, avg 2µs/call
351256858µ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
3541163µs return %table;
355};
356
357
358143µs1;
359__END__
 
# spent 24.9ms within Net::DNS::Domain::CORE:match which was called 5627 times, avg 4µs/call: # 4588 times (17.0ms+0s) by Net::DNS::Domain::new at line 117, avg 4µs/call # 1039 times (7.93ms+0s) by Net::DNS::Domain::new at line 140, avg 8µs/call
sub Net::DNS::Domain::CORE:match; # opcode
# spent 1.41ms within Net::DNS::Domain::CORE:pack which was called 773 times, avg 2µs/call: # 324 times (601µs+0s) by Net::DNS::RR::BEGIN@42 at line 334, avg 2µs/call # 256 times (467µs+0s) by Net::DNS::RR::BEGIN@42 at line 350, avg 2µs/call # 188 times (331µs+0s) by Net::DNS::RR::BEGIN@42 at line 320, avg 2µs/call # 4 times (10µs+0s) by Net::DNS::RR::BEGIN@42 at line 325, avg 3µs/call # once (2µs+0s) by Net::DNS::RR::BEGIN@42 at line 351
sub Net::DNS::Domain::CORE:pack; # opcode
# spent 65.9ms within Net::DNS::Domain::CORE:subst which was called 15842 times, avg 4µs/call: # 4588 times (30.8ms+0s) by Net::DNS::Domain::new at line 131, avg 7µs/call # 4588 times (18.3ms+0s) by Net::DNS::Domain::name at line 167, avg 4µs/call # 4588 times (9.78ms+0s) by Net::DNS::Domain::new at line 130, avg 2µs/call # 1039 times (3.61ms+0s) by Net::DNS::Domain::new at line 111, avg 3µs/call # 1039 times (3.46ms+0s) by Net::DNS::Domain::new at line 110, 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.