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__ |