← 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/Question.pm
StatementsExecuted 49218 statements in 406ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
196811170ms617msNet::DNS::Question::::newNet::DNS::Question::new
19681173.3ms600msNet::DNS::Question::::encodeNet::DNS::Question::encode
19681133.8ms50.9msNet::DNS::Question::::classNet::DNS::Question::class
19681133.6ms236msNet::DNS::Question::::qnameNet::DNS::Question::qname
19681131.1ms51.3msNet::DNS::Question::::typeNet::DNS::Question::type
19681123.2ms74.4msNet::DNS::Question::::qtypeNet::DNS::Question::qtype
19681122.8ms73.7msNet::DNS::Question::::qclassNet::DNS::Question::qclass
19681122.7ms22.7msNet::DNS::Question::::CORE:matchNet::DNS::Question::CORE:match (opcode)
1969215.85ms5.85msNet::DNS::Question::::CORE:packNet::DNS::Question::CORE:pack (opcode)
11148µs64µsNet::DNS::Question::::BEGIN@27Net::DNS::Question::BEGIN@27
11140µs268µsNet::DNS::Question::::BEGIN@107Net::DNS::Question::BEGIN@107
11133µs33µsNet::DNS::Question::::BEGIN@33Net::DNS::Question::BEGIN@33
11129µs701µsNet::DNS::Question::::BEGIN@32Net::DNS::Question::BEGIN@32
11128µs51µsNet::DNS::Question::::BEGIN@28Net::DNS::Question::BEGIN@28
11123µs28µsNet::DNS::Question::::BEGIN@29Net::DNS::Question::BEGIN@29
11119µs204µsNet::DNS::Question::::BEGIN@30Net::DNS::Question::BEGIN@30
11118µs18µ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#
612µ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
27265µs280µs
# spent 64µs (48+16) within Net::DNS::Question::BEGIN@27 which was called: # once (48µs+16µs) by Net::DNS::Packet::BEGIN@36 at line 27
use strict;
# spent 64µs making 1 call to Net::DNS::Question::BEGIN@27 # spent 16µs making 1 call to strict::import
28266µs275µs
# spent 51µs (28+23) within Net::DNS::Question::BEGIN@28 which was called: # once (28µs+23µs) by Net::DNS::Packet::BEGIN@36 at line 28
use warnings;
# spent 51µs making 1 call to Net::DNS::Question::BEGIN@28 # spent 23µs making 1 call to warnings::import
29275µs233µs
# spent 28µs (23+5) within Net::DNS::Question::BEGIN@29 which was called: # once (23µs+5µs) by Net::DNS::Packet::BEGIN@36 at line 29
use integer;
# spent 28µs making 1 call to Net::DNS::Question::BEGIN@29 # spent 5µs making 1 call to integer::import
30265µs2388µs
# spent 204µs (19+184) within Net::DNS::Question::BEGIN@30 which was called: # once (19µs+184µs) by Net::DNS::Packet::BEGIN@36 at line 30
use Carp;
# spent 204µs making 1 call to Net::DNS::Question::BEGIN@30 # spent 184µs making 1 call to Exporter::import
31
32278µs21.37ms
# spent 701µs (29+673) within Net::DNS::Question::BEGIN@32 which was called: # once (29µs+673µs) by Net::DNS::Packet::BEGIN@36 at line 32
use Net::DNS::Parameters;
# spent 701µs making 1 call to Net::DNS::Question::BEGIN@32 # spent 673µs making 1 call to Exporter::import
33268µs133µs
# spent 33µs within Net::DNS::Question::BEGIN@33 which was called: # once (33µs+0s) by Net::DNS::Packet::BEGIN@36 at line 33
use Net::DNS::Domain;
# spent 33µs making 1 call to Net::DNS::Question::BEGIN@33
342580µs118µs
# spent 18µs within Net::DNS::Question::BEGIN@34 which was called: # once (18µs+0s) by Net::DNS::Packet::BEGIN@36 at line 34
use Net::DNS::DomainName;
# spent 18µ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 617ms (170+447) within Net::DNS::Question::new which was called 1968 times, avg 314µs/call: # 1968 times (170ms+447ms) by Net::DNS::Packet::new at line 73 of Net/DNS/Packet.pm, avg 314µs/call
sub new {
5719686.62ms my $self = bless {}, shift;
5819687.55ms my $qname = shift;
5919687.08ms my $qtype = shift || '';
6019684.21ms my $qclass = shift || '';
61
62 # tolerate (possibly unknown) type and class in zone file order
6319685.05ms unless ( exists $classbyname{$qclass} ) {
64 ( $qtype, $qclass ) = ( $qclass, $qtype ) if exists $classbyname{$qtype};
65 ( $qtype, $qclass ) = ( $qclass, $qtype ) if $qtype =~ /CLASS/;
66 }
6719686.57ms 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
73196838.7ms196822.7ms if ( defined $qname and $qname =~ m/:|\d$/ ) {
# spent 22.7ms making 1968 calls to Net::DNS::Question::CORE:match, avg 12µs/call
74 if ( my $reverse = _dns_addr($qname) ) {
75 $qname = $reverse;
76 $qtype ||= 'PTR';
77 }
78 }
79
80196824.7ms1968384ms $self->{qname} = new Net::DNS::DomainName1035($qname);
# spent 384ms making 1968 calls to Net::DNS::Domain::new, avg 195µs/call
81196818.9ms196822.7ms $self->{qtype} = typebyname( $qtype || 'A' );
# spent 22.7ms making 1968 calls to Net::DNS::Parameters::typebyname, avg 12µs/call
82196816.4ms196817.5ms $self->{qclass} = classbyname( $qclass || 'IN' );
# spent 17.5ms making 1968 calls to Net::DNS::Parameters::classbyname, avg 9µs/call
83
84196827.4ms 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
10722.00ms3497µs
# spent 268µs (40+229) within Net::DNS::Question::BEGIN@107 which was called: # once (40µs+229µs) by Net::DNS::Packet::BEGIN@36 at line 107
use constant QFIXEDSZ => length pack 'n2', (0) x 2;
# spent 268µs making 1 call to Net::DNS::Question::BEGIN@107 # spent 222µ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 600ms (73.3+527) within Net::DNS::Question::encode which was called 1968 times, avg 305µs/call: # 1968 times (73.3ms+527ms) by Net::DNS::Packet::encode at line 205 of Net/DNS/Packet.pm, avg 305µs/call
sub encode {
13719683.59ms my $self = shift;
138
139393673.4ms3936527ms pack 'a* n2', $self->{qname}->encode(@_), @{$self}{qw(qtype qclass)};
# spent 521ms making 1968 calls to Net::DNS::DomainName1035::encode, avg 265µs/call # spent 5.84ms 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 236ms (33.6+202) within Net::DNS::Question::qname which was called 1968 times, avg 120µs/call: # 1968 times (33.6ms+202ms) by Mail::SpamAssassin::Util::decode_dns_question_entry at line 936 of Mail/SpamAssassin/Util.pm, avg 120µs/call
sub qname {
21219683.62ms my $self = shift;
213
21419683.77ms croak 'immutable object: argument invalid' if scalar @_;
215196827.6ms1968202ms $self->{qname}->name;
# spent 202ms making 1968 calls to Net::DNS::Domain::name, avg 103µ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 51.3ms (31.1+20.2) within Net::DNS::Question::type which was called 1968 times, avg 26µs/call: # 1968 times (31.1ms+20.2ms) by Net::DNS::Question::qtype at line 239, avg 26µs/call
sub type {
23319683.61ms my $self = shift;
234
23519683.76ms croak 'immutable object: argument invalid' if scalar @_;
236196824.3ms196820.2ms typebyval( $self->{qtype} );
# spent 20.2ms making 1968 calls to Net::DNS::Parameters::typebyval, avg 10µs/call
237}
238
239196841.5ms196851.3ms
# spent 74.4ms (23.2+51.3) within Net::DNS::Question::qtype which was called 1968 times, avg 38µs/call: # 1968 times (23.2ms+51.3ms) by Mail::SpamAssassin::Util::decode_dns_question_entry at line 946 of Mail/SpamAssassin/Util.pm, avg 38µs/call
sub qtype { &type; }
# spent 51.3ms making 1968 calls to Net::DNS::Question::type, avg 26µ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 50.9ms (33.8+17.1) within Net::DNS::Question::class which was called 1968 times, avg 26µs/call: # 1968 times (33.8ms+17.1ms) by Net::DNS::Question::qclass at line 261, avg 26µs/call
sub class {
25519683.69ms my $self = shift;
256
25719683.79ms croak 'immutable object: argument invalid' if scalar @_;
258196825.0ms196817.1ms classbyval( $self->{qclass} );
# spent 17.1ms making 1968 calls to Net::DNS::Parameters::classbyval, avg 9µs/call
259}
260
261196822.2ms196850.9ms
# spent 73.7ms (22.8+50.9) within Net::DNS::Question::qclass which was called 1968 times, avg 37µs/call: # 1968 times (22.8ms+50.9ms) by Mail::SpamAssassin::Util::decode_dns_question_entry at line 946 of Mail/SpamAssassin/Util.pm, avg 37µs/call
sub qclass { &class; }
# spent 50.9ms making 1968 calls to Net::DNS::Question::class, avg 26µ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
299115µs1;
300__END__
 
# spent 22.7ms within Net::DNS::Question::CORE:match which was called 1968 times, avg 12µs/call: # 1968 times (22.7ms+0s) by Net::DNS::Question::new at line 73, avg 12µs/call
sub Net::DNS::Question::CORE:match; # opcode
# spent 5.85ms within Net::DNS::Question::CORE:pack which was called 1969 times, avg 3µs/call: # 1968 times (5.84ms+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.