File Coverage

blib/lib/Net/DNS/RR/TKEY.pm
Criterion Covered Total %
statement 83 83 100.0
branch 6 6 100.0
condition 14 14 100.0
subroutine 20 20 100.0
pod 8 9 100.0
total 131 132 100.0


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