File Coverage

blib/lib/Net/DNS/RR/NSEC.pm
Criterion Covered Total %
statement 129 129 100.0
branch 18 18 100.0
condition 9 9 100.0
subroutine 23 23 100.0
pod 8 10 100.0
total 187 189 100.0


line stmt bran cond sub pod time code
1             package Net::DNS::RR::NSEC;
2              
3 14     14   2556 use strict;
  14         34  
  14         429  
4 14     14   88 use warnings;
  14         30  
  14         681  
5             our $VERSION = (qw$Id: NSEC.pm 1896 2023-01-30 12:59:25Z willem $)[2];
6              
7 14     14   92 use base qw(Net::DNS::RR);
  14         30  
  14         1318  
8              
9              
10             =head1 NAME
11              
12             Net::DNS::RR::NSEC - DNS NSEC resource record
13              
14             =cut
15              
16 14     14   103 use integer;
  14         28  
  14         166  
17              
18 14     14   562 use Net::DNS::DomainName;
  14         43  
  14         533  
19 14     14   80 use Net::DNS::Parameters qw(:type);
  14         30  
  14         23873  
20              
21              
22             sub _decode_rdata { ## decode rdata from wire-format octet string
23 1     1   2 my ( $self, $data, $offset ) = @_;
24              
25 1         2 my $limit = $offset + $self->{rdlength};
26 1         4 ( $self->{nxtdname}, $offset ) = Net::DNS::DomainName->decode( $data, $offset );
27 1         4 $self->{typebm} = substr $$data, $offset, $limit - $offset;
28 1         3 return;
29             }
30              
31              
32             sub _encode_rdata { ## encode rdata as wire-format octet string
33 20     20   28 my $self = shift;
34              
35 20         30 my $nxtdname = $self->{nxtdname};
36 20         53 return join '', $nxtdname->encode(), $self->{typebm};
37             }
38              
39              
40             sub _format_rdata { ## format rdata portion of RR string.
41 3     3   5 my $self = shift;
42              
43 3         13 my $nxtdname = $self->{nxtdname};
44 3         10 return ( $nxtdname->string(), $self->typelist );
45             }
46              
47              
48             sub _parse_rdata { ## populate RR from rdata in argument list
49 40     40   99 my ( $self, @argument ) = @_;
50              
51 40         112 $self->nxtdname( shift @argument );
52 40         105 $self->typelist(@argument);
53 40         88 return;
54             }
55              
56              
57             sub _defaults { ## specify RR attribute default values
58 5     5   10 my $self = shift;
59              
60 5         16 $self->_parse_rdata('.');
61 5         11 return;
62             }
63              
64              
65             sub nxtdname {
66 44     44 1 84 my ( $self, @value ) = @_;
67 44         83 for (@value) { $self->{nxtdname} = Net::DNS::DomainName->new($_) }
  42         139  
68 44 100       206 return $self->{nxtdname} ? $self->{nxtdname}->name : undef;
69             }
70              
71              
72             sub typelist {
73 244     244 1 6848 my ( $self, @argument ) = @_;
74              
75 244 100 100     723 if ( scalar(@argument) || !defined(wantarray) ) {
76 229         1484 $self->{typebm} = &_type2bm(@argument);
77 229         535 return;
78             }
79              
80 15         38 my @type = &_bm2type( $self->{typebm} );
81 15 100       139 return wantarray ? (@type) : "@type";
82             }
83              
84              
85             sub typemap {
86 126     126 1 517 my ( $self, $type ) = @_;
87              
88 126         274 my $number = typebyname($type);
89 126         217 my $window = $number >> 8;
90 126         178 my $bitnum = $number & 255;
91              
92 126   100     280 my $typebm = $self->{typebm} || return;
93 125         163 my @bitmap;
94 125         182 my $index = 0;
95 125         272 while ( $index < length $typebm ) {
96 125         426 my ( $block, $size ) = unpack "\@$index C2", $typebm;
97 125         396 $bitmap[$block] = unpack "\@$index xxa$size", $typebm;
98 125         317 $index += $size + 2;
99             }
100              
101 125   100     968 my @bit = split //, unpack 'B*', ( $bitmap[$window] || return );
102 124         760 return $bit[$bitnum];
103             }
104              
105              
106             sub match {
107 8     8 1 2215 my ( $self, $qname ) = @_;
108 8         29 my $name = Net::DNS::DomainName->new($qname)->canonical;
109 8         24 return $name eq $self->{owner}->canonical;
110             }
111              
112              
113             sub covers {
114 29     29 1 112 my ( $self, $qname ) = @_;
115 29         69 my $name = join chr(0), reverse Net::DNS::DomainName->new($qname)->_wire;
116 29         80 my $this = join chr(0), reverse $self->{owner}->_wire;
117 29         68 my $next = join chr(0), reverse $self->{nxtdname}->_wire;
118 29         59 foreach ( $name, $this, $next ) {tr /\101-\132/\141-\172/}
  87         153  
119              
120 29 100       95 return ( $name cmp $this ) + ( "$next\001" cmp $name ) == 2 unless $next gt $this;
121 23         128 return ( $name cmp $this ) + ( $next cmp $name ) == 2;
122             }
123              
124              
125             sub encloser {
126 42     42 1 5784 my ( $self, $qname ) = @_;
127 42         97 my @label = Net::DNS::Domain->new($qname)->label;
128              
129 42         99 my @owner = $self->{owner}->label;
130 42         63 my $depth = scalar(@owner);
131 42         52 my $next;
132 42         82 while ( scalar(@label) > $depth ) {
133 36         72 $next = shift @label;
134             }
135              
136 42 100       96 return unless defined $next;
137              
138 20         40 my $nextcloser = join( '.', $next, @label );
139 20 100       63 return if lc($nextcloser) ne lc( join '.', $next, @owner );
140              
141 12         19 $self->{nextcloser} = $nextcloser;
142 12         23 $self->{wildcard} = join( '.', '*', @label );
143 12         35 return $self->owner;
144             }
145              
146              
147 2     2 1 9 sub nextcloser { return shift->{nextcloser}; }
148              
149 2     2 1 10 sub wildcard { return shift->{wildcard}; }
150              
151              
152             ########################################
153              
154             sub _type2bm {
155 229     229   473 my @typelist = @_;
156 229         324 my @typearray;
157 229         439 foreach my $typename ( map { split() } @typelist ) {
  291         989  
158 302         693 my $number = typebyname($typename);
159 302         544 my $window = $number >> 8;
160 302         437 my $bitnum = $number & 255;
161 302         406 my $octet = $bitnum >> 3;
162 302         378 my $bit = $bitnum & 7;
163 302         832 $typearray[$window][$octet] |= 0x80 >> $bit;
164             }
165              
166 229         428 my $bitmap = '';
167 229         1301 my $window = 0;
168 229         404 foreach (@typearray) {
169 234 100       511 if ( my $pane = $typearray[$window] ) {
170 214 100       403 my @content = map { $_ || 0 } @$pane;
  844         2059  
171 214         906 $bitmap .= pack 'CC C*', $window, scalar(@content), @content;
172             }
173 234         463 $window++;
174             }
175              
176 229         648 return $bitmap;
177             }
178              
179              
180             sub _bm2type {
181 15     15   24 my @empty;
182 15   100     37 my $bitmap = shift || return @empty;
183              
184 13         21 my $index = 0;
185 13         18 my $limit = length $bitmap;
186 13         16 my @typelist;
187              
188 13         37 while ( $index < $limit ) {
189 13         54 my ( $block, $size ) = unpack "\@$index C2", $bitmap;
190 13         32 my $typenum = $block << 8;
191 13         39 foreach my $octet ( unpack "\@$index xxC$size", $bitmap ) {
192 69         87 my $i = $typenum += 8;
193 69         81 my @name;
194 69         121 while ($octet) {
195 155         176 --$i;
196 155 100       277 unshift @name, typebyval($i) if $octet & 1;
197 155         260 $octet = $octet >> 1;
198             }
199 69         120 push @typelist, @name;
200             }
201 13         40 $index += $size + 2;
202             }
203              
204 13         43 return @typelist;
205             }
206              
207              
208             sub typebm { ## historical
209 1     1 0 5 my ( $self, @typebm ) = @_; # uncoverable pod
210 1         2 for (@typebm) { $self->{typebm} = $_ }
  1         2  
211 1         8 $self->_deprecate('prefer $rr->typelist() or $rr->typemap()');
212 1         6 return $self->{typebm};
213             }
214              
215             sub covered { ## historical
216 1     1 0 21 my ( $self, @argument ) = @_; # uncoverable pod
217 1         3 return $self->covers(@argument);
218             }
219              
220             ########################################
221              
222              
223             1;
224             __END__