File Coverage

blib/lib/Validator/LIVR/Rules/Special.pm
Criterion Covered Total %
statement 46 46 100.0
branch 20 20 100.0
condition 14 21 66.6
subroutine 14 14 100.0
pod 0 4 0.0
total 94 105 89.5


line stmt bran cond sub pod time code
1             package Validator::LIVR::Rules::Special;
2              
3 4     4   15 use strict;
  4         5  
  4         119  
4 4     4   13 use warnings;
  4         5  
  4         75  
5              
6 4     4   1928 use Email::Valid;
  4         374566  
  4         145  
7 4     4   1983 use Regexp::Common qw/URI/;
  4         13746  
  4         19  
8 4     4   88152 use Time::Piece;
  4         32067  
  4         20  
9              
10             our $VERSION = '0.08';
11              
12             sub email {
13             return sub {
14 8     8   13 my $value = shift;
15 8 100 66     34 return if !defined($value) || $value eq '';
16              
17 6 100       25 return 'WRONG_EMAIL' unless Email::Valid->address($value);
18 3         2209 return;
19 8     8 0 51 };
20             }
21              
22              
23             sub equal_to_field {
24 8     8 0 11 my $field = shift;
25              
26             return sub {
27 8     8   11 my ( $value, $params ) = @_;
28 8 100 66     36 return if !defined($value) || $value eq '';
29              
30 6 100       16 return 'FIELDS_NOT_EQUAL' unless $value eq $params->{$field};
31 3         6 return;
32 8         68 };
33             }
34              
35              
36             sub url {
37             return sub {
38 8     8   11 my $value = shift;
39 8 100 66     31 return if !defined($value) || $value eq '';
40              
41 6         19 $value =~ s/#[^#]*$//;
42              
43 6 100       43 return 'WRONG_URL' unless lc($value) =~ /^$RE{URI}{HTTP}{-scheme => 'https?'}$/;
44 3         739 return;
45 8     8 0 65 };
46             }
47              
48              
49             sub iso_date {
50             return sub {
51 8     8   10 my $value = shift;
52 8 100 66     32 return if !defined($value) || $value eq '';
53              
54 6         14 my $iso_date_re = qr#^
55             (?\d{4})-
56             (?[0-1][0-9])-
57             (?[0-3][0-9])
58             $#x;
59              
60 6 100       40 if ( $value =~ $iso_date_re ) {
61 5         7 my $date = eval { Time::Piece->strptime($value, "%Y-%m-%d") };
  5         24  
62 5 100 66     184 return "WRONG_DATE" if !$date || $@;
63              
64 4 100 66 4   3413 if ( $date->year == $+{year} && $date->mon == $+{month} && $date->mday == $+{day} ) {
  4   66     1435  
  4         304  
  4         217  
65 3         85 return;
66             }
67             }
68              
69 2         31 return "WRONG_DATE";
70 8     8 0 57 };
71             }
72              
73             1;