File Coverage

lib/Mail/DMARC/Report/Aggregate/Record/Auth_Results/SPF.pm
Criterion Covered Total %
statement 37 44 84.0
branch 14 26 53.8
condition 4 6 66.6
subroutine 10 10 100.0
pod 0 5 0.0
total 65 91 71.4


line stmt bran cond sub pod time code
1             package Mail::DMARC::Report::Aggregate::Record::Auth_Results::SPF;
2             our $VERSION = '1.20211209';
3 13     13   97 use strict;
  13         31  
  13         420  
4              
5 13     13   72 use Carp;
  13         34  
  13         743  
6 13     13   566 use parent 'Mail::DMARC::Base';
  13         349  
  13         93  
7              
8             sub new {
9 64     64 0 185 my ( $class, @args ) = @_;
10              
11 64         155 my $self = bless {}, $class;
12              
13 64 50       187 if (0 == scalar @args) {
14 0         0 return $self;
15             }
16              
17             # a bare hash
18 64 100       224 return $self->_from_hash(@args) if scalar @args > 1;
19              
20 57         108 my $spf = shift @args;
21 57 100       196 return $spf if ref $spf eq $class;
22              
23 47 50       229 return $self->_from_hashref($spf) if 'HASH' eq ref $spf;
24              
25 0         0 croak "invalid spf argument";
26             }
27              
28             sub domain {
29 53 50   53 0 171 return $_[0]->{domain} if 1 == scalar @_;
30 53         136 return $_[0]->{domain} = $_[1];
31             }
32              
33             sub result {
34 53 50   53 0 153 return $_[0]->{result} if 1 == scalar @_;
35 53 50       235 croak if !$_[0]->is_valid_spf_result( $_[1] );
36 53         278 return $_[0]->{result} = $_[1];
37             }
38              
39             sub scope {
40 53 50   53 0 150 return $_[0]->{scope} if 1 == scalar @_;
41 53 50       307 croak if ! $_[0]->is_valid_spf_scope( $_[1] );
42 53         161 return $_[0]->{scope} = $_[1];
43             }
44              
45             sub _from_hash {
46 54     54   238 my ($self, %args) = @_;
47              
48 54         174 foreach my $key ( keys %args ) {
49             # scope is frequently absent on received reports
50 160 50 66     532 next if ($key eq 'scope' && !$args{$key});
51 160         490 $self->$key( $args{$key} );
52             }
53              
54 53         212 $self->is_valid;
55 53         241 return $self;
56             }
57              
58             sub _from_hashref {
59 47     47   94 return $_[0]->_from_hash(%{ $_[1] });
  47         211  
60             }
61              
62             sub is_valid {
63 53     53 0 98 my $self = shift;
64              
65 53         119 foreach my $f (qw/ domain result scope /) {
66 159 50       364 next if $self->{$f};
67 0 0       0 if ($f ne 'scope') {
68             # quite a few DMARC reporters don't include scope
69 0         0 warn "SPF $f is required but missing!\n";
70             }
71 0         0 return 0;
72             }
73              
74 53 50 66     398 if ( $self->{result} =~ /^pass$/i && !$self->{domain} ) {
75 0         0 warn "SPF pass MUST include the RFC5321.MailFrom domain!\n";
76 0         0 return 0;
77             }
78              
79 53         120 return 1;
80             }
81              
82             1;
83              
84             __END__