← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 02:36:06 2017
Reported on Sun Nov 5 02:56:19 2017

Filename/usr/local/lib/perl5/site_perl/Net/DNS/Domain.pm
StatementsExecuted 76071 statements in 714ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
393622413ms500msNet::DNS::Domain::::newNet::DNS::Domain::new
196811123ms194msNet::DNS::Domain::::nameNet::DNS::Domain::name
158425143.1ms43.1msNet::DNS::Domain::::CORE:substNet::DNS::Domain::CORE:subst (opcode)
10391131.9ms41.9msNet::DNS::Domain::::_encode_utf8Net::DNS::Domain::_encode_utf8
10381128.9ms38.0msNet::DNS::Domain::::_decode_asciiNet::DNS::Domain::_decode_ascii
56272120.1ms20.1msNet::DNS::Domain::::CORE:matchNet::DNS::Domain::CORE:match (opcode)
1111.49ms3.50msNet::DNS::Domain::::BEGIN@53Net::DNS::Domain::BEGIN@53
773511.47ms1.47msNet::DNS::Domain::::CORE:packNet::DNS::Domain::CORE:pack (opcode)
111872µs2.54msNet::DNS::Domain::::BEGIN@54Net::DNS::Domain::BEGIN@54
11169µs249µsNet::DNS::Domain::::BEGIN@56Net::DNS::Domain::BEGIN@56
11144µs53µsNet::DNS::Domain::::BEGIN@38Net::DNS::Domain::BEGIN@38
11142µs285µsNet::DNS::Domain::::BEGIN@44Net::DNS::Domain::BEGIN@44
11136µs276µsNet::DNS::Domain::::BEGIN@49Net::DNS::Domain::BEGIN@49
11124µs38µsNet::DNS::Domain::::BEGIN@40Net::DNS::Domain::BEGIN@40
11124µs260µsNet::DNS::Domain::::BEGIN@41Net::DNS::Domain::BEGIN@41
11120µs48µsNet::DNS::Domain::::BEGIN@39Net::DNS::Domain::BEGIN@39
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
38262µs262µs
# spent 53µs (44+9) within Net::DNS::Domain::BEGIN@38 which was called: # once (44µs+9µs) by Net::DNS::RR::BEGIN@42 at line 38
use strict;
# spent 53µs making 1 call to Net::DNS::Domain::BEGIN@38 # spent 9µs making 1 call to strict::import
39259µs275µs
# spent 48µs (20+27) within Net::DNS::Domain::BEGIN@39 which was called: # once (20µs+27µs) by Net::DNS::RR::BEGIN@42 at line 39
use warnings;
# spent 48µs making 1 call to Net::DNS::Domain::BEGIN@39 # spent 27µs making 1 call to warnings::import
402100µs253µs
# spent 38µs (24+15) within Net::DNS::Domain::BEGIN@40 which was called: # once (24µs+15µs) by Net::DNS::RR::BEGIN@42 at line 40
use integer;
# spent 38µs making 1 call to Net::DNS::Domain::BEGIN@40 # spent 15µs making 1 call to integer::import
412100µs2496µs
# spent 260µs (24+236) within Net::DNS::Domain::BEGIN@41 which was called: # once (24µs+236µs) by Net::DNS::RR::BEGIN@42 at line 41
use Carp;
# spent 260µs making 1 call to Net::DNS::Domain::BEGIN@41 # spent 236µs making 1 call to Exporter::import
42
43
4412µs
# spent 285µs (42+242) within Net::DNS::Domain::BEGIN@44 which was called: # once (42µs+242µs) by Net::DNS::RR::BEGIN@42 at line 47
use constant ASCII => ref eval {
4519µs require Encode;
46111µs146µs Encode::find_encoding('ascii');
# spent 46µs making 1 call to Encode::find_encoding
471135µs2481µs};
# spent 285µs making 1 call to Net::DNS::Domain::BEGIN@44 # spent 196µs making 1 call to constant::import
48
4912µs
# spent 276µs (36+240) within Net::DNS::Domain::BEGIN@49 which was called: # once (36µs+240µs) by Net::DNS::RR::BEGIN@42 at line 51
use constant UTF8 => scalar eval { ## not UTF-EBCDIC [see UTR#16 3.6]
50118µs248µs Encode::encode_utf8( chr(182) ) eq pack( 'H*', 'C2B6' );
# spent 32µs making 1 call to Encode::encode_utf8 # spent 15µs making 1 call to main::CORE:pack
51177µs2483µs};
# spent 276µs making 1 call to Net::DNS::Domain::BEGIN@49 # spent 208µs making 1 call to constant::import
52
532158µs23.70ms
# spent 3.50ms (1.49+2.00) within Net::DNS::Domain::BEGIN@53 which was called: # once (1.49ms+2.00ms) by Net::DNS::RR::BEGIN@42 at line 53
use constant LIBIDN => defined eval 'require Net::LibIDN';
# spent 3.50ms making 1 call to Net::DNS::Domain::BEGIN@53 # spent 200µs making 1 call to constant::import
# spent 247µs executing statements in string eval
542174µs22.74ms
# spent 2.54ms (872µs+1.66) within Net::DNS::Domain::BEGIN@54 which was called: # once (872µs+1.66ms) 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.54ms making 1 call to Net::DNS::Domain::BEGIN@54 # spent 202µs making 1 call to constant::import
# spent 272µs executing statements in string eval
55
5622.97ms2428µs
# spent 249µs (69+180) within Net::DNS::Domain::BEGIN@56 which was called: # once (69µs+180µs) by Net::DNS::RR::BEGIN@42 at line 56
use constant IDN2FLAG => eval 'Net::LibIDN2::IDN2_NFC_INPUT + Net::LibIDN2::IDN2_NONTRANSITIONAL';
# spent 249µs making 1 call to Net::DNS::Domain::BEGIN@56 # spent 180µ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
59110µs146µsmy $ascii = ASCII ? Encode::find_encoding('ascii') : undef; # Osborn's Law:
# spent 46µs making 1 call to Encode::find_encoding
6016µs130µsmy $utf8 = UTF8 ? Encode::find_encoding('utf8') : undef; # Variables won't; constants aren't.
# spent 30µ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
9312µsmy ( %escape, %unescape ); ## precalculated ASCII escape tables
94
95our $ORIGIN;
96110µsmy ( $cache1, $cache2, $limit ) = ( {}, {}, 100 );
97
98
# spent 500ms (413+87.3) within Net::DNS::Domain::new which was called 3936 times, avg 127µs/call: # 1968 times (375ms+87.3ms) by Net::DNS::Question::new at line 80 of Net/DNS/Question.pm, avg 235µs/call # 1968 times (38.2ms+43µs) by Net::DNS::RR::owner at line 424 of Net/DNS/RR.pm, avg 19µs/call
sub new {
99393618.0ms my ( $class, $s ) = @_;
10039366.88ms croak 'domain identifier undefined' unless defined $s;
101
102393616.1ms my $k = join '', $s, $class, $ORIGIN || ''; # cache key
103393627.2ms my $cache = $$cache1{$k} ||= $$cache2{$k}; # two layer cache
104393643.5ms return $cache if defined $cache;
105
10610392.61ms ( $cache1, $cache2, $limit ) = ( {}, $cache1, 500 ) unless $limit--; # recycle cache
107
10810394.99ms my $self = bless {}, $class;
109
110103910.8ms10393.08ms $s =~ s/\\\\/\\092/g; # disguise escaped escape
# spent 3.08ms making 1039 calls to Net::DNS::Domain::CORE:subst, avg 3µs/call
11110399.69ms10392.94ms $s =~ s/\\\./\\046/g; # disguise escaped dot
# spent 2.94ms making 1039 calls to Net::DNS::Domain::CORE:subst, avg 3µs/call
112
113103928.2ms103941.9ms my $label = $self->{label} = ( $s eq '@' ) ? [] : [split /\056/, _encode_utf8($s)];
# spent 41.9ms making 1039 calls to Net::DNS::Domain::_encode_utf8, avg 40µs/call
114
115103921.6ms foreach (@$label) {
116
117458879.4ms458814.0ms if ( LIBIDN2 && UTF8 && /[^\000-\177]/ ) {
# spent 14.0ms 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
130458870.9ms45889.40ms s/\134([\060-\071]{3})/$unescape{$1}/eg; # numeric escape
# spent 9.40ms making 4588 calls to Net::DNS::Domain::CORE:subst, avg 2µs/call
131458857.9ms45889.96ms s/\134(.)/$1/g; # character escape
# spent 9.96ms making 4588 calls to Net::DNS::Domain::CORE:subst, avg 2µs/call
132458810.2ms croak 'empty domain label' unless length;
133458811.0ms next unless length > 63;
134 substr( $_, 63 ) = '';
135 carp 'domain label truncated';
136 }
137
13810393.43ms $$cache1{$k} = $self; # cache object reference
139
140103944.2ms10396.07ms return $self if $s =~ /\.$/; # fully qualified name
# spent 6.07ms 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 194ms (123+70.7) within Net::DNS::Domain::name which was called 1968 times, avg 98µs/call: # 1968 times (123ms+70.7ms) by Net::DNS::Question::qname at line 215 of Net/DNS/Question.pm, avg 98µs/call
sub name {
16219684.06ms my ($self) = @_;
163
164196816.0ms return $self->{name} if defined $self->{name};
16510382.06ms return unless defined wantarray;
166
1671021489.5ms562632.7ms my @label = map { s/([^\055\101-\132\141-\172\060-\071])/$escape{$1}/eg; $_ } $self->_wire;
# spent 17.8ms making 4588 calls to Net::DNS::Domain::CORE:subst, avg 4µs/call # spent 14.9ms making 1038 calls to Net::DNS::DomainName::_wire, avg 14µs/call
168
16910382.05ms return $self->{name} = '.' unless scalar @label;
170103823.7ms103838.0ms $self->{name} = _decode_ascii( join chr(46), @label );
# spent 38.0ms making 1038 calls to Net::DNS::Domain::_decode_ascii, avg 37µ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
27417µ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 38.0ms (28.9+9.15) within Net::DNS::Domain::_decode_ascii which was called 1038 times, avg 37µs/call: # 1038 times (28.9ms+9.15ms) by Net::DNS::Domain::name at line 170, avg 37µs/call
sub _decode_ascii { ## ASCII to perl internal encoding
29110383.92ms 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.21ms my $z = length($_) - length($_); # pre-5.18 taint workaround
299103831.1ms10389.15ms ASCII ? substr( $ascii->decode($_), $z ) : $_;
# spent 9.15ms making 1038 calls to Encode::XS::decode, avg 9µs/call
300}
301
302
303
# spent 41.9ms (31.9+9.94) within Net::DNS::Domain::_encode_utf8 which was called 1039 times, avg 40µs/call: # 1039 times (31.9ms+9.94ms) by Net::DNS::Domain::new at line 113, avg 40µs/call
sub _encode_utf8 { ## perl internal encoding to UTF8
30410395.76ms 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.54ms my $z = length($_) - length($_); # pre-5.18 taint workaround
312103941.1ms10399.94ms ASCII ? substr( ( UTF8 ? $utf8 : $ascii )->encode($_), $z ) : $_;
# spent 9.94ms making 1039 calls to Encode::utf8::encode_xs, avg 10µs/call
313}
314
315
3161129µs%escape = eval { ## precalculated ASCII escape table
31719µs my %table;
318
31916µs foreach ( 33 .. 126 ) { # ASCII printable
320942.52ms188346µs $table{pack( 'C', $_ )} = pack 'C', $_;
# spent 346µ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 ) { # \. \\
325267µs418µs $table{pack( 'C', $_ )} = pack 'C*', 92, $_;
# spent 18µs making 4 calls to Net::DNS::Domain::CORE:pack, avg 5µs/call
326 }
327
32814µs foreach my $n ( 0 .. 32, 127 .. 255 ) { # \ddd
329162391µs my $codepoint = sprintf( '%03u', $n );
330
331 # partial transliteration for non-ASCII character encodings
332162286µs $codepoint =~ tr [0-9] [\060-\071];
333
3341624.56ms324621µs $table{pack( 'C', $n )} = pack 'C a3', 92, $codepoint;
# spent 621µs making 324 calls to Net::DNS::Domain::CORE:pack, avg 2µs/call
335 }
336
3371198µs return %table;
338};
339
340
3411127µs%unescape = eval { ## precalculated numeric escape table
34212µs my %table;
343
344114µs foreach my $n ( 0 .. 255 ) {
345256599µs my $key = sprintf( '%03u', $n );
346
347 # partial transliteration for non-ASCII character encodings
348256429µs $key =~ tr [0-9] [\060-\071];
349
3502564.18ms256482µs $table{$key} = pack 'C', $n;
# spent 482µs making 256 calls to Net::DNS::Domain::CORE:pack, avg 2µs/call
351256867µ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
3541176µs return %table;
355};
356
357
358172µs1;
359__END__
 
# spent 20.1ms within Net::DNS::Domain::CORE:match which was called 5627 times, avg 4µs/call: # 4588 times (14.0ms+0s) by Net::DNS::Domain::new at line 117, avg 3µs/call # 1039 times (6.07ms+0s) by Net::DNS::Domain::new at line 140, avg 6µs/call
sub Net::DNS::Domain::CORE:match; # opcode
# spent 1.47ms within Net::DNS::Domain::CORE:pack which was called 773 times, avg 2µs/call: # 324 times (621µs+0s) by Net::DNS::RR::BEGIN@42 at line 334, avg 2µs/call # 256 times (482µs+0s) by Net::DNS::RR::BEGIN@42 at line 350, avg 2µs/call # 188 times (346µ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 5µs/call # once (2µs+0s) by Net::DNS::RR::BEGIN@42 at line 351
sub Net::DNS::Domain::CORE:pack; # opcode
# spent 43.1ms within Net::DNS::Domain::CORE:subst which was called 15842 times, avg 3µs/call: # 4588 times (17.8ms+0s) by Net::DNS::Domain::name at line 167, avg 4µs/call # 4588 times (9.96ms+0s) by Net::DNS::Domain::new at line 131, avg 2µs/call # 4588 times (9.40ms+0s) by Net::DNS::Domain::new at line 130, avg 2µs/call # 1039 times (3.08ms+0s) by Net::DNS::Domain::new at line 110, avg 3µs/call # 1039 times (2.94ms+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.