File Coverage

lib/Sisimai/Reason.pm

Criterion	Covered	Total	%
statement	91	94	96.8
branch	45	52	86.5
condition	49	66	74.2
subroutine	10	10	100.0
pod	1	7	14.2
total	196	229	85.5

package Sisimai::Reason;
use v5.26;
use strict;
use warnings;

my $ModulePath = __PACKAGE__->path;
my $GetRetried = __PACKAGE__->retry;
my $ClassOrder = [
    # 0. true() meethod in the following reasons are called from Reason->find()
    [qw/MailboxFull EmailTooLarge Suspend HasMoved NoRelaying AuthFailure UserUnknown Filtered RequirePTR
        NotCompliantRFC BadReputation ContentError Rejected HostUnknown SpamDetected RateLimited Blocked
        FailedSTARTTLS NotAccept VirusDetected PolicyViolation/
    ],
    # 1. match() method in the following reasons are called from Reason->find()
    [qw/MailboxFull SpamDetected VirusDetected NoRelaying SystemError NetworkError Suspend SystemFull
        Suppressed MailerError SecurityError PolicyViolation SyntaxError Expired/
    ],
    [qw/MailboxFull EmailTooLarge Suspend UserUnknown Filtered Rejected HostUnknown SpamDetected
        RateLimited Blocked SpamDetected AuthFailure FailedSTARTTLS SecurityError SystemError
        NetworkError Suspend Expired ContentError HasMoved SystemFull NotAccept MailerError
        NoRelaying Suppressed SyntaxError OnHold/
    ],
];

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

sub is_explicit {
    # is_explicit() returns 0 when the argument is empty or is "undefined" or is "onhold"
    # @param    string argv1  Reason name
    # @return   bool          false: The reaosn is not explicit
    my $class = shift;
    my $argv1 = shift || return 0;

    return 0 if $argv1 eq "undefined" || $argv1 eq "onhold" || $argv1 eq "";
    return 1;
}

sub index {
    # All the error reason list Sisimai support
    # @return   [Array] Reason list
    return [qw/
        AuthFailure BadReputation Blocked ContentError Expired FailedSTARTTLS Filtered HasMoved
        HostUnknown MailboxFull MailerError EmailTooLarge NetworkError NotAccept NotCompliantRFC
        OnHold Rejected NoRelaying SpamDetected VirusDetected PolicyViolation SecurityError
        Suspend RequirePTR SystemError SystemFull RateLimited Suppressed 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 find {
    # Detect the bounce reason
    # @param    [Hash]   argvs  Decoded email object
    # @return   [String]        Bounce reason or an empty string if the argument is missing or not HASH
    # @see anotherone
    my $class = shift;
    my $argvs = shift // return "";

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

    my $reasontext = '';
    my $issuedcode = $argvs->{'diagnosticcode'} || '';
    my $codeformat = $argvs->{'diagnostictype'} || '';
    if( $codeformat eq 'SMTP' || $codeformat eq '' ) {
        # Diagnostic-Code: SMTP; ... or empty value
        for my $e ( $ClassOrder->[0]->@* ) {
            # Check the values of Diagnostic-Code: and Status: fields using true() method of each
            # child class in Sisimai::Reason
            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 $issuedcode);
        $reasontext ||= 'onhold'   if $issuedcode;
        $reasontext ||= 'undefined';
    }
    return $reasontext;
}

sub anotherone {
    # Detect the other bounce reason, fall back method for find()
    # @param    [Hash] argvs    Decoded email structure
    # @return   [String]        Bounce reason or an empty string if the argument is missing or not HASH
    # @see      find()
    my $class = shift;
    my $argvs = shift // return ""; return $argvs->{'reason'} if $argvs->{'reason'};

    require Sisimai::SMTP::Status;
    my $issuedcode = lc $argvs->{'diagnosticcode'} // '';
    my $codeformat = $argvs->{'diagnostictype'}    // '';
    my $actiontext = $argvs->{'action'}            // '';
    my $statuscode = $argvs->{'deliverystatus'}    // '';
    my $reasontext = Sisimai::SMTP::Status->name($statuscode) || '';
    my $trytomatch = $reasontext eq '' ? 1 : 0;
       $trytomatch = 1 if exists $GetRetried->{ $reasontext } || $codeformat ne 'SMTP';

    while($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($issuedcode);
            $reasontext = lc $e;
            last;
        }
        last if $reasontext;

        # Check the value of Status:
        my $code2digit = substr($statuscode, 0, 3) || '';
        if( $code2digit eq '5.6' || $code2digit eq '4.6' ) {
            #  X.6.0   Other or undefined media error
            $reasontext = 'contenterror';

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

        } elsif( CORE::index($codeformat, 'X-UNIX') == 0 ) {
            # Diagnostic-Code: X-UNIX; ..., X-Postfix, or other X-*
            $reasontext = 'mailererror';

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

        # Check the value of Action: field, first
        if( CORE::index($actiontext, 'delayed') == 0 || CORE::index($actiontext, 'expired') == 0 ) {
            # Action: delayed, expired
            $reasontext = 'expired';

        } else {
            # Check the value of SMTP command
            my $thecommand = $argvs->{'command'} // '';
            if( $thecommand eq 'EHLO' || $thecommand eq 'HELO' ) {
                # Rejected at connection or after EHLO|HELO
                $reasontext = 'blocked';
            }
        }
        last;
    }
    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 "";

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

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

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

    if( CORE::index(uc $issuedcode, 'X-UNIX; ') > -1 ) {
        # X-Unix; ...
        $reasontext = 'mailererror';

    } else {
        # Detect the bounce reason from "Status:" code
        require Sisimai::SMTP::Status;
        my $cv = Sisimai::SMTP::Status->find($argv1)   || '';
        $reasontext = Sisimai::SMTP::Status->name($cv) || 'undefined';
    }
    return $reasontext;
}

1;
__END__