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