File Coverage

lib/Sisimai/Lhost/Activehunter.pm
Criterion Covered Total %
statement 43 45 95.5
branch 16 20 80.0
condition 4 7 57.1
subroutine 6 6 100.0
pod 2 2 100.0
total 71 80 88.7


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::Activehunter;
2 15     15   6955 use parent 'Sisimai::Lhost';
  15         33  
  15         118  
3 15     15   917 use feature ':5.10';
  15         30  
  15         1015  
4 15     15   91 use strict;
  15         37  
  15         289  
5 15     15   69 use warnings;
  15         33  
  15         8314  
6              
7 2     2 1 1830 sub description { 'TransWARE Active!hunter' };
8             sub make {
9             # Detect an error from TransWARE Active!hunter
10             # @param [Hash] mhead Message headers of a bounce email
11             # @param [String] mbody Message body of a bounce email
12             # @return [Hash] Bounce data list and message/rfc822 part
13             # @return [Undef] failed to parse or the arguments are missing
14             # @since v4.1.1
15 199     199 1 1178 my $class = shift;
16 199   100     643 my $mhead = shift // return undef;
17 198   50     510 my $mbody = shift // return undef;
18              
19             # 'from' => qr/\A"MAILER-DAEMON"/,
20             # 'subject' => qr/FAILURE NOTICE :/,
21 198 100       720 return undef unless defined $mhead->{'x-ahmailid'};
22              
23 11         48 state $indicators = __PACKAGE__->INDICATORS;
24 11         29 state $rebackbone = qr|^Content-Type:[ ]message/rfc822|m;
25 11         28 state $startingof = { 'message' => [' ----- The following addresses had permanent fatal errors -----'] };
26              
27 11         51 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
28 11         65 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
29 11         26 my $readcursor = 0; # (Integer) Points the current cursor position
30 11         27 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
31 11         21 my $v = undef;
32              
33 11         83 for my $e ( split("\n", $emailsteak->[0]) ) {
34             # Read error messages and delivery status lines from the head of the email
35             # to the previous line of the beginning of the original message.
36 121 100       206 unless( $readcursor ) {
37             # Beginning of the bounce message or delivery status part
38 66 100       160 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
39 66         81 next;
40             }
41 55 50       119 next unless $readcursor & $indicators->{'deliverystatus'};
42 55 100       107 next unless length $e;
43              
44             # ----- The following addresses had permanent fatal errors -----
45             #
46             # >>> kijitora@example.org
47             #
48             # ----- Transcript of session follows -----
49             # 550 sorry, no mailbox here by that name (#5.1.1 - chkusr)
50 33         53 $v = $dscontents->[-1];
51              
52 33 100       121 if( $e =~ /\A[>]{3}[ \t]+.+[<]([^ ]+?[@][^ ]+?)[>]\z/ ) {
53             # >>> kijitora@example.org
54 11 50       37 if( $v->{'recipient'} ) {
55             # There are multiple recipient addresses in the message body.
56 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
57 0         0 $v = $dscontents->[-1];
58             }
59 11         43 $v->{'recipient'} = $1;
60 11         21 $recipients++;
61              
62             } else {
63             # ----- Transcript of session follows -----
64             # 550 sorry, no mailbox here by that name (#5.1.1 - chkusr)
65 22 100       77 next unless $e =~ /\A[0-9A-Za-z]+/;
66 11 50       39 next if length $v->{'diagnosis'};
67 11   33     60 $v->{'diagnosis'} ||= $e;
68             }
69             }
70 11 50       46 return undef unless $recipients;
71              
72 11         58 require Sisimai::String;
73 11         85 $_->{'diagnosis'} = Sisimai::String->sweep($_->{'diagnosis'}) for @$dscontents;
74 11         62 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
75             }
76              
77             1;
78             __END__