File Coverage

blib/lib/String/Validator/Email.pm

Criterion	Covered	Total	%
statement	93	94	98.9
branch	36	38	94.7
condition	1	2	50.0
subroutine	14	14	100.0
pod	3	3	100.0
total	147	151	97.3

package String::Validator::Email;
$String::Validator::Email::VERSION = '2.01';
use 5.008;
use strict;
use warnings;
no warnings 'uninitialized';
use String::Validator::Common 2.00;
use Regexp::Common qw /net/;
use Net::DNS;
use Email::Valid;

# ABSTRACT: String::Validator for checking Email Addresses.

my $email_messages = {
    email_fqdn        => 'Does not appear to contain a Fully Qualified Domain Name.',
    email_rfc822_noat => 'Missing @ symbol',
    email_rfc822      => 'Does not look like an email address.',
    email_tld         => 'This TLD (Top Level Domain) is not recognized.',
    email_nomx1       => 'Mail Exchanger for ',
    email_nomx2       => ' is missing from Public DNS. Mail cannot be delivered.',
};

sub new {
    my $class = shift ;
    my $self = { @_ } ;
    use base ( 'String::Validator::Common' ) ;
    unless ( defined $self->{ min_len } )
                { $self->{ min_len } = 6 ; }
    unless ( defined $self->{ max_len } )
                { $self->{ max_len } = 64 ; }
	# allow_ip wont work with fqdn or tldcheck
	if ( $self->{ allow_ip } ) {
	    $self->{ mxcheck } = 0 ;
		$self->{ fqdn } = 0 ;
		$self->{ tldcheck } = 0 ;
		}
    # Converts String::Validator Switches to Email::Valid Switches.
	my %switchhash = () ;
    for  ( qw / tldcheck fqdn allow_ip /) {
		my $dashstr = '-' . $_ ;
        if ( defined $self->{ $_ } )
             { $switchhash{ $dashstr } = $self->{ $_ } }
        }
	unless( defined $self->{ tldcheck } ) {
        $switchhash{ '-tldcheck' } = 1 }
    $self->{ switchhash } = \%switchhash ;
    if( $self->{ mxcheck } ) {
        $self->{ fqdn } = 1 ; #before mx, must pass fqdn.
        $self->{ NetDNS } = Net::DNS::Resolver->new;
        }
    $self->{messages}
        = String::Validator::Common::_Messages(
                $email_messages, $self->{language}, $self->{custom_messages} );
    bless $self, $class ;
    return $self ;
}

# Email::Valid has very terse error codes.
# Not an OO method
sub _expound {
    my $self = shift ;
    my $errors = shift || '';
    my $string = shift ;
    my $expounded = '' ;
    if ( $errors =~ m/fqdn/ ) {
        $expounded .= $self->{messages}{ email_fqdn } }
    if ( $errors =~ m/rfc822/ ) {
        unless ( $string =~ /\@/ ) {
            $expounded .= $self->{messages}{ email_rfc822_noat } }
        else {
            $expounded .= $self->{messages}{ email_rfc822 } }
        }
    if ( $errors =~ m/tld/ ) {
        $string =~ m/\.(.*)$/;
        $expounded .= "'$1' : $self->{messages}{ email_tld }" ;
        }
    if ( $errors =~ m/mx/ ) {
    	$expounded .= $self->{messages}{ email_nomx1 } . $string .
            $self->{messages}{ email_nomx2 } ;
    	}
    return $expounded ;
}

sub _rejectip {
	my $self = shift ;
	if  ( $self->{ string } =~ /$RE{net}{IPv4}/ ) {
		$self->IncreaseErr(
			"$self->{ string } Looks like it contains an IP Address." ) }
}

sub Check{
    my ( $self, $string1, $string2 ) = @_ ;
    #not standard hashvar so not inited by inherited method in CheckCommon.
    $self->{ expounded } = '' ;
    if ( $self->CheckCommon( $string1, $string2 ) ) {
        return $self->{ error } }
    my %switchhash = %{ $self->{switchhash} } ;
    $switchhash{ -address  } = $self->{ string } ;
    my $fail = 0;
    my $addr = Email::Valid->address( %switchhash );
       $fail = $Email::Valid::Details unless $addr;
    if ( $fail ) {
        $self->IncreaseErr( $fail ) ;
        $self->{ expounded } = $self->_expound(
            $fail, $self->{ string } ) ;
        }
	else {
		unless ( $self->{ allow_ip } ) {
			$self->_rejectip() }
		}
	# Need maildomain for mxcheck.
	( my $discard, $self->{maildomain} ) = split( /\@/, $self->{ string } );
    $self->{maildomain} =~ tr/\>//d ; #clean out unwanted chars.
    if ( $self->{ mxcheck } ) {
		if ( $self->{ error } == 0 ) {
		    unless ( mx( $self->{ NetDNS }, $self->{ maildomain } ) ) {
                $self->IncreaseErr( "MX" ) ;
                $self->{ expounded } =
                    $self->_expound( 'mx', $self->{ maildomain} ) ;
		    }
		}
    }
return $self->{ error } ;
}

sub Expound {
    my $self = shift ;
    return $self->{ expounded } ;
    }


1; # End of String::Validator::Email

__END__