File Coverage

blib/lib/Net/DNS/RR/ZONEMD.pm
Criterion Covered Total %
statement 58 58 100.0
branch 4 4 100.0
condition 10 10 100.0
subroutine 15 15 100.0
pod 5 5 100.0
total 92 92 100.0


line stmt bran cond sub pod time code
1             package Net::DNS::RR::ZONEMD;
2              
3 2     2   15 use strict;
  2         3  
  2         63  
4 2     2   9 use warnings;
  2         4  
  2         131  
5             our $VERSION = (qw$Id: ZONEMD.pm 1896 2023-01-30 12:59:25Z willem $)[2];
6              
7 2     2   14 use base qw(Net::DNS::RR);
  2         5  
  2         217  
8              
9              
10             =head1 NAME
11              
12             Net::DNS::RR::ZONEMD - DNS ZONEMD resource record
13              
14             =cut
15              
16 2     2   15 use integer;
  2         5  
  2         14  
17              
18 2     2   68 use Carp;
  2         7  
  2         1540  
19              
20              
21             sub _decode_rdata { ## decode rdata from wire-format octet string
22 4     4   12 my ( $self, $data, $offset ) = @_;
23              
24 4         15 my $rdata = substr $$data, $offset, $self->{rdlength};
25 4         19 @{$self}{qw(serial scheme algorithm digestbin)} = unpack 'NC2a*', $rdata;
  4         18  
26 4         12 return;
27             }
28              
29              
30             sub _encode_rdata { ## encode rdata as wire-format octet string
31 5     5   7 my $self = shift;
32              
33 5         7 return pack 'NC2a*', @{$self}{qw(serial scheme algorithm digestbin)};
  5         17  
34             }
35              
36              
37             sub _format_rdata { ## format rdata portion of RR string.
38 7     7   9 my $self = shift;
39              
40 7   100     10 my @digest = split /(\S{64})/, $self->digest || qq("");
41 7         10 my @rdata = ( @{$self}{qw(serial scheme algorithm)}, @digest );
  7         16  
42 7         18 return @rdata;
43             }
44              
45              
46             sub _parse_rdata { ## populate RR from rdata in argument list
47 4     4   10 my ( $self, @argument ) = @_;
48              
49 4         11 for (qw(serial scheme algorithm)) { $self->$_( shift @argument ) }
  12         28  
50 4         12 $self->digest(@argument);
51 4         9 return;
52             }
53              
54              
55             sub _defaults { ## specify RR attribute default values
56 2     2   3 my $self = shift;
57              
58 2         10 $self->_parse_rdata( 0, 1, 1, '' );
59 2         5 return;
60             }
61              
62              
63             sub serial {
64 7     7 1 19 my ( $self, @value ) = @_;
65 7         9 for (@value) { $self->{serial} = 0 + $_ }
  5         19  
66 7   100     32 return $self->{serial} || 0;
67             }
68              
69              
70             sub scheme {
71 8     8 1 676 my ( $self, @value ) = @_;
72 8         11 for (@value) { $self->{scheme} = 0 + $_ }
  6         10  
73 8   100     32 return $self->{scheme} || 0;
74             }
75              
76              
77             sub algorithm {
78 7     7 1 665 my ( $self, @value ) = @_;
79 7         13 for (@value) { $self->{algorithm} = 0 + $_ }
  5         10  
80 7   100     24 return $self->{algorithm} || 0;
81             }
82              
83              
84             sub digest {
85 15     15 1 917 my ( $self, @value ) = @_;
86 15 100       34 return unpack "H*", $self->digestbin() unless scalar @value;
87 6 100       12 my @hex = map { /^"*([\dA-Fa-f]*)"*$/ || croak("corrupt hex"); $1 } @value;
  6         208  
  5         22  
88 5         30 return $self->digestbin( pack "H*", join "", @hex );
89             }
90              
91              
92             sub digestbin {
93 18     18 1 681 my ( $self, @value ) = @_;
94 18         26 for (@value) { $self->{digestbin} = $_ }
  6         12  
95 18   100     90 return $self->{digestbin} || "";
96             }
97              
98              
99             1;
100             __END__