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   737636 use feature ':5.10';
  78         268  
  78         6507  
3 78     78   552 use strict;
  78         190  
  78         2256  
4 78     78   433 use warnings;
  78         199  
  78         30149  
5              
6 78         31205 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   623 };
  78         209  
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 32621 my $class = shift;
26 4920   100     8682 my $rhost = shift // return undef;
27 4919   100     11208 my $host0 = lc($rhost) || return 0;
28 4275         5609 my $match = 0;
29              
30 4275         5032 for my $e ( keys %{ RhostClass() } ) {
  4275         14426  
31             # Try to match with each key of RhostClass
32 44494 100       1011063 next unless $host0 =~ $e;
33 491         1317 $match = 1;
34 491         811 last;
35             }
36 4275         20127 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 958 my $class = shift;
45 408   100     1673 my $argvs = shift || return undef;
46 407   100     1554 my $proxy = shift || undef;
47              
48 407   66     2469 my $remotehost = $proxy || lc $argvs->rhost;
49 407         2551 my $rhostclass = '';
50              
51 407         736 for my $e ( keys %{ RhostClass() } ) {
  407         1402  
52             # Try to match with each key of RhostClass
53 2274 100       51732 next unless $remotehost =~ $e;
54 407         1956 $rhostclass = __PACKAGE__.'::'.RhostClass->{ $e };
55 407         1457 last;
56             }
57 407 50       1749 return undef unless $rhostclass;
58              
59 407         2058 (my $modulepath = $rhostclass) =~ s|::|/|g;
60 407         26889 require $modulepath.'.pm';
61 407         4103 return $rhostclass->get($argvs);
62             }
63              
64             1;
65             __END__