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


line stmt bran cond sub pod time code
1             package String::Validator::Email;
2             $String::Validator::Email::VERSION = '2.011'; # TRIAL
3 7     7   427079 use 5.008;
  7         73  
4 7     7   37 use strict;
  7         12  
  7         164  
5 7     7   32 use warnings;
  7         14  
  7         224  
6 7     7   33 no warnings 'uninitialized';
  7         20  
  7         249  
7 7     7   3164 use String::Validator::Common 2.00;
  7         304573  
  7         239  
8 7     7   3630 use Regexp::Common qw /net/;
  7         31129  
  7         30  
9 7     7   23685 use Net::DNS;
  7         644848  
  7         1718  
10 7     7   3754 use Email::Valid;
  7         198223  
  7         590  
11              
12             # ABSTRACT: String::Validator for checking Email Addresses.
13              
14             my $email_messages = {
15             email_fqdn => 'Does not appear to contain a Fully Qualified Domain Name.',
16             email_rfc822_noat => 'Missing @ symbol',
17             email_rfc822 => 'Does not look like an email address.',
18             email_tld => 'This TLD (Top Level Domain) is not recognized.',
19             email_nomx1 => 'Mail Exchanger for ',
20             email_nomx2 => ' is missing from Public DNS. Mail cannot be delivered.',
21             };
22              
23             sub new {
24 10     10 1 7721 my $class = shift ;
25 10         39 my $self = { @_ } ;
26 7     7   80 use base ( 'String::Validator::Common' ) ;
  7         18  
  7         5429  
27 10 50       45 unless ( defined $self->{ min_len } )
28 10         39 { $self->{ min_len } = 6 ; }
29 10 100       32 unless ( defined $self->{ max_len } )
30 9         26 { $self->{ max_len } = 64 ; }
31             # allow_ip wont work with fqdn or tldcheck
32 10 100       103 if ( $self->{ allow_ip } ) {
33 1         2 $self->{ mxcheck } = 0 ;
34 1         3 $self->{ fqdn } = 0 ;
35 1         2 $self->{ tldcheck } = 0 ;
36             }
37             # Converts String::Validator Switches to Email::Valid Switches.
38 10         85 my %switchhash = () ;
39 10         52 for ( qw / tldcheck fqdn allow_ip /) {
40 30         89 my $dashstr = '-' . $_ ;
41 30 100       87 if ( defined $self->{ $_ } )
42 9         24 { $switchhash{ $dashstr } = $self->{ $_ } }
43             }
44 10 100       36 unless( defined $self->{ tldcheck } ) {
45 6         22 $switchhash{ '-tldcheck' } = 1 }
46 10         38 $self->{ switchhash } = \%switchhash ;
47 10 100       35 if( $self->{ mxcheck } ) {
48 1         2 $self->{ fqdn } = 1 ; #before mx, must pass fqdn.
49 1         14 $self->{ NetDNS } = Net::DNS::Resolver->new;
50             }
51             $self->{messages}
52             = String::Validator::Common::_Messages(
53 10         140 $email_messages, $self->{language}, $self->{custom_messages} );
54 10         554 bless $self, $class ;
55 10         56 return $self ;
56             }
57              
58             # Email::Valid has very terse error codes.
59             # Not an OO method
60             sub _expound {
61 10     10   20 my $self = shift ;
62 10   50     30 my $errors = shift || '';
63 10         18 my $string = shift ;
64 10         20 my $expounded = '' ;
65 10 100       37 if ( $errors =~ m/fqdn/ ) {
66 5         30 $expounded .= $self->{messages}{ email_fqdn } }
67 10 100       35 if ( $errors =~ m/rfc822/ ) {
68 1 50       6 unless ( $string =~ /\@/ ) {
69 1         4 $expounded .= $self->{messages}{ email_rfc822_noat } }
70             else {
71 0         0 $expounded .= $self->{messages}{ email_rfc822 } }
72             }
73 10 100       41 if ( $errors =~ m/tld/ ) {
74 1         5 $string =~ m/\.(.*)$/;
75 1         7 $expounded .= "'$1' : $self->{messages}{ email_tld }" ;
76             }
77 10 100       40 if ( $errors =~ m/mx/ ) {
78             $expounded .= $self->{messages}{ email_nomx1 } . $string .
79 3         14 $self->{messages}{ email_nomx2 } ;
80             }
81 10         38 return $expounded ;
82             }
83              
84             sub _rejectip {
85 12     12   24 my $self = shift ;
86 12 100       96 if ( $self->{ string } =~ /$RE{net}{IPv4}/ ) {
87 2         448 $self->IncreaseErr(
88             "$self->{ string } Looks like it contains an IP Address." ) }
89             }
90              
91             sub Check{
92 21     21 1 10332 my ( $self, $string1, $string2 ) = @_ ;
93             #not standard hashvar so not inited by inherited method in CheckCommon.
94 21         69 $self->{ expounded } = '' ;
95 21 100       103 if ( $self->CheckCommon( $string1, $string2 ) ) {
96 1         35 return $self->{ error } }
97 20         828 my %switchhash = %{ $self->{switchhash} } ;
  20         81  
98 20         54 $switchhash{ -address } = $self->{ string } ;
99 20         33 my $fail = 0;
100 20         116 my $addr = Email::Valid->address( %switchhash );
101 20 100       52417 $fail = $Email::Valid::Details unless $addr;
102 20 100       68 if ( $fail ) {
103 7         47 $self->IncreaseErr( $fail ) ;
104             $self->{ expounded } = $self->_expound(
105 7         79 $fail, $self->{ string } ) ;
106             }
107             else {
108 13 100       41 unless ( $self->{ allow_ip } ) {
109 12         39 $self->_rejectip() }
110             }
111             # Need maildomain for mxcheck.
112 20         1881 ( my $discard, $self->{maildomain} ) = split( /\@/, $self->{ string } );
113 20         59 $self->{maildomain} =~ tr/\>//d ; #clean out unwanted chars.
114 20 100       89 if ( $self->{ mxcheck } ) {
115 6 100       18 if ( $self->{ error } == 0 ) {
116 5 100       21 unless ( mx( $self->{ NetDNS }, $self->{ maildomain } ) ) {
117 3         106245 $self->IncreaseErr( "MX" ) ;
118             $self->{ expounded } =
119 3         35 $self->_expound( 'mx', $self->{ maildomain} ) ;
120             }
121             }
122             }
123 20         43030 return $self->{ error } ;
124             }
125              
126             sub Expound {
127 6     6 1 4392 my $self = shift ;
128 6         39 return $self->{ expounded } ;
129             }
130              
131              
132             1; # End of String::Validator::Email
133              
134             __END__