File Coverage

lib/Sisimai/Reason.pm

Criterion	Covered	Total	%
statement	94	96	97.9
branch	57	64	89.0
condition	30	45	66.6
subroutine	9	9	100.0
pod	1	6	16.6
total	191	220	86.8

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

my $ModulePath = __PACKAGE__->path;
my $GetRetried = __PACKAGE__->retry;
my $ClassOrder = [
    [qw|MailboxFull MesgTooBig ExceedLimit Suspend HasMoved NoRelaying UserUnknown
        Filtered Rejected HostUnknown SpamDetected TooManyConn Blocked
    |],
    [qw|MailboxFull SpamDetected PolicyViolation VirusDetected NoRelaying
        SecurityError SystemError NetworkError Suspend Expired ContentError
        SystemFull NotAccept MailerError
    |],
    [qw|MailboxFull MesgTooBig ExceedLimit Suspend UserUnknown Filtered Rejected
        HostUnknown SpamDetected TooManyConn Blocked SpamDetected SecurityError
        SystemError NetworkError Suspend Expired ContentError HasMoved SystemFull
        NotAccept MailerError NoRelaying SyntaxError OnHold
    |],
];

sub retry {
    # Reason list better to retry detecting an error reason
    # @return   [Array] Reason list
    return {
        'undefined' => 1, 'onhold' => 1, 'systemerror' => 1, 'securityerror' => 1,
        'networkerror' => 1, 'hostunknown' => 1, 'userunknown'=> 1
    };
}

sub index {
    # All the error reason list Sisimai support
    # @return   [Array] Reason list
    return [qw|
        Blocked ContentError ExceedLimit Expired Filtered HasMoved HostUnknown
        MailboxFull MailerError MesgTooBig NetworkError NotAccept OnHold
        Rejected NoRelaying SpamDetected VirusDetected PolicyViolation SecurityError
        Suspend SystemError SystemFull TooManyConn UserUnknown SyntaxError
    |];
}

sub path {
    # Returns Sisimai::Reason::* module path table
    # @return   [Hash] Module path table
    # @since    v4.25.6
    my $class = shift;
    my $index = __PACKAGE__->index;
    my $table = {};
    $table->{ __PACKAGE__.'::'.$_ } = 'Sisimai/Reason/'.$_.'.pm' for @$index;
    return $table;
}

sub get {
    # Detect the bounce reason
    # @param    [Sisimai::Data] argvs   Parsed email object
    # @return   [String, Undef]         Bounce reason or Undef if the argument
    #                                   is missing or invalid object
    # @see anotherone
    my $class = shift;
    my $argvs = shift // return undef;
    return undef unless ref $argvs eq 'Sisimai::Data';

    unless( exists $GetRetried->{ $argvs->reason } ) {
        # Return reason text already decided except reason match with the
        # regular expression of ->retry() method.
        return $argvs->reason if $argvs->reason;
    }
    return 'delivered' if substr($argvs->deliverystatus, 0, 2) eq '2.';

    my $reasontext = '';
    if( $argvs->diagnostictype eq 'SMTP' || $argvs->diagnostictype eq '' ) {
        # Diagnostic-Code: SMTP; ... or empty value
        for my $e ( @{ $ClassOrder->[0] } ) {
            # Check the value of Diagnostic-Code: and the value of Status:, it is a
            # deliverystats, with true() method in each Sisimai::Reason::* class.
            my $p = 'Sisimai::Reason::'.$e;
            require $ModulePath->{ $p };

            next unless $p->true($argvs);
            $reasontext = $p->text;
            last;
        }
    }

    if( not $reasontext || $reasontext eq 'undefined' ) {
        # Bounce reason is not detected yet.
        $reasontext   = __PACKAGE__->anotherone($argvs);
        $reasontext   = '' if $reasontext eq 'undefined';
        $reasontext ||= 'expired' if $argvs->action eq 'delayed';
        return $reasontext if $reasontext;

        # Try to match with message patterns in Sisimai::Reason::Vacation
        require Sisimai::Reason::Vacation;
        $reasontext   = 'vacation' if Sisimai::Reason::Vacation->match(lc $argvs->diagnosticcode);
        $reasontext ||= 'onhold'   if $argvs->diagnosticcode;
        $reasontext ||= 'undefined';
    }
    return $reasontext;
}

