line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::FormValidator::Constraints::DateTime; |
2
|
6
|
|
|
6
|
|
482929
|
use strict; |
|
6
|
|
|
|
|
17
|
|
|
6
|
|
|
|
|
299
|
|
3
|
6
|
|
|
6
|
|
1460
|
use DateTime; |
|
6
|
|
|
|
|
194977
|
|
|
6
|
|
|
|
|
176
|
|
4
|
6
|
|
|
6
|
|
13641
|
use DateTime::Format::Strptime; |
|
6
|
|
|
|
|
49026
|
|
|
6
|
|
|
|
|
557
|
|
5
|
6
|
|
|
6
|
|
69
|
use Scalar::Util qw(blessed); |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
368
|
|
6
|
6
|
|
|
6
|
|
34
|
use Exporter; |
|
6
|
|
|
|
|
9
|
|
|
6
|
|
|
|
|
1283
|
|
7
|
6
|
|
|
6
|
|
38
|
use Carp qw(croak); |
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
20973
|
|
8
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
9
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
10
|
|
|
|
|
|
|
to_datetime |
11
|
|
|
|
|
|
|
ymd_to_datetime |
12
|
|
|
|
|
|
|
before_today |
13
|
|
|
|
|
|
|
after_today |
14
|
|
|
|
|
|
|
ymd_before_today |
15
|
|
|
|
|
|
|
ymd_after_today |
16
|
|
|
|
|
|
|
before_datetime |
17
|
|
|
|
|
|
|
after_datetime |
18
|
|
|
|
|
|
|
between_datetimes |
19
|
|
|
|
|
|
|
to_mysql_datetime |
20
|
|
|
|
|
|
|
to_mysql_date |
21
|
|
|
|
|
|
|
to_mysql_timestamp |
22
|
|
|
|
|
|
|
to_pg_datetime |
23
|
|
|
|
|
|
|
); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( |
26
|
|
|
|
|
|
|
all => \@EXPORT_OK, |
27
|
|
|
|
|
|
|
mysql => [qw(to_mysql_datetime to_mysql_date to_mysql_timestamp)], |
28
|
|
|
|
|
|
|
pg => [qw(to_pg_datetime)], |
29
|
|
|
|
|
|
|
); |
30
|
|
|
|
|
|
|
our $VERSION = '1.11'; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=head1 NAME |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
Data::FormValidator::Constraints::DateTime - D::FV constraints for dates and times |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 DESCRIPTION |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
This package provides constraint routines for L for |
39
|
|
|
|
|
|
|
dealing with dates and times. It provides an easy mechanism for validating |
40
|
|
|
|
|
|
|
dates of any format (using strptime(3)) and transforming those dates (as long |
41
|
|
|
|
|
|
|
as you 'untaint' the fields) into valid L objects, or into strings |
42
|
|
|
|
|
|
|
that would be properly formatted for various database engines. |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=head1 ABSTRACT |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
use Data::FormValidator; |
47
|
|
|
|
|
|
|
use Data::FormValidator::Constraints::DateTime qw(:all); |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# create our profile |
50
|
|
|
|
|
|
|
my $profile = { |
51
|
|
|
|
|
|
|
required => [qw(my_date)], |
52
|
|
|
|
|
|
|
constraint_methods => { |
53
|
|
|
|
|
|
|
my_date => to_datetime('%D'), # in the format MM/DD/YYYY |
54
|
|
|
|
|
|
|
}, |
55
|
|
|
|
|
|
|
untaint_all_constraints => 1, |
56
|
|
|
|
|
|
|
}; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# validate 'my_date' |
59
|
|
|
|
|
|
|
my $results = Data::FormValidator->check($my_input, $profile); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
if( $results->success ) { |
62
|
|
|
|
|
|
|
# if we got here then $results->valid('my_date') |
63
|
|
|
|
|
|
|
# is a valid DateTime object |
64
|
|
|
|
|
|
|
my $datetime = $results->valid('my_date'); |
65
|
|
|
|
|
|
|
. |
66
|
|
|
|
|
|
|
. |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 STRPTIME FORMATS |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
Most of the validation routines provided by this module use |
72
|
|
|
|
|
|
|
strptime(3) format strings to know what format your date string |
73
|
|
|
|
|
|
|
is in before we can process it. You specify this format for each |
74
|
|
|
|
|
|
|
date you want to validate using by passing it to constraint |
75
|
|
|
|
|
|
|
generation routine (see the example above). |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
We use L for this transformation. |
78
|
|
|
|
|
|
|
If you need a list of these formats (if you haven't yet committed |
79
|
|
|
|
|
|
|
them to memory) you can see the strptime(3) man page (if you are |
80
|
|
|
|
|
|
|
on a *nix system) or you can see the L |
81
|
|
|
|
|
|
|
documentation. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
There are however some routines that can live without the format |
84
|
|
|
|
|
|
|
param. These include routines which try and validate according |
85
|
|
|
|
|
|
|
to rules for a particular database (C<< to_mysql_* >> and |
86
|
|
|
|
|
|
|
C<< to_pg_* >>). If no format is provided, then we will attempt to |
87
|
|
|
|
|
|
|
validate according to the rules for that datatype in that database |
88
|
|
|
|
|
|
|
(using L and L). |
89
|
|
|
|
|
|
|
Here are some examples: |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
without a format param |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
my $profile = { |
94
|
|
|
|
|
|
|
required => [qw(my_date)], |
95
|
|
|
|
|
|
|
constraint_methods => { |
96
|
|
|
|
|
|
|
my_date => to_mysql_datetime(), |
97
|
|
|
|
|
|
|
}, |
98
|
|
|
|
|
|
|
}; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
with a format param |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
my $profile = { |
103
|
|
|
|
|
|
|
required => [qw(my_date)], |
104
|
|
|
|
|
|
|
constraint_methods => { |
105
|
|
|
|
|
|
|
my_date => to_mysql_datetime('%m/%d/%Y'), |
106
|
|
|
|
|
|
|
}, |
107
|
|
|
|
|
|
|
}; |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head2 DateTime::Format Objects |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Using strptime(3) format strings gives a lot of flexibility, but sometimes |
112
|
|
|
|
|
|
|
not enough. Suppose you have a web form that allows the user to input a date |
113
|
|
|
|
|
|
|
in the format '11/21/2006' or simply '11/21/06'. A simple format string is |
114
|
|
|
|
|
|
|
not enough. To take full advantage of the DateTime project, any place that |
115
|
|
|
|
|
|
|
you can pass in a strptime(3) format string, you can also pass in a |
116
|
|
|
|
|
|
|
L object. To solve the above problem you might have code |
117
|
|
|
|
|
|
|
that looks like this: |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# your formatter code |
120
|
|
|
|
|
|
|
package MyProject::DateTime::FlexYear; |
121
|
|
|
|
|
|
|
use DateTime::Format::Strptime; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
use DateTime::Format::Builder ( |
124
|
|
|
|
|
|
|
parsers => { |
125
|
|
|
|
|
|
|
parse_datetime => [ |
126
|
|
|
|
|
|
|
sub { eval { DateTime::Format::Strptime->new(pattern => '%m/%d/%Y')->parse_datetime($_[1]) } }, |
127
|
|
|
|
|
|
|
sub { eval { DateTime::Format::Strptime->new(pattern => '%m/%d/%y')->parse_datetime($_[1]) } }, |
128
|
|
|
|
|
|
|
] |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
); |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
1; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
# in your web validation code |
135
|
|
|
|
|
|
|
my $profile = { |
136
|
|
|
|
|
|
|
required => [qw(my_date)], |
137
|
|
|
|
|
|
|
constraint_methods => { |
138
|
|
|
|
|
|
|
my_date => to_mysql_datetime(MyProject::DateTime::FlexYear->new()), |
139
|
|
|
|
|
|
|
}, |
140
|
|
|
|
|
|
|
}; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=head1 VALIDATION ROUTINES |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
Following is the list of validation routines that are provided |
146
|
|
|
|
|
|
|
by this module. |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head2 to_datetime |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
The routine will validate the date aginst a strptime(3) format and |
151
|
|
|
|
|
|
|
change the date string into a DateTime object. This routine B |
152
|
|
|
|
|
|
|
have an accompanying L format param. |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
If the value is untainted (using C or |
155
|
|
|
|
|
|
|
C, it will change the date string into a DateTime |
156
|
|
|
|
|
|
|
object. |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=cut |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub to_datetime { |
161
|
6
|
|
|
6
|
1
|
5059
|
my $format = shift; |
162
|
|
|
|
|
|
|
# dereference stuff if we need to |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
return sub { |
165
|
8
|
|
|
8
|
|
11663
|
my $dfv = shift; |
166
|
8
|
50
|
33
|
|
|
102
|
croak("Must be called using 'constraint_methods'!") |
167
|
|
|
|
|
|
|
unless( blessed $dfv && $dfv->isa('Data::FormValidator::Results') ); |
168
|
8
|
|
|
|
|
27
|
return match_to_datetime($dfv, $format); |
169
|
|
|
|
|
|
|
} |
170
|
6
|
|
|
|
|
51
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub match_to_datetime { |
173
|
16
|
|
|
16
|
0
|
15853
|
my ($dfv, $format) = @_; |
174
|
|
|
|
|
|
|
# if $dfv is a ref then we are called as 'constraint_method' |
175
|
|
|
|
|
|
|
# else as 'constaint' |
176
|
16
|
100
|
|
|
|
96
|
my $value = ref $dfv ? $dfv->get_current_constraint_value : $dfv; |
177
|
|
|
|
|
|
|
# get the DateTime |
178
|
16
|
|
|
|
|
94
|
my $dt = _get_datetime_from_strp($value, $format); |
179
|
16
|
|
|
|
|
57
|
return $dt; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub _get_datetime_from_strp { |
183
|
318
|
|
|
318
|
|
559
|
my ($value, $format) = @_; |
184
|
318
|
100
|
|
|
|
966
|
$format = $$format if( ref $format eq 'SCALAR' ); |
185
|
318
|
|
|
|
|
347
|
my $formatter; |
186
|
|
|
|
|
|
|
# if we have a simple scalar for the format |
187
|
318
|
100
|
|
|
|
651
|
if( ! ref $format ) { |
188
|
|
|
|
|
|
|
# create the formatter |
189
|
314
|
|
|
|
|
1290
|
$formatter = DateTime::Format::Strptime->new( |
190
|
|
|
|
|
|
|
pattern => $format |
191
|
|
|
|
|
|
|
); |
192
|
|
|
|
|
|
|
# else we assume it's a DateTime::Format based object |
193
|
|
|
|
|
|
|
} else { |
194
|
4
|
|
|
|
|
6
|
$formatter = $format; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
# create the DateTime object |
198
|
318
|
|
|
|
|
136052
|
my $dt; |
199
|
318
|
|
|
|
|
634
|
eval { $dt = $formatter->parse_datetime($value); }; |
|
318
|
|
|
|
|
1172
|
|
200
|
|
|
|
|
|
|
# set the formatter (if we can) so that the object |
201
|
|
|
|
|
|
|
# stringifies to the same format as we parsed |
202
|
318
|
100
|
100
|
|
|
215688
|
$dt->set_formatter($formatter) |
203
|
|
|
|
|
|
|
if( $dt && $formatter->can('format_datetime') ); |
204
|
318
|
|
|
|
|
22300
|
return $dt; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=head2 ymd_to_datetime |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
This routine is used to take multiple inputs (one each for the |
210
|
|
|
|
|
|
|
year, month, and day) and combine them into a L object, |
211
|
|
|
|
|
|
|
validate the resulting date, and give you the resulting DateTime |
212
|
|
|
|
|
|
|
object in your C<< valid() >> results. It must recieve as C<< params >> |
213
|
|
|
|
|
|
|
the year, month, and day inputs in that order. You may also specify |
214
|
|
|
|
|
|
|
additional C<< params >> that will be interpretted as 'hour', 'minute' |
215
|
|
|
|
|
|
|
and 'second' values to use. If none are provided, then the time '00:00:00' |
216
|
|
|
|
|
|
|
will be used. |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
my $profile = { |
219
|
|
|
|
|
|
|
required => [qw(my_year)], |
220
|
|
|
|
|
|
|
constraint_methods => { |
221
|
|
|
|
|
|
|
my_year => ymd_to_datetime(qw(my_year my_month my_day my_hour my_min my_sec)), |
222
|
|
|
|
|
|
|
}, |
223
|
|
|
|
|
|
|
}; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
If the value is untainted (using C or |
226
|
|
|
|
|
|
|
C, it will change the date string into a DateTime |
227
|
|
|
|
|
|
|
object. |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=cut |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
sub ymd_to_datetime { |
232
|
5
|
|
|
5
|
1
|
8055
|
my ($year, $month, $day, $hour, $min, $sec) = @_; |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
return sub { |
235
|
12
|
|
|
12
|
|
16781
|
my $dfv = shift; |
236
|
12
|
50
|
33
|
|
|
129
|
croak("Must be called using 'constraint_methods'!") |
237
|
|
|
|
|
|
|
unless( blessed $dfv && $dfv->isa('Data::FormValidator::Results') ); |
238
|
12
|
|
|
|
|
41
|
my $data = $dfv->get_input_data(as_hashref => 1); |
239
|
12
|
|
|
|
|
729
|
return match_ymd_to_datetime( |
240
|
|
|
|
|
|
|
$dfv, |
241
|
|
|
|
|
|
|
_get_value($year, $data), |
242
|
|
|
|
|
|
|
_get_value($month, $data), |
243
|
|
|
|
|
|
|
_get_value($day, $data), |
244
|
|
|
|
|
|
|
_get_value($hour, $data), |
245
|
|
|
|
|
|
|
_get_value($min, $data), |
246
|
|
|
|
|
|
|
_get_value($sec, $data), |
247
|
|
|
|
|
|
|
); |
248
|
5
|
|
|
|
|
58
|
}; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
sub _get_value { |
252
|
130
|
|
|
130
|
|
193
|
my ($value, $data) = @_; |
253
|
130
|
100
|
100
|
|
|
529
|
if( $value && exists $data->{$value} ) { |
254
|
75
|
|
|
|
|
214
|
return $data->{$value}; |
255
|
|
|
|
|
|
|
} else { |
256
|
55
|
|
|
|
|
142
|
return $value; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
sub match_ymd_to_datetime { |
261
|
44
|
|
|
44
|
0
|
78462
|
my ($dfv, $year, $month, $day, $hour, $min, $sec); |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
# if we were called as a 'constraint_method' |
264
|
44
|
100
|
|
|
|
145
|
if( ref $_[0] ) { |
265
|
32
|
|
|
|
|
100
|
($dfv, $year, $month, $day, $hour, $min, $sec) = @_; |
266
|
|
|
|
|
|
|
# else we were called as a 'constraint' |
267
|
|
|
|
|
|
|
} else { |
268
|
12
|
|
|
|
|
35
|
($year, $month, $day, $hour, $min, $sec) = @_; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
# make sure year, month and day are positive numbers |
272
|
44
|
100
|
100
|
|
|
660
|
if( |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
273
|
|
|
|
|
|
|
defined $year && $year ne "" |
274
|
|
|
|
|
|
|
&& defined $month && $month ne "" |
275
|
|
|
|
|
|
|
&& defined $day && $day ne "" |
276
|
|
|
|
|
|
|
) { |
277
|
|
|
|
|
|
|
# set the defaults for time if we don't have any |
278
|
26
|
|
100
|
|
|
363
|
$hour ||= 0; |
279
|
26
|
|
100
|
|
|
90
|
$min ||= 0; |
280
|
26
|
|
100
|
|
|
165
|
$sec ||= 0; |
281
|
|
|
|
|
|
|
|
282
|
26
|
|
|
|
|
49
|
my $dt; |
283
|
26
|
|
|
|
|
41
|
eval { |
284
|
26
|
|
|
|
|
169
|
$dt = DateTime->new( |
285
|
|
|
|
|
|
|
year => $year, |
286
|
|
|
|
|
|
|
month => $month, |
287
|
|
|
|
|
|
|
day => $day, |
288
|
|
|
|
|
|
|
hour => $hour, |
289
|
|
|
|
|
|
|
minute => $min, |
290
|
|
|
|
|
|
|
second => $sec, |
291
|
|
|
|
|
|
|
); |
292
|
|
|
|
|
|
|
}; |
293
|
|
|
|
|
|
|
|
294
|
26
|
|
|
|
|
10328
|
return $dt; |
295
|
|
|
|
|
|
|
} else { |
296
|
18
|
|
|
|
|
66
|
return; |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=head2 before_today |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
This routine will validate the date and make sure it less than or |
303
|
|
|
|
|
|
|
equal to today (using C<< DateTime->today >>). It takes one param |
304
|
|
|
|
|
|
|
which is the format string for the date. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
If it validates and you tell D::FV to untaint this parameter it will be |
307
|
|
|
|
|
|
|
converted into a DateTime object. |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
# make sure they weren't born in the future |
310
|
|
|
|
|
|
|
my $profile = { |
311
|
|
|
|
|
|
|
required => [qw(birth_date)], |
312
|
|
|
|
|
|
|
constraint_methods => { |
313
|
|
|
|
|
|
|
birth_date => before_today('%m/%d/%Y'), |
314
|
|
|
|
|
|
|
}, |
315
|
|
|
|
|
|
|
}; |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
If the value is untainted (using C or |
318
|
|
|
|
|
|
|
C, it will change the date string into a DateTime |
319
|
|
|
|
|
|
|
object. |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=cut |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
sub before_today { |
324
|
3
|
|
|
3
|
1
|
567
|
my $format = shift; |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
return sub { |
327
|
3
|
|
|
3
|
|
899
|
my $dfv = shift; |
328
|
3
|
50
|
33
|
|
|
32
|
croak("Must be called using 'constraint_methods'!") |
329
|
|
|
|
|
|
|
unless( blessed $dfv && $dfv->isa('Data::FormValidator::Results') ); |
330
|
3
|
|
|
|
|
10
|
return match_before_today($dfv, $format); |
331
|
3
|
|
|
|
|
21
|
}; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
sub match_before_today { |
335
|
9
|
|
|
9
|
0
|
10060
|
my ($dfv, $format) = @_; |
336
|
|
|
|
|
|
|
# if $dfv is a ref then we are called as 'constraint_method' |
337
|
|
|
|
|
|
|
# else as 'constaint' |
338
|
9
|
100
|
|
|
|
43
|
my $value = ref $dfv ? $dfv->get_current_constraint_value : $dfv; |
339
|
|
|
|
|
|
|
# get the DateTime |
340
|
9
|
|
|
|
|
49
|
my $dt = _get_datetime_from_strp($value, $format); |
341
|
9
|
|
|
|
|
74
|
my $dt_target = DateTime->today(); |
342
|
|
|
|
|
|
|
# if we have valid DateTime objects and they have the correct |
343
|
|
|
|
|
|
|
# temporaral relationship |
344
|
9
|
100
|
33
|
|
|
5411
|
if( $dt && $dt_target && $dt <= $dt_target ) { |
|
|
|
66
|
|
|
|
|
345
|
6
|
|
|
|
|
3237
|
return $dt; |
346
|
|
|
|
|
|
|
} else { |
347
|
3
|
|
|
|
|
1586
|
return; |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
=head2 after_today |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
This routine will validate the date and make sure it is greater |
354
|
|
|
|
|
|
|
than or equal to today (using C<< DateTime->today() >>). It takes |
355
|
|
|
|
|
|
|
only one param, which is the L format for the date being |
356
|
|
|
|
|
|
|
validated. |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
If it validates and you tell D::FV to untaint this parameter it will be |
359
|
|
|
|
|
|
|
converted into a DateTime object. |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
# make sure the project isn't already due |
362
|
|
|
|
|
|
|
my $profile = { |
363
|
|
|
|
|
|
|
required => [qw(death_date)], |
364
|
|
|
|
|
|
|
constraint_methods => { |
365
|
|
|
|
|
|
|
death_date => after_today('%m/%d/%Y'), |
366
|
|
|
|
|
|
|
}, |
367
|
|
|
|
|
|
|
untaint_all_constraints => 1, |
368
|
|
|
|
|
|
|
}; |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
If the value is untainted (using C or |
371
|
|
|
|
|
|
|
C, it will change the date string into a DateTime |
372
|
|
|
|
|
|
|
object. |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
=cut |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
sub after_today { |
377
|
3
|
|
|
3
|
1
|
9329
|
my $format = shift; |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
return sub { |
380
|
3
|
|
|
3
|
|
8354
|
my $dfv = shift; |
381
|
3
|
50
|
33
|
|
|
44
|
croak("Must be called using 'constraint_methods'!") |
382
|
|
|
|
|
|
|
unless( blessed $dfv && $dfv->isa('Data::FormValidator::Results') ); |
383
|
3
|
|
|
|
|
12
|
return match_after_today($dfv, $format); |
384
|
3
|
|
|
|
|
22
|
}; |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
sub match_after_today { |
388
|
9
|
|
|
9
|
0
|
10661
|
my ($dfv, $format) = @_; |
389
|
|
|
|
|
|
|
# if $dfv is a ref then we are called as 'constraint_method' |
390
|
|
|
|
|
|
|
# else as 'constaint' |
391
|
9
|
100
|
|
|
|
50
|
my $value = ref $dfv ? $dfv->get_current_constraint_value : $dfv; |
392
|
|
|
|
|
|
|
# get the DateTime |
393
|
9
|
|
|
|
|
72
|
my $dt = _get_datetime_from_strp($value, $format); |
394
|
9
|
|
|
|
|
37
|
my $dt_target = DateTime->today(); |
395
|
|
|
|
|
|
|
# if we have valid DateTime objects and they have the correct |
396
|
|
|
|
|
|
|
# temporaral relationship |
397
|
9
|
100
|
33
|
|
|
5654
|
if( $dt && $dt_target && $dt >= $dt_target ) { |
|
|
|
66
|
|
|
|
|
398
|
6
|
|
|
|
|
3427
|
return $dt; |
399
|
|
|
|
|
|
|
} else { |
400
|
3
|
|
|
|
|
1362
|
return; |
401
|
|
|
|
|
|
|
} |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=head2 ymd_before_today |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
This routine will validate the date and make sure it less than or |
408
|
|
|
|
|
|
|
equal to today (using C<< DateTime->today >>). It works just like |
409
|
|
|
|
|
|
|
L in the parameters it takes. |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
If it validates and you tell D::FV to untaint this parameter it will be |
412
|
|
|
|
|
|
|
converted into a DateTime object. |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
# make sure they weren't born in the future |
415
|
|
|
|
|
|
|
my $profile = { |
416
|
|
|
|
|
|
|
required => [qw(birth_date)], |
417
|
|
|
|
|
|
|
constraint_methods => { |
418
|
|
|
|
|
|
|
birth_date => ymd_before_today(qw(dob_year dob_month dob_day)), |
419
|
|
|
|
|
|
|
}, |
420
|
|
|
|
|
|
|
untaint_all_constraints => 1, |
421
|
|
|
|
|
|
|
}; |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
If the value is untainted (using C or |
424
|
|
|
|
|
|
|
C, it will change the date string into a DateTime |
425
|
|
|
|
|
|
|
object. |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=cut |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
sub ymd_before_today { |
430
|
3
|
|
|
3
|
1
|
5469
|
my ($year, $month, $day, $hour, $min, $sec) = @_; |
431
|
|
|
|
|
|
|
return sub { |
432
|
3
|
|
|
3
|
|
1238
|
my $dfv = shift; |
433
|
3
|
50
|
33
|
|
|
184
|
croak("Must be called using 'constraint_methods'!") |
434
|
|
|
|
|
|
|
unless( blessed $dfv && $dfv->isa('Data::FormValidator::Results') ); |
435
|
|
|
|
|
|
|
|
436
|
3
|
|
|
|
|
11
|
my $data = $dfv->get_input_data(as_hashref => 1); |
437
|
3
|
|
|
|
|
142
|
return match_ymd_before_today( |
438
|
|
|
|
|
|
|
$dfv, |
439
|
|
|
|
|
|
|
_get_value($year, $data), |
440
|
|
|
|
|
|
|
_get_value($month, $data), |
441
|
|
|
|
|
|
|
_get_value($day, $data), |
442
|
|
|
|
|
|
|
_get_value($hour, $data), |
443
|
|
|
|
|
|
|
_get_value($min, $data), |
444
|
|
|
|
|
|
|
_get_value($sec, $data), |
445
|
|
|
|
|
|
|
); |
446
|
3
|
|
|
|
|
24
|
}; |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
sub match_ymd_before_today { |
450
|
6
|
|
|
6
|
0
|
6906
|
my $dt = match_ymd_to_datetime(@_); |
451
|
6
|
100
|
66
|
|
|
158
|
if( $dt && ( $dt <= DateTime->today ) ) { |
452
|
4
|
|
|
|
|
3479
|
return $dt; |
453
|
|
|
|
|
|
|
} |
454
|
2
|
|
|
|
|
1690
|
return; # if we get here then it's false |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
=head2 ymd_after_today |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
This routine will validate the date and make sure it greater than or |
460
|
|
|
|
|
|
|
equal to today (using C<< DateTime->today >>). It works just like |
461
|
|
|
|
|
|
|
L in the parameters it takes. |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
If it validates and you tell D::FV to untaint this parameter it will be |
464
|
|
|
|
|
|
|
converted into a DateTime object. |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
# make sure the project isn't already due |
467
|
|
|
|
|
|
|
my $profile = { |
468
|
|
|
|
|
|
|
required => [qw(due_date)], |
469
|
|
|
|
|
|
|
constraint_methods => { |
470
|
|
|
|
|
|
|
birth_date => ymd_after_today(qw(dob_year dob_month dob_day)), |
471
|
|
|
|
|
|
|
}, |
472
|
|
|
|
|
|
|
untaint_all_constraints => 1, |
473
|
|
|
|
|
|
|
}; |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
If the value is untainted (using C or |
476
|
|
|
|
|
|
|
C, it will change the date string into a DateTime |
477
|
|
|
|
|
|
|
object. |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
=cut |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
sub ymd_after_today { |
482
|
3
|
|
|
3
|
1
|
3215
|
my ($year, $month, $day, $hour, $min, $sec) = @_; |
483
|
|
|
|
|
|
|
return sub { |
484
|
3
|
|
|
3
|
|
1103
|
my $dfv = shift; |
485
|
3
|
50
|
33
|
|
|
35
|
croak("Must be called using 'constraint_methods'!") |
486
|
|
|
|
|
|
|
unless( blessed $dfv && $dfv->isa('Data::FormValidator::Results') ); |
487
|
|
|
|
|
|
|
|
488
|
3
|
|
|
|
|
11
|
my $data = $dfv->get_input_data(as_hashref => 1); |
489
|
3
|
|
|
|
|
135
|
return match_ymd_after_today( |
490
|
|
|
|
|
|
|
$dfv, |
491
|
|
|
|
|
|
|
_get_value($year, $data), |
492
|
|
|
|
|
|
|
_get_value($month, $data), |
493
|
|
|
|
|
|
|
_get_value($day, $data), |
494
|
|
|
|
|
|
|
_get_value($hour, $data), |
495
|
|
|
|
|
|
|
_get_value($min, $data), |
496
|
|
|
|
|
|
|
_get_value($sec, $data), |
497
|
|
|
|
|
|
|
); |
498
|
3
|
|
|
|
|
24
|
}; |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
sub match_ymd_after_today { |
502
|
6
|
|
|
6
|
0
|
3844
|
my $dt = match_ymd_to_datetime(@_); |
503
|
6
|
100
|
66
|
|
|
33
|
if( $dt && ( $dt >= DateTime->today ) ) { |
504
|
4
|
|
|
|
|
3061
|
return $dt; |
505
|
|
|
|
|
|
|
} |
506
|
2
|
|
|
|
|
2170
|
return; # if we get here then it's false |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=head2 before_datetime |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
This routine will validate the date and make sure it occurs before |
512
|
|
|
|
|
|
|
the specified date. It takes two params: |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
=over |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
=item * first, the L format |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
(for both the date we are validating and also the date we want to |
519
|
|
|
|
|
|
|
compare against) |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
=item * second, the date we are comparing against. |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
This date we are comparing against can either be a specified date (using |
524
|
|
|
|
|
|
|
a scalar ref), or a named parameter from your form (using a scalar name). |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
=back |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
If it validates and you tell D::FV to untaint this parameter it will be |
529
|
|
|
|
|
|
|
converted into a DateTime object. |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
# make sure they were born before 1979 |
532
|
|
|
|
|
|
|
my $profile = { |
533
|
|
|
|
|
|
|
required => [qw(birth_date)], |
534
|
|
|
|
|
|
|
constraint_methods => { |
535
|
|
|
|
|
|
|
birth_date => before_datetime('%m/%d/%Y', '01/01/1979'), |
536
|
|
|
|
|
|
|
}, |
537
|
|
|
|
|
|
|
untaint_all_constraints => 1, |
538
|
|
|
|
|
|
|
}; |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
If the value is untainted (using C or |
541
|
|
|
|
|
|
|
C, it will change the date string into a DateTime |
542
|
|
|
|
|
|
|
object. |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
=cut |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
sub before_datetime { |
547
|
6
|
|
|
6
|
1
|
8591
|
my ($format, $date) = @_; |
548
|
|
|
|
|
|
|
# dereference stuff if we need to |
549
|
6
|
50
|
|
|
|
21
|
$date = $$date if( ref $date eq 'SCALAR' ); |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
return sub { |
552
|
6
|
|
|
6
|
|
2744
|
my $dfv = shift; |
553
|
6
|
50
|
33
|
|
|
62
|
croak("Must be called using 'constraint_methods'!") |
554
|
|
|
|
|
|
|
unless( blessed $dfv && $dfv->isa('Data::FormValidator::Results') ); |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
# are we using a real date or the name of a parameter |
557
|
6
|
|
|
|
|
27
|
my $data = $dfv->get_input_data(as_hashref => 1); |
558
|
6
|
50
|
|
|
|
463
|
$date = $data->{$date} if( $data->{$date} ); |
559
|
6
|
|
|
|
|
17
|
return match_before_datetime($dfv, $format, $date); |
560
|
6
|
|
|
|
|
46
|
}; |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
sub match_before_datetime { |
564
|
26
|
|
|
26
|
0
|
21281
|
my ($dfv, $format, $target_date) = @_; |
565
|
26
|
100
|
|
|
|
103
|
$target_date = $$target_date if( ref $target_date eq 'SCALAR' ); |
566
|
|
|
|
|
|
|
# if $dfv is a ref then we are called as 'constraint_method' |
567
|
|
|
|
|
|
|
# else as 'constaint' |
568
|
26
|
100
|
|
|
|
102
|
my $value = ref $dfv ? $dfv->get_current_constraint_value : $dfv; |
569
|
|
|
|
|
|
|
# get the DateTime |
570
|
26
|
|
|
|
|
129
|
my $dt = _get_datetime_from_strp($value, $format); |
571
|
26
|
|
|
|
|
65
|
my $dt_target = _get_datetime_from_strp($target_date, $format); |
572
|
|
|
|
|
|
|
# if we have valid DateTime objects and they have the correct |
573
|
|
|
|
|
|
|
# temporaral relationship |
574
|
26
|
100
|
100
|
|
|
112
|
if( $dt && $dt_target && $dt < $dt_target ) { |
|
|
|
100
|
|
|
|
|
575
|
3
|
|
|
|
|
2176
|
return $dt; |
576
|
|
|
|
|
|
|
} else { |
577
|
23
|
|
|
|
|
3452
|
return; |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
} |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
=head2 after_datetime |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
This routine will validate the date and make sure it occurs after |
584
|
|
|
|
|
|
|
the specified date. It takes two params: |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
=over |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
=item * first, the L format |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
(for both the date we are validating and also the date we want to |
591
|
|
|
|
|
|
|
compare against) |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
=item * second, the date we are comparing against. |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
This date we are comparing against can either be a specified date (using a |
596
|
|
|
|
|
|
|
scalar ref), or a named parameter from your form (using a scalar name). |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=back |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
# make sure they died after they were born |
601
|
|
|
|
|
|
|
my $profile = { |
602
|
|
|
|
|
|
|
required => [qw(birth_date death_date)], |
603
|
|
|
|
|
|
|
constraint_methods => { |
604
|
|
|
|
|
|
|
death_date => after_datetime('%m/%d/%Y', 'birth_date'), |
605
|
|
|
|
|
|
|
}, |
606
|
|
|
|
|
|
|
untaint_all_constraints => 1, |
607
|
|
|
|
|
|
|
}; |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
If the value is untainted (using C or |
610
|
|
|
|
|
|
|
C, it will change the date string into a DateTime |
611
|
|
|
|
|
|
|
object. |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
=cut |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
sub after_datetime { |
616
|
6
|
|
|
6
|
1
|
12898
|
my ($format, $date) = @_; |
617
|
|
|
|
|
|
|
# dereference stuff if we need to |
618
|
6
|
50
|
|
|
|
22
|
$date = $$date if( ref $date eq 'SCALAR' ); |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
return sub { |
621
|
6
|
|
|
6
|
|
7304
|
my $dfv = shift; |
622
|
6
|
50
|
33
|
|
|
74
|
croak("Must be called using 'constraint_methods'!") |
623
|
|
|
|
|
|
|
unless( blessed $dfv && $dfv->isa('Data::FormValidator::Results') ); |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
# are we using a real date or the name of a parameter |
626
|
6
|
|
|
|
|
23
|
my $data = $dfv->get_input_data(as_hashref => 1); |
627
|
6
|
|
|
|
|
267
|
$date = _get_value($date, $data); |
628
|
6
|
|
|
|
|
18
|
return match_after_datetime($dfv, $format, $date); |
629
|
6
|
|
|
|
|
50
|
}; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
sub match_after_datetime { |
633
|
26
|
|
|
26
|
0
|
30380
|
my ($dfv, $format, $target_date) = @_; |
634
|
26
|
100
|
|
|
|
115
|
$target_date = $$target_date if( ref $target_date eq 'SCALAR' ); |
635
|
|
|
|
|
|
|
# if $dfv is a ref then we are called as 'constraint_method' |
636
|
|
|
|
|
|
|
# else as 'constaint' |
637
|
26
|
100
|
|
|
|
117
|
my $value = ref $dfv ? $dfv->get_current_constraint_value : $dfv; |
638
|
|
|
|
|
|
|
# get the DateTime |
639
|
26
|
|
|
|
|
144
|
my $dt = _get_datetime_from_strp($value, $format); |
640
|
26
|
|
|
|
|
90
|
my $dt_target = _get_datetime_from_strp($target_date, $format); |
641
|
|
|
|
|
|
|
# if we have valid DateTime objects and they have the correct |
642
|
|
|
|
|
|
|
# temporaral relationship |
643
|
26
|
100
|
100
|
|
|
203
|
if( $dt && $dt_target && $dt > $dt_target ) { |
|
|
|
100
|
|
|
|
|
644
|
3
|
|
|
|
|
2422
|
return $dt; |
645
|
|
|
|
|
|
|
} else { |
646
|
23
|
|
|
|
|
3553
|
return; |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
} |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
=head2 between_datetimes |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
This routine will validate the date and make sure it occurs after |
653
|
|
|
|
|
|
|
the first specified date and before the second specified date. It |
654
|
|
|
|
|
|
|
takes three params: |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
=over |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
=item * first, the L format |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
(for both the date we are validating and also the dates we want to |
661
|
|
|
|
|
|
|
compare against) |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
=item * second, the first date we are comparing against. |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
=item * third, the second date we are comparing against. |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
This date (and the second) we are comparing against can either be a specified date |
668
|
|
|
|
|
|
|
(using a scalar ref), or a named parameter from your form (using a scalar name). |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
=back |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
# make sure they died after they were born |
673
|
|
|
|
|
|
|
my $profile = { |
674
|
|
|
|
|
|
|
required => [qw(birth_date death_date marriage_date)], |
675
|
|
|
|
|
|
|
constraint_methods => { |
676
|
|
|
|
|
|
|
marriage_date => between_datetimes('%m/%d/%Y', 'birth_date', 'death_date'), |
677
|
|
|
|
|
|
|
}, |
678
|
|
|
|
|
|
|
untaint_all_constraints => 1, |
679
|
|
|
|
|
|
|
}; |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
If the value is untainted (using C or |
682
|
|
|
|
|
|
|
C, it will change the date string into a DateTime |
683
|
|
|
|
|
|
|
object. |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
=cut |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
sub between_datetimes { |
688
|
8
|
|
|
8
|
1
|
7080
|
my ($format, $target1, $target2) = @_; |
689
|
|
|
|
|
|
|
# dereference stuff if we need to |
690
|
8
|
50
|
|
|
|
27
|
$target1 = $$target1 if( ref $target1 eq 'SCALAR' ); |
691
|
8
|
50
|
|
|
|
91
|
$target2 = $$target2 if( ref $target2 eq 'SCALAR' ); |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
return sub { |
694
|
8
|
|
|
8
|
|
11005
|
my $dfv = shift; |
695
|
8
|
50
|
33
|
|
|
114
|
croak("Must be called using 'constraint_methods'!") |
696
|
|
|
|
|
|
|
unless( blessed $dfv && $dfv->isa('Data::FormValidator::Results') ); |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
# are we using a real date or the name of a parameter |
699
|
8
|
|
|
|
|
40
|
my $data = $dfv->get_input_data(as_hashref => 1); |
700
|
8
|
|
|
|
|
427
|
$target1 = _get_value($target1, $data); |
701
|
8
|
|
|
|
|
19
|
$target2 = _get_value($target2, $data); |
702
|
8
|
|
|
|
|
26
|
return match_between_datetimes($dfv, $format, $target1, $target2); |
703
|
|
|
|
|
|
|
} |
704
|
8
|
|
|
|
|
59
|
} |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
sub match_between_datetimes { |
707
|
44
|
|
|
44
|
0
|
34423
|
my ($dfv, $format, $target1, $target2) = @_; |
708
|
44
|
100
|
|
|
|
179
|
$target1 = $$target1 if( ref $target1 eq 'SCALAR' ); |
709
|
44
|
100
|
|
|
|
1241
|
$target2 = $$target2 if( ref $target2 eq 'SCALAR' ); |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
# if $dfv is a ref then we are called as 'constraint_method' |
712
|
|
|
|
|
|
|
# else as 'constaint' |
713
|
44
|
100
|
|
|
|
187
|
my $value = ref $dfv ? $dfv->get_current_constraint_value : $dfv; |
714
|
|
|
|
|
|
|
# get the DateTime |
715
|
44
|
|
|
|
|
348
|
my $dt = _get_datetime_from_strp($value, $format); |
716
|
44
|
|
|
|
|
114
|
my $dt_target1 = _get_datetime_from_strp($target1, $format); |
717
|
44
|
|
|
|
|
103
|
my $dt_target2 = _get_datetime_from_strp($target2, $format); |
718
|
|
|
|
|
|
|
# if we have valid DateTime objects and they have the correct |
719
|
|
|
|
|
|
|
# temporaral relationship |
720
|
44
|
100
|
100
|
|
|
197
|
if( |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
721
|
|
|
|
|
|
|
$dt |
722
|
|
|
|
|
|
|
&& $dt_target1 |
723
|
|
|
|
|
|
|
&& $dt_target2 |
724
|
|
|
|
|
|
|
&& $dt > $dt_target1 |
725
|
|
|
|
|
|
|
&& $dt < $dt_target2 |
726
|
|
|
|
|
|
|
) { |
727
|
3
|
|
|
|
|
7977
|
return $dt; |
728
|
|
|
|
|
|
|
} else { |
729
|
41
|
|
|
|
|
32363
|
return; |
730
|
|
|
|
|
|
|
} |
731
|
|
|
|
|
|
|
} |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
=head1 DATABASE RELATED VALIDATION ROUTINES |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
=head2 to_mysql_datetime |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
The routine will change the date string into a DATETIME datatype |
738
|
|
|
|
|
|
|
suitable for MySQL. If you don't provide a format parameter then |
739
|
|
|
|
|
|
|
this routine will just validate the data as a valid MySQL DATETIME |
740
|
|
|
|
|
|
|
datatype (using L). |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
If the value is untainted (using C or |
743
|
|
|
|
|
|
|
C, it will change the date string into a DateTime |
744
|
|
|
|
|
|
|
object. |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
=cut |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
sub to_mysql_datetime { |
749
|
9
|
|
|
9
|
1
|
27606
|
my $format = shift; |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
return sub { |
752
|
9
|
|
|
9
|
|
3606
|
my $dfv = shift; |
753
|
9
|
50
|
33
|
|
|
106
|
croak("Must be called using 'constraint_methods'!") |
754
|
|
|
|
|
|
|
unless( blessed $dfv && $dfv->isa('Data::FormValidator::Results') ); |
755
|
9
|
|
|
|
|
28
|
return match_to_mysql_datetime($dfv, $format); |
756
|
|
|
|
|
|
|
} |
757
|
9
|
|
|
|
|
72
|
} |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
sub match_to_mysql_datetime { |
760
|
22
|
|
|
22
|
0
|
41772
|
my ($dfv, $format) = @_; |
761
|
|
|
|
|
|
|
# if $dfv is a ref then we are called as 'constraint_method' |
762
|
|
|
|
|
|
|
# else as 'constaint' |
763
|
22
|
100
|
|
|
|
97
|
my $value = ref $dfv ? $dfv->get_current_constraint_value : $dfv; |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
# make sure they have DateTime::Format::MySQL |
766
|
22
|
|
|
|
|
86
|
eval { require DateTime::Format::MySQL; }; |
|
22
|
|
|
|
|
176
|
|
767
|
22
|
100
|
|
|
|
191
|
die "DateTime::Format::MySQL is required to use this routine" |
768
|
|
|
|
|
|
|
if( $@ ); |
769
|
20
|
|
|
|
|
26
|
my $dt; |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
# if they gave us a format (through params as a scalar ref) |
772
|
|
|
|
|
|
|
# then translate the value |
773
|
20
|
100
|
|
|
|
42
|
if( $format ) { |
774
|
12
|
|
|
|
|
34
|
$dt = _get_datetime_from_strp($value, $format); |
775
|
|
|
|
|
|
|
# else there is no format, so just use parse_datetime |
776
|
|
|
|
|
|
|
} else { |
777
|
8
|
|
|
|
|
11
|
eval { $dt = DateTime::Format::MySQL->parse_datetime($value) }; |
|
8
|
|
|
|
|
37
|
|
778
|
|
|
|
|
|
|
} |
779
|
20
|
100
|
|
|
|
4270
|
if( $dt ) { |
780
|
5
|
|
|
|
|
899
|
return DateTime::Format::MySQL->format_datetime($dt); |
781
|
|
|
|
|
|
|
} else { |
782
|
15
|
|
|
|
|
54
|
return undef; |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
=head2 to_mysql_date |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
The routine will change the date string into a DATE datatype |
789
|
|
|
|
|
|
|
suitable for MySQL. If you don't provide a format param then |
790
|
|
|
|
|
|
|
this routine will validate the data as a valid DATE datatype |
791
|
|
|
|
|
|
|
in MySQL (using L). |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
If the value is untainted (using C or |
794
|
|
|
|
|
|
|
C, it will change the date string into a DateTime |
795
|
|
|
|
|
|
|
object. |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
=cut |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
sub to_mysql_date { |
800
|
9
|
|
|
9
|
1
|
6093
|
my $format = shift; |
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
return sub { |
803
|
9
|
|
|
9
|
|
3125
|
my $dfv = shift; |
804
|
9
|
50
|
33
|
|
|
92
|
croak("Must be called using 'constraint_methods'!") |
805
|
|
|
|
|
|
|
unless( blessed $dfv && $dfv->isa('Data::FormValidator::Results') ); |
806
|
9
|
|
|
|
|
27
|
return match_to_mysql_date($dfv, $format); |
807
|
9
|
|
|
|
|
55
|
}; |
808
|
|
|
|
|
|
|
} |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
sub match_to_mysql_date { |
811
|
22
|
|
|
22
|
0
|
16251
|
my ($dfv, $format) = @_; |
812
|
|
|
|
|
|
|
# if $dfv is a ref then we are called as 'constraint_method' |
813
|
|
|
|
|
|
|
# else as 'constaint' |
814
|
22
|
100
|
|
|
|
252
|
my $value = ref $dfv ? $dfv->get_current_constraint_value : $dfv; |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
# make sure they have DateTime::Format::MySQL |
817
|
22
|
|
|
|
|
75
|
eval { require DateTime::Format::MySQL; }; |
|
22
|
|
|
|
|
192
|
|
818
|
22
|
100
|
|
|
|
222
|
die "DateTime::Format::MySQL is required to use this routine" |
819
|
|
|
|
|
|
|
if( $@ ); |
820
|
20
|
|
|
|
|
30
|
my $dt; |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
# if they gave us a format (through params as a scalar ref) |
823
|
|
|
|
|
|
|
# then translate the value |
824
|
20
|
100
|
|
|
|
46
|
if( $format ) { |
825
|
12
|
|
|
|
|
31
|
$dt = _get_datetime_from_strp($value, $format); |
826
|
|
|
|
|
|
|
# else there is no format, so just use parse_datetime |
827
|
|
|
|
|
|
|
} else { |
828
|
8
|
|
|
|
|
11
|
eval { $dt = DateTime::Format::MySQL->parse_date($value) }; |
|
8
|
|
|
|
|
42
|
|
829
|
|
|
|
|
|
|
} |
830
|
20
|
100
|
|
|
|
4837
|
if( $dt ) { |
831
|
5
|
|
|
|
|
858
|
return DateTime::Format::MySQL->format_date($dt); |
832
|
|
|
|
|
|
|
} else { |
833
|
15
|
|
|
|
|
52
|
return undef; |
834
|
|
|
|
|
|
|
} |
835
|
|
|
|
|
|
|
} |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
=head2 to_mysql_timestamp |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
The routine will change the date string into a TIMESTAMP datatype |
840
|
|
|
|
|
|
|
suitable for MySQL. If you don't provide a format then the data |
841
|
|
|
|
|
|
|
will be validated as a MySQL TIMESTAMP datatype. |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
If the value is untainted (using C or |
844
|
|
|
|
|
|
|
C, it will change the date string into a DateTime |
845
|
|
|
|
|
|
|
object. |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=cut |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
sub to_mysql_timestamp { |
850
|
8
|
|
|
8
|
1
|
5247
|
my $format = shift; |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
return sub { |
853
|
8
|
|
|
8
|
|
2611
|
my $dfv = shift; |
854
|
8
|
50
|
33
|
|
|
88
|
croak("Must be called using 'constraint_methods'!") |
855
|
|
|
|
|
|
|
unless( blessed $dfv && $dfv->isa('Data::FormValidator::Results') ); |
856
|
8
|
|
|
|
|
26
|
match_to_mysql_timestamp($dfv, $format); |
857
|
8
|
|
|
|
|
51
|
}; |
858
|
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
sub match_to_mysql_timestamp { |
861
|
20
|
|
|
20
|
0
|
12084
|
my ($dfv, $format) = @_; |
862
|
|
|
|
|
|
|
# if $dfv is a ref then we are called as 'constraint_method' |
863
|
|
|
|
|
|
|
# else as 'constaint' |
864
|
20
|
100
|
|
|
|
76
|
my $value = ref $dfv ? $dfv->get_current_constraint_value : $dfv; |
865
|
20
|
|
|
|
|
64
|
my $dt; |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
# if they gave us a format (through params as a scalar ref) |
868
|
|
|
|
|
|
|
# then translate the value |
869
|
20
|
100
|
|
|
|
41
|
if( $format ) { |
870
|
12
|
|
|
|
|
30
|
$dt = _get_datetime_from_strp($value, $format); |
871
|
|
|
|
|
|
|
# else there is no format, so parse into a timestamp |
872
|
|
|
|
|
|
|
} else { |
873
|
|
|
|
|
|
|
# if it matches a timestamp format YYYYMMDDHHMMSS |
874
|
|
|
|
|
|
|
# but we're actually a little looser than that... we take |
875
|
|
|
|
|
|
|
# YYYY-MM-DD HH:MM:SS with any other potential separators |
876
|
8
|
100
|
|
|
|
33
|
if( $value =~ /(\d{4})\D*(\d{2})\D*(\d{2})\D*(\d{2})\D*(\d{2})\D*(\d{2})/ ) { |
877
|
2
|
|
|
|
|
6
|
eval { |
878
|
2
|
|
|
|
|
18
|
$dt = DateTime->new( |
879
|
|
|
|
|
|
|
year => $1, |
880
|
|
|
|
|
|
|
month => $2, |
881
|
|
|
|
|
|
|
day => $3, |
882
|
|
|
|
|
|
|
hour => $4, |
883
|
|
|
|
|
|
|
minute => $5, |
884
|
|
|
|
|
|
|
second => $6, |
885
|
|
|
|
|
|
|
); |
886
|
|
|
|
|
|
|
}; |
887
|
|
|
|
|
|
|
} |
888
|
|
|
|
|
|
|
} |
889
|
20
|
100
|
|
|
|
772
|
if( $dt ) { |
890
|
5
|
|
|
|
|
778
|
return $dt->ymd('') . $dt->hms(''); |
891
|
|
|
|
|
|
|
} else { |
892
|
15
|
|
|
|
|
42
|
return undef; |
893
|
|
|
|
|
|
|
} |
894
|
|
|
|
|
|
|
} |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
=head2 to_pg_datetime |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
The routine will change the date string into a DATETIME datatype |
899
|
|
|
|
|
|
|
suitable for PostgreSQL. If you don't provide a format then the |
900
|
|
|
|
|
|
|
data will validated as a DATETIME datatype in PostgresSQL (using |
901
|
|
|
|
|
|
|
L). |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
If the value is untainted (using C or |
904
|
|
|
|
|
|
|
C, it will change the date string into a DateTime |
905
|
|
|
|
|
|
|
object. |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
=cut |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
sub to_pg_datetime { |
910
|
9
|
|
|
9
|
1
|
17076
|
my $format = shift; |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
return sub { |
913
|
9
|
|
|
9
|
|
3140
|
my $dfv = shift; |
914
|
9
|
50
|
33
|
|
|
94
|
croak("Must be called using 'constraint_methods'!") |
915
|
|
|
|
|
|
|
unless( blessed $dfv && $dfv->isa('Data::FormValidator::Results') ); |
916
|
9
|
|
|
|
|
24
|
match_to_pg_datetime($dfv, $format); |
917
|
9
|
|
|
|
|
70
|
}; |
918
|
|
|
|
|
|
|
} |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
sub match_to_pg_datetime { |
921
|
22
|
|
|
22
|
0
|
34759
|
my ($dfv, $format) = @_; |
922
|
|
|
|
|
|
|
# if $dfv is a ref then we are called as 'constraint_method' |
923
|
|
|
|
|
|
|
# else as 'constaint' |
924
|
22
|
100
|
|
|
|
223
|
my $value = ref $dfv ? $dfv->get_current_constraint_value : $dfv; |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
# make sure they have DateTime::Format::MySQL |
927
|
22
|
|
|
|
|
82
|
eval { require DateTime::Format::Pg; }; |
|
22
|
|
|
|
|
196
|
|
928
|
22
|
100
|
|
|
|
108
|
die "DateTime::Format::Pg is required to use this routine" |
929
|
|
|
|
|
|
|
if( $@ ); |
930
|
20
|
|
|
|
|
27
|
my $dt; |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
# if they gave us a format (through params as a scalar ref) |
933
|
|
|
|
|
|
|
# then translate the value |
934
|
20
|
100
|
|
|
|
40
|
if( $format ) { |
935
|
12
|
|
|
|
|
73
|
$dt = _get_datetime_from_strp($value, $format); |
936
|
|
|
|
|
|
|
# else there is no format, so just use parse_datetime |
937
|
|
|
|
|
|
|
} else { |
938
|
8
|
|
|
|
|
10
|
eval { $dt = DateTime::Format::Pg->parse_datetime($value) }; |
|
8
|
|
|
|
|
39
|
|
939
|
|
|
|
|
|
|
} |
940
|
20
|
100
|
|
|
|
5362
|
if( $dt ) { |
941
|
5
|
|
|
|
|
891
|
return DateTime::Format::Pg->format_datetime($dt); |
942
|
|
|
|
|
|
|
} else { |
943
|
15
|
|
|
|
|
56
|
return undef; |
944
|
|
|
|
|
|
|
} |
945
|
|
|
|
|
|
|
} |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
=head1 AUTHOR |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
Michael Peters |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
Thanks to Plus Three, LP (http://www.plusthree.com) for sponsoring my work on this module |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
=head1 CONTRIBUTORS |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
=over |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
=item Mark Stosberg |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
=item Charles Frank |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
=item Aaron Ross |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
=back |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
=head1 SUPPORT |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
This module is a part of the larger L project. If you have |
969
|
|
|
|
|
|
|
questions, comments, bug reports or feature requests, please join the |
970
|
|
|
|
|
|
|
L's mailing list. |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
=head1 CAVEAT |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
When passing parameters to typical L constraints you pass |
975
|
|
|
|
|
|
|
plain scalars to refer to query params and scalar-refs to refer to literals. We get |
976
|
|
|
|
|
|
|
around that in this module by assuming everything could be refering to a query param, |
977
|
|
|
|
|
|
|
and if one is not found, then it's a literal. This works well unless you have query |
978
|
|
|
|
|
|
|
params with names like C<'01/02/2005'> or C<'%m/%d/%Y'>. |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
And if you do, shame on you for having such horrible names. |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
=head1 SEE ALSO |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
L, L. L, |
985
|
|
|
|
|
|
|
L, L |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
Copyright Michael Peters 2010, all rights reserved. |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
992
|
|
|
|
|
|
|
|