File Coverage

lib/Sisimai/Lhost/Yahoo.pm
Criterion Covered Total %
statement 49 52 94.2
branch 23 26 88.4
condition 5 6 83.3
subroutine 6 6 100.0
pod 2 2 100.0
total 85 92 92.3


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::Yahoo;
2 21     21   5304 use parent 'Sisimai::Lhost';
  21         43  
  21         121  
3 21     21   1333 use feature ':5.10';
  21         47  
  21         1514  
4 21     21   111 use strict;
  21         35  
  21         433  
5 21     21   105 use warnings;
  21         37  
  21         14704  
6              
7 2     2 1 1011 sub description { 'Yahoo! MAIL: https://www.yahoo.com' }
8             sub make {
9             # Detect an error from Yahoo! MAIL
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.3
15 356     356 1 921 my $class = shift;
16 356   100     1008 my $mhead = shift // return undef;
17 355   50     967 my $mbody = shift // return undef;
18              
19             # X-YMailISG: YtyUVyYWLDsbDh...
20             # X-YMail-JAS: Pb65aU4VM1mei...
21             # X-YMail-OSG: bTIbpDEVM1lHz...
22             # X-Originating-IP: [192.0.2.9]
23 355 100       1253 return undef unless $mhead->{'x-ymailisg'};
24              
25 76         191 state $indicators = __PACKAGE__->INDICATORS;
26 76         160 state $rebackbone = qr|^--- Below this line is a copy of the message[.]|m;
27 76         165 state $startingof = { 'message' => ['Sorry, we were unable to deliver your message'] };
28              
29 76         258 my $dscontents = [__PACKAGE__->DELIVERYSTATUS];
30 76         410 my $emailsteak = Sisimai::RFC5322->fillet($mbody, $rebackbone);
31 76         194 my $readcursor = 0; # (Integer) Points the current cursor position
32 76         165 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
33 76         165 my $v = undef;
34              
35 76         473 for my $e ( split("\n", $emailsteak->[0]) ) {
36             # Read error messages and delivery status lines from the head of the email
37             # to the previous line of the beginning of the original message.
38 514 100       789 unless( $readcursor ) {
39             # Beginning of the bounce message or message/delivery-status part
40 261 100       838 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
41 261         362 next;
42             }
43 253 50       491 next unless $readcursor & $indicators->{'deliverystatus'};
44 253 100       514 next unless length $e;
45              
46             # Sorry, we were unable to deliver your message to the following address.
47             #
48             # :
49             # Remote host said: 550 5.1.1 ... User Unknown [RCPT_TO]
50 182         284 $v = $dscontents->[-1];
51              
52 182 100       591 if( $e =~ /\A[<](.+[@].+)[>]:[ \t]*\z/ ) {
53             # :
54 71 50       254 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 71         246 $v->{'recipient'} = $1;
60 71         144 $recipients++;
61              
62             } else {
63 111 100       342 if( index($e, 'Remote host said:') == 0 ) {
64             # Remote host said: 550 5.1.1 ... User Unknown [RCPT_TO]
65 36         71 $v->{'diagnosis'} = $e;
66              
67             # Get SMTP command from the value of "Remote host said:"
68 36 100       189 $v->{'command'} = $1 if $e =~ /\[([A-Z]{4}).*\]\z/;
69             } else {
70             # :
71             # Remote host said:
72             # 550 5.2.2 ... Mailbox Full
73             # [RCPT_TO]
74 75 100       231 if( $v->{'diagnosis'} eq 'Remote host said:' ) {
75             # Remote host said:
76             # 550 5.2.2 ... Mailbox Full
77 20 50       75 if( $e =~ /\[([A-Z]{4}).*\]\z/ ) {
78             # [RCPT_TO]
79 0         0 $v->{'command'} = $1;
80              
81             } else {
82             # 550 5.2.2 ... Mailbox Full
83 20         57 $v->{'diagnosis'} = $e;
84             }
85             } else {
86             # Error message which does not start with 'Remote host said:'
87 55         214 $v->{'diagnosis'} .= ' '.$e;
88             }
89             }
90             }
91             }
92 76 100       272 return undef unless $recipients;
93              
94 71         153 for my $e ( @$dscontents ) {
95 71         182 $e->{'diagnosis'} =~ y/\n/ /;
96 71         432 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
97 71 100 100     556 $e->{'command'} ||= 'RCPT' if $e->{'diagnosis'} =~ /[<].+[@].+[>]/;
98             }
99 71         410 return { 'ds' => $dscontents, 'rfc822' => $emailsteak->[1] };
100             }
101              
102             1;
103             __END__