← 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/Question.pm
StatementsExecuted 49218 statements in 437ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
196811160ms661msNet::DNS::Question::::newNet::DNS::Question::new
19681190.2ms629msNet::DNS::Question::::encodeNet::DNS::Question::encode
19681146.6ms116msNet::DNS::Question::::qclassNet::DNS::Question::qclass
19681142.0ms69.2msNet::DNS::Question::::classNet::DNS::Question::class
19681134.8ms294msNet::DNS::Question::::qnameNet::DNS::Question::qname
19681133.0ms59.4msNet::DNS::Question::::typeNet::DNS::Question::type
19681131.0ms31.0msNet::DNS::Question::::CORE:matchNet::DNS::Question::CORE:match (opcode)
19681122.9ms82.2msNet::DNS::Question::::qtypeNet::DNS::Question::qtype
1969215.93ms5.93msNet::DNS::Question::::CORE:packNet::DNS::Question::CORE:pack (opcode)
11142µs51µsNet::DNS::Question::::BEGIN@27Net::DNS::Question::BEGIN@27
11133µs193µsNet::DNS::Question::::BEGIN@107Net::DNS::Question::BEGIN@107
11125µs48µsNet::DNS::Question::::BEGIN@28Net::DNS::Question::BEGIN@28
11119µs486µsNet::DNS::Question::::BEGIN@32Net::DNS::Question::BEGIN@32
11119µs156µsNet::DNS::Question::::BEGIN@30Net::DNS::Question::BEGIN@30
11119µs24µsNet::DNS::Question::::BEGIN@29Net::DNS::Question::BEGIN@29
11114µs14µsNet::DNS::Question::::BEGIN@33Net::DNS::Question::BEGIN@33
11112µs12µ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
27256µs260µs
# spent 51µs (42+9) within Net::DNS::Question::BEGIN@27 which was called: # once (42µs+9µs) by Net::DNS::Packet::BEGIN@36 at line 27
use strict;
# spent 51µs making 1 call to Net::DNS::Question::BEGIN@27 # spent 9µs making 1 call to strict::import
28251µs272µs
# spent 48µs (25+24) within Net::DNS::Question::BEGIN@28 which was called: # once (25µs+24µs) by Net::DNS::Packet::BEGIN@36 at line 28
use warnings;
# spent 48µs making 1 call to Net::DNS::Question::BEGIN@28 # spent 24µs making 1 call to warnings::import
29257µs228µs
# spent 24µs (19+5) within Net::DNS::Question::BEGIN@29 which was called: # once (19µs+5µs) by Net::DNS::Packet::BEGIN@36 at line 29
use integer;
# spent 24µs making 1 call to Net::DNS::Question::BEGIN@29 # spent 5µs making 1 call to integer::import
30252µs2294µs
# spent 156µs (19+137) within Net::DNS::Question::BEGIN@30 which was called: # once (19µs+137µs) by Net::DNS::Packet::BEGIN@36 at line 30
use Carp;
# spent 156µs making 1 call to Net::DNS::Question::BEGIN@30 # spent 137µs making 1 call to Exporter::import
31
32254µs2953µs
# spent 486µs (19+467) within Net::DNS::Question::BEGIN@32 which was called: # once (19µs+467µs) by Net::DNS::Packet::BEGIN@36 at line 32
use Net::DNS::Parameters;
# spent 486µs making 1 call to Net::DNS::Question::BEGIN@32 # spent 467µs making 1 call to Exporter::import
33250µs114µs
# spent 14µs within Net::DNS::Question::BEGIN@33 which was called: # once (14µs+0s) by Net::DNS::Packet::BEGIN@36 at line 33
use Net::DNS::Domain;
# spent 14µs making 1 call to Net::DNS::Question::BEGIN@33
342535µs112µs
# spent 12µs within Net::DNS::Question::BEGIN@34 which was called: # once (12µs+0s) by Net::DNS::Packet::BEGIN@36 at line 34
use Net::DNS::DomainName;
# spent 12µ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 661ms (160+501) within Net::DNS::Question::new which was called 1968 times, avg 336µs/call: # 1968 times (160ms+501ms) by Net::DNS::Packet::new at line 73 of Net/DNS/Packet.pm, avg 336µs/call
sub new {
5719686.48ms my $self = bless {}, shift;
5819686.90ms my $qname = shift;
5919686.81ms my $qtype = shift || '';
6019684.06ms my $qclass = shift || '';
61
62 # tolerate (possibly unknown) type and class in zone file order
6319685.64ms unless ( exists $classbyname{$qclass} ) {
64 ( $qtype, $qclass ) = ( $qclass, $qtype ) if exists $classbyname{$qtype};
65 ( $qtype, $qclass ) = ( $qclass, $qtype ) if $qtype =~ /CLASS/;
66 }
6719686.29ms 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
73196856.8ms196831.0ms if ( defined $qname and $qname =~ m/:|\d$/ ) {
# spent 31.0ms making 1968 calls to Net::DNS::Question::CORE:match, avg 16µs/call
74 if ( my $reverse = _dns_addr($qname) ) {
75 $qname = $reverse;
76 $qtype ||= 'PTR';
77 }
78 }
79
80196822.8ms1968412ms $self->{qname} = new Net::DNS::DomainName1035($qname);
# spent 412ms making 1968 calls to Net::DNS::Domain::new, avg 210µs/call
81196821.5ms196831.7ms $self->{qtype} = typebyname( $qtype || 'A' );
# spent 31.7ms making 1968 calls to Net::DNS::Parameters::typebyname, avg 16µs/call
82196816.4ms196825.7ms $self->{qclass} = classbyname( $qclass || 'IN' );
# spent 25.7ms making 1968 calls to Net::DNS::Parameters::classbyname, avg 13µs/call
83
84196816.3ms 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.86ms3353µs
# spent 193µs (33+160) within Net::DNS::Question::BEGIN@107 which was called: # once (33µs+160µs) by Net::DNS::Packet::BEGIN@36 at line 107
use constant QFIXEDSZ => length pack 'n2', (0) x 2;
# spent 193µs making 1 call to Net::DNS::Question::BEGIN@107 # spent 155µs making 1 call to constant::import # spent 5µ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 629ms (90.2+539) within Net::DNS::Question::encode which was called 1968 times, avg 320µs/call: # 1968 times (90.2ms+539ms) by Net::DNS::Packet::encode at line 205 of Net/DNS/Packet.pm, avg 320µs/call
sub encode {
13719683.57ms my $self = shift;
138
139393683.3ms3936539ms pack 'a* n2', $self->{qname}->encode(@_), @{$self}{qw(qtype qclass)};
# spent 533ms making 1968 calls to Net::DNS::DomainName1035::encode, avg 271µs/call # spent 5.92ms 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 294ms (34.8+259) within Net::DNS::Question::qname which was called 1968 times, avg 149µs/call: # 1968 times (34.8ms+259ms) by Mail::SpamAssassin::Util::decode_dns_question_entry at line 936 of Mail/SpamAssassin/Util.pm, avg 149µs/call
sub qname {
21219683.73ms my $self = shift;
213
21419683.89ms croak 'immutable object: argument invalid' if scalar @_;
215196827.9ms1968259ms $self->{qname}->name;
# spent 259ms making 1968 calls to Net::DNS::Domain::name, avg 132µ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 59.4ms (33.0+26.4) within Net::DNS::Question::type which was called 1968 times, avg 30µs/call: # 1968 times (33.0ms+26.4ms) by Net::DNS::Question::qtype at line 239, avg 30µs/call
sub type {
23319683.55ms my $self = shift;
234
23519683.76ms croak 'immutable object: argument invalid' if scalar @_;
236196825.8ms196826.4ms typebyval( $self->{qtype} );
# spent 26.4ms making 1968 calls to Net::DNS::Parameters::typebyval, avg 13µs/call
237}
238
239196822.4ms196859.4ms
# spent 82.2ms (22.9+59.4) within Net::DNS::Question::qtype which was called 1968 times, avg 42µs/call: # 1968 times (22.9ms+59.4ms) by Mail::SpamAssassin::Util::decode_dns_question_entry at line 946 of Mail/SpamAssassin/Util.pm, avg 42µs/call
sub qtype { &type; }
# spent 59.4ms making 1968 calls to Net::DNS::Question::type, avg 30µ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 69.2ms (42.0+27.2) within Net::DNS::Question::class which was called 1968 times, avg 35µs/call: # 1968 times (42.0ms+27.2ms) by Net::DNS::Question::qclass at line 261, avg 35µs/call
sub class {
25519683.64ms my $self = shift;
256
25719683.64ms croak 'immutable object: argument invalid' if scalar @_;
258196847.2ms196827.2ms classbyval( $self->{qclass} );
# spent 27.2ms making 1968 calls to Net::DNS::Parameters::classbyval, avg 14µs/call
259}
260
261196832.0ms196869.2ms
# spent 116ms (46.6+69.2) within Net::DNS::Question::qclass which was called 1968 times, avg 59µs/call: # 1968 times (46.6ms+69.2ms) by Mail::SpamAssassin::Util::decode_dns_question_entry at line 946 of Mail/SpamAssassin/Util.pm, avg 59µs/call
sub qclass { &class; }
# spent 69.2ms making 1968 calls to Net::DNS::Question::class, avg 35µ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 31.0ms within Net::DNS::Question::CORE:match which was called 1968 times, avg 16µs/call: # 1968 times (31.0ms+0s) by Net::DNS::Question::new at line 73, avg 16µs/call
sub Net::DNS::Question::CORE:match; # opcode
# spent 5.93ms within Net::DNS::Question::CORE:pack which was called 1969 times, avg 3µs/call: # 1968 times (5.92ms+0s) by Net::DNS::Question::encode at line 139, avg 3µs/call # once (5µ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.