File Coverage

blib/lib/Mail/Message/Field/DKIM.pm
Criterion Covered Total %
statement 42 47 89.3
branch 1 2 50.0
condition n/a
subroutine 22 25 88.0
pod 19 20 95.0
total 84 94 89.3


line stmt bran cond sub pod time code
1             # Copyrights 2001-2022 by [Mark Overmeer ].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.03.
5             # This code is part of distribution Mail-Message. Meta-POD processed with
6             # OODoc into POD and HTML manual-pages. See README.md
7             # Copyright Mark Overmeer. Licensed under the same terms as Perl itself.
8              
9             package Mail::Message::Field::DKIM;
10 21     21   661 use vars '$VERSION';
  21         45  
  21         1091  
11             $VERSION = '3.012';
12              
13 21     21   123 use base 'Mail::Message::Field::Structured';
  21         38  
  21         2349  
14              
15 21     21   129 use warnings;
  21         36  
  21         502  
16 21     21   97 use strict;
  21         42  
  21         398  
17              
18 21     21   594 use URI;
  21         4236  
  21         12680  
19              
20              
21             sub init($)
22 1     1 0 4 { my ($self, $args) = @_;
23 1         57 $self->{MMFD_tags} = { v => 1, a => 'rsa-sha256' };
24 1         5 $self->SUPER::init($args);
25             }
26              
27             sub parse($)
28 1     1 1 3 { my ($self, $string) = @_;
29              
30 1         3 my $tags = $self->{MMFD_tags};
31              
32 1         7 foreach (split /\;/, $string)
33 13 50       68 { m/^\s*([a-z][a-z0-9_]*)\s*\=\s*([\s\x21-\x7E]+?)\s*$/is or next;
34             # tag-values stay unparsed (for now)
35 13         24 $self->addTag($1, $2);
36             }
37              
38 1         42 (undef, $string) = $self->consumeComment($string);
39              
40 1         2 $self;
41             }
42              
43             sub produceBody()
44 0     0 1 0 { my $self = shift;
45             }
46              
47             #------------------------------------------
48              
49              
50              
51             sub addAttribute($;@)
52 0     0 1 0 { my $self = shift;
53 0         0 $self->log(ERROR => 'No attributes for DKIM headers.');
54 0         0 $self;
55             }
56              
57              
58             sub addTag($$)
59 13     13 1 24 { my ($self, $name) = (shift, lc shift);
60 13         34 $self->{MMFD_tags}{$name} = join ' ', @_;
61 13         70 $self;
62             }
63              
64              
65 13     13 1 58 sub tag($) { $_[0]->{MMFD_tags}{lc $_[1]} }
66              
67              
68             #------------------------------------------
69              
70 1     1 1 4 sub tagAlgorithm() { shift->tag('a') }
71 1     1 1 4 sub tagSignData() { shift->tag('b') }
72 1     1 1 4 sub tagSignature() { shift->tag('bh') }
73 1     1 1 4 sub tagC14N() { shift->tag('c') }
74 1     1 1 3 sub tagDomain() { shift->tag('d') }
75 1     1 1 3 sub tagSignedHeaders() { shift->tag('h') }
76 1     1 1 4 sub tagAgentID() { shift->tag('i') }
77 0     0 1 0 sub tagBodyLength(){ shift->tag('l') }
78 1     1 1 4 sub tagQueryMethods() { shift->tag('q') }
79 1     1 1 4 sub tagSelector() { shift->tag('s') }
80 1     1 1 4 sub tagTimestamp() { shift->tag('t') }
81 1     1 1 4 sub tagExpires() { shift->tag('x') }
82 1     1 1 989 sub tagVersion() { shift->tag('v') }
83 1     1 1 4 sub tagExtract() { shift->tag('z') }
84              
85             #------------------------------------------
86              
87              
88             1;