File Coverage

lib/Mail/DMARC/Result.pm
Criterion Covered Total %
statement 48 49 97.9
branch 28 34 82.3
condition n/a
subroutine 13 13 100.0
pod 8 10 80.0
total 97 106 91.5


line stmt bran cond sub pod time code
1             package Mail::DMARC::Result;
2             our $VERSION = '1.20210927';
3 7     7   47 use strict;
  7         15  
  7         212  
4 7     7   45 use warnings;
  7         16  
  7         177  
5              
6 7     7   32 use Carp;
  7         16  
  7         5739  
7             require Mail::DMARC::Result::Reason;
8              
9             sub new {
10 19     19 0 55 my $class = shift;
11 19         224 return bless {
12             dkim => '',
13             spf => '',
14             reason => [],
15             },
16             $class;
17             }
18              
19             sub published {
20 74     74 1 174 my ( $self, $policy ) = @_;
21              
22 74 100       189 if ( !$policy ) {
23 52 50       141 if ( !defined $self->{published} ) {
24 0         0 croak
25             "no policy discovered. Did you validate(), or at least fetch_dmarc_record() first? Or inspected results to detect a 'No Results Found' type error?";
26             }
27 52         224 return $self->{published};
28             }
29              
30             $policy->{domain}
31 22 50       74 or croak
32             "tag the policy object with a domain indicating where the DMARC record was found!";
33 22         74 return $self->{published} = $policy;
34             }
35              
36             sub disposition {
37 52 100   52 1 6190 return $_[0]->{disposition} if 1 == scalar @_;
38             croak "invalid disposition ($_[1]"
39 47 100       101 if 0 == grep {/^$_[1]$/ix} qw/ reject quarantine none /;
  141         1490  
40 41         149 return $_[0]->{disposition} = $_[1];
41             }
42              
43             sub dkim {
44 86 100   86 1 2636 return $_[0]->{dkim} if 1 == scalar @_;
45 42 100       88 croak "invalid dkim" if 0 == grep {/^$_[1]$/ix} qw/ pass fail /;
  84         1139  
46 38         131 return $_[0]->{dkim} = $_[1];
47             }
48              
49             sub dkim_align {
50 14 50   14 1 2312 return $_[0]->{dkim_align} if 1 == scalar @_;
51             croak "invalid dkim_align"
52 14 100       31 if 0 == grep {/^$_[1]$/ix} qw/ relaxed strict /;
  28         519  
53 10         51 return $_[0]->{dkim_align} = $_[1];
54             }
55              
56             sub dkim_meta {
57 7 50   7 0 24 return $_[0]->{dkim_meta} if 1 == scalar @_;
58 7         29 return $_[0]->{dkim_meta} = $_[1];
59             }
60              
61             sub spf {
62 65 100   65 1 2537 return $_[0]->{spf} if 1 == scalar @_;
63 39 100       82 croak "invalid spf" if 0 == grep {/^$_[1]$/ix} qw/ pass fail /;
  78         985  
64 35         135 return $_[0]->{spf} = $_[1];
65             }
66              
67             sub spf_align {
68 10 100   10 1 74 return $_[0]->{spf_align} if 1 == scalar @_;
69 8 50       20 croak "invalid spf_align" if 0 == grep {/^$_[1]$/ix} qw/ relaxed strict /;
  16         145  
70 8         31 return $_[0]->{spf_align} = $_[1];
71             }
72              
73             sub result {
74 34 50   34 1 2378 return $_[0]->{result} if 1 == scalar @_;
75 34 100       80 croak "invalid result" if 0 == grep {/^$_[1]$/ix} qw/ pass fail none /;
  102         1057  
76 30         129 return $_[0]->{result} = $_[1];
77             }
78              
79             sub reason {
80 29     29 1 4060 my ($self, @args) = @_;
81 29 100       145 return $self->{reason} if ! scalar @args;
82 21         36 push @{ $self->{reason}}, Mail::DMARC::Result::Reason->new(@args);
  21         142  
83 15         71 return $self->{reason};
84             }
85              
86             1;
87              
88             __END__