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-2021 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.02.
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   808 use vars '$VERSION';
  21         50  
  21         1349  
11             $VERSION = '3.011';
12              
13 21     21   133 use base 'Mail::Message::Field::Structured';
  21         48  
  21         2993  
14              
15 21     21   148 use warnings;
  21         46  
  21         688  
16 21     21   119 use strict;
  21         42  
  21         469  
17              
18 21     21   808 use URI;
  21         5419  
  21         15581  
19              
20              
21             sub init($)
22 1     1 0 3 { my ($self, $args) = @_;
23 1         61 $self->{MMFD_tags} = { v => 1, a => 'rsa-sha256' };
24 1         7 $self->SUPER::init($args);
25             }
26              
27             sub parse($)
28 1     1 1 3 { my ($self, $string) = @_;
29              
30 1         2 my $tags = $self->{MMFD_tags};
31              
32 1         8 foreach (split /\;/, $string)
33 13 50       79 { 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         28 $self->addTag($1, $2);
36             }
37              
38 1         50 (undef, $string) = $self->consumeComment($string);
39              
40 1         3 $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 31 { my ($self, $name) = (shift, lc shift);
60 13         39 $self->{MMFD_tags}{$name} = join ' ', @_;
61 13         79 $self;
62             }
63              
64              
65 13     13 1 65 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 5 sub tagC14N() { shift->tag('c') }
74 1     1 1 4 sub tagDomain() { shift->tag('d') }
75 1     1 1 4 sub tagSignedHeaders() { shift->tag('h') }
76 1     1 1 5 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 3 sub tagExpires() { shift->tag('x') }
82 1     1 1 1169 sub tagVersion() { shift->tag('v') }
83 1     1 1 5 sub tagExtract() { shift->tag('z') }
84              
85             #------------------------------------------
86              
87              
88             1;