File Coverage

blib/lib/Net/Frame/Layer/DNS/RR.pm
Criterion Covered Total %
statement 72 92 78.2
branch 5 36 13.8
condition 1 3 33.3
subroutine 21 22 95.4
pod 6 6 100.0
total 105 159 66.0


line stmt bran cond sub pod time code
1             #
2             # $Id: RR.pm 49 2009-05-31 13:15:34Z VinsWorldcom $
3             #
4             package Net::Frame::Layer::DNS::RR;
5 6     6   12650 use strict; use warnings;
  6     6   12  
  6         177  
  6         29  
  6         10  
  6         170  
6              
7 6     6   829 use Net::Frame::Layer qw(:consts :subs);
  6         70232  
  6         1320  
8             our @ISA = qw(Net::Frame::Layer Exporter);
9              
10 6     6   736 use Net::Frame::Layer::DNS::Constants qw(:consts);
  6         10  
  6         3670  
11             my @consts;
12             for my $c (sort(keys(%constant::declared))) {
13             if ($c =~ /^Net::Frame::Layer::DNS::Constants::/) {
14             $c =~ s/^Net::Frame::Layer::DNS::Constants:://;
15             push @consts, $c
16             }
17             }
18             our %EXPORT_TAGS = (
19             consts => [@consts]
20             );
21             our @EXPORT_OK = (
22             @{$EXPORT_TAGS{consts}},
23             );
24              
25             our @AS = qw(
26             name
27             type
28             class
29             ttl
30             rdlength
31             rdata
32             );
33             __PACKAGE__->cgBuildIndices;
34             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
35              
36 6     6   628 use Net::Frame::Layer::DNS qw(:subs);
  6         16  
  6         676  
37 6     6   3786 use Net::Frame::Layer::DNS::RR::A;
  6         16  
  6         309  
38 6     6   3635 use Net::Frame::Layer::DNS::RR::AAAA;
  6         14  
  6         229  
39 6     6   3364 use Net::Frame::Layer::DNS::RR::CNAME;
  6         17  
  6         243  
40 6     6   3740 use Net::Frame::Layer::DNS::RR::HINFO;
  6         13  
  6         244  
41 6     6   3410 use Net::Frame::Layer::DNS::RR::MX;
  6         14  
  6         257  
42 6     6   3450 use Net::Frame::Layer::DNS::RR::NS;
  6         14  
  6         243  
43 6     6   3524 use Net::Frame::Layer::DNS::RR::PTR;
  6         16  
  6         228  
44 6     6   3612 use Net::Frame::Layer::DNS::RR::rdata;
  6         15  
  6         237  
45 6     6   3432 use Net::Frame::Layer::DNS::RR::SOA;
  6         12  
  6         244  
46 6     6   3482 use Net::Frame::Layer::DNS::RR::SRV;
  6         17  
  6         252  
47 6     6   3916 use Net::Frame::Layer::DNS::RR::TXT;
  6         16  
  6         4662  
48              
49             sub new {
50             shift->SUPER::new(
51 1     1 1 27 name => 'localhost',
52             type => NF_DNS_TYPE_A,
53             class => NF_DNS_CLASS_IN,
54             ttl => 0,
55             rdlength => 0,
56             rdata => '',
57             @_,
58             );
59             }
60              
61             sub getLength {
62 0     0 1 0 my $self = shift;
63              
64             # 1 byte leading length, name, 1 byte trailing null, 2 bytes type, 2 bytes class
65             # 4 bytes ttl, 2 bytes rdlength, rdata
66 0 0       0 if (length($self->name) == 0) {
67 0         0 return length($self->name) + 11 + length($self->rdata)
68             } else {
69 0         0 return length($self->name) + 12 + length($self->rdata)
70             }
71             }
72              
73             sub pack {
74 1     1 1 300 my $self = shift;
75              
76 1         5 my $name = dnsAton($self->name);
77              
78 1 50 33     5 if (($self->rdlength == 0) && (length($self->rdata) > 0)) {
79 0         0 $self->rdlength(length($self->rdata))
80             }
81              
82 1 50       33 $self->raw($self->SUPER::pack('H* nnNn a*',
83             $name, $self->type, $self->class, $self->ttl, $self->rdlength, $self->rdata
84             )) or return;
85              
86 1         79 return $self->raw;
87             }
88              
89             sub unpack {
90 1     1 1 11 my $self = shift;
91              
92 1         3 my ($name, $ptr1) = dnsNtoa($self->raw);
93              
94 1 50       9 my ($type, $class, $ttl, $rdlength, $payload) =
95             $self->SUPER::unpack('nnNn a*', (substr $self->raw, $ptr1))
96             or return;
97              
98 1         32 $self->name($name);
99 1         10 $self->type($type);
100 1         10 $self->class($class);
101 1         10 $self->ttl($ttl);
102 1         8 $self->rdlength($rdlength);
103              
104 1         12 $self->payload($payload);
105              
106 1         9 return $self;
107             }
108              
109             sub encapsulate {
110 1     1 1 6 my $self = shift;
111              
112 1 50       8 return $self->nextLayer if $self->nextLayer;
113              
114 1 50       16 if ($self->payload) {
115 0 0       0 if ($self->rdlength == 0) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
116 0         0 return "DNS::RR"
117             } elsif ($self->type == NF_DNS_TYPE_A) {
118 0         0 return "DNS::RR::A"
119             } elsif ($self->type == NF_DNS_TYPE_AAAA) {
120 0         0 return "DNS::RR::AAAA"
121             } elsif ($self->type == NF_DNS_TYPE_CNAME) {
122 0         0 return "DNS::RR::CNAME"
123             } elsif ($self->type == NF_DNS_TYPE_HINFO) {
124 0         0 return "DNS::RR::HINFO"
125             } elsif ($self->type == NF_DNS_TYPE_MX) {
126 0         0 return "DNS::RR::MX"
127             } elsif ($self->type == NF_DNS_TYPE_NS) {
128 0         0 return "DNS::RR::NS"
129             } elsif ($self->type == NF_DNS_TYPE_PTR) {
130 0         0 return "DNS::RR::PTR"
131             } elsif ($self->type == NF_DNS_TYPE_SOA) {
132 0         0 return "DNS::RR::SOA"
133             } elsif ($self->type == NF_DNS_TYPE_SRV) {
134 0         0 return "DNS::RR::SRV"
135             } elsif ($self->type == NF_DNS_TYPE_TXT) {
136 0         0 return "DNS::RR::TXT"
137             } else {
138             # must include rdlength on calls to DNS::RR::rdata
139 0 0       0 my $temp = $self->SUPER::pack('n a*',
140             $self->rdlength, $self->payload
141             ) or return;
142 0         0 $self->payload($temp);
143 0         0 return "DNS::RR::rdata"
144             }
145             }
146              
147 1         14 NF_LAYER_NONE;
148             }
149              
150             sub print {
151 1     1 1 5 my $self = shift;
152              
153 1         8 my $l = $self->layer;
154 1         14 my $buf = sprintf
155             "$l: name:%s\n".
156             "$l: type:%d class:%d ttl:%d rdlength:%d",
157             $self->name,
158             $self->type, $self->class, $self->ttl, $self->rdlength;
159              
160 1         352 return $buf;
161             }
162              
163             1;
164              
165             __END__