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