File Coverage

blib/lib/Net/Frame/Layer/DNS/Question.pm
Criterion Covered Total %
statement 37 42 88.1
branch 4 10 40.0
condition n/a
subroutine 10 11 90.9
pod 6 6 100.0
total 57 69 82.6


line stmt bran cond sub pod time code
1             #
2             # $Id: Question.pm 49 2009-05-31 13:15:34Z VinsWorldcom $
3             #
4             package Net::Frame::Layer::DNS::Question;
5 9     9   14356 use strict; use warnings;
  9     9   22  
  9         323  
  9         50  
  9         15  
  9         292  
6              
7 9     9   2925 use Net::Frame::Layer qw(:consts :subs);
  9         83288  
  9         2139  
8             our @ISA = qw(Net::Frame::Layer Exporter);
9              
10 9     9   843 use Net::Frame::Layer::DNS::Constants qw(:consts);
  9         17  
  9         5469  
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             );
30             __PACKAGE__->cgBuildIndices;
31             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
32              
33 9     9   712 use Net::Frame::Layer::DNS qw(:subs);
  9         13  
  9         4877  
34              
35             sub new {
36             shift->SUPER::new(
37 4     4 1 873 name => '',
38             type => NF_DNS_TYPE_A,
39             class => NF_DNS_CLASS_IN,
40             @_,
41             );
42             }
43              
44             sub getLength {
45 0     0 1 0 my $self = shift;
46            
47             # 1 byte leading length, name, 1 byte trailing null, 2 bytes type, 2 bytes class
48 0 0       0 if (length($self->name) == 0) {
49 0         0 return length($self->name) + 5
50             } else {
51 0         0 return length($self->name) + 6
52             }
53             }
54              
55             sub pack {
56 1     1 1 245 my $self = shift;
57              
58 1         4 my $name = dnsAton($self->name);
59              
60 1 50       5 $self->raw($self->SUPER::pack('H* nn',
61             $name, $self->type, $self->class,
62             )) or return;
63              
64 1         56 return $self->raw;
65             }
66              
67             sub unpack {
68 1     1 1 15 my $self = shift;
69              
70 1         5 my @parts = split /\0/, $self->raw, 2;
71 1         18 my ($name) = dnsNtoa($parts[0]);
72              
73 1 50       20 my ($type, $class, $payload) =
74             $self->SUPER::unpack('nn a*', $parts[1])
75             or return;
76              
77 1         22 $self->name($name);
78 1         11 $self->type($type);
79 1         10 $self->class($class);
80 1         13 $self->payload($payload);
81              
82 1         9 return $self;
83             }
84              
85             sub encapsulate {
86 1     1 1 7 my $self = shift;
87              
88 1 50       9 return $self->nextLayer if $self->nextLayer;
89              
90 1 50       17 if ($self->payload) {
91 0         0 return 'DNS::RR';
92             }
93              
94 1         15 NF_LAYER_NONE;
95             }
96              
97             sub print {
98 1     1 1 6 my $self = shift;
99              
100 1         7 my $l = $self->layer;
101 1         14 my $buf = sprintf
102             "$l: name:%s\n".
103             "$l: type:%d class:%d",
104             $self->name,
105             $self->type, $self->class;
106              
107 1         369 return $buf;
108             }
109              
110             1;
111              
112             __END__