File Coverage

lib/Sisimai/SMTP/Error.pm

Criterion	Covered	Total	%
statement	51	51	100.0
branch	23	24	95.8
condition	27	28	96.4
subroutine	7	7	100.0
pod	2	2	100.0
total	110	112	98.2

package Sisimai::SMTP::Error;
use feature ':5.10';
use strict;
use warnings;
use Sisimai::SMTP::Reply;
use Sisimai::SMTP::Status;

sub is_permanent {
    # Permanent error or not
    # @param    [String] argv1  String including SMTP Status code
    # @return   [Integer]       1:     Permanet error
    #                           0:     Temporary error
    #                           undef: is not an error
    # @since v4.17.3
    my $class = shift;
    my $argv1 = shift || return undef;

    my $statuscode = Sisimai::SMTP::Status->find($argv1) || Sisimai::SMTP::Reply->find($argv1) || '';
    my $parmanent1 = undef;

    if( (my $classvalue = int(substr($statuscode, 0, 1) || 0)) > 0 ) {
        # 2, 4, or 5
        if( $classvalue == 5 ) {
            # Permanent error
            $parmanent1 = 1;

        } elsif( $classvalue == 4 ) {
            # Temporary error
            $parmanent1 = 0;

        } elsif( $classvalue == 2 ) {
            # Succeeded
            $parmanent1 = undef;
        }
    } else {
        # Check with regular expression
        my $v = lc $argv1;
        if( rindex($v, 'temporar') > -1 || rindex($v, 'persistent') > -1 ) {
            # Temporary failure
            $parmanent1 = 0;

        } elsif( rindex($v, 'permanent') > -1 ) {
            # Permanently failure
            $parmanent1 = 1;

        } else {
            # did not find information to decide that it is a soft bounce
            # or a hard bounce.
            $parmanent1 = undef;
        }
    }
    return $parmanent1;
}

sub soft_or_hard {
    # Check softbounce or not
    # @param    [String] argv1  Detected bounce reason
    # @param    [String] argv2  String including SMTP Status code
    # @return   [String]        'soft': Soft bounce
    #                           'hard': Hard bounce
    #                           '':     May not be bounce ?
    # @since v4.17.3
    my $class = shift;
    my $argv1 = shift || return undef;
    my $argv2 = shift || '';
    my $value = undef;

    state $softorhard = {
        'soft' => [qw|
            blocked contenterror exceedlimit expired filtered mailboxfull mailererror
            mesgtoobig networkerror norelaying policyviolation rejected securityerror
            spamdetected suspend syntaxerror systemerror systemfull toomanyconn virusdetected
        |],
        'hard' => [qw|hasmoved hostunknown userunknown|],
    };

    if( $argv1 eq 'delivered' || $argv1 eq 'feedback' || $argv1 eq 'vacation' ) {
        # These are not dealt as a bounce reason
        $value = '';

    } elsif( $argv1 eq 'onhold' || $argv1 eq 'undefined' ) {
        # It should be "soft" when a reason is "onhold" or "undefined"
        $value = 'soft';

    } elsif( $argv1 eq 'notaccept' ) {
        # NotAccept: 5xx => hard bounce, 4xx => soft bounce
        if( $argv2 ) {
            # Get D.S.N. or SMTP reply code from The 2nd argument string
            my $statuscode = Sisimai::SMTP::Status->find($argv2) || Sisimai::SMTP::Reply->find($argv2) || '';
            my $classvalue = int(substr($statuscode, 0, 1) || 0);
            $value = $classvalue == 4 ? 'soft' : 'hard';

        } else {
            # "notaccept" is a hard bounce
            $value = 'hard';
        }
    } else {
        # Check all the reasons defined at the above
        SOFT_OR_HARD: for my $e ('hard', 'soft') {
            # Soft or Hard?
            for my $f ( @{ $softorhard->{ $e } } ) {
                # Hard bounce?
                next unless $argv1 eq $f;
                $value = $e;
                last(SOFT_OR_HARD);
            }
        }
    }
    $value //= '';
    return $value;
}

1;
__END__