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