← 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.pm
StatementsExecuted 19 statements in 2.42ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11148µs56µsNet::DNS::::BEGIN@34Net::DNS::BEGIN@34
11127µs275µsNet::DNS::::BEGIN@38Net::DNS::BEGIN@38
11126µs54µsNet::DNS::::BEGIN@35Net::DNS::BEGIN@35
11125µs32µsNet::DNS::::BEGIN@36Net::DNS::BEGIN@36
0000s0sNet::DNS::::SEQUENTIALNet::DNS::SEQUENTIAL
0000s0sNet::DNS::::UNIXTIMENet::DNS::UNIXTIME
0000s0sNet::DNS::::YYYYMMDDxxNet::DNS::YYYYMMDDxx
0000s0sNet::DNS::::mxNet::DNS::mx
0000s0sNet::DNS::::nxdomainNet::DNS::nxdomain
0000s0sNet::DNS::::nxrrsetNet::DNS::nxrrset
0000s0sNet::DNS::::rrNet::DNS::rr
0000s0sNet::DNS::::rr_addNet::DNS::rr_add
0000s0sNet::DNS::::rr_delNet::DNS::rr_del
0000s0sNet::DNS::::rrsortNet::DNS::rrsort
0000s0sNet::DNS::::versionNet::DNS::version
0000s0sNet::DNS::::yxdomainNet::DNS::yxdomain
0000s0sNet::DNS::::yxrrsetNet::DNS::yxrrset
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;
2
3#
4# $Id: DNS.pm 1604 2017-10-18 09:00:29Z willem $
5#
6121µsrequire 5.006;
7our $VERSION;
812µs$VERSION = '1.13';
9146µs$VERSION = eval $VERSION;
# spent 6µs executing statements in string eval
1012µsour $SVNVERSION = (qw$LastChangedRevision: 1604 $)[1];
11
12
13=head1 NAME
14
15Net::DNS - Perl Interface to the Domain Name System
16
17=head1 SYNOPSIS
18
19 use Net::DNS;
20
21=head1 DESCRIPTION
22
23Net::DNS is a collection of Perl modules that act as a Domain Name System
24(DNS) resolver. It allows the programmer to perform DNS queries that are
25beyond the capabilities of "gethostbyname" and "gethostbyaddr".
26
27The programmer should be somewhat familiar with the format of a DNS packet
28and its various sections. See RFC 1035 or DNS and BIND (Albitz & Liu) for
29details.
30
31=cut
32
33
34263µs264µs
# spent 56µs (48+8) within Net::DNS::BEGIN@34 which was called: # once (48µs+8µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@74 at line 34
use strict;
# spent 56µs making 1 call to Net::DNS::BEGIN@34 # spent 8µs making 1 call to strict::import
35276µs281µs
# spent 54µs (26+27) within Net::DNS::BEGIN@35 which was called: # once (26µs+27µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@74 at line 35
use warnings;
# spent 54µs making 1 call to Net::DNS::BEGIN@35 # spent 27µs making 1 call to warnings::import
36267µs239µs
# spent 32µs (25+7) within Net::DNS::BEGIN@36 which was called: # once (25µs+7µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@74 at line 36
use integer;
# spent 32µs making 1 call to Net::DNS::BEGIN@36 # spent 7µs making 1 call to integer::import
37
3821.58ms2523µs
# spent 275µs (27+248) within Net::DNS::BEGIN@38 which was called: # once (27µs+248µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@74 at line 38
use base qw(Exporter);
# spent 275µs making 1 call to Net::DNS::BEGIN@38 # spent 248µs making 1 call to base::import
3915µsour @EXPORT = qw(SEQUENTIAL UNIXTIME YYYYMMDDxx
40 yxrrset nxrrset yxdomain nxdomain rr_add rr_del
41 mx rr rrsort);
42
43
4414µslocal $SIG{__DIE__};
451257µsrequire Net::DNS::Resolver;
4613µsrequire Net::DNS::Packet;
4712µsrequire Net::DNS::RR;
481263µsrequire Net::DNS::Update;
49
50
51sub version { $VERSION; }
52
53
54#
55# rr()
56#
57# Usage:
58# @rr = rr('example.com');
59# @rr = rr('example.com', 'A', 'IN');
60# @rr = rr($res, 'example.com' ... );
61#
62sub rr {
63 my ($arg1) = @_;
64 my $res = ref($arg1) ? shift : new Net::DNS::Resolver();
65
66 my $ans = $res->query(@_);
67 my @list = $ans ? $ans->answer : ();
68}
69
70
71#
72# mx()
73#
74# Usage:
75# @mx = mx('example.com');
76# @mx = mx($res, 'example.com');
77#
78sub mx {
79 my ($arg1) = @_;
80 my @res = ( ref($arg1) ? shift : () );
81 my ( $name, @class ) = @_;
82
83 # This construct is best read backwards.
84 #
85 # First we take the answer section of the packet.
86 # Then we take just the MX records from that list
87 # Then we sort the list by preference
88 # We do this into an array to force list context.
89 # Then we return the list.
90
91 my @list = sort { $a->preference <=> $b->preference }
92 grep $_->type eq 'MX', &rr( @res, $name, 'MX', @class );
93 return @list;
94}
95
96
97#
98# rrsort()
99#
100# Usage:
101# @prioritysorted = rrsort( "SRV", "priority", @rr_array );
102#
103sub rrsort {
104 my $rrtype = uc shift;
105 my ( $attribute, @rr ) = @_; ## NB: attribute is optional
106 ( @rr, $attribute ) = @_ if ref($attribute) =~ /^Net::DNS::RR/;
107
108 my @extracted = grep $_->type eq $rrtype, @rr;
109 return @extracted unless scalar @extracted;
110 my $func = "Net::DNS::RR::$rrtype"->get_rrsort_func($attribute);
111 my @sorted = sort $func @extracted;
112}
113
114
115#
116# Auxiliary functions to support policy-driven zone serial numbering.
117#
118# $successor = $soa->serial(SEQUENTIAL);
119# $successor = $soa->serial(UNIXTIME);
120# $successor = $soa->serial(YYYYMMDDxx);
121#
122
123sub SEQUENTIAL {undef}
124
125sub UNIXTIME { return CORE::time; }
126
127sub YYYYMMDDxx {
128 my ( $dd, $mm, $yy ) = (localtime)[3 .. 5];
129 return 1900010000 + sprintf '%d%0.2d%0.2d00', $yy, $mm, $dd;
130}
131
132
133#
134# Auxiliary functions to support dynamic update.
135#
136
137sub yxrrset {
138 my $rr = new Net::DNS::RR(@_);
139 $rr->ttl(0);
140 $rr->class('ANY') unless $rr->rdata;
141 return $rr;
142}
143
144sub nxrrset {
145 my $rr = new Net::DNS::RR(@_);
146 new Net::DNS::RR(
147 name => $rr->name,
148 type => $rr->type,
149 class => 'NONE'
150 );
151}
152
153sub yxdomain {
154 my ( $domain, @etc ) = map split, @_;
155 my $rr = new Net::DNS::RR( scalar(@etc) ? @_ : ( name => $domain ) );
156 new Net::DNS::RR(
157 name => $rr->name,
158 type => 'ANY',
159 class => 'ANY'
160 );
161}
162
163sub nxdomain {
164 my ( $domain, @etc ) = map split, @_;
165 my $rr = new Net::DNS::RR( scalar(@etc) ? @_ : ( name => $domain ) );
166 new Net::DNS::RR(
167 name => $rr->name,
168 type => 'ANY',
169 class => 'NONE'
170 );
171}
172
173sub rr_add {
174 my $rr = new Net::DNS::RR(@_);
175 $rr->{ttl} = 86400 unless defined $rr->{ttl};
176 return $rr;
177}
178
179sub rr_del {
180 my ( $domain, @etc ) = map split, @_;
181 my $rr = new Net::DNS::RR( scalar(@etc) ? @_ : ( name => $domain, type => 'ANY' ) );
182 $rr->class( $rr->rdata ? 'NONE' : 'ANY' );
183 $rr->ttl(0);
184 return $rr;
185}
186
187
188132µs1;
189__END__