File Coverage

blib/lib/Data/FormValidator/Constraints/Dates.pm
Criterion Covered Total %
statement 48 48 100.0
branch 21 26 80.7
condition 7 14 50.0
subroutine 8 8 100.0
pod 1 2 50.0
total 85 98 86.7


line stmt bran cond sub pod time code
1             package Data::FormValidator::Constraints::Dates;
2 2     2   5667 use Exporter 'import';
  2         4  
  2         58  
3 2     2   40 use 5.005;
  2         6  
4 2     2   8 use strict;
  2         4  
  2         1073  
5              
6             our %EXPORT_TAGS = ( 'all' => [ qw() ] );
7              
8             our @EXPORT_OK = (
9             'date_and_time',
10             @{ $EXPORT_TAGS{'all'} }
11             );
12              
13             our @EXPORT = qw(
14             match_date_and_time
15             );
16              
17             our $VERSION = 4.88;
18              
19             sub date_and_time {
20 5     5 1 3641 my $fmt = shift;
21             return sub {
22 4     4   6 my $self = shift;
23 4         13 $self->set_current_constraint_name('date_and_time');
24 4         9 return match_date_and_time($self,\$fmt);
25             }
26 5         32 }
27              
28             sub match_date_and_time {
29 6     6 0 8 my $self = shift;
30 6   50     13 my $fmt_ref = shift || die q!date_and_time: need format parameter. Be sure to pass it by reference, like this: \'MM/DD/YYYY'!;
31 6         19 my $fmt = $$fmt_ref;
32              
33 6         20 require Date::Calc;
34 6         205 import Date::Calc (qw/check_date check_time/);
35              
36 6         15 my $format = _prepare_date_format($fmt);
37 6         20 my ($date,$Y,$M,$D,$h,$m,$s) = _parse_date_format($format,$self->get_current_constraint_value);
38 6 100       40 return if not defined $date;
39              
40              
41             # We need to check the date if we find any in the format string, otherwise, it succeeds
42 4         5 my $date_test = 1;
43 4 50       22 $date_test = check_date($Y,$M,$D) if ($fmt =~ /[YMD]/) ;
44              
45             # If we find a time, check that
46 4         10 my $time_test = 1;
47 4 100       16 $time_test = check_time($h,$m,$s) if ($fmt =~ /[hms]/) ;
48              
49             # If either the time or date fails, it all fails
50 4 100 66     26 return ($date_test && $time_test) ? $date : undef;
51             }
52              
53             sub _prepare_date_format {
54 11     11   10114 my $format = shift;
55              
56             # Originally by Jan Krynicky
57              
58             # TODO: check that only valid characters appear in the format
59             # The logic should be: for any character A-Z in the format string,
60             # die if it's not one of: Y M D h m s p
61              
62 11         22 my ($i, @order) = 0;
63 11         61 $format =~ s{(Y+|M+|D+|h+|m+|s+|pp)(\?)?}{
64 61         132 my ($chr,$q) = ($1,$2);
65 61 50       104 $chr = '' if not defined $chr;
66 61 50       98 $q = '' if not defined $chr;
67              
68 61         111 $order[$i++] = substr($chr,0,1);
69 61 100       98 if ($chr eq 'pp') {
70 6         16 "(AM|PM|am|pm)"
71             } else {
72 55 100       209 '(' . ('\d' x length($chr)) . ($q ? $q : "") . ")"
73             }
74             }ge;
75              
76              
77 11         268 $format = qr/^((?:$format))$/;
78 11         51 return [$format, \@order];
79             }
80              
81             sub _parse_date_format {
82             # Originally by Jan Krynicky
83              
84 11     11   35 my ($format, $date) = @_;
85 11 100       102 my ($untainted_date,@data) = ($date =~ $format->[0])
86             or return;
87 9         18 my %result;
88 9         26 for(my $i = 0; $i <= $#data; $i++) {
89 49   66     193 $result{$format->[1]->[$i]} ||= $data[$i];
90             }
91              
92 9 100       21 if (exists $result{p}) {
93 4 50 33     22 $result{h} += 12 if ($result{p} eq 'PM' and $result{h} != 12);
94 4 50 33     14 $result{h} = 0 if ($result{p} eq 'AM' and $result{h} == 12);
95             }
96              
97              
98 9 100       22 return $untainted_date, map {defined $result{$_} ? $result{$_} : 0} qw(Y M D h m s);
  54         148  
99             }
100              
101             1;
102             __END__