File Coverage

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 that accepts a date or date / time
24             as a string (I), and a I consisting of special substrings which represent
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(I, I);
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 tells
37             the software what format to expect the date / time value in the I to be in.
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, or B - Assume hour is AM (if 1-11), and convert 12 to midnight
53             (0 in 24-hour time). (all specifiers are identical and case insensitive). See also:
54             B

, B

, B, or B below.

55              
56             B, B, or B - Three letter abbreviation of the day of the week
57             (case insensitive), ie. "sun". Reason for the three versions is to match up with
58             L, which has three separate versions for I the desired case,
59             but here (I), case doesn't matter. This applies also to Month, etc. and
60             similiarly to functions that pad or don't pad with leading zeros!
61              
62             B, B, or B - Day of the week (case insensitive).
63              
64             B - Number of days since beginning of year. NOTE: This is calculated by adding
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
, B - Day of month (1 or 2 digits, left padded with a zero if needed), ie.
78             "3" or "03" for March.
79              
80             B, B - Numeric day of the week zero-based (Sunday=0, Monday=1, ... Saturday=6).
81              
82             B, B

- Hour in common format, ie. 1-12 (1 or 2 digits, as needed).

83             (see B and B specifiers).
84              
85             B, B - Hours and minutes in 12-hour time (hours and minutes no colon).
86              
87             B - Hours, minutes and seconds in 12-hour time (no colons). Must be six
88             digits.
89              
90             B, B - Hours and minutes in 24-hour (military) time (no colon).
91              
92             B, B

- Hour in 24-hour format, ie. 00-23 (1 or 2 digits, as needed).

93              
94             B - Hours, minutes and seconds in 24-hour (military) time (no colons).
95             Must be six digits.
96              
97             B - Minute, ie. 0-59 (1 or 2 digits, as needed).
98              
99             B, B - Number of month (1 or 2 digits, as needed), ie. "1" or "01" for January.
100              
101             B - Numeric date in 4 digits, ie. "0107" for January, 7, (current year).
102              
103             B - Numeric date in 6 digits, ie. "010715" for January 7, 2015.
104              
105             B - Numeric date in 8 digits, ie. "01072015" for January 7, 2015.
106              
107             B, B - Minutes since start of day (0-3599).
108              
109             B - Numeric date in 4 digits, ie. "0115" for January, 2015.
110              
111             B - Numeric date in 6 digits, ie. "012015" for January, 2015.
112              
113             B, B, or B - Three letter abbreviation of the month (case insensitive),
114             ie. "jan" for January.
115              
116             B, B, or B - The Full name of the month (case insensitive),
117             ie. "january".
118              
119             B

, B

, B, or B - Assume hour is noon if 12, otherwise, convert (add 12 to)

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 - Roman numeral for the month (i-xii) in lower case.
125              
126             B - Roman numeral for the month (I-XII) in upper case.
127              
128             B - Seconds since start of last minute (1 or 2 digits as needed), ie. 0-59.
129              
130             B, B - Seconds since start of day (0-86399) 1-5 digits as needed
131             (leading zeros ignored).
132              
133             B - Number of week (one-based) of the month (1-5).
134              
135             B - Number of week (one-based) of the year (1-52) (1 or 2 digits as needed).
136              
137             B, B - Year in last 2 digits.
138              
139             B - Numeric date in 4 digits, ie. "1501" for January, 2015.
140              
141             B - Numeric date in 6 digits, ie. "150107" for January 7, 2015.
142              
143             B, B - Year in 4 digits.
144              
145             B - Numeric date in 6 digits, ie. "201501" for January, 2015.
146              
147             B - Numeric date in 8 digits, ie. "20150107" for January 7, 2015.
148              
149             B - Numeric date/time in 12 digits, ie. "201501071345" for January 7, 2015 1:45pm.
150              
151             B - Numeric date/time in 14 digits, ie. "20150107134512" for January 7, 2015 1:45:12pm.
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, or through
170             the web interface at L. I will be notified, and then you'll
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