File Coverage

lib/Haineko/SMTPD/Greeting.pm

Criterion	Covered	Total	%
statement	34	35	97.1
branch	11	12	91.6
condition	2	2	100.0
subroutine	6	6	100.0
pod	2	2	100.0
total	55	57	96.4

package Haineko::SMTPD::Greeting;
use strict;
use warnings;
use Class::Accessor::Lite;

my $rwaccessors = [
    'dsn',          # (Integer) Support DSN or not
    'size',         # (Integer) Max message size
    'auth',         # (Integer) Support SMTP-AUTH
    'mechanism',    # (ArrayRef) SMTP-AUTH Mechanisms
    'feature',      # (ArrayRef) Greeting message lines
    'greeting',     # (String) The first line of EHLO response
    'starttls',     # (Integer) STARTTLS suppored or not
    'pipelining'    # (Integer) PIPELINING supported or not
];
my $roaccessors = [];
my $woaccessors = [];
Class::Accessor::Lite->mk_accessors( @$rwaccessors );

sub new {
    my $class = shift;
    my $greet = [ @_ ];
    my $feats = {
        'dsn'        => undef,
        'size'       => undef,
        'auth'       => undef,
        'feature'    => [],
        'starttls'   => undef,
        'greeting'   => q(),
        'mechanism'  => [],
        'pipelining' => undef,
    };

    $feats->{'greeting'} = shift @$greet;
    chomp $feats->{'greeting'};

    for my $e ( @$greet ) {
        chomp $e;

        if( $e =~ /SIZE (?\d+)/ ) {
            # 250-SIZE 26214400
            $feats->{'size'} = int $+{'SIZE'};

        } elsif( $e =~ /AUTH (?.+)\z/ ) {
            # 250-AUTH LOGIN PLAIN CRAM-MD5
            $feats->{'auth'} = 1;
            $feats->{'mechanism'} = [ split( ' ', $+{'MECHS'} ) ];

        } elsif( $e =~ /PIPELINING/ ) {
            # 250-PIPELINING
            $feats->{'pipelining'} = 1;

        } elsif( $e =~ /STARTTLS/ ) {
            # 250-STARTTLS
            $feats->{'starttls'} = 1;

        } elsif( $e =~ /DSN/ ) {
            # 250-DSN
            $feats->{'dsn'} = 1;
        }

        push @{ $feats->{'feature'} }, $e;
    }

    return bless $feats, __PACKAGE__;
}

sub mechs {
    my $self = shift;
    my $mech = shift || return 0;

    return 1 if grep { uc $mech eq $_ } @{ $self->{'mechanism'} };
    return 0;
}

1;
__END__