File Coverage

lib/Haineko/SMTPD/Address.pm

Criterion	Covered	Total	%
statement	57	57	100.0
branch	17	20	85.0
condition			n/a
subroutine	8	8	100.0
pod	3	3	100.0
total	85	88	96.5

package Haineko::SMTPD::Address;
use feature ':5.10';
use strict;
use warnings;
use Class::Accessor::Lite;

my $rwaccessors = [];
my $roaccessors = [
    'address',  # (String) Email address
    'user',     # (String) local part of the email address
    'host',     # (String) domain part of the email address
];
my $woaccessors = [];
Class::Accessor::Lite->mk_accessors( @$roaccessors );


sub new {
    my $class = shift;
    my $argvs = { @_ };

    return undef unless defined $argvs->{'address'};

    if( $argvs->{'address'} =~ m{\A(?[^@]+)[@](?[^@]+)\z} ) {

        $argvs->{'user'} = lc $+{'localpart'};
        $argvs->{'host'} = lc $+{'domainpart'};

        map { $argvs->{ $_ } =~ y{`'"<>}{}d } keys %$argvs;
        $argvs->{'address'} = sprintf( "%s@%s", $argvs->{'user'}, $argvs->{'host'} );

        return bless $argvs, __PACKAGE__

    } else {
        return undef;
    }
}

sub canonify {
    my $class = shift;
    my $email = shift;

    return q() unless defined $email;
    return q() if ref $email;

    # "=?ISO-2022-JP?B?....?="
    # no space character between " and < .
    $email =~ s/(?.)"

    my $canonified = q();
    my $addressset = [];
    my $emailtoken = [ split ' ', $email ];

    for my $e ( @$emailtoken ) {
        # Convert character entity; "<" -> ">", ">" -> "<".
        $e =~ s/</
        $e =~ s/>/>/g;
        $e =~ s/,\z//g;
    }

    if( scalar( @$emailtoken ) == 1 ) {
        # [e-mail]
        push @$addressset, $emailtoken->[0];

    } else {
        foreach my $e ( @$emailtoken ) {
            # Kijitora cat
            chomp $e;
            next unless $e =~ m{\A[<]?.+[@][-.0-9A-Za-z]+[.][A-Za-z]{2,}[>]?\z};
            push @$addressset, $e;
        }
    }

    if( scalar( @$addressset ) > 1 ) {
        # Get an  from string
        $canonified = [ grep { $_ =~ m{\A[<].+[>]\z} } @$addressset ]->[0];
        $canonified = $addressset->[0] unless $canonified;

    } else {
        # [e-mail]
        $canonified = shift @$addressset;
    }

    return q() unless defined $canonified;
    return q() unless $canonified;

    $canonified =~ y{<>[]():;}{}d;  # Remove brackets, colons
    $canonified =~ y/{}'"`//d;      # Remove brackets, quotations
    return $canonified;
}

sub damn {
    my $self = shift;
    my $addr = {
        'user' => $self->user,
        'host' => $self->host,
        'address' => $self->address,
    };
    return $addr;
}

1;
__END__