File Coverage

blib/lib/HTML/FormFu/Constraint/Email.pm
Criterion Covered Total %
statement 28 28 100.0
branch 10 12 83.3
condition 2 3 66.6
subroutine 5 5 100.0
pod 0 1 0.0
total 45 49 91.8


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