File Coverage

blib/lib/Input/Validator/Constraint/Email.pm
Criterion Covered Total %
statement 25 25 100.0
branch 10 12 83.3
condition 7 9 77.7
subroutine 6 6 100.0
pod 1 1 100.0
total 49 53 92.4


line stmt bran cond sub pod time code
1             package Input::Validator::Constraint::Email;
2              
3 1     1   18815 use strict;
  1         1  
  1         30  
4 1     1   4 use warnings;
  1         1  
  1         23  
5              
6 1     1   4 use base 'Input::Validator::Constraint';
  1         1  
  1         525  
7              
8 1     1   5 use constant NAME_MAX_LENGTH => 64;
  1         1  
  1         86  
9 1     1   4 use constant DOMAIN_MAX_LENGTH => 255;
  1         2  
  1         195  
10              
11             sub is_valid {
12 9     9 1 428 my ($self, $value) = @_;
13              
14 9 100       31 return unless length $value <= NAME_MAX_LENGTH + 1 + DOMAIN_MAX_LENGTH;
15              
16 7         22 my ($name, $domain) = split /@/ => $value;
17 7 100 66     41 return 0 unless defined $name && defined $domain;
18 6 100 66     31 return 0 if $name eq '' || $domain eq '';
19              
20 5 50       12 return unless length $name <= NAME_MAX_LENGTH;
21 5 50       12 return unless length $domain <= DOMAIN_MAX_LENGTH;
22              
23 5         13 my ($subdomain, $root) = split /\./ => $domain;
24 5 100 100     43 return unless $subdomain && $root;
25              
26 2         8 return 1;
27             }
28              
29             1;
30             __END__