File Coverage

blib/lib/Net/DNS/RR/TKEY.pm
Criterion Covered Total %
statement 84 84 100.0
branch 6 6 100.0
condition 14 14 100.0
subroutine 21 21 100.0
pod 9 10 100.0
total 134 135 100.0


line stmt bran cond sub pod time code
1             package Net::DNS::RR::TKEY;
2              
3 1     1   7 use strict;
  1         2  
  1         34  
4 1     1   4 use warnings;
  1         2  
  1         45  
5             our $VERSION = (qw$Id: TKEY.pm 1908 2023-03-15 07:28:50Z willem $)[2];
6              
7 1     1   6 use base qw(Net::DNS::RR);
  1         3  
  1         108  
8              
9              
10             =head1 NAME
11              
12             Net::DNS::RR::TKEY - DNS TKEY resource record
13              
14             =cut
15              
16 1     1   8 use integer;
  1         1  
  1         6  
17              
18 1     1   37 use Carp;
  1         2  
  1         81  
19              
20 1     1   8 use Net::DNS::Parameters qw(:class :type);
  1         2  
  1         207  
21 1     1   10 use Net::DNS::DomainName;
  1         1  
  1         41  
22              
23 1     1   4 use constant ANY => classbyname qw(ANY);
  1         9  
  1         6  
24 1     1   6 use constant TKEY => typebyname qw(TKEY);
  1         2  
  1         3  
25              
26              
27             sub _decode_rdata { ## decode rdata from wire-format octet string
28 3     3   6 my ( $self, $data, $offset ) = @_;
29              
30 3         6 my $limit = $offset + $self->{rdlength};
31              
32 3         17 ( $self->{algorithm}, $offset ) = Net::DNS::DomainName->decode( $data, $offset );
33              
34 3         11 @{$self}{qw(inception expiration mode error)} = unpack "\@$offset N2n2", $$data;
  3         11  
35 3         5 $offset += 12;
36              
37 3         6 my $key_size = unpack "\@$offset n", $$data;
38 3         7 $self->{key} = substr $$data, $offset + 2, $key_size;
39 3         7 $offset += $key_size + 2;
40              
41 3         5 my $other_size = unpack "\@$offset n", $$data;
42 3         16 $self->{other} = substr $$data, $offset + 2, $other_size;
43 3         4 $offset += $other_size + 2;
44              
45 3 100       264 croak('corrupt TKEY data') unless $offset == $limit; # more or less FUBAR
46 2         5 return;
47             }
48              
49              
50             sub _encode_rdata { ## encode rdata as wire-format octet string
51 11     11   14 my $self = shift;
52              
53 11 100       43 return '' unless defined $self->{algorithm};
54 9         25 my $rdata = $self->{algorithm}->encode;
55              
56 9         21 $rdata .= pack 'N2n2', $self->inception, $self->expiration, $self->mode, $self->error;
57              
58 9         18 my $key = $self->key; # RFC2930(2.7)
59 9         24 $rdata .= pack 'na*', length $key, $key;
60              
61 9         15 my $other = $self->other; # RFC2930(2.8)
62 9         20 $rdata .= pack 'na*', length $other, $other;
63 9         38 return $rdata;
64             }
65              
66              
67             sub class { ## override RR method
68 2     2 1 12 return 'ANY';
69             }
70              
71             sub encode { ## override RR method
72 6     6 1 720 my $self = shift;
73              
74 6         19 my $owner = $self->{owner}->encode();
75 6   100     9 my $rdata = eval { $self->_encode_rdata() } || '';
76 6         42 return pack 'a* n2 N n a*', $owner, TKEY, ANY, 0, length $rdata, $rdata;
77             }
78              
79              
80             sub algorithm {
81 3     3 1 13 my ( $self, @value ) = @_;
82 3         6 for (@value) { $self->{algorithm} = Net::DNS::DomainName->new($_) }
  1         7  
83 3 100       27 return $self->{algorithm} ? $self->{algorithm}->name : undef;
84             }
85              
86              
87             sub inception {
88 12     12 1 1122 my ( $self, @value ) = @_;
89 12         24 for (@value) { $self->{inception} = 0 + $_ }
  1         3  
90 12   100     39 return $self->{inception} || 0;
91             }
92              
93              
94             sub expiration {
95 12     12 1 1145 my ( $self, @value ) = @_;
96 12         19 for (@value) { $self->{expiration} = 0 + $_ }
  1         3  
97 12   100     37 return $self->{expiration} || 0;
98             }
99              
100              
101             sub mode {
102 12     12 1 1073 my ( $self, @value ) = @_;
103 12         19 for (@value) { $self->{mode} = 0 + $_ }
  1         3  
104 12   100     41 return $self->{mode} || 0;
105             }
106              
107              
108             sub error {
109 12     12 1 1075 my ( $self, @value ) = @_;
110 12         21 for (@value) { $self->{error} = 0 + $_ }
  1         2  
111 12   100     49 return $self->{error} || 0;
112             }
113              
114              
115             sub key {
116 12     12 1 1054 my ( $self, @value ) = @_;
117 12         18 for (@value) { $self->{key} = $_ }
  1         3  
118 12   100     39 return $self->{key} || "";
119             }
120              
121              
122             sub other {
123 14     14 1 1403 my ( $self, @value ) = @_;
124 14         26 for (@value) { $self->{other} = $_ }
  1         2  
125 14   100     52 return $self->{other} || "";
126             }
127              
128              
129 2     2 0 651 sub other_data { return &other; } # uncoverable pod
130              
131              
132             1;
133             __END__