File Coverage

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