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

package Sisimai::Rhost;
use feature ':5.10';
use strict;
use warnings;

use constant RhostClass => {
    qr/cox[.]net/                                     => 'Cox',
    qr/[.](?:prod|protection)[.]outlook[.]com\z/      => 'ExchangeOnline',
    qr/\b(?>laposte[.]net|(?:orange|wanadoo)[.]fr)\z/ => 'FrancePTT',
    qr/\A(?:smtp|mailstore1)[.]secureserver[.]net\z/  => 'GoDaddy',
    qr/(?:aspmx|gmail-smtp-in)[.]l[.]google[.]com\z/  => 'GoogleApps',
    qr/[.]email[.]ua\z/                               => 'IUA',
    qr/[.](?:ezweb[.]ne[.]jp|au[.]com)\z/             => 'KDDI',
    qr/[.]mimecast[.]com\z/                           => 'Mimecast',
    qr/mfsmax[.]docomo[.]ne[.]jp\z/                   => 'NTTDOCOMO',
    qr/charter[.]net/                                 => 'Spectrum',
    qr/mx[0-9]+[.]qq[.]com\z/                         => 'TencentQQ',
};

sub match {
    # The value of "rhost" is listed in RhostClass or not
    # @param    [String] argv1  Remote host name
    # @return   [Integer]       0: did not match
    #                           1: match
    my $class = shift;
    my $rhost = shift // return undef;
    my $host0 = lc($rhost) || return 0;
    my $match = 0;

    for my $e ( keys %{ RhostClass() } ) {
        # Try to match with each key of RhostClass
        next unless $host0 =~ $e;
        $match = 1;
        last;
    }
    return $match;
}

sub get {
    # Detect the bounce reason from certain remote hosts
    # @param    [Sisimai::Data] argvs   Parsed email object
    # @param    [String]        proxy   The alternative of the "rhost"
    # @return   [String]                The value of bounce reason
    my $class = shift;
    my $argvs = shift || return undef;
    my $proxy = shift || undef;

    my $remotehost = $proxy || lc $argvs->rhost;
    my $rhostclass = '';

    for my $e ( keys %{ RhostClass() } ) {
        # Try to match with each key of RhostClass
        next unless $remotehost =~ $e;
        $rhostclass = __PACKAGE__.'::'.RhostClass->{ $e };
        last;
    }
    return undef unless $rhostclass;

    (my $modulepath = $rhostclass) =~ s|::|/|g;
    require $modulepath.'.pm';
    return $rhostclass->get($argvs);
}

1;
__END__