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.20230215';
3 7     7   67 use strict;
  7         13  
  7         241  
4 7     7   34 use warnings;
  7         13  
  7         171  
5              
6 7     7   35 use Carp;
  7         16  
  7         5448  
7             require Mail::DMARC::Result::Reason;
8              
9             sub new {
10 18     18 0 50 my $class = shift;
11 18         150 return bless {
12             dkim => '',
13             spf => '',
14             reason => [],
15             },
16             $class;
17             }
18              
19             sub published {
20 74     74 1 145 my ( $self, $policy ) = @_;
21              
22 74 100       170 if ( !$policy ) {
23 52 50       123 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         219 return $self->{published};
28             }
29              
30             $policy->{domain}
31 22 50       68 or croak
32             "tag the policy object with a domain indicating where the DMARC record was found!";
33 22         73 return $self->{published} = $policy;
34             }
35              
36             sub disposition {
37 52 100   52 1 5429 return $_[0]->{disposition} if 1 == scalar @_;
38             croak "invalid disposition ($_[1]"
39 47 100       95 if 0 == grep {/^$_[1]$/ix} qw/ reject quarantine none /;
  141         1526  
40 41         127 return $_[0]->{disposition} = $_[1];
41             }
42              
43             sub dkim {
44 86 100   86 1 2715 return $_[0]->{dkim} if 1 == scalar @_;
45 42 100       81 croak "invalid dkim" if 0 == grep {/^$_[1]$/ix} qw/ pass fail /;
  84         1032  
46 38         144 return $_[0]->{dkim} = $_[1];
47             }
48              
49             sub dkim_align {
50 14 50   14 1 2318 return $_[0]->{dkim_align} if 1 == scalar @_;
51             croak "invalid dkim_align"
52 14 100       28 if 0 == grep {/^$_[1]$/ix} qw/ relaxed strict /;
  28         624  
53 10         52 return $_[0]->{dkim_align} = $_[1];
54             }
55              
56             sub dkim_meta {
57 7 50   7 0 30 return $_[0]->{dkim_meta} if 1 == scalar @_;
58 7         32 return $_[0]->{dkim_meta} = $_[1];
59             }
60              
61             sub spf {
62 65 100   65 1 2566 return $_[0]->{spf} if 1 == scalar @_;
63 39 100       72 croak "invalid spf" if 0 == grep {/^$_[1]$/ix} qw/ pass fail /;
  78         927  
64 35         112 return $_[0]->{spf} = $_[1];
65             }
66              
67             sub spf_align {
68 10 100   10 1 42 return $_[0]->{spf_align} if 1 == scalar @_;
69 8 50       53 croak "invalid spf_align" if 0 == grep {/^$_[1]$/ix} qw/ relaxed strict /;
  16         125  
70 8         29 return $_[0]->{spf_align} = $_[1];
71             }
72              
73             sub result {
74 34 50   34 1 2436 return $_[0]->{result} if 1 == scalar @_;
75 34 100       65 croak "invalid result" if 0 == grep {/^$_[1]$/ix} qw/ pass fail none /;
  102         1023  
76 30         111 return $_[0]->{result} = $_[1];
77             }
78              
79             sub reason {
80 29     29 1 3975 my ($self, @args) = @_;
81 29 100       146 return $self->{reason} if ! scalar @args;
82 21         33 push @{ $self->{reason}}, Mail::DMARC::Result::Reason->new(@args);
  21         150  
83 15         58 return $self->{reason};
84             }
85              
86             1;
87              
88             __END__