File Coverage

blib/lib/Email/Valid/Loose.pm
Criterion Covered Total %
statement 18 18 100.0
branch 4 6 66.6
condition n/a
subroutine 5 5 100.0
pod 1 1 100.0
total 28 30 93.3


line stmt bran cond sub pod time code
1             package Email::Valid::Loose;
2              
3 2     2   66289 use strict;
  2         6  
  2         190  
4             our $VERSION = '0.05';
5              
6 2     2   2612 use Email::Valid 0.17;
  2         409702  
  2         77  
7 2     2   20 use base qw(Email::Valid);
  2         10  
  2         730  
8              
9             # This is BNF from RFC822
10             my $esc = '\\\\';
11             my $period = '\.';
12             my $space = '\040';
13             my $open_br = '\[';
14             my $close_br = '\]';
15             my $nonASCII = '\x80-\xff';
16             my $ctrl = '\000-\037';
17             my $cr_list = '\n\015';
18             my $qtext = qq/[^$esc$nonASCII$cr_list\"]/; # "
19             my $dtext = qq/[^$esc$nonASCII$cr_list$open_br$close_br]/;
20             my $quoted_pair = qq<$esc>.qq<[^$nonASCII]>;
21             my $atom_char = qq/[^($space)<>\@,;:\".$esc$open_br$close_br$ctrl$nonASCII]/; # "
22             my $atom = qq<$atom_char+(?!$atom_char)>;
23             my $quoted_str = qq<\"$qtext*(?:$quoted_pair$qtext*)*\">; # "
24             my $word = qq<(?:$atom|$quoted_str)>;
25             my $domain_ref = $atom;
26             my $domain_lit = qq<$open_br(?:$dtext|$quoted_pair)*$close_br>;
27             my $sub_domain = qq<(?:$domain_ref|$domain_lit)>;
28             my $domain = qq<$sub_domain(?:$period$sub_domain)*>;
29             my $local_part = qq<$word(?:$word|$period)*>; # This part is modified
30              
31             # Finally, the address-spec regex (more or less)
32 2     2   12 use vars qw($Addr_spec_re);
  2         4  
  2         458  
33             $Addr_spec_re = qr<$local_part\@$domain>;
34              
35             sub rfc822 {
36 6     6 1 2531 my $self = shift;
37 6         22 my %args = $self->_rearrange([qw( address )], \@_);
38              
39 6 50       176 my $addr = $args{address} or return $self->details('rfc822');
40 6 50       30 $addr = $addr->address if UNIVERSAL::isa($addr, 'Mail::Address');
41              
42 6 100       201 return $self->details('rfc822') unless $addr =~ m/^$Addr_spec_re$/o;
43 3         16 return 1;
44             }
45             1;
46             __END__