File Coverage

blib/lib/HTML/FormFu/Constraint/Email.pm
Criterion Covered Total %
statement 29 29 100.0
branch 10 12 83.3
condition 4 5 80.0
subroutine 5 5 100.0
pod 0 1 0.0
total 48 52 92.3


line stmt bran cond sub pod time code
1 5     5   775 use strict;
  5         13  
  5         326  
2              
3             package HTML::FormFu::Constraint::Email;
4             $HTML::FormFu::Constraint::Email::VERSION = '2.07';
5             # ABSTRACT: Email Address Constraint
6              
7 5     5   31 use Moose;
  5         12  
  5         39  
8 5     5   34915 use MooseX::Attribute::Chained;
  5         15  
  5         213  
9              
10             extends 'HTML::FormFu::Constraint';
11              
12 5     5   3311 use Email::Valid;
  5         564708  
  5         1948  
13              
14             has options => ( is => 'rw', traits => ['Chained'] );
15              
16             sub constrain_value {
17 12     12 0 50 my ( $self, $value ) = @_;
18              
19 12 100 66     71 return 1 if !defined $value || $value eq '';
20              
21 11         53 my %options = ( -address => $value );
22              
23 11 100       358 if ( defined $self->options ) {
24              
25 5 100       156 if ( ref $self->options eq 'ARRAY' ) {
    100          
26              
27 1         3 for my $foo ( @{ $self->options } ) {
  1         29  
28 1 50       5 next if $foo eq 'address';
29 1         6 $options{ '-' . $foo } = 1;
30             }
31              
32             }
33             elsif ( ref $self->options eq 'HASH' ) {
34              
35 3         8 for my $foo ( keys %{ $self->options } ) {
  3         85  
36 3 50       12 next if $foo eq 'address';
37 3         87 $options{ '-' . $foo } = $self->options->{$foo};
38             }
39              
40             }
41             else {
42              
43 1         29 $options{ '-' . $self->options } = 1;
44              
45             }
46              
47             }
48              
49 11   100     101 my $validated_address = ( Email::Valid->address(%options) // '' );
50 11         126199 my $ok = $value eq $validated_address;
51              
52 11         75 return $ok;
53             }
54              
55             __PACKAGE__->meta->make_immutable;
56              
57             1;
58              
59             __END__
60              
61             =pod
62              
63             =encoding UTF-8
64              
65             =head1 NAME
66              
67             HTML::FormFu::Constraint::Email - Email Address Constraint
68              
69             =head1 VERSION
70              
71             version 2.07
72              
73             =head1 DESCRIPTION
74              
75             Checks the input value is an email address according to the C<address>
76             method of L<Email::Valid>.
77              
78             =head1 METHODS
79              
80             =head2 options
81              
82             Arguments: $string
83              
84             Arguments: \@strings
85              
86             Arguments: \%keypairs
87              
88             Options are passed to L<Email::Valid>. An array or single option is
89             passd through with each option as 'true'. Using a hash instead, you
90             can pass through more specific key pair options. Remember in both
91             cases to omitted the leading dash that you would otherwise need if
92             using L<Email::Valid> directly.
93              
94             type: Email
95             options:
96             - macheck
97             - tldcheck
98             - fudge
99             - fqdn
100             - allow_ip
101             - local_rules
102              
103             =head2 SEE ALSO
104              
105             Is a sub-class of, and inherits methods from L<HTML::FormFu::Constraint>
106              
107             The available options are as per L<Email::Valid> but without the '-'
108              
109             =head1 AUTHOR
110              
111             Carl Franks C<cfranks@cpan.org>, Dean Hamstead C<dean@bytefoundry.com.au>
112              
113             =head1 LICENSE
114              
115             This library is free software, you can redistribute it and/or modify it under
116             the same terms as Perl itself.
117              
118             =head1 AUTHOR
119              
120             Carl Franks <cpan@fireartist.com>
121              
122             =head1 COPYRIGHT AND LICENSE
123              
124             This software is copyright (c) 2018 by Carl Franks.
125              
126             This is free software; you can redistribute it and/or modify it under
127             the same terms as the Perl 5 programming language system itself.
128              
129             =cut