blib/lib/Date/Fmtstr2time.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 12 | 295 | 4.0 |
branch | 0 | 150 | 0.0 |
condition | 0 | 158 | 0.0 |
subroutine | 4 | 67 | 5.9 |
pod | 1 | 1 | 100.0 |
total | 17 | 671 | 2.5 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | =head1 NAME | ||||||
2 | |||||||
3 | Date::Fmtstr2time - Functions to format date/time strings into a Perl Time based on a "Picture" format string. | ||||||
4 | |||||||
5 | =head1 AUTHOR | ||||||
6 | |||||||
7 | Jim Turner | ||||||
8 | |||||||
9 | (c) 2015-2019, Jim Turner under the same license that Perl 5 itself is. All rights reserved. | ||||||
10 | |||||||
11 | =head1 SYNOPSIS | ||||||
12 | |||||||
13 | use Date::Fmtstr2time; | ||||||
14 | |||||||
15 | my $timevalue = str2time('12-25-2015 07:15 AM', 'mm-dd-yyyy hh:mi PM'); | ||||||
16 | |||||||
17 | die $timevalue if ($timevalue =~ /\D/); | ||||||
18 | |||||||
19 | print "Perl time (seconds since epoc): $timevalue.\n"; | ||||||
20 | |||||||
21 | =head1 DESCRIPTION | ||||||
22 | |||||||
23 | Date::Fmtstr2time provides a single function B |
||||||
24 | as a string (I |
||||||
25 | the format of various parts of a date and time value. It returns a standard Perl (Unix) "time" | ||||||
26 | value (a large integer equivalent to the number of seconds since 1980) or an error string. | ||||||
27 | |||||||
28 | =head1 METHODS | ||||||
29 | |||||||
30 | =over 4 | ||||||
31 | |||||||
32 | =item $integer = B |
||||||
33 | |||||||
34 | Returns a standard Perl (Unix) "time" value (a large integer) on success, or an error message | ||||||
35 | string on failure. One can easily check for failure by checking the result for any non-integer | ||||||
36 | characters (=~ /\D/). The I |
||||||
37 | the software what format to expect the date / time value in the I |
||||||
38 | |||||||
39 | For example: | ||||||
40 | |||||||
41 | $s = &str2time('01-09-2016 01:20 AM (Sat) (January)', 'mm-dd-yyyy hh:mi PM (Day) (Month)'); | ||||||
42 | |||||||
43 | would set $s to 1452324000, (the Unix time equivalent). | ||||||
44 | |||||||
45 | =item B |
||||||
46 | |||||||
47 | There are numerous choices of special format substrings which can be used in an infinite | ||||||
48 | number of combinations to produce the desired results. They are listed below: | ||||||
49 | |||||||
50 | =over 4 | ||||||
51 | |||||||
52 | B, B, B |
||||||
53 | (0 in 24-hour time). (all specifiers are identical and case insensitive). See also: | ||||||
54 | B , B , B |
||||||
55 | |||||||
56 | B |
||||||
57 | (case insensitive), ie. "sun". Reason for the three versions is to match up with | ||||||
58 | L |
||||||
59 | but here (I |
||||||
60 | similiarly to functions that pad or don't pad with leading zeros! | ||||||
61 | |||||||
62 | B |
||||||
63 | |||||||
64 | B |
||||||
65 | the number of SECONDS (86400 per day) to midnight, 1/1/current-year, so if spanning a | ||||||
66 | daylight-savings time boundary may result in +1 hour difference, which the underlying | ||||||
67 | Perl localtime/timelocal functions will take into account! For example, if the current | ||||||
68 | time was "1570286966" (2019/10/05 09:49:26), the following code: | ||||||
69 | |||||||
70 | print &time2str(&str2time(&time2str(1570286966, 'ddd, hh:mi:ss'), 'ddd, hh:mi:ss'), 'yyyy/mm/dd hh:mi:ss') . "\n"; | ||||||
71 | |||||||
72 | would print "2019/10/05 10:49:26" due to the fact that 1 hour (3600 seconds) was | ||||||
73 | automatically skipped over when DST was imposed between 1 January and 5 October. This | ||||||
74 | "feature" only applies when calculating the date/time based on days since beginning | ||||||
75 | of the year ("ddd"). | ||||||
76 | |||||||
77 | B |
||||||
78 | "3" or "03" for March. | ||||||
79 | |||||||
80 | B |
||||||
81 | |||||||
82 | B- Hour in common format, ie. 1-12 (1 or 2 digits, as needed). |
||||||
83 | (see B |
||||||
84 | |||||||
85 | B |
||||||
86 | |||||||
87 | B |
||||||
88 | digits. | ||||||
89 | |||||||
90 | B |
||||||
91 | |||||||
92 | B- Hour in 24-hour format, ie. 00-23 (1 or 2 digits, as needed). |
||||||
93 | |||||||
94 | B |
||||||
95 | Must be six digits. | ||||||
96 | |||||||
97 | B |
||||||
98 | |||||||
99 | B |
||||||
100 | |||||||
101 | B |
||||||
102 | |||||||
103 | B |
||||||
104 | |||||||
105 | B |
||||||
106 | |||||||
107 | B |
||||||
108 | |||||||
109 | B |
||||||
110 | |||||||
111 | B |
||||||
112 | |||||||
113 | B |
||||||
114 | ie. "jan" for January. | ||||||
115 | |||||||
116 | B |
||||||
117 | ie. "january". | ||||||
118 | |||||||
119 | B , B , B |
||||||
120 | 1-11 to convert to PM (13-23 in 24 hour time). (all specifiers are identical). | ||||||
121 | |||||||
122 | B- Number of the quarter of the year - (1-4). |
||||||
123 | |||||||
124 | B |
||||||
125 | |||||||
126 | B |
||||||
127 | |||||||
128 | B |
||||||
129 | |||||||
130 | B |
||||||
131 | (leading zeros ignored). | ||||||
132 | |||||||
133 | B |
||||||
134 | |||||||
135 | B |
||||||
136 | |||||||
137 | B |
||||||
138 | |||||||
139 | B |
||||||
140 | |||||||
141 | B |
||||||
142 | |||||||
143 | B |
||||||
144 | |||||||
145 | B |
||||||
146 | |||||||
147 | B |
||||||
148 | |||||||
149 | B |
||||||
150 | |||||||
151 | B |
||||||
152 | |||||||
153 | =back | ||||||
154 | |||||||
155 | =back | ||||||
156 | |||||||
157 | =head1 DEPENDENCIES | ||||||
158 | |||||||
159 | Perl 5 | ||||||
160 | |||||||
161 | L |
||||||
162 | |||||||
163 | =head1 RECCOMENDS | ||||||
164 | |||||||
165 | L |
||||||
166 | |||||||
167 | =head1 BUGS | ||||||
168 | |||||||
169 | Please report any bugs or feature requests to C |
||||||
170 | the web interface at L |
||||||
171 | automatically be notified of progress on your bug as I make changes. | ||||||
172 | |||||||
173 | =head1 SUPPORT | ||||||
174 | |||||||
175 | You can find documentation for this module with the perldoc command. | ||||||
176 | |||||||
177 | perldoc Date::Fmtstr2time | ||||||
178 | |||||||
179 | You can also look for information at: | ||||||
180 | |||||||
181 | =over 4 | ||||||
182 | |||||||
183 | =item * RT: CPAN's request tracker (report bugs here) | ||||||
184 | |||||||
185 | L |
||||||
186 | |||||||
187 | =item * AnnoCPAN: Annotated CPAN documentation | ||||||
188 | |||||||
189 | L |
||||||
190 | |||||||
191 | =item * CPAN Ratings | ||||||
192 | |||||||
193 | L |
||||||
194 | |||||||
195 | =item * Search CPAN | ||||||
196 | |||||||
197 | L |
||||||
198 | |||||||
199 | =back | ||||||
200 | |||||||
201 | =head1 SEE ALSO | ||||||
202 | |||||||
203 | L |
||||||
204 | |||||||
205 | =head1 KEYWORDS | ||||||
206 | |||||||
207 | Date::Fmtstr2time, Date::Time2fmtstr, formatting, picture_clause, strings | ||||||
208 | |||||||
209 | =head1 LICENSE AND COPYRIGHT | ||||||
210 | |||||||
211 | Copyright (C) 2015-2019 Jim Turner | ||||||
212 | |||||||
213 | This program is free software; you can redistribute it and/or modify it | ||||||
214 | under the terms of the the Artistic License (2.0). You may obtain a | ||||||
215 | copy of the full license at: | ||||||
216 | |||||||
217 | L |
||||||
218 | |||||||
219 | Any use, modification, and distribution of the Standard or Modified | ||||||
220 | Versions is governed by this Artistic License. By using, modifying or | ||||||
221 | distributing the Package, you accept this license. Do not use, modify, | ||||||
222 | or distribute the Package, if you do not accept this license. | ||||||
223 | |||||||
224 | If your Modified Version has been derived from a Modified Version made | ||||||
225 | by someone other than you, you are nevertheless required to ensure that | ||||||
226 | your Modified Version complies with the requirements of this license. | ||||||
227 | |||||||
228 | This license does not grant you the right to use any trademark, service | ||||||
229 | mark, tradename, or logo of the Copyright Holder. | ||||||
230 | |||||||
231 | This license includes the non-exclusive, worldwide, free-of-charge | ||||||
232 | patent license to make, have made, use, offer to sell, sell, import and | ||||||
233 | otherwise transfer the Package with respect to any patent claims | ||||||
234 | licensable by the Copyright Holder that are necessarily infringed by the | ||||||
235 | Package. If you institute patent litigation (including a cross-claim or | ||||||
236 | counterclaim) against any party alleging that the Package constitutes | ||||||
237 | direct or contributory patent infringement, then this Artistic License | ||||||
238 | to you shall terminate on the date that such litigation is filed. | ||||||
239 | |||||||
240 | Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER | ||||||
241 | AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. | ||||||
242 | THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR | ||||||
243 | PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY | ||||||
244 | YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR | ||||||
245 | CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR | ||||||
246 | CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, | ||||||
247 | EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. | ||||||
248 | |||||||
249 | =cut | ||||||
250 | |||||||
251 | package Date::Fmtstr2time; | ||||||
252 | |||||||
253 | 1 | 1 | 78861 | use strict; | |||
1 | 2 | ||||||
1 | 76 | ||||||
254 | #use warnings; | ||||||
255 | 1 | 1 | 6 | use vars qw(@ISA @EXPORT $VERSION); | |||
1 | 2 | ||||||
1 | 124 | ||||||
256 | $VERSION = '1.11'; | ||||||
257 | |||||||
258 | 1 | 1 | 1013 | use Time::Local; | |||
1 | 4989 | ||||||
1 | 442 | ||||||
259 | |||||||
260 | require Exporter; | ||||||
261 | |||||||
262 | @ISA = qw(Exporter); | ||||||
263 | @EXPORT = qw(str2time); | ||||||
264 | |||||||
265 | my @inputs = (); | ||||||
266 | my @today = ();; | ||||||
267 | my $rtnTime = ''; | ||||||
268 | my @tl = (); | ||||||
269 | my $begofyear; | ||||||
270 | my %mthhash = ( | ||||||
271 | 'january' => '0', | ||||||
272 | 'february' => 1, | ||||||
273 | 'march' => 2, | ||||||
274 | 'april' => 3, | ||||||
275 | 'may' => 4, | ||||||
276 | 'june' => 5, | ||||||
277 | 'july' => 6, | ||||||
278 | 'august' => 7, | ||||||
279 | 'september' => 8, | ||||||
280 | 'october' => 9, | ||||||
281 | 'november' => 10, | ||||||
282 | 'december' => 11 | ||||||
283 | ); | ||||||
284 | |||||||
285 | sub str2time | ||||||
286 | { | ||||||
287 | 0 | 0 | 1 | my ($s) = $_[0]; | |||
288 | 0 | my ($f) = $_[1]; | |||||
289 | |||||||
290 | 0 | my @fmts = split(/\b/o, $f); | |||||
291 | 0 | @inputs = split(/\b/o, $s); | |||||
292 | 0 | @today = localtime(time); | |||||
293 | #print STDERR "-to_date: inputs=".join('|',@inputs)."=\n"; | ||||||
294 | #print STDERR "-to_date: formats=".join('|',@fmts)."=\n"; | ||||||
295 | 0 | my $err = ''; | |||||
296 | 0 | $rtnTime = ''; #USED IF "ddd" (Days since beg. of year) AND AN OTHERWISE INCOMPLETE mm/dd/yy DATE GIVEN. | |||||
297 | 0 | @tl = (); | |||||
298 | 0 | $begofyear = timelocal(0,0,0,1,0,$today[5]); | |||||
299 | |||||||
300 | 0 | my $fn; | |||||
301 | 0 | for (my $i=0;$i<=$#fmts;$i++) | |||||
302 | { | ||||||
303 | 0 | 0 | next unless ($fmts[$i] =~ /\w/o); | ||||
304 | 0 | foreach my $f (qw(month Month MONTH dayofweek Dayofweek DAYOFWEEK day Day DAY ddd | |||||
305 | dd d1 d0 mmddyyyy yyyymmddhhmiss yyyymmddhhmi yyyymmdd yyyymm yymmdd mmyyyy | ||||||
306 | mmddyy yyyy yymm mmyy yy mmdd hh24 HHmiss hhmiss HHmi h1mi hhmi hh HH h1 H1 mi | ||||||
307 | mmm0 mmmm mm mon Mon MON m1 ssss0 sssss ss am pm AM PM a p A P rm RM rr d ww w q)) | ||||||
308 | { | ||||||
309 | 0 | 0 | if ($fmts[$i] =~ /^$f/) | ||||
310 | { | ||||||
311 | 0 | $fn = '_tod_'.$f; | |||||
312 | 1 | 1 | 7 | no strict 'refs'; | |||
1 | 3 | ||||||
1 | 6085 | ||||||
313 | 0 | $err .= &$fn($i); | |||||
314 | #print "-to_date: called($fn($i)), input=$inputs[$i]= res=$err= tl=".join('|',@tl)."= RT=$rtnTime=\n"; | ||||||
315 | 0 | last; | |||||
316 | } | ||||||
317 | } | ||||||
318 | } | ||||||
319 | |||||||
320 | 0 | 0 | return $err if ($err =~ /\w/); | ||||
321 | |||||||
322 | #print "***** rtnTime =$rtnTime= tl=".join('|',@tl)." ($#tl)\n"; | ||||||
323 | 0 | 0 | if ($rtnTime >= $begofyear) { | ||||
324 | 0 | 0 | return $rtnTime if ($#tl < 5); | ||||
325 | } else { | ||||||
326 | 0 | for (my $i=3;$i<=5;$i++) { #FILL IN ANY MISSING MTH,DAY,YEAR WITH TODAY (DEFAULT IF NO ERRORS): | |||||
327 | 0 | 0 | $tl[$i] = $today[$i] unless (defined $tl[$i]); | ||||
328 | } | ||||||
329 | } | ||||||
330 | 0 | 0 | $tl[3] = '1' unless ($tl[3]); #MAKE SURE DAY IS ONE-BASED! | ||||
331 | #NOW DOUBLE-CHECK WHAT WE'RE FEEDING TO timelocal(): | ||||||
332 | 0 | 0 | $err .= "e:Invalid second ($tl[0]) - must be 0-59! " if ($tl[0] > 59); | ||||
333 | 0 | 0 | $err .= "e:Invalid minute ($tl[1]) - must be 0-59! " if ($tl[1] > 59); | ||||
334 | 0 | 0 | $err .= "e:Invalid hour ($tl[2]) - must be 0-23! " if ($tl[2] > 23); | ||||
335 | 0 | 0 | $err .= "e:Invalid day ($tl[3]) - must be 1-31! " if ($tl[3] > 31); | ||||
336 | 0 | 0 | $err .= "e:Invalid month ($tl[4]) - must be 0-11! " if ($tl[4] > 11); | ||||
337 | #WE'RE NOT CURRENTLY CHECKING YEAR, SINCE THERE ARE TOO MANY VALID VALUES. | ||||||
338 | 0 | 0 | return $err if ($err =~ /\w/); | ||||
339 | |||||||
340 | 0 | my $rt = timelocal(@tl); | |||||
341 | |||||||
342 | #print "***** tl=".join('|',@tl)." ($#tl) = rt=$rt=\n"; | ||||||
343 | 0 | return $rt; | |||||
344 | } | ||||||
345 | |||||||
346 | sub _tod_month | ||||||
347 | { | ||||||
348 | 0 | 0 | my $indx = shift; | ||||
349 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
350 | |||||||
351 | 0 | $input =~ tr/A-Z/a-z/; | |||||
352 | 0 | $tl[4] = $mthhash{$input}; | |||||
353 | 0 | 0 | return "e:Invalid Month ($input)! " unless (length($tl[4])); | ||||
354 | 0 | return ''; | |||||
355 | } | ||||||
356 | |||||||
357 | sub _tod_Month | ||||||
358 | { | ||||||
359 | 0 | 0 | return &_tod_month(@_); | ||||
360 | } | ||||||
361 | |||||||
362 | sub _tod_MONTH | ||||||
363 | { | ||||||
364 | 0 | 0 | return &_tod_month(@_); | ||||
365 | } | ||||||
366 | |||||||
367 | sub _tod_mon | ||||||
368 | { | ||||||
369 | 0 | 0 | my $indx = shift; | ||||
370 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
371 | |||||||
372 | 0 | my %mthhash = ( | |||||
373 | 'jan' => '0', | ||||||
374 | 'feb' => 1, | ||||||
375 | 'mar' => 2, | ||||||
376 | 'apr' => 3, | ||||||
377 | 'may' => 4, | ||||||
378 | 'jun' => 5, | ||||||
379 | 'jul' => 6, | ||||||
380 | 'aug' => 7, | ||||||
381 | 'sep' => 8, | ||||||
382 | 'oct' => 9, | ||||||
383 | 'nov' => 10, | ||||||
384 | 'dec' => 11 | ||||||
385 | ); | ||||||
386 | |||||||
387 | 0 | $input =~ tr/A-Z/a-z/; | |||||
388 | 0 | $tl[4] = $mthhash{substr($input,0,3)}; | |||||
389 | 0 | 0 | return "e:Invalid Mth ($input)! " unless (length($tl[4])); | ||||
390 | 0 | return ''; | |||||
391 | } | ||||||
392 | |||||||
393 | sub _tod_Mon | ||||||
394 | { | ||||||
395 | 0 | 0 | return &_tod_mon(@_); | ||||
396 | } | ||||||
397 | |||||||
398 | sub _tod_MON | ||||||
399 | { | ||||||
400 | 0 | 0 | return &_tod_mon(@_); | ||||
401 | } | ||||||
402 | |||||||
403 | sub _tod_rm | ||||||
404 | { | ||||||
405 | 0 | 0 | my $indx = shift; | ||||
406 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
407 | |||||||
408 | 0 | my %mthhash = ( | |||||
409 | 'i' => '0', | ||||||
410 | 'ii' => 1, | ||||||
411 | 'iii' => 2, | ||||||
412 | 'iv' => 3, | ||||||
413 | 'v' => 4, | ||||||
414 | 'vi' => 5, | ||||||
415 | 'vii' => 6, | ||||||
416 | 'viii' => 7, | ||||||
417 | 'ix' => 8, | ||||||
418 | 'x' => 9, | ||||||
419 | 'xi' => 10, | ||||||
420 | 'xii' => 11 | ||||||
421 | ); | ||||||
422 | |||||||
423 | 0 | $input =~ tr/A-Z/a-z/; | |||||
424 | 0 | $tl[4] = $mthhash{$input}; | |||||
425 | 0 | 0 | return "e:Invalid Roman Month. ($input)! " unless (length($tl[4])); | ||||
426 | 0 | return ''; | |||||
427 | } | ||||||
428 | |||||||
429 | sub _tod_RM | ||||||
430 | { | ||||||
431 | 0 | 0 | return &_tod_rm(@_); | ||||
432 | } | ||||||
433 | |||||||
434 | sub _tod_mm | ||||||
435 | { | ||||||
436 | 0 | 0 | my $indx = shift; | ||||
437 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
438 | |||||||
439 | 0 | $input =~ s/^0//; | |||||
440 | 0 | 0 | 0 | return "e:Invalid month ($input)! " | |||
441 | unless ($input > 0 && $input <= 12); | ||||||
442 | |||||||
443 | 0 | $tl[4] = $input - 1; | |||||
444 | 0 | return ''; | |||||
445 | } | ||||||
446 | |||||||
447 | sub _tod_m1 | ||||||
448 | { | ||||||
449 | 0 | 0 | return &_tod_mm(@_); | ||||
450 | } | ||||||
451 | |||||||
452 | sub _tod_yyyymmdd | ||||||
453 | { | ||||||
454 | 0 | 0 | my $indx = shift; | ||||
455 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
456 | |||||||
457 | 0 | &_tod_yyyy($indx, substr($input,0,4)); | |||||
458 | 0 | &_tod_mm($indx, substr($input,4,2)); | |||||
459 | 0 | return &_tod_dd($indx, substr($input,6,2)); | |||||
460 | } | ||||||
461 | |||||||
462 | sub _tod_yyyymmddhhmi | ||||||
463 | { | ||||||
464 | 0 | 0 | my $indx = shift; | ||||
465 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
466 | |||||||
467 | 0 | 0 | return "e:Invalid yyyymmddhhmi ($input) - must be 12-digit number! " unless ($input =~ /^\d{12}$/); | ||||
468 | |||||||
469 | 0 | &_tod_yyyy($indx, substr($input,0,4)); | |||||
470 | 0 | &_tod_mm($indx, substr($input,4,2)); | |||||
471 | 0 | &_tod_dd($indx, substr($input,6,2)); | |||||
472 | 0 | return &_tod_hh24($indx, substr($input,8,4)); | |||||
473 | } | ||||||
474 | |||||||
475 | sub _tod_yyyymmddhhmiss | ||||||
476 | { | ||||||
477 | 0 | 0 | my $indx = shift; | ||||
478 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
479 | |||||||
480 | 0 | 0 | return "e:Invalid yyyymmddhhmiss ($input) - must be 14-digit number! " unless ($input =~ /^\d{14}$/); | ||||
481 | |||||||
482 | 0 | &_tod_yyyy($indx, substr($input,0,4)); | |||||
483 | 0 | &_tod_mm($indx, substr($input,4,2)); | |||||
484 | 0 | &_tod_dd($indx, substr($input,6,2)); | |||||
485 | 0 | &_tod_hh24($indx, substr($input,8,4)); | |||||
486 | 0 | return &_tod_ss($indx, substr($input,12,2)); | |||||
487 | } | ||||||
488 | |||||||
489 | sub _tod_yyyymm | ||||||
490 | { | ||||||
491 | 0 | 0 | my $indx = shift; | ||||
492 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
493 | |||||||
494 | 0 | 0 | return "e:Invalid yyyymm ($input) - must be 6-digit number! " unless ($input =~ /^\d{6}$/); | ||||
495 | |||||||
496 | 0 | &_tod_yyyy($indx, substr($input,0,4)); | |||||
497 | 0 | return &_tod_mm($indx, substr($input,4,2)); | |||||
498 | } | ||||||
499 | |||||||
500 | sub _tod_yymmdd | ||||||
501 | { | ||||||
502 | 0 | 0 | my $indx = shift; | ||||
503 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
504 | |||||||
505 | 0 | 0 | return "e:Invalid yymmdd ($input) - must be 6-digit number! " unless ($input =~ /^\d{6}$/); | ||||
506 | |||||||
507 | 0 | &_tod_rr($indx, substr($input,0,2)); | |||||
508 | 0 | &_tod_mm($indx, substr($input,2,2)); | |||||
509 | 0 | return &_tod_dd($indx, substr($input,4,2)); | |||||
510 | } | ||||||
511 | |||||||
512 | sub _tod_yymm | ||||||
513 | { | ||||||
514 | 0 | 0 | my $indx = shift; | ||||
515 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
516 | |||||||
517 | 0 | 0 | return "e:Invalid yymm ($input) - must be 4-digit number! " unless ($input =~ /^\d{4}$/); | ||||
518 | |||||||
519 | 0 | &_tod_rr($indx, substr($input,0,2)); | |||||
520 | 0 | return &_tod_mm($indx, substr($input,2,2)); | |||||
521 | } | ||||||
522 | |||||||
523 | sub _tod_mmyyyy | ||||||
524 | { | ||||||
525 | 0 | 0 | my $indx = shift; | ||||
526 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
527 | |||||||
528 | 0 | 0 | return "e:Invalid mmyyyy ($input) - must be 6-digit number! " unless ($input =~ /^\d{6}$/); | ||||
529 | |||||||
530 | 0 | &_tod_mm($indx, substr($input,0,2)); | |||||
531 | 0 | return &_tod_yyyy($indx, substr($input,2,4)); | |||||
532 | } | ||||||
533 | |||||||
534 | sub _tod_mmyy | ||||||
535 | { | ||||||
536 | 0 | 0 | my $indx = shift; | ||||
537 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
538 | |||||||
539 | 0 | 0 | return "e:Invalid mmyy ($input) - must be 4-digit number! " unless ($input =~ /^\d{4}$/); | ||||
540 | |||||||
541 | 0 | &_tod_mm($indx, substr($input,0,2)); | |||||
542 | 0 | return &_tod_rr($indx, substr($input,2,2)); | |||||
543 | } | ||||||
544 | |||||||
545 | sub _tod_mmddyyyy | ||||||
546 | { | ||||||
547 | 0 | 0 | my $indx = shift; | ||||
548 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
549 | |||||||
550 | 0 | 0 | return "e:Invalid _tod_mmddyyyy ($input) - must be 8-digit number! " unless ($input =~ /^\d{8}$/); | ||||
551 | |||||||
552 | 0 | &_tod_mm($indx, substr($input,0,2)); | |||||
553 | 0 | &_tod_dd($indx, substr($input,2,2)); | |||||
554 | 0 | return &_tod_yyyy($indx, substr($input,4,4)); | |||||
555 | } | ||||||
556 | |||||||
557 | sub _tod_mmddyy | ||||||
558 | { | ||||||
559 | 0 | 0 | my $indx = shift; | ||||
560 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
561 | |||||||
562 | 0 | 0 | return "e:Invalid mmddyy ($input) - must be 6-digit number! " unless ($input =~ /^\d{6}$/); | ||||
563 | |||||||
564 | 0 | &_tod_mm($indx, substr($input,0,2)); | |||||
565 | 0 | &_tod_dd($indx, substr($input,2,2)); | |||||
566 | 0 | return &_tod_rr($indx, substr($input,4,2)); | |||||
567 | } | ||||||
568 | |||||||
569 | sub _tod_mmdd | ||||||
570 | { | ||||||
571 | 0 | 0 | my $indx = shift; | ||||
572 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
573 | |||||||
574 | 0 | 0 | return "e:Invalid mmyy ($input) - must be 4-digit number! " unless ($input =~ /^\d{4}$/); | ||||
575 | |||||||
576 | 0 | &_tod_mm($indx, substr($input,0,2)); | |||||
577 | 0 | return &_tod_dd($indx, substr($input,2,2)); | |||||
578 | } | ||||||
579 | |||||||
580 | sub _tod_yyyy | ||||||
581 | { | ||||||
582 | 0 | 0 | my $indx = shift; | ||||
583 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
584 | |||||||
585 | 0 | 0 | return "e:Invalid year ($input)! " | ||||
586 | unless ($input =~ /^\d\d\d\d$/); | ||||||
587 | |||||||
588 | 0 | $tl[5] = $input - 1900; | |||||
589 | 0 | return ''; | |||||
590 | } | ||||||
591 | |||||||
592 | sub _tod_yy | ||||||
593 | { | ||||||
594 | 0 | 0 | return &_tod_rr(@_); | ||||
595 | } | ||||||
596 | |||||||
597 | sub _tod_rr | ||||||
598 | { | ||||||
599 | 0 | 0 | my $indx = shift; | ||||
600 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
601 | |||||||
602 | 0 | 0 | return "e:Invalid year ($input)! " | ||||
603 | unless ($input =~ /^\d\d$/); | ||||||
604 | |||||||
605 | 0 | 0 | if (($today[5] % 100) > 50) | ||||
606 | { | ||||||
607 | 0 | 0 | $input += 100 if ($input < 50); | ||||
608 | } | ||||||
609 | else | ||||||
610 | { | ||||||
611 | #$input -= 100 if ($input > 50); | ||||||
612 | 0 | 0 | $input += 100 if ($input < 50); | ||||
613 | } | ||||||
614 | 0 | $tl[5] = $input; | |||||
615 | 0 | return ''; | |||||
616 | } | ||||||
617 | |||||||
618 | sub _tod_rrrr | ||||||
619 | { | ||||||
620 | 0 | 0 | my $indx = shift; | ||||
621 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
622 | |||||||
623 | 0 | 0 | return &_tod_rr($indx) if ($input =~ /^\d\d?$/); | ||||
624 | 0 | 0 | return "e:Invalid year ($input)! " | ||||
625 | unless ($input =~ /^\d\d\d\d?$/); | ||||||
626 | |||||||
627 | 0 | 0 | if (($today[5] % 100) > 50) | ||||
628 | { | ||||||
629 | 0 | 0 | $input += 100 if (($input % 100) < 50); | ||||
630 | } | ||||||
631 | else | ||||||
632 | { | ||||||
633 | #$input -= 100 if (($input % 100) > 50); | ||||||
634 | 0 | 0 | $input += 100 if ($input < 50); | ||||
635 | } | ||||||
636 | 0 | $tl[5] = $input - 1900; | |||||
637 | 0 | return ''; | |||||
638 | } | ||||||
639 | |||||||
640 | sub _tod_ddd | ||||||
641 | { | ||||||
642 | 0 | 0 | my $indx = shift; | ||||
643 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
644 | |||||||
645 | 0 | $input =~ s/^0+//; | |||||
646 | 0 | 0 | 0 | return "e:Invalid year-day ($input)! " | |||
647 | unless ($input > 0 and $input <= 366); | ||||||
648 | |||||||
649 | 0 | 0 | $rtnTime += $begofyear + (($input*86400) - 86400) unless ($rtnTime > 86400); | ||||
650 | 0 | return ''; | |||||
651 | } | ||||||
652 | |||||||
653 | sub _tod_dd | ||||||
654 | { | ||||||
655 | 0 | 0 | my $indx = shift; | ||||
656 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
657 | |||||||
658 | 0 | 0 | 0 | return "e:Invalid day ($input)! " | |||
659 | unless ($input > 0 and $input <= 31); | ||||||
660 | |||||||
661 | 0 | $tl[3] = $input; | |||||
662 | 0 | return ''; | |||||
663 | } | ||||||
664 | |||||||
665 | sub _tod_d1 | ||||||
666 | { | ||||||
667 | 0 | 0 | return &_tod_dd(@_); | ||||
668 | } | ||||||
669 | |||||||
670 | sub _tod_hh | ||||||
671 | { | ||||||
672 | 0 | 0 | my $indx = shift; | ||||
673 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
674 | |||||||
675 | 0 | 0 | 0 | return "e:Invalid hour ($input)! " | |||
676 | unless ($input > 0 and $input <= 12); | ||||||
677 | |||||||
678 | 0 | 0 | unless ($tl[2] =~ /\d/) { | ||||
679 | 0 | $tl[2] = $input; | |||||
680 | 0 | 0 | $rtnTime += ($input * 3600) if ($rtnTime); | ||||
681 | } | ||||||
682 | 0 | return ''; | |||||
683 | } | ||||||
684 | |||||||
685 | sub _tod_h1 | ||||||
686 | { | ||||||
687 | 0 | 0 | return &_tod_hh(@_); | ||||
688 | } | ||||||
689 | |||||||
690 | sub _tod_HH | ||||||
691 | { | ||||||
692 | 0 | 0 | my $indx = shift; | ||||
693 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
694 | |||||||
695 | 0 | 0 | 0 | return "e:Invalid hour ($input)! " | |||
696 | unless ($input >= 0 and $input < 24); | ||||||
697 | |||||||
698 | 0 | 0 | unless ($tl[2] =~ /\d/) { | ||||
699 | 0 | $tl[2] = $input; | |||||
700 | 0 | 0 | $rtnTime += ($input * 3600) if ($rtnTime); | ||||
701 | } | ||||||
702 | 0 | return ''; | |||||
703 | } | ||||||
704 | |||||||
705 | sub _tod_H1 | ||||||
706 | { | ||||||
707 | 0 | 0 | return &_tod_HH(@_); | ||||
708 | } | ||||||
709 | |||||||
710 | sub _tod_hh24 | ||||||
711 | { | ||||||
712 | 0 | 0 | my $indx = shift; | ||||
713 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
714 | |||||||
715 | 0 | 0 | 0 | return "e:Invalid 24-hr time ($input)! " | |||
0 | |||||||
716 | unless ($input >= 0 and $input < 2400 | ||||||
717 | && ($input % 100) < 60); | ||||||
718 | |||||||
719 | 0 | 0 | 0 | unless ($tl[1] =~ /\d/ || $tl[2] =~ /\d/) { | |||
720 | 0 | $tl[1] = ($input % 100); | |||||
721 | 0 | $input = int($input / 100); | |||||
722 | 0 | $tl[2] = $input; | |||||
723 | 0 | 0 | $rtnTime += ($tl[2] * 3600) + ($tl[1] * 60) if ($rtnTime); | ||||
724 | } | ||||||
725 | 0 | return ''; | |||||
726 | } | ||||||
727 | |||||||
728 | sub _tod_HHmi | ||||||
729 | { | ||||||
730 | 0 | 0 | return &_tod_hh24(@_) | ||||
731 | } | ||||||
732 | |||||||
733 | sub _tod_hhmi | ||||||
734 | { | ||||||
735 | 0 | 0 | my $indx = shift; | ||||
736 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
737 | |||||||
738 | 0 | 0 | 0 | return "e:Invalid time ($input)! " | |||
739 | if ($input < 100 || $input > 1259); | ||||||
740 | |||||||
741 | 0 | 0 | 0 | unless ($tl[1] =~ /\d/ || $tl[2] =~ /\d/) { | |||
742 | 0 | $tl[1] = ($input % 100); | |||||
743 | 0 | $input = int($input / 100); | |||||
744 | 0 | $tl[2] = $input; | |||||
745 | 0 | 0 | $rtnTime += ($tl[2] * 3600) + ($tl[1] * 60) if ($rtnTime); | ||||
746 | } | ||||||
747 | } | ||||||
748 | |||||||
749 | sub _tod_hhmiss | ||||||
750 | { | ||||||
751 | 0 | 0 | my $indx = shift; | ||||
752 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
753 | |||||||
754 | 0 | 0 | return "e:Invalid hhmiss ($input) - must be 6-digit number! " unless ($input =~ /^\d{6}$/); | ||||
755 | |||||||
756 | 0 | &_tod_hh($indx, substr($input,0,2)); | |||||
757 | 0 | &_tod_mi($indx, substr($input,2,2)); | |||||
758 | 0 | return &_tod_ss($indx, substr($input,4,2)); | |||||
759 | } | ||||||
760 | |||||||
761 | sub _tod_HHmiss | ||||||
762 | { | ||||||
763 | 0 | 0 | my $indx = shift; | ||||
764 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
765 | |||||||
766 | 0 | 0 | return "e:Invalid HHmiss ($input) - must be 6-digit number! " unless ($input =~ /^\d{6}$/); | ||||
767 | |||||||
768 | 0 | &_tod_hh24($indx, substr($input,0,4)); | |||||
769 | 0 | return &_tod_ss($indx, substr($input,4,2)); | |||||
770 | } | ||||||
771 | |||||||
772 | sub _tod_a | ||||||
773 | { | ||||||
774 | 0 | 0 | my $indx = shift; | ||||
775 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
776 | |||||||
777 | 0 | 0 | if ($tl[2] < 12) | ||||
778 | { | ||||||
779 | 0 | 0 | if ($input =~ /p/io) { | ||||
780 | 0 | $tl[2] += 12; | |||||
781 | 0 | 0 | $rtnTime += 43200 if ($rtnTime); | ||||
782 | } | ||||||
783 | } | ||||||
784 | else | ||||||
785 | { | ||||||
786 | 0 | 0 | if ($input =~ /a/io) { | ||||
787 | 0 | $tl[2] -= 12; | |||||
788 | 0 | 0 | $rtnTime -= 43200 if ($rtnTime); | ||||
789 | } | ||||||
790 | } | ||||||
791 | 0 | return ''; | |||||
792 | } | ||||||
793 | |||||||
794 | sub _tod_p | ||||||
795 | { | ||||||
796 | 0 | 0 | return &_tod_a; | ||||
797 | } | ||||||
798 | |||||||
799 | sub _tod_A | ||||||
800 | { | ||||||
801 | 0 | 0 | return &_tod_a; | ||||
802 | } | ||||||
803 | |||||||
804 | sub _tod_P | ||||||
805 | { | ||||||
806 | 0 | 0 | return &_tod_a; | ||||
807 | } | ||||||
808 | |||||||
809 | sub _tod_am | ||||||
810 | { | ||||||
811 | 0 | 0 | return &_tod_a; | ||||
812 | } | ||||||
813 | |||||||
814 | sub _tod_pm | ||||||
815 | { | ||||||
816 | 0 | 0 | return &_tod_a; | ||||
817 | } | ||||||
818 | |||||||
819 | sub _tod_AM | ||||||
820 | { | ||||||
821 | 0 | 0 | return &_tod_a; | ||||
822 | } | ||||||
823 | |||||||
824 | sub _tod_PM | ||||||
825 | { | ||||||
826 | 0 | 0 | return &_tod_a; | ||||
827 | } | ||||||
828 | |||||||
829 | sub _tod_mi | ||||||
830 | { | ||||||
831 | 0 | 0 | my $indx = shift; | ||||
832 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
833 | |||||||
834 | 0 | 0 | 0 | return "e:Invalid minutes ($input)! " | |||
835 | unless ($input >= 0 and $input <= 59); | ||||||
836 | |||||||
837 | 0 | 0 | unless ($tl[1] =~ /\d/) { | ||||
838 | 0 | $tl[1] = $input; | |||||
839 | 0 | 0 | $rtnTime += ($input * 60) if ($rtnTime); | ||||
840 | } | ||||||
841 | 0 | return ''; | |||||
842 | } | ||||||
843 | |||||||
844 | sub _tod_sssss #SECONDS SINCE MIDNIGHT OF CURRENT DAY: | ||||||
845 | { | ||||||
846 | 0 | 0 | my $indx = shift; | ||||
847 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
848 | |||||||
849 | 0 | 0 | 0 | return "e:Invalid seconds ($input)! " | |||
850 | unless ($input >= 0 and $input < 86400); | ||||||
851 | |||||||
852 | 0 | 0 | 0 | unless ($tl[0] =~ /\d/ || $tl[1] =~ /\d/ || $tl[2] =~ /\d/) { | |||
0 | |||||||
853 | 0 | $tl[2] = int($input / 3600); | |||||
854 | 0 | $tl[0] = $input % 60; | |||||
855 | 0 | $tl[1] = int($input / 60) % 60; | |||||
856 | 0 | 0 | $rtnTime += $input if ($rtnTime); | ||||
857 | } | ||||||
858 | 0 | return ''; | |||||
859 | } | ||||||
860 | |||||||
861 | sub _tod_ssss0 #SECONDS SINCE MIDNIGHT OF CURRENT DAY: | ||||||
862 | { | ||||||
863 | 0 | 0 | return &_tod_sssss(@_); | ||||
864 | } | ||||||
865 | |||||||
866 | sub _tod_mmmm #MINUTES SINCE MIDNIGHT OF CURRENT DAY: | ||||||
867 | { | ||||||
868 | 0 | 0 | my $indx = shift; | ||||
869 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
870 | |||||||
871 | 0 | 0 | 0 | return "e:Invalid minutes ($input)! " | |||
872 | unless ($input >= 0 and $input < 1440); | ||||||
873 | |||||||
874 | 0 | 0 | 0 | unless ($tl[1] =~ /\d/ || $tl[2] =~ /\d/) { | |||
875 | 0 | $tl[2] = int($input / 60); | |||||
876 | 0 | $tl[1] = int($input % 60); | |||||
877 | 0 | 0 | $rtnTime += ($input / 60) if ($rtnTime); | ||||
878 | } | ||||||
879 | 0 | return ''; | |||||
880 | } | ||||||
881 | |||||||
882 | sub _tod_mmm0 #MINUTES SINCE MIDNIGHT OF CURRENT DAY: | ||||||
883 | { | ||||||
884 | 0 | 0 | return &_tod_mmmm(@_); | ||||
885 | } | ||||||
886 | |||||||
887 | sub _tod_ss | ||||||
888 | { | ||||||
889 | 0 | 0 | my $indx = shift; | ||||
890 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
891 | |||||||
892 | 0 | 0 | 0 | return "e:Invalid seconds ($input)! " | |||
893 | unless ($input >= 0 and $input <= 59); | ||||||
894 | |||||||
895 | 0 | 0 | unless ($tl[0] =~ /\d/) { | ||||
896 | 0 | $tl[0] = $input; | |||||
897 | 0 | 0 | $rtnTime += $input if ($rtnTime); | ||||
898 | } | ||||||
899 | 0 | return ''; | |||||
900 | } | ||||||
901 | |||||||
902 | sub _tod_d | ||||||
903 | { | ||||||
904 | 0 | 0 | return ''; | ||||
905 | } | ||||||
906 | |||||||
907 | sub _tod_d0 | ||||||
908 | { | ||||||
909 | 0 | 0 | return ''; | ||||
910 | } | ||||||
911 | |||||||
912 | sub _tod_day | ||||||
913 | { | ||||||
914 | 0 | 0 | my $indx = shift; | ||||
915 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
916 | |||||||
917 | 0 | my %dayhash = ( | |||||
918 | 'sun' => '0', | ||||||
919 | 'mon' => 1, | ||||||
920 | 'tue' => 2, | ||||||
921 | 'wed' => 3, | ||||||
922 | 'thu' => 4, | ||||||
923 | 'fri' => 5, | ||||||
924 | 'sat' => 6 | ||||||
925 | ); | ||||||
926 | |||||||
927 | 0 | $input =~ tr/A-Z/a-z/; | |||||
928 | 0 | 0 | return "e:Invalid Day ($input)! " unless (defined $dayhash{$input}); | ||||
929 | 0 | return ''; | |||||
930 | } | ||||||
931 | |||||||
932 | sub _tod_Day | ||||||
933 | { | ||||||
934 | 0 | 0 | return &_tod_day(@_); | ||||
935 | } | ||||||
936 | |||||||
937 | sub _tod_DAY | ||||||
938 | { | ||||||
939 | 0 | 0 | return &_tod_day(@_); | ||||
940 | } | ||||||
941 | |||||||
942 | sub _tod_dayofweek | ||||||
943 | { | ||||||
944 | 0 | 0 | my $indx = shift; | ||||
945 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
946 | |||||||
947 | 0 | my %dayhash = ( | |||||
948 | 'sunday' => '0', | ||||||
949 | 'monday' => 1, | ||||||
950 | 'tuesday' => 2, | ||||||
951 | 'wednesday' => 3, | ||||||
952 | 'thursday' => 4, | ||||||
953 | 'friday' => 5, | ||||||
954 | 'saturday' => 6 | ||||||
955 | ); | ||||||
956 | |||||||
957 | 0 | $input =~ tr/A-Z/a-z/; | |||||
958 | 0 | 0 | return "e:Invalid Day ($input)! " unless (defined $dayhash{$input}); | ||||
959 | 0 | return ''; | |||||
960 | } | ||||||
961 | |||||||
962 | sub _tod_Dayofweek | ||||||
963 | { | ||||||
964 | 0 | 0 | return &_tod_dayofweek(@_); | ||||
965 | } | ||||||
966 | |||||||
967 | sub _tod_DAYOFWEEK | ||||||
968 | { | ||||||
969 | 0 | 0 | return &_tod_dayofweek(@_); | ||||
970 | } | ||||||
971 | |||||||
972 | sub _tod_ww | ||||||
973 | { | ||||||
974 | 0 | 0 | return ''; | ||||
975 | } | ||||||
976 | |||||||
977 | sub _tod_w | ||||||
978 | { | ||||||
979 | 0 | 0 | return ''; | ||||
980 | } | ||||||
981 | |||||||
982 | sub _tod_q | ||||||
983 | { | ||||||
984 | 0 | 0 | my $indx = shift; | ||||
985 | 0 | 0 | my $input = shift || $inputs[$indx]; | ||||
986 | |||||||
987 | 0 | 0 | 0 | return "e:Invalid Quarter ($input) - must be 1-4! " if ($input < 1 || $input > 4); | |||
988 | 0 | 0 | unless ($#tl >= 5) { | ||||
989 | 0 | 0 | $tl[3] ||= 1; | ||||
990 | 0 | $tl[4] = ($input-1)*3; | |||||
991 | } | ||||||
992 | 0 | return ''; | |||||
993 | } | ||||||
994 | |||||||
995 | 1 |