File Coverage

lib/Sisimai/Rhost.pm
Criterion Covered Total %
statement 36 36 100.0
branch 5 6 83.3
condition 10 11 90.9
subroutine 6 6 100.0
pod 1 2 50.0
total 58 61 95.0


line stmt bran cond sub pod time code
1             package Sisimai::Rhost;
2 78     78   754231 use feature ':5.10';
  78         251  
  78         6560  
3 78     78   727 use strict;
  78         159  
  78         2000  
4 78     78   423 use warnings;
  78         194  
  78         29197  
5              
6 78         30211 use constant RhostClass => {
7             qr/cox[.]net/ => 'Cox',
8             qr/[.](?:prod|protection)[.]outlook[.]com\z/ => 'ExchangeOnline',
9             qr/\b(?>laposte[.]net|(?:orange|wanadoo)[.]fr)\z/ => 'FrancePTT',
10             qr/\A(?:smtp|mailstore1)[.]secureserver[.]net\z/ => 'GoDaddy',
11             qr/(?:aspmx|gmail-smtp-in)[.]l[.]google[.]com\z/ => 'GoogleApps',
12             qr/[.]email[.]ua\z/ => 'IUA',
13             qr/[.](?:ezweb[.]ne[.]jp|au[.]com)\z/ => 'KDDI',
14             qr/[.]mimecast[.]com\z/ => 'Mimecast',
15             qr/mfsmax[.]docomo[.]ne[.]jp\z/ => 'NTTDOCOMO',
16             qr/charter[.]net/ => 'Spectrum',
17             qr/mx[0-9]+[.]qq[.]com\z/ => 'TencentQQ',
18 78     78   591 };
  78         188  
19              
20             sub match {
21             # The value of "rhost" is listed in RhostClass or not
22             # @param [String] argv1 Remote host name
23             # @return [Integer] 0: did not match
24             # 1: match
25 4920     4920 1 32992 my $class = shift;
26 4920   100     9204 my $rhost = shift // return undef;
27 4919   100     13926 my $host0 = lc($rhost) || return 0;
28 4275         5728 my $match = 0;
29              
30 4275         4818 for my $e ( keys %{ RhostClass() } ) {
  4275         14269  
31             # Try to match with each key of RhostClass
32 44428 100       992840 next unless $host0 =~ $e;
33 491         1274 $match = 1;
34 491         843 last;
35             }
36 4275         20239 return $match;
37             }
38              
39             sub get {
40             # Detect the bounce reason from certain remote hosts
41             # @param [Sisimai::Data] argvs Parsed email object
42             # @param [String] proxy The alternative of the "rhost"
43             # @return [String] The value of bounce reason
44 408     408 0 1001 my $class = shift;
45 408   100     1103 my $argvs = shift || return undef;
46 407   100     1548 my $proxy = shift || undef;
47              
48 407   66     1734 my $remotehost = $proxy || lc $argvs->rhost;
49 407         2685 my $rhostclass = '';
50              
51 407         572 for my $e ( keys %{ RhostClass() } ) {
  407         1603  
52             # Try to match with each key of RhostClass
53 2431 100       55857 next unless $remotehost =~ $e;
54 407         1723 $rhostclass = __PACKAGE__.'::'.RhostClass->{ $e };
55 407         1680 last;
56             }
57 407 50       1290 return undef unless $rhostclass;
58              
59 407         2002 (my $modulepath = $rhostclass) =~ s|::|/|g;
60 407         23761 require $modulepath.'.pm';
61 407         4170 return $rhostclass->get($argvs);
62             }
63              
64             1;
65             __END__