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