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