File Coverage

blib/lib/MooX/Value/EmailAddress.pm

Criterion	Covered	Total	%
statement	43	43	100.0
branch	7	10	70.0
condition	1	3	33.3
subroutine	10	10	100.0
pod	3	3	100.0
total	64	69	92.7

package MooX::Value::EmailAddress;

use warnings;
use strict;
use Moo;
use namespace::clean;

use MooX::Value::ValidationUtils;
use MooX::Value::Domain;

our $VERSION = '0.04';

extends 'MooX::Value';

sub _why_invalid
{
    my ($self, $value) = @_;
    return ( __PACKAGE__ . ': undefined value', '', undef ) unless defined $value;
    return ( __PACKAGE__ . ': missing domain', '', undef ) unless $value =~ tr/@//;

    my $pos = rindex( $value, '@' );
    {
        my $lp = substr( $value, 0, $pos );
        my ($why, $long, $data) = MooX::Value::ValidationUtils::why_invalid_email_local_part( $lp );
        return ( __PACKAGE__ . ": $why", '', undef ) if defined $why;
    }

    {
        my $dom = substr( $value, $pos+1 );
        my ($why, $long, $data) = MooX::Value::ValidationUtils::why_invalid_domain_name( $dom );
        return ( __PACKAGE__ . ": $why", '', $dom ) if defined $why;
    }
    return;
}

sub local_part
{
    my ($self) = @_;
    return substr( $self->value, 0, rindex( $self->value, '@' ) );
}

sub domain
{
    my ($self) = @_;
    return MooX::Value::Domain->new( substr( $self->value, rindex( $self->value, '@' )+1 ) );
}

sub new_canonical
{
    my ($class, $value) = @_;

    # Canonicalize if possible. If not, let normal validation proceed.
    if( defined $value and $value =~ tr/@// )
    {
        my $pos = rindex( $value, '@' );
        my $lp = substr( $value, 0, $pos );
        my $dom = substr( $value, $pos+1 );
        $dom =~ tr/A-Z/a-z/;
        $value = "$lp\@$dom";
    }
    return __PACKAGE__->new( $value );
}

1;
__END__