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-2023 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 22     22   863 use vars '$VERSION';
  22         45  
  22         1248  
11             $VERSION = '3.013';
12              
13 22     22   144 use base 'Mail::Message::Field::Structured';
  22         57  
  22         2611  
14              
15 22     22   149 use warnings;
  22         56  
  22         569  
16 22     22   121 use strict;
  22         47  
  22         445  
17              
18 22     22   713 use URI;
  22         4940  
  22         15533  
19              
20              
21             sub init($)
22 1     1 0 3 { my ($self, $args) = @_;
23 1         112 $self->{MMFD_tags} = { v => 1, a => 'rsa-sha256' };
24 1         12 $self->SUPER::init($args);
25             }
26              
27             sub parse($)
28 1     1 1 5 { my ($self, $string) = @_;
29              
30 1         5 my $tags = $self->{MMFD_tags};
31              
32 1         15 foreach (split /\;/, $string)
33 13 50       84 { 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         29 $self->addTag($1, $2);
36             }
37              
38 1         60 (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         44 $self->{MMFD_tags}{$name} = join ' ', @_;
61 13         81 $self;
62             }
63              
64              
65 13     13 1 69 sub tag($) { $_[0]->{MMFD_tags}{lc $_[1]} }
66              
67              
68             #------------------------------------------
69              
70 1     1 1 6 sub tagAlgorithm() { shift->tag('a') }
71 1     1 1 5 sub tagSignData() { shift->tag('b') }
72 1     1 1 6 sub tagSignature() { shift->tag('bh') }
73 1     1 1 7 sub tagC14N() { shift->tag('c') }
74 1     1 1 5 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 6 sub tagQueryMethods() { shift->tag('q') }
79 1     1 1 5 sub tagSelector() { shift->tag('s') }
80 1     1 1 4 sub tagTimestamp() { shift->tag('t') }
81 1     1 1 5 sub tagExpires() { shift->tag('x') }
82 1     1 1 1916 sub tagVersion() { shift->tag('v') }
83 1     1 1 3 sub tagExtract() { shift->tag('z') }
84              
85             #------------------------------------------
86              
87              
88             1;