File Coverage

blib/lib/Data/FormValidator/Constraints/DateTime.pm
Criterion Covered Total %
statement 227 227 100.0
branch 96 114 84.2
condition 74 108 68.5
subroutine 47 47 100.0
pod 13 26 50.0
total 457 522 87.5


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