File Coverage

lib/Sisimai/Lhost/Biglobe.pm
Criterion Covered Total %
statement 50 52 96.1
branch 20 24 83.3
condition 8 10 80.0
subroutine 6 6 100.0
pod 2 2 100.0
total 86 94 91.4


line stmt bran cond sub pod time code
1             package Sisimai::Lhost::Biglobe;
2 35     35   4523 use parent 'Sisimai::Lhost';
  35         104  
  35         265  
3 35     35   3172 use v5.26;
  35         132  
4 35     35   209 use strict;
  35         83  
  35         1181  
5 35     35   171 use warnings;
  35         66  
  35         29391  
6              
7 1     1 1 4 sub description { 'BIGLOBE: https://www.biglobe.ne.jp' }
8             sub inquire {
9             # Detect an error from Biglobe
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 decode or the arguments are missing
14             # @since v4.0.0
15 914     914 1 4253 my $class = shift;
16 914   100     2729 my $mhead = shift // return undef;
17 913   100     2415 my $mbody = shift // return undef;
18              
19 912 100       3896 return undef unless index($mhead->{'from'}, 'postmaster@') > -1;
20 199 100       521 return undef unless grep { index($mhead->{'from'}, '@'.$_.'.ne.jp') > -1 } (qw|biglobe inacatv tmtv ttv|);
  796         2289  
21 6 50       27 return undef unless index($mhead->{'subject'}, 'Returned mail:') == 0;
22              
23 6         34 state $indicators = __PACKAGE__->INDICATORS;
24 6         13 state $boundaries = ['Content-Type: message/rfc822'];
25 6         24 state $startingof = {
26             'message' => [' ----- The following addresses had delivery problems -----'],
27             'error' => [' ----- Non-delivered information -----'],
28             };
29 6         21 state $messagesof = {
30             'filtered' => ['Mail Delivery Failed... User unknown'],
31             'mailboxfull' => ["The number of messages in recipient's mailbox exceeded the local limit."],
32             };
33              
34 6         37 my $dscontents = [__PACKAGE__->DELIVERYSTATUS]; my $v = undef;
  6         12  
35 6         33 my $emailparts = Sisimai::RFC5322->part($mbody, $boundaries);
36 6         11 my $readcursor = 0; # (Integer) Points the current cursor position
37 6         12 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
38              
39 6         48 for my $e ( split("\n", $emailparts->[0]) ) {
40             # Read error messages and delivery status lines from the head of the email to the previous
41             # line of the beginning of the original message.
42 42 100       71 unless( $readcursor ) {
43             # Beginning of the bounce message or message/delivery-status part
44 18 100       53 $readcursor |= $indicators->{'deliverystatus'} if index($e, $startingof->{'message'}->[0]) == 0;
45 18         26 next;
46             }
47 24 100 66     97 next if ($readcursor & $indicators->{'deliverystatus'}) == 0 || $e eq "";
48              
49             # This is a MIME-encapsulated message.
50             #
51             # ----_Biglobe000000/00000.biglobe.ne.jp
52             # Content-Type: text/plain; charset="iso-2022-jp"
53             #
54             # ----- The following addresses had delivery problems -----
55             # ********@***.biglobe.ne.jp
56             #
57             # ----- Non-delivered information -----
58             # The number of messages in recipient's mailbox exceeded the local limit.
59             #
60             # ----_Biglobe000000/00000.biglobe.ne.jp
61             # Content-Type: message/rfc822
62             #
63 18         25 $v = $dscontents->[-1];
64              
65 18 100 66     62 if( index($e, '@') > 1 && index($e, ' ') == -1 ) {
66             # ----- The following addresses had delivery problems -----
67             # ********@***.biglobe.ne.jp
68 6 50       20 if( $v->{'recipient'} ) {
69             # There are multiple recipient addresses in the message body.
70 0         0 push @$dscontents, __PACKAGE__->DELIVERYSTATUS;
71 0         0 $v = $dscontents->[-1];
72             }
73 6 50       42 next unless Sisimai::Address->is_emailaddress($e);
74 6         22 $v->{'recipient'} = $e;
75 6         25 $recipients++;
76              
77             } else {
78 12 100       35 next if index($e, '--') > -1;
79 6         23 $v->{'diagnosis'} .= $e.' ';
80             }
81             }
82 6 50       22 return undef unless $recipients;
83              
84 6         14 for my $e ( @$dscontents ) {
85 6         66 $e->{'diagnosis'} = Sisimai::String->sweep($e->{'diagnosis'});
86              
87 6         24 SESSION: for my $r ( keys %$messagesof ) {
88             # Verify each regular expression of session errors
89 8 100       21 next unless grep { index($e->{'diagnosis'}, $_) > -1 } $messagesof->{ $r }->@*;
  8         35  
90 6         17 $e->{'reason'} = $r;
91 6         13 last;
92             }
93             }
94 6         40 return {"ds" => $dscontents, "rfc822" => $emailparts->[1]};
95             }
96              
97             1;
98             __END__