File Coverage

lib/Sisimai/SMTP/Error.pm
Criterion Covered Total %
statement 51 51 100.0
branch 23 24 95.8
condition 27 28 96.4
subroutine 7 7 100.0
pod 2 2 100.0
total 110 112 98.2


line stmt bran cond sub pod time code
1             package Sisimai::SMTP::Error;
2 79     79   69641 use feature ':5.10';
  79         158  
  79         5916  
3 79     79   465 use strict;
  79         147  
  79         1575  
4 79     79   351 use warnings;
  79         127  
  79         1831  
5 79     79   27795 use Sisimai::SMTP::Reply;
  79         193  
  79         2267  
6 79     79   37329 use Sisimai::SMTP::Status;
  79         207  
  79         38675  
7              
8             sub is_permanent {
9             # Permanent error or not
10             # @param [String] argv1 String including SMTP Status code
11             # @return [Integer] 1: Permanet error
12             # 0: Temporary error
13             # undef: is not an error
14             # @since v4.17.3
15 625     625 1 8742 my $class = shift;
16 625   100     1647 my $argv1 = shift || return undef;
17              
18 614   100     2033 my $statuscode = Sisimai::SMTP::Status->find($argv1) || Sisimai::SMTP::Reply->find($argv1) || '';
19 614         1118 my $parmanent1 = undef;
20              
21 614 100 100     3076 if( (my $classvalue = int(substr($statuscode, 0, 1) || 0)) > 0 ) {
22             # 2, 4, or 5
23 236 100       621 if( $classvalue == 5 ) {
    100          
    50          
24             # Permanent error
25 224         428 $parmanent1 = 1;
26              
27             } elsif( $classvalue == 4 ) {
28             # Temporary error
29 11         24 $parmanent1 = 0;
30              
31             } elsif( $classvalue == 2 ) {
32             # Succeeded
33 1         2 $parmanent1 = undef;
34             }
35             } else {
36             # Check with regular expression
37 378         1198 my $v = lc $argv1;
38 378 100 66     2892 if( rindex($v, 'temporar') > -1 || rindex($v, 'persistent') > -1 ) {
    100          
39             # Temporary failure
40 10         25 $parmanent1 = 0;
41              
42             } elsif( rindex($v, 'permanent') > -1 ) {
43             # Permanently failure
44 20         40 $parmanent1 = 1;
45              
46             } else {
47             # did not find information to decide that it is a soft bounce
48             # or a hard bounce.
49 348         613 $parmanent1 = undef;
50             }
51             }
52 614         1267 return $parmanent1;
53             }
54              
55             sub soft_or_hard {
56             # Check softbounce or not
57             # @param [String] argv1 Detected bounce reason
58             # @param [String] argv2 String including SMTP Status code
59             # @return [String] 'soft': Soft bounce
60             # 'hard': Hard bounce
61             # '': May not be bounce ?
62             # @since v4.17.3
63 2849     2849 1 35603 my $class = shift;
64 2849   100     5523 my $argv1 = shift || return undef;
65 2848   100     5786 my $argv2 = shift || '';
66 2848         4114 my $value = undef;
67              
68 2848         4393 state $softorhard = {
69             'soft' => [qw|
70             blocked contenterror exceedlimit expired filtered mailboxfull mailererror
71             mesgtoobig networkerror norelaying policyviolation rejected securityerror
72             spamdetected suspend syntaxerror systemerror systemfull toomanyconn virusdetected
73             |],
74             'hard' => [qw|hasmoved hostunknown userunknown|],
75             };
76              
77 2848 100 100     19578 if( $argv1 eq 'delivered' || $argv1 eq 'feedback' || $argv1 eq 'vacation' ) {
    100 100        
    100 100        
78             # These are not dealt as a bounce reason
79 3         6 $value = '';
80              
81             } elsif( $argv1 eq 'onhold' || $argv1 eq 'undefined' ) {
82             # It should be "soft" when a reason is "onhold" or "undefined"
83 45         101 $value = 'soft';
84              
85             } elsif( $argv1 eq 'notaccept' ) {
86             # NotAccept: 5xx => hard bounce, 4xx => soft bounce
87 38 100       183 if( $argv2 ) {
88             # Get D.S.N. or SMTP reply code from The 2nd argument string
89 37   100     150 my $statuscode = Sisimai::SMTP::Status->find($argv2) || Sisimai::SMTP::Reply->find($argv2) || '';
90 37   100     307 my $classvalue = int(substr($statuscode, 0, 1) || 0);
91 37 100       140 $value = $classvalue == 4 ? 'soft' : 'hard';
92              
93             } else {
94             # "notaccept" is a hard bounce
95 1         3 $value = 'hard';
96             }
97             } else {
98             # Check all the reasons defined at the above
99 2762         5685 SOFT_OR_HARD: for my $e ('hard', 'soft') {
100             # Soft or Hard?
101 4614         4781 for my $f ( @{ $softorhard->{ $e } } ) {
  4614         7965  
102             # Hard bounce?
103 22341 100       33710 next unless $argv1 eq $f;
104 2761         4167 $value = $e;
105 2761         5117 last(SOFT_OR_HARD);
106             }
107             }
108             }
109 2848   100     5968 $value //= '';
110 2848         5719 return $value;
111             }
112              
113             1;
114             __END__