← 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/DomainName.pm
StatementsExecuted 89594 statements in 489ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
196811395ms465msNet::DNS::DomainName1035::::encodeNet::DNS::DomainName1035::encode
30062258.9ms58.9msNet::DNS::DomainName::::_wire Net::DNS::DomainName::_wire
83481126.2ms26.2msNet::DNS::DomainName1035::::CORE:packNet::DNS::DomainName1035::CORE:pack (opcode)
11142µs52µsNet::DNS::DomainName::::BEGIN@41 Net::DNS::DomainName::BEGIN@41
11130µs250µsNet::DNS::DomainName1035::::BEGIN@158Net::DNS::DomainName1035::BEGIN@158
11129µs276µsNet::DNS::DomainName2535::::BEGIN@220Net::DNS::DomainName2535::BEGIN@220
11129µs57µsNet::DNS::DomainName::::BEGIN@42 Net::DNS::DomainName::BEGIN@42
11125µs193µsNet::DNS::DomainName::::BEGIN@46 Net::DNS::DomainName::BEGIN@46
11124µs255µsNet::DNS::DomainName::::BEGIN@43 Net::DNS::DomainName::BEGIN@43
11122µs28µsNet::DNS::DomainName::::BEGIN@45 Net::DNS::DomainName::BEGIN@45
0000s0sNet::DNS::DomainName2535::::encodeNet::DNS::DomainName2535::encode
0000s0sNet::DNS::DomainName::::canonical Net::DNS::DomainName::canonical
0000s0sNet::DNS::DomainName::::decode Net::DNS::DomainName::decode
0000s0sNet::DNS::DomainName::::encode Net::DNS::DomainName::encode
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::DomainName;
2
3#
4# $Id: DomainName.pm 1558 2017-04-03 11:38:22Z willem $
5#
612µsour $VERSION = (qw$LastChangedRevision: 1558 $)[1];
7
8
9=head1 NAME
10
11Net::DNS::DomainName - DNS name representation
12
13=head1 SYNOPSIS
14
15 use Net::DNS::DomainName;
16
17 $object = new Net::DNS::DomainName('example.com');
18 $name = $object->name;
19 $data = $object->encode;
20
21 ( $object, $next ) = decode Net::DNS::DomainName( \$data, $offset );
22
23=head1 DESCRIPTION
24
25The Net::DNS::DomainName module implements the concrete representation
26of DNS domain names used within DNS packets.
27
28Net::DNS::DomainName defines methods for encoding and decoding wire
29format octet strings as defined in RFC1035. All other behaviour,
30including the new() constructor, is inherited from Net::DNS::Domain.
31
32The Net::DNS::DomainName1035 and Net::DNS::DomainName2535 packages
33implement disjoint domain name subtypes which provide the name
34compression and canonicalisation specified by RFC1035 and RFC2535.
35These are necessary to meet the backward compatibility requirements
36introduced by RFC3597.
37
38=cut
39
40
41265µs262µs
# spent 52µs (42+10) within Net::DNS::DomainName::BEGIN@41 which was called: # once (42µs+10µs) by Net::DNS::RR::BEGIN@43 at line 41
use strict;
# spent 52µs making 1 call to Net::DNS::DomainName::BEGIN@41 # spent 10µs making 1 call to strict::import
42272µs286µs
# spent 57µs (29+29) within Net::DNS::DomainName::BEGIN@42 which was called: # once (29µs+29µs) by Net::DNS::RR::BEGIN@43 at line 42
use warnings;
# spent 57µs making 1 call to Net::DNS::DomainName::BEGIN@42 # spent 29µs making 1 call to warnings::import
43283µs2255µs
# spent 255µs (24+231) within Net::DNS::DomainName::BEGIN@43 which was called: # once (24µs+231µs) by Net::DNS::RR::BEGIN@43 at line 43
use base qw(Net::DNS::Domain);
# spent 255µs making 1 call to Net::DNS::DomainName::BEGIN@43 # spent 231µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 231µs
44
45271µs234µs
# spent 28µs (22+6) within Net::DNS::DomainName::BEGIN@45 which was called: # once (22µs+6µs) by Net::DNS::RR::BEGIN@43 at line 45
use integer;
# spent 28µs making 1 call to Net::DNS::DomainName::BEGIN@45 # spent 6µs making 1 call to integer::import
462847µs2360µs
# spent 193µs (25+168) within Net::DNS::DomainName::BEGIN@46 which was called: # once (25µs+168µs) by Net::DNS::RR::BEGIN@43 at line 46
use Carp;
# spent 193µs making 1 call to Net::DNS::DomainName::BEGIN@46 # spent 168µs making 1 call to Exporter::import
47
48
49=head1 METHODS
50
51=head2 new
52
53 $object = new Net::DNS::DomainName('example.com');
54
55Creates a domain name object which identifies the domain specified
56by the character string argument.
57
58
59=head2 canonical
60
61 $data = $object->canonical;
62
63Returns the canonical wire-format representation of the domain name
64as defined in RFC2535(8.1).
65
66=cut
67
68sub canonical {
69 join '', map( { tr /\101-\132/\141-\172/;
70 pack 'C a*', length($_), $_;
71 } shift->_wire ),
7218µs pack 'x';
# spent 8µs making 1 call to main::CORE:pack
73}
74
75
76=head2 decode
77
78 $object = decode Net::DNS::DomainName( \$buffer, $offset, $hash );
79
80 ( $object, $next ) = decode Net::DNS::DomainName( \$buffer, $offset, $hash );
81
82Creates a domain name object which represents the DNS domain name
83identified by the wire-format data at the indicated offset within
84the data buffer.
85
86The argument list consists of a reference to a scalar containing the
87wire-format data and specified offset. The optional reference to a
88hash table provides improved efficiency of decoding compressed names
89by exploiting already cached compression pointers.
90
91The returned offset value indicates the start of the next item in the
92data buffer.
93
94=cut
95
96sub decode {
97 my $label = [];
98 my $self = bless {label => $label}, shift;
99 my $buffer = shift; # reference to data buffer
100 my $offset = shift || 0; # offset within buffer
101 my $cache = shift || {}; # hashed objectref by offset
102
103 my $buflen = length $$buffer;
104 my $index = $offset;
105
106 while ( $index < $buflen ) {
107 my $header = unpack( "\@$index C", $$buffer )
108 || return wantarray ? ( $self, ++$index ) : $self;
109
110 if ( $header < 0x40 ) { # non-terminal label
111 push @$label, substr( $$buffer, ++$index, $header );
112 $index += $header;
113
114 } elsif ( $header < 0xC0 ) { # deprecated extended label types
115 croak 'unimplemented label type';
116
117 } else { # compression pointer
118 my $link = 0x3FFF & unpack( "\@$index n", $$buffer );
119 croak 'corrupt compression pointer' unless $link < $offset;
120
121 # uncoverable condition false
122 $self->{origin} = $cache->{$link} ||= decode Net::DNS::DomainName( $buffer, $link, $cache );
123 return wantarray ? ( $self, $index + 2 ) : $self;
124 }
125 }
126 croak 'corrupt wire-format data';
127}
128
129
130=head2 encode
131
132 $data = $object->encode;
133
134Returns the wire-format representation of the domain name suitable
135for inclusion in a DNS packet buffer.
136
137=cut
138
139sub encode {
140 join '', map pack( 'C a*', length($_), $_ ), shift->_wire, '';
141}
142
143
144########################################
145
146
# spent 58.9ms within Net::DNS::DomainName::_wire which was called 3006 times, avg 20µs/call: # 1968 times (44.0ms+0s) by Net::DNS::DomainName1035::encode at line 198, avg 22µs/call # 1038 times (14.9ms+0s) by Net::DNS::Domain::name at line 167 of Net/DNS/Domain.pm, avg 14µs/call
sub _wire { ## Generate list of wire-format labels
14730065.27ms my $self = shift;
148
149300611.4ms my $label = $self->{label};
150300658.7ms my $origin = $self->{origin} || return (@$label);
151 return ( @$label, $origin->_wire );
152}
153
154
155########################################
156
157package Net::DNS::DomainName1035;
1582404µs2250µs
# spent 250µs (30+220) within Net::DNS::DomainName1035::BEGIN@158 which was called: # once (30µs+220µs) by Net::DNS::RR::BEGIN@43 at line 158
use base qw(Net::DNS::DomainName);
# spent 250µs making 1 call to Net::DNS::DomainName1035::BEGIN@158 # spent 220µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 220µs
159
160=head1 Net::DNS::DomainName1035
161
162Net::DNS::DomainName1035 implements a subclass of domain name
163objects which are to be encoded using the compressed wire format
164defined in RFC1035.
165
166 use Net::DNS::DomainName;
167
168 $object = new Net::DNS::DomainName1035('compressible.example.com');
169 $data = $object->encode( $offset, $hash );
170
171 ( $object, $next ) = decode Net::DNS::DomainName1035( \$data, $offset );
172
173Note that RFC3597 implies that the RR types defined in RFC1035
174section 3.3 are the only types eligible for compression.
175
176
177=head2 encode
178
179 $data = $object->encode( $offset, $hash );
180
181Returns the wire-format representation of the domain name suitable
182for inclusion in a DNS packet buffer.
183
184The optional arguments are the offset within the packet data where
185the domain name is to be stored and a reference to a hash table used
186to index compressed names within the packet.
187
188If the hash reference is undefined, encode() returns the lowercase
189uncompressed canonical representation defined in RFC2535(8.1).
190
191=cut
192
193
# spent 465ms (395+70.2) within Net::DNS::DomainName1035::encode which was called 1968 times, avg 236µs/call: # 1968 times (395ms+70.2ms) by Net::DNS::Question::encode at line 139 of Net/DNS/Question.pm, avg 236µs/call
sub encode {
19419683.42ms my $self = shift;
19519684.27ms my $offset = shift || 0; # offset in data buffer
19619683.86ms my $hash = shift || return $self->canonical; # hashed offset by name
197
198196835.0ms196844.0ms my @labels = $self->_wire;
# spent 44.0ms making 1968 calls to Net::DNS::DomainName::_wire, avg 22µs/call
19919683.93ms my $data = '';
20019687.48ms while (@labels) {
201834832.3ms my $name = join( '.', @labels );
202
203834816.7ms return $data . pack( 'n', 0xC000 | $hash->{$name} ) if defined $hash->{$name};
204
205834825.6ms my $label = shift @labels;
206834820.6ms my $length = length $label;
2078348100ms834826.2ms $data .= pack( 'C a*', $length, $label );
# spent 26.2ms making 8348 calls to Net::DNS::DomainName1035::CORE:pack, avg 3µs/call
208
209834814.9ms next unless $offset < 0x4000;
210834871.5ms $hash->{$name} = $offset;
211834848.6ms $offset += 1 + $length;
212 }
213196823.6ms13µs $data .= pack 'x';
# spent 3µs making 1 call to main::CORE:pack
214}
215
216
217########################################
218
219package Net::DNS::DomainName2535;
2202196µs2276µs
# spent 276µs (29+248) within Net::DNS::DomainName2535::BEGIN@220 which was called: # once (29µs+248µs) by Net::DNS::RR::BEGIN@43 at line 220
use base qw(Net::DNS::DomainName);
# spent 276µs making 1 call to Net::DNS::DomainName2535::BEGIN@220 # spent 248µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 248µs
221
222=head1 Net::DNS::DomainName2535
223
224Net::DNS::DomainName2535 implements a subclass of domain name
225objects which are to be encoded using uncompressed wire format.
226
227Note that RFC3597, and latterly RFC4034, specifies that the lower
228case canonical encoding defined in RFC2535 is to be used for RR
229types defined prior to RFC3597.
230
231 use Net::DNS::DomainName;
232
233 $object = new Net::DNS::DomainName2535('incompressible.example.com');
234 $data = $object->encode( $offset, $hash );
235
236 ( $object, $next ) = decode Net::DNS::DomainName2535( \$data, $offset );
237
238
239=head2 encode
240
241 $data = $object->encode( $offset, $hash );
242
243Returns the uncompressed wire-format representation of the domain
244name suitable for inclusion in a DNS packet buffer.
245
246If the hash reference is undefined, encode() returns the lowercase
247canonical form defined in RFC2535(8.1).
248
249=cut
250
251sub encode {
252 return shift->canonical unless defined $_[2];
253 join '', map pack( 'C a*', length($_), $_ ), shift->_wire, '';
254}
255
25618µs1;
257__END__
 
# spent 26.2ms within Net::DNS::DomainName1035::CORE:pack which was called 8348 times, avg 3µs/call: # 8348 times (26.2ms+0s) by Net::DNS::DomainName1035::encode at line 207, avg 3µs/call
sub Net::DNS::DomainName1035::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.