← 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/Question.pm
StatementsExecuted 49218 statements in 412ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
196811133ms665msNet::DNS::Question::::newNet::DNS::Question::new
19681165.2ms536msNet::DNS::Question::::encodeNet::DNS::Question::encode
19681142.6ms59.2msNet::DNS::Question::::classNet::DNS::Question::class
19681141.4ms61.8msNet::DNS::Question::::typeNet::DNS::Question::type
19681133.0ms227msNet::DNS::Question::::qnameNet::DNS::Question::qname
19681125.5ms25.5msNet::DNS::Question::::CORE:matchNet::DNS::Question::CORE:match (opcode)
19681123.4ms82.6msNet::DNS::Question::::qclassNet::DNS::Question::qclass
19681122.2ms84.0msNet::DNS::Question::::qtypeNet::DNS::Question::qtype
1969215.75ms5.75msNet::DNS::Question::::CORE:packNet::DNS::Question::CORE:pack (opcode)
11162µs70µsNet::DNS::Question::::BEGIN@27Net::DNS::Question::BEGIN@27
11139µs276µsNet::DNS::Question::::BEGIN@107Net::DNS::Question::BEGIN@107
11128µs670µsNet::DNS::Question::::BEGIN@32Net::DNS::Question::BEGIN@32
11128µs32µsNet::DNS::Question::::BEGIN@29Net::DNS::Question::BEGIN@29
11121µs54µsNet::DNS::Question::::BEGIN@28Net::DNS::Question::BEGIN@28
11118µs246µsNet::DNS::Question::::BEGIN@30Net::DNS::Question::BEGIN@30
11115µs15µsNet::DNS::Question::::BEGIN@33Net::DNS::Question::BEGIN@33
11114µs14µsNet::DNS::Question::::BEGIN@34Net::DNS::Question::BEGIN@34
0000s0sNet::DNS::Question::::_dns_addrNet::DNS::Question::_dns_addr
0000s0sNet::DNS::Question::::decodeNet::DNS::Question::decode
0000s0sNet::DNS::Question::::nameNet::DNS::Question::name
0000s0sNet::DNS::Question::::printNet::DNS::Question::print
0000s0sNet::DNS::Question::::stringNet::DNS::Question::string
0000s0sNet::DNS::Question::::zclassNet::DNS::Question::zclass
0000s0sNet::DNS::Question::::znameNet::DNS::Question::zname
0000s0sNet::DNS::Question::::ztypeNet::DNS::Question::ztype
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::Question;
2
3#
4# $Id: Question.pm 1530 2017-01-27 10:40:37Z willem $
5#
613µsour $VERSION = (qw$LastChangedRevision: 1530 $)[1];
7
8
9=head1 NAME
10
11Net::DNS::Question - DNS question record
12
13=head1 SYNOPSIS
14
15 use Net::DNS::Question;
16
17 $question = new Net::DNS::Question('example.com', 'A', 'IN');
18
19=head1 DESCRIPTION
20
21A Net::DNS::Question object represents a record in the question
22section of a DNS packet.
23
24=cut
25
26
27259µs278µs
# spent 70µs (62+8) within Net::DNS::Question::BEGIN@27 which was called: # once (62µs+8µs) by Net::DNS::Packet::BEGIN@36 at line 27
use strict;
# spent 70µs making 1 call to Net::DNS::Question::BEGIN@27 # spent 8µs making 1 call to strict::import
28263µs286µs
# spent 54µs (21+32) within Net::DNS::Question::BEGIN@28 which was called: # once (21µs+32µs) by Net::DNS::Packet::BEGIN@36 at line 28
use warnings;
# spent 54µs making 1 call to Net::DNS::Question::BEGIN@28 # spent 32µs making 1 call to warnings::import
29262µs237µs
# spent 32µs (28+5) within Net::DNS::Question::BEGIN@29 which was called: # once (28µs+5µs) by Net::DNS::Packet::BEGIN@36 at line 29
use integer;
# spent 32µs making 1 call to Net::DNS::Question::BEGIN@29 # spent 5µs making 1 call to integer::import
30264µs2473µs
# spent 246µs (18+227) within Net::DNS::Question::BEGIN@30 which was called: # once (18µs+227µs) by Net::DNS::Packet::BEGIN@36 at line 30
use Carp;
# spent 246µs making 1 call to Net::DNS::Question::BEGIN@30 # spent 227µs making 1 call to Exporter::import
31
32272µs21.31ms
# spent 670µs (28+642) within Net::DNS::Question::BEGIN@32 which was called: # once (28µs+642µs) by Net::DNS::Packet::BEGIN@36 at line 32
use Net::DNS::Parameters;
# spent 670µs making 1 call to Net::DNS::Question::BEGIN@32 # spent 642µs making 1 call to Exporter::import
33254µs115µs
# spent 15µs within Net::DNS::Question::BEGIN@33 which was called: # once (15µs+0s) by Net::DNS::Packet::BEGIN@36 at line 33
use Net::DNS::Domain;
# spent 15µs making 1 call to Net::DNS::Question::BEGIN@33
342618µs114µs
# spent 14µs within Net::DNS::Question::BEGIN@34 which was called: # once (14µs+0s) by Net::DNS::Packet::BEGIN@36 at line 34
use Net::DNS::DomainName;
# spent 14µs making 1 call to Net::DNS::Question::BEGIN@34
35
36
37=head1 METHODS
38
39=head2 new
40
41 $question = new Net::DNS::Question('example.com', 'A', 'IN');
42 $question = new Net::DNS::Question('example.com');
43
44 $question = new Net::DNS::Question('192.0.32.10', 'PTR', 'IN');
45 $question = new Net::DNS::Question('192.0.32.10');
46
47Creates a question object from the domain, type, and class passed as
48arguments. One or both type and class arguments may be omitted and
49will assume the default values shown above.
50
51RFC4291 and RFC4632 IP address/prefix notation is supported for
52queries in both in-addr.arpa and ip6.arpa namespaces.
53
54=cut
55
56
# spent 665ms (133+532) within Net::DNS::Question::new which was called 1968 times, avg 338µs/call: # 1968 times (133ms+532ms) by Net::DNS::Packet::new at line 73 of Net/DNS/Packet.pm, avg 338µs/call
sub new {
5719686.36ms my $self = bless {}, shift;
5819687.24ms my $qname = shift;
5919686.93ms my $qtype = shift || '';
6019684.02ms my $qclass = shift || '';
61
62 # tolerate (possibly unknown) type and class in zone file order
6319684.99ms unless ( exists $classbyname{$qclass} ) {
64 ( $qtype, $qclass ) = ( $qclass, $qtype ) if exists $classbyname{$qtype};
65 ( $qtype, $qclass ) = ( $qclass, $qtype ) if $qtype =~ /CLASS/;
66 }
6719686.55ms unless ( exists $typebyname{$qtype} ) {
68 ( $qtype, $qclass ) = ( $qclass, $qtype ) if exists $typebyname{$qclass};
69 ( $qtype, $qclass ) = ( $qclass, $qtype ) if $qclass =~ /TYPE/;
70 }
71
72 # if argument is an IP address, do appropriate reverse lookup
73196841.0ms196825.5ms if ( defined $qname and $qname =~ m/:|\d$/ ) {
# spent 25.5ms making 1968 calls to Net::DNS::Question::CORE:match, avg 13µs/call
74 if ( my $reverse = _dns_addr($qname) ) {
75 $qname = $reverse;
76 $qtype ||= 'PTR';
77 }
78 }
79
80196823.0ms1968462ms $self->{qname} = new Net::DNS::DomainName1035($qname);
# spent 462ms making 1968 calls to Net::DNS::Domain::new, avg 235µs/call
81196820.7ms196824.2ms $self->{qtype} = typebyname( $qtype || 'A' );
# spent 24.2ms making 1968 calls to Net::DNS::Parameters::typebyname, avg 12µs/call
82196816.3ms196820.3ms $self->{qclass} = classbyname( $qclass || 'IN' );
# spent 20.3ms making 1968 calls to Net::DNS::Parameters::classbyname, avg 10µs/call
83
84196851.7ms return $self;
85}
86
87
88=head2 decode
89
90 $question = decode Net::DNS::Question(\$data, $offset);
91
92 ($question, $offset) = decode Net::DNS::Question(\$data, $offset);
93
94Decodes the question record at the specified location within a DNS
95wire-format packet. The first argument is a reference to the buffer
96containing the packet data. The second argument is the offset of
97the start of the question record.
98
99Returns a Net::DNS::Question object and the offset of the next
100location in the packet.
101
102An exception is raised if the object cannot be created
103(e.g., corrupt or insufficient data).
104
105=cut
106
10721.97ms3513µs
# spent 276µs (39+237) within Net::DNS::Question::BEGIN@107 which was called: # once (39µs+237µs) by Net::DNS::Packet::BEGIN@36 at line 107
use constant QFIXEDSZ => length pack 'n2', (0) x 2;
# spent 276µs making 1 call to Net::DNS::Question::BEGIN@107 # spent 231µs making 1 call to constant::import # spent 6µs making 1 call to Net::DNS::Question::CORE:pack
108
109sub decode {
110 my $self = bless {}, shift;
111 my ( $data, $offset ) = @_;
112
113 ( $self->{qname}, $offset ) = decode Net::DNS::DomainName1035(@_);
114
115 my $next = $offset + QFIXEDSZ;
116 die 'corrupt wire-format data' if length $$data < $next;
117 @{$self}{qw(qtype qclass)} = unpack "\@$offset n2", $$data;
118
119 wantarray ? ( $self, $next ) : $self;
120}
121
122
123=head2 encode
124
125 $data = $question->encode( $offset, $hash );
126
127Returns the Net::DNS::Question in binary format suitable for
128inclusion in a DNS packet buffer.
129
130The optional arguments are the offset within the packet data where
131the Net::DNS::Question is to be stored and a reference to a hash
132table used to index compressed names within the packet.
133
134=cut
135
136
# spent 536ms (65.2+471) within Net::DNS::Question::encode which was called 1968 times, avg 272µs/call: # 1968 times (65.2ms+471ms) by Net::DNS::Packet::encode at line 205 of Net/DNS/Packet.pm, avg 272µs/call
sub encode {
13719683.52ms my $self = shift;
138
139393662.3ms3936471ms pack 'a* n2', $self->{qname}->encode(@_), @{$self}{qw(qtype qclass)};
# spent 465ms making 1968 calls to Net::DNS::DomainName1035::encode, avg 236µs/call # spent 5.74ms making 1968 calls to Net::DNS::Question::CORE:pack, avg 3µs/call
140}
141
142
143=head2 print
144
145 $object->print;
146
147Prints the record to the standard output. Calls the string() method
148to get the string representation.
149
150=cut
151
152sub print {
153 print shift->string, "\n";
154}
155
156
157=head2 string
158
159 print "string = ", $question->string, "\n";
160
161Returns a string representation of the question record.
162
163=cut
164
165sub string {
166 my $self = shift;
167
168 join "\t", $self->{qname}->string, $self->qclass, $self->qtype;
169}
170
171
172=head2 name
173
174 $name = $question->name;
175
176Internationalised domain name corresponding to the qname attribute.
177
178Decoding non-ASCII domain names is computationally expensive and
179undesirable for names which are likely to be used to construct
180further queries.
181
182When required to communicate with humans, the 'proper' domain name
183should be extracted from a query or reply packet.
184
185 $query = new Net::DNS::Packet( $example, 'ANY' );
186 $reply = $resolver->send($query) or die;
187 ($question) = $reply->question;
188 $name = $question->name;
189
190=cut
191
192sub name {
193 my $self = shift;
194
195 croak 'immutable object: argument invalid' if scalar @_;
196 $self->{qname}->xname;
197}
198
199
200=head2 qname, zname
201
202 $qname = $question->qname;
203 $zname = $question->zname;
204
205Canonical ASCII domain name as required for the query subject
206transmitted to a nameserver. In dynamic update packets, this
207attribute is known as zname() and refers to the zone name.
208
209=cut
210
211
# spent 227ms (33.0+194) within Net::DNS::Question::qname which was called 1968 times, avg 115µs/call: # 1968 times (33.0ms+194ms) by Mail::SpamAssassin::Util::decode_dns_question_entry at line 936 of Mail/SpamAssassin/Util.pm, avg 115µs/call
sub qname {
21219683.66ms my $self = shift;
213
21419683.75ms croak 'immutable object: argument invalid' if scalar @_;
215196827.2ms1968194ms $self->{qname}->name;
# spent 194ms making 1968 calls to Net::DNS::Domain::name, avg 98µs/call
216}
217
218sub zname { &qname; }
219
220
221=head2 qtype, ztype, type
222
223 $qtype = $question->type;
224 $qtype = $question->qtype;
225 $ztype = $question->ztype;
226
227Returns the question type attribute. In dynamic update packets,
228this attribute is known as ztype() and refers to the zone type.
229
230=cut
231
232
# spent 61.8ms (41.4+20.4) within Net::DNS::Question::type which was called 1968 times, avg 31µs/call: # 1968 times (41.4ms+20.4ms) by Net::DNS::Question::qtype at line 239, avg 31µs/call
sub type {
23319683.50ms my $self = shift;
234
23519683.57ms croak 'immutable object: argument invalid' if scalar @_;
236196823.0ms196820.4ms typebyval( $self->{qtype} );
# spent 20.4ms making 1968 calls to Net::DNS::Parameters::typebyval, avg 10µs/call
237}
238
239196822.0ms196861.8ms
# spent 84.0ms (22.2+61.8) within Net::DNS::Question::qtype which was called 1968 times, avg 43µs/call: # 1968 times (22.2ms+61.8ms) by Mail::SpamAssassin::Util::decode_dns_question_entry at line 946 of Mail/SpamAssassin/Util.pm, avg 43µs/call
sub qtype { &type; }
# spent 61.8ms making 1968 calls to Net::DNS::Question::type, avg 31µs/call
240sub ztype { &type; }
241
242
243=head2 qclass, zclass, class
244
245 $qclass = $question->class;
246 $qclass = $question->qclass;
247 $zclass = $question->zclass;
248
249Returns the question class attribute. In dynamic update packets,
250this attribute is known as zclass() and refers to the zone class.
251
252=cut
253
254
# spent 59.2ms (42.6+16.6) within Net::DNS::Question::class which was called 1968 times, avg 30µs/call: # 1968 times (42.6ms+16.6ms) by Net::DNS::Question::qclass at line 261, avg 30µs/call
sub class {
25519683.80ms my $self = shift;
256
25719683.76ms croak 'immutable object: argument invalid' if scalar @_;
258196825.3ms196816.6ms classbyval( $self->{qclass} );
# spent 16.6ms making 1968 calls to Net::DNS::Parameters::classbyval, avg 8µs/call
259}
260
261196834.9ms196859.2ms
# spent 82.6ms (23.4+59.2) within Net::DNS::Question::qclass which was called 1968 times, avg 42µs/call: # 1968 times (23.4ms+59.2ms) by Mail::SpamAssassin::Util::decode_dns_question_entry at line 946 of Mail/SpamAssassin/Util.pm, avg 42µs/call
sub qclass { &class; }
# spent 59.2ms making 1968 calls to Net::DNS::Question::class, avg 30µs/call
262sub zclass { &class; }
263
264
265########################################
266
267sub _dns_addr { ## Map IP address into reverse lookup namespace
268 local $_ = shift;
269
270 # IP address must contain address characters only
271 s/[%].+$//; # discard RFC4007 scopeid
272 return undef unless m#^[a-fA-F0-9:./]+$#;
273
274 my ( $address, $pfxlen ) = split m#/#;
275
276 # map IPv4 address to in-addr.arpa space
277 if (m#^\d*[.\d]*\d(/\d+)?$#) {
278 my @parse = split /\./, $address;
279 $pfxlen = scalar(@parse) << 3 unless $pfxlen;
280 my $last = $pfxlen > 24 ? 3 : ( $pfxlen - 1 ) >> 3;
281 return join '.', reverse( ( @parse, (0) x 3 )[0 .. $last] ), 'in-addr.arpa.';
282 }
283
284 # map IPv6 address to ip6.arpa space
285 return unless m#^[:\w]+:([.\w]*)(/\d+)?$#;
286 my $rhs = $1 || '0';
287 return _dns_addr($rhs) if m#^[:0]*:0*:[fF]{4}:[^:]+$#; # IPv4
288 $rhs = sprintf '%x%0.2x:%x%0.2x', map $_ || 0, split( /\./, $rhs, 4 ) if /\./;
289 $address =~ s/:[^:]*$/:0$rhs/;
290 my @parse = split /:/, ( reverse "0$address" ), 9;
291 my @xpand = map { /./ ? $_ : ('0') x ( 9 - @parse ) } @parse; # expand ::
292 $pfxlen = ( scalar(@xpand) << 4 ) unless $pfxlen; # implicit length if unspecified
293 my $len = $pfxlen > 124 ? 32 : ( $pfxlen + 3 ) >> 2;
294 my $hex = pack 'A4' x 8, map { $_ . '000' } ('0') x ( 8 - @xpand ), @xpand;
295 return join '.', split( //, substr( $hex, -$len ) ), 'ip6.arpa.';
296}
297
298
29918µs1;
300__END__
 
# spent 25.5ms within Net::DNS::Question::CORE:match which was called 1968 times, avg 13µs/call: # 1968 times (25.5ms+0s) by Net::DNS::Question::new at line 73, avg 13µs/call
sub Net::DNS::Question::CORE:match; # opcode
# spent 5.75ms within Net::DNS::Question::CORE:pack which was called 1969 times, avg 3µs/call: # 1968 times (5.74ms+0s) by Net::DNS::Question::encode at line 139, avg 3µs/call # once (6µs+0s) by Net::DNS::Question::BEGIN@107 at line 107
sub Net::DNS::Question::CORE:pack; # 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.