File Coverage

blib/lib/Validation/Class/Directive/Date.pm
Criterion Covered Total %
statement 26 26 100.0
branch 8 12 66.6
condition 2 6 33.3
subroutine 5 5 100.0
pod 0 1 0.0
total 41 50 82.0


line stmt bran cond sub pod time code
1             # ABSTRACT: Date Directive for Validation Class Field Definitions
2              
3             package Validation::Class::Directive::Date;
4              
5 109     109   44338 use strict;
  109         233  
  109         2666  
6 109     109   497 use warnings;
  109         244  
  109         2358  
7              
8 109     109   480 use base 'Validation::Class::Directive';
  109         196  
  109         8259  
9              
10 109     109   679 use Validation::Class::Util;
  109         236  
  109         544  
11              
12             our $VERSION = '7.900058'; # VERSION
13              
14              
15             has 'mixin' => 1;
16             has 'field' => 1;
17             has 'multi' => 0;
18             has 'message' => '%s requires a valid date';
19              
20             sub validate {
21              
22 5     5 0 11 my ($self, $proto, $field, $param) = @_;
23              
24 5 50 33     20 if (defined $field->{date} && defined $param) {
25              
26 5         71 my $dtre = {
27             # options:
28             # dmy 27-12-2006 or 27-12-06 separators can be a space, period, dash, forward slash
29             # mdy 12-27-2006 or 12-27-06 separators can be a space, period, dash, forward slash
30             # ymd 2006-12-27 or 06-12-27 separators can be a space, period, dash, forward slash
31             # dMy 27 December 2006 or 27 Dec 2006
32             # Mdy December 27, 2006 or Dec 27, 2006 comma is optional
33             # My December 2006 or Dec 2006
34             # my 12/2006 separators can be a space, period, dash, forward slash
35             'dmy' => qr%^(?:(?:31(\/|-|\.|\x20)(?:0?[13578]|1[02]))\1|(?:(?:29|30)(\/|-|\.|\x20)(?:0?[1,3-9]|1[0-2])\2))(?:(?:1[6-9]|[2-9]\d)?\d{2})$|^(?:29(\/|-|\.|\x20)0?2\3(?:(?:(?:1[6-9]|[2-9]\d)?(?:0[48]|[2468][048]|[13579][26])|(?:(?:16|[2468][048]|[3579][26])00))))$|^(?:0?[1-9]|1\d|2[0-8])(\/|-|\.|\x20)(?:(?:0?[1-9])|(?:1[0-2]))\4(?:(?:1[6-9]|[2-9]\d)?\d{2})$%,
36             'mdy' => qr%^(?:(?:(?:0?[13578]|1[02])(\/|-|\.|\x20)31)\1|(?:(?:0?[13-9]|1[0-2])(\/|-|\.|\x20)(?:29|30)\2))(?:(?:1[6-9]|[2-9]\d)?\d{2})$|^(?:0?2(\/|-|\.|\x20)29\3(?:(?:(?:1[6-9]|[2-9]\d)?(?:0[48]|[2468][048]|[13579][26])|(?:(?:16|[2468][048]|[3579][26])00))))$|^(?:(?:0?[1-9])|(?:1[0-2]))(\/|-|\.|\x20)(?:0?[1-9]|1\d|2[0-8])\4(?:(?:1[6-9]|[2-9]\d)?\d{2})$%,
37             'ymd' => qr%^(?:(?:(?:(?:(?:1[6-9]|[2-9]\d)?(?:0[48]|[2468][048]|[13579][26])|(?:(?:16|[2468][048]|[3579][26])00)))(\/|-|\.|\x20)(?:0?2\1(?:29)))|(?:(?:(?:1[6-9]|[2-9]\d)?\d{2})(\/|-|\.|\x20)(?:(?:(?:0?[13578]|1[02])\2(?:31))|(?:(?:0?[1,3-9]|1[0-2])\2(29|30))|(?:(?:0?[1-9])|(?:1[0-2]))\2(?:0?[1-9]|1\d|2[0-8]))))$%,
38             'dMy' => qr%^((31(?!\ (Feb(ruary)?|Apr(il)?|June?|(Sep(?=\b|t)t?|Nov)(ember)?)))|((30|29)(?!\ Feb(ruary)?))|(29(?=\ Feb(ruary)?\ (((1[6-9]|[2-9]\d)(0[48]|[2468][048]|[13579][26])|((16|[2468][048]|[3579][26])00)))))|(0?[1-9])|1\d|2[0-8])\ (Jan(uary)?|Feb(ruary)?|Ma(r(ch)?|y)|Apr(il)?|Ju((ly?)|(ne?))|Aug(ust)?|Oct(ober)?|(Sep(?=\b|t)t?|Nov|Dec)(ember)?)\ ((1[6-9]|[2-9]\d)\d{2})$%,
39             'Mdy' => qr%^(?:(((Jan(uary)?|Ma(r(ch)?|y)|Jul(y)?|Aug(ust)?|Oct(ober)?|Dec(ember)?)\ 31)|((Jan(uary)?|Ma(r(ch)?|y)|Apr(il)?|Ju((ly?)|(ne?))|Aug(ust)?|Oct(ober)?|(Sep)(tember)?|(Nov|Dec)(ember)?)\ (0?[1-9]|([12]\d)|30))|(Feb(ruary)?\ (0?[1-9]|1\d|2[0-8]|(29(?=,?\ ((1[6-9]|[2-9]\d)(0[48]|[2468][048]|[13579][26])|((16|[2468][048]|[3579][26])00)))))))\,?\ ((1[6-9]|[2-9]\d)\d{2}))$%,
40             'My' => qr%^(Jan(uary)?|Feb(ruary)?|Ma(r(ch)?|y)|Apr(il)?|Ju((ly?)|(ne?))|Aug(ust)?|Oct(ober)?|(Sep(?=\b|t)t?|Nov|Dec)(ember)?)[ /]((1[6-9]|[2-9]\d)\d{2})$%,
41             'my' => qr%^(((0[123456789]|10|11|12)([- /.])(([1][9][0-9][0-9])|([2][0-9][0-9][0-9]))))$%
42             };
43              
44 5         12 my $type = $field->{date};
45              
46 5 50 33     18 if ($field->{required} || $param) {
47              
48 5         13 my $is_valid = 0;
49              
50 5 50       12 $type = isa_arrayref($type) ?
    50          
51             $type : $type eq '1' ? [sort keys %$dtre] : [$type]
52             ;
53              
54 5         8 for (@{$type}) {
  5         9  
55              
56 5 100       50 if ($param =~ $dtre->{$_}) {
57 2         4 $is_valid = 1;
58 2         3 last;
59             }
60              
61             }
62              
63 5 100       24 $self->error($proto, $field) unless $is_valid;
64              
65             }
66              
67             }
68              
69 5         12 return $self;
70              
71             }
72              
73             1;
74              
75             __END__