File Coverage

blib/lib/Net/DNS/RR/TLSA.pm
Criterion Covered Total %
statement 63 63 100.0
branch 4 4 100.0
condition 8 8 100.0
subroutine 17 17 100.0
pod 7 7 100.0
total 99 99 100.0


line stmt bran cond sub pod time code
1             package Net::DNS::RR::TLSA;
2              
3 2     2   12 use strict;
  2         4  
  2         63  
4 2     2   9 use warnings;
  2         7  
  2         104  
5             our $VERSION = (qw$Id: TLSA.pm 1896 2023-01-30 12:59:25Z willem $)[2];
6              
7 2     2   11 use base qw(Net::DNS::RR);
  2         4  
  2         185  
8              
9              
10             =head1 NAME
11              
12             Net::DNS::RR::TLSA - DNS TLSA resource record
13              
14             =cut
15              
16 2     2   12 use integer;
  2         45  
  2         18  
17              
18 2     2   77 use Carp;
  2         5  
  2         188  
19 2     2   22 use constant BABBLE => defined eval { require Digest::BubbleBabble };
  2         5  
  2         4  
  2         966  
20              
21              
22             sub _decode_rdata { ## decode rdata from wire-format octet string
23 13     13   33 my ( $self, $data, $offset ) = @_;
24              
25 13         28 my $next = $offset + $self->{rdlength};
26              
27 13         50 @{$self}{qw(usage selector matchingtype)} = unpack "\@$offset C3", $$data;
  13         53  
28 13         23 $offset += 3;
29 13         46 $self->{certbin} = substr $$data, $offset, $next - $offset;
30 13         41 return;
31             }
32              
33              
34             sub _encode_rdata { ## encode rdata as wire-format octet string
35 5     5   9 my $self = shift;
36              
37 5         7 return pack 'C3 a*', @{$self}{qw(usage selector matchingtype certbin)};
  5         21  
38             }
39              
40              
41             sub _format_rdata { ## format rdata portion of RR string.
42 2     2   5 my $self = shift;
43              
44 2         5 $self->_annotation( $self->babble ) if BABBLE;
45 2         7 my @cert = split /(\S{64})/, $self->cert;
46 2         7 my @rdata = ( $self->usage, $self->selector, $self->matchingtype, @cert );
47 2         9 return @rdata;
48             }
49              
50              
51             sub _parse_rdata { ## populate RR from rdata in argument list
52 1     1   3 my ( $self, @argument ) = @_;
53              
54 1         3 for (qw(usage selector matchingtype)) { $self->$_( shift @argument ) }
  3         9  
55 1         3 $self->cert(@argument);
56 1         3 return;
57             }
58              
59              
60             sub usage {
61 6     6 1 18 my ( $self, @value ) = @_;
62 6         10 for (@value) { $self->{usage} = 0 + $_ }
  2         4  
63 6   100     36 return $self->{usage} || 0;
64             }
65              
66              
67             sub selector {
68 6     6 1 1128 my ( $self, @value ) = @_;
69 6         18 for (@value) { $self->{selector} = 0 + $_ }
  2         4  
70 6   100     40 return $self->{selector} || 0;
71             }
72              
73              
74             sub matchingtype {
75 6     6 1 1090 my ( $self, @value ) = @_;
76 6         10 for (@value) { $self->{matchingtype} = 0 + $_ }
  2         6  
77 6   100     29 return $self->{matchingtype} || 0;
78             }
79              
80              
81             sub cert {
82 7     7 1 15 my ( $self, @value ) = @_;
83 7 100       21 return unpack "H*", $self->certbin() unless scalar @value;
84 3 100       6 my @hex = map { /^"*([\dA-Fa-f]*)"*$/ || croak("corrupt hex"); $1 } @value;
  4         237  
  3         15  
85 2         16 return $self->certbin( pack "H*", join "", @hex );
86             }
87              
88              
89             sub certbin {
90 12     12 1 670 my ( $self, @value ) = @_;
91 12         22 for (@value) { $self->{certbin} = $_ }
  2         5  
92 12   100     78 return $self->{certbin} || "";
93             }
94              
95              
96 4     4 1 1511 sub certificate { return &cert; }
97              
98              
99             sub babble {
100 4     4 1 1078 return BABBLE ? Digest::BubbleBabble::bubblebabble( Digest => shift->certbin ) : '';
101             }
102              
103              
104             1;
105             __END__