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   21 use strict;
  4         7  
  4         187  
4 4     4   26 use warnings;
  4         7  
  4         137  
5              
6 4     4   2764 use Email::Valid;
  4         444152  
  4         217  
7 4     4   2434 use Regexp::Common qw/URI/;
  4         18057  
  4         22  
8 4     4   119241 use Time::Piece;
  4         39254  
  4         117  
9              
10             our $VERSION = '0.09';
11              
12             sub email {
13             return sub {
14 8     8   12 my $value = shift;
15 8 100 66     36 return if !defined($value) || $value eq '';
16              
17 6 100       28 return 'WRONG_EMAIL' unless Email::Valid->address($value);
18 3         1970 return;
19 8     8 0 50 };
20             }
21              
22              
23             sub equal_to_field {
24 8     8 0 10 my $field = shift;
25              
26             return sub {
27 8     8   10 my ( $value, $params ) = @_;
28 8 100 66     29 return if !defined($value) || $value eq '';
29              
30 6 100       14 return 'FIELDS_NOT_EQUAL' unless $value eq $params->{$field};
31 3         4 return;
32 8         51 };
33             }
34              
35              
36             sub url {
37             return sub {
38 8     8   9 my $value = shift;
39 8 100 66     35 return if !defined($value) || $value eq '';
40              
41 6         12 $value =~ s/#[^#]*$//;
42              
43 6 100       39 return 'WRONG_URL' unless lc($value) =~ /^$RE{URI}{HTTP}{-scheme => 'https?'}$/;
44 3         522 return;
45 8     8 0 54 };
46             }
47              
48              
49             sub iso_date {
50             return sub {
51 8     8   9 my $value = shift;
52 8 100 66     31 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       41 if ( $value =~ $iso_date_re ) {
61 5         4 my $date = eval { Time::Piece->strptime($value, "%Y-%m-%d") };
  5         24  
62 5 100 66     181 return "WRONG_DATE" if !$date || $@;
63              
64 4 100 66 4   4413 if ( $date->year == $+{year} && $date->mon == $+{month} && $date->mday == $+{day} ) {
  4   66     1808  
  4         360  
  4         233  
65 3         83 return;
66             }
67             }
68              
69 2         28 return "WRONG_DATE";
70 8     8 0 50 };
71             }
72              
73             1;