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