sub anotherone {
    # Detect the other bounce reason, fall back method for get()
    # @param    [Sisimai::Data] argvs   Parsed email object
    # @return   [String, Undef]         Bounce reason or Undef if the argument
    #                                   is missing or invalid object
    # @see get
    my $class = shift;
    my $argvs = shift // return undef;

    return undef unless ref $argvs eq 'Sisimai::Data';
    return $argvs->reason if $argvs->reason;

    require Sisimai::SMTP::Status;
    my $statuscode = $argvs->deliverystatus // '';
    my $reasontext = Sisimai::SMTP::Status->name($statuscode) || '';

    TRY_TO_MATCH: while(1) {
        my $diagnostic   = lc $argvs->diagnosticcode // '';
        my $trytomatch   = $reasontext eq '' ? 1 : 0;
           $trytomatch ||= 1 if $reasontext eq 'expired';
           $trytomatch ||= 1 if exists $GetRetried->{ $reasontext };
           $trytomatch ||= 1 if $argvs->diagnostictype ne 'SMTP';
        last unless $trytomatch;

        # Could not decide the reason by the value of Status:
        for my $e ( @{ $ClassOrder->[1] } ) {
            # Trying to match with other patterns in Sisimai::Reason::* classes
            my $p = 'Sisimai::Reason::'.$e;
            require $ModulePath->{ $p };

            next unless $p->match($diagnostic);
            $reasontext = lc $e;
            last;
        }
        last(TRY_TO_MATCH) if $reasontext;

        # Check the value of Status:
        if( (my $v = substr($statuscode, 0, 3)) =~ /\A[45][.]6\z/ ) {
            #  X.6.0   Other or undefined media error
            $reasontext = 'contenterror';

        } elsif( $v eq '5.7' || $v eq '4.7' ) {
            #  X.7.0   Other or undefined security status
            $reasontext = 'securityerror';

        } elsif( $argvs->diagnostictype eq 'X-UNIX' || $argvs->diagnostictype eq 'X-POSTFIX' ) {
            # Diagnostic-Code: X-UNIX; ...
            $reasontext = 'mailererror';

        } else {
            # 50X Syntax Error?
            require Sisimai::Reason::SyntaxError;
            $reasontext = 'syntaxerror' if Sisimai::Reason::SyntaxError->true($argvs);
        }
        last(TRY_TO_MATCH) if $reasontext;

        # Check the value of Action: field, first
        if( $argvs->action =~ /\A(?:delayed|expired)/ ) {
            # Action: delayed, expired
            $reasontext = 'expired';
        } else {
            # Check the value of SMTP command
            my $commandtxt = $argvs->smtpcommand // '';
            if( $commandtxt eq 'EHLO' || $commandtxt eq 'HELO' ) {
                # Rejected at connection or after EHLO|HELO
                $reasontext = 'blocked';
            }
        }
        last(TRY_TO_MATCH);
    }
    return $reasontext;
}

sub match {
    # Detect the bounce reason from given text
    # @param    [String] argv1  Error message
    # @return   [String]        Bounce reason
    my $class = shift;
    my $argv1 = shift // return undef;

    my $reasontext = '';
    my $diagnostic = lc $argv1;

    # Diagnostic-Code: SMTP; ... or empty value
    for my $e ( @{ $ClassOrder->[2] } ) {
        # Check the value of Diagnostic-Code: and the value of Status:, it is a
        # deliverystats, with true() method in each Sisimai::Reason::* class.
        my $p = 'Sisimai::Reason::'.$e;
        require $ModulePath->{ $p };

        next unless $p->match($diagnostic);
        $reasontext = $p->text;
        last;
    }
    return $reasontext if $reasontext;

    # Check the value of $typestring
    my $typestring = uc($argv1) =~ /\A(SMTP|X-.+);/ ? uc($1) : '';
    if( $typestring eq 'X-UNIX' ) {
        # X-Unix; ...
        $reasontext = 'mailererror';
    } else {
        # Detect the bounce reason from "Status:" code
        require Sisimai::SMTP::Status;
        my $statuscode = Sisimai::SMTP::Status->find($argv1) || '';
        $reasontext = Sisimai::SMTP::Status->name($statuscode) || 'undefined';
    }
    return $reasontext;
}

1;
__END__