blib/lib/Date/Time2fmtstr.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 9 | 136 | 6.6 |
branch | 0 | 50 | 0.0 |
condition | 0 | 26 | 0.0 |
subroutine | 3 | 67 | 4.4 |
pod | 1 | 6 | 16.6 |
total | 13 | 285 | 4.5 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | =head1 NAME | ||||||
2 | |||||||
3 | Date::Time2fmtstr - Functions to format Perl time integers to strings 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::Time2fmtstr; | ||||||
14 | |||||||
15 | my $timestring = time2str(time, 'mm-dd-yyyy hh:mi PM'); | ||||||
16 | |||||||
17 | die $timestring if ($timestring =~ /^e\:/); | ||||||
18 | |||||||
19 | print "Current date/time (formatted): $timestring.\n"; | ||||||
20 | |||||||
21 | =head1 DESCRIPTION | ||||||
22 | |||||||
23 | Date::Time2fmtstr provides a single function B |
||||||
24 | "time" value (a large integer equivalent to the number of seconds since 1980) and converts it | ||||||
25 | to a string value based on a I |
||||||
26 | the various parts of a date and time value. It returns a string that is essentially the | ||||||
27 | same as the original I |
||||||
28 | the corresponding date/time value. | ||||||
29 | |||||||
30 | =head1 METHODS | ||||||
31 | |||||||
32 | =over 4 | ||||||
33 | |||||||
34 | =item $string = B |
||||||
35 | |||||||
36 | Returns a string corresponding to the specified I |
||||||
37 | replaced with the corresponding date/time data field. | ||||||
38 | |||||||
39 | For example: | ||||||
40 | |||||||
41 | $s = &time2str(1452324044, 'mm-dd-yyyy hh:mi PM (Day) (Month)'); | ||||||
42 | |||||||
43 | would set $s to '01-09-2016 01:20 AM (Sat) (January)'. | ||||||
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 - display "a" if between Midnight and Noon, "p" otherwise (both specifiers are identical). |
||||||
53 | |||||||
54 | B, B - display "A" if between Midnight and Noon, "P" otherwise (both specifiers are identical). |
||||||
55 | |||||||
56 | B |
||||||
57 | |||||||
58 | B |
||||||
59 | |||||||
60 | B |
||||||
61 | |||||||
62 | B |
||||||
63 | |||||||
64 | B |
||||||
65 | |||||||
66 | B |
||||||
67 | |||||||
68 | B |
||||||
69 | |||||||
70 | B |
||||||
71 | |||||||
72 | B |
||||||
73 | the number of SECONDS (86400 per day) to midnight, 1/1/current-year, so if spanning a | ||||||
74 | daylight-savings time boundary may result in +1 hour difference, which the underlying | ||||||
75 | Perl localtime/timelocal functions will take into account! For example, if the current | ||||||
76 | time was "1570286966" (2019/10/05 09:49:26), the following code: | ||||||
77 | |||||||
78 | print &time2str(&str2time(&time2str(1570286966, 'ddd, hh:mi:ss'), 'ddd, hh:mi:ss'), 'yyyy/mm/dd hh:mi:ss') . "\n"; | ||||||
79 | |||||||
80 | would print "2019/10/05 10:49:26" due to the fact that 1 hour (3600 seconds) was | ||||||
81 | automatically skipped over when DST was imposed between 1 January and 5 October. This | ||||||
82 | "feature" only applies when calculating the date/time based on days since beginning | ||||||
83 | of the year ("ddd"). | ||||||
84 | |||||||
85 | B |
||||||
86 | |||||||
87 | B |
||||||
88 | |||||||
89 | B |
||||||
90 | |||||||
91 | B |
||||||
92 | |||||||
93 | B |
||||||
94 | with a zero if needed for 4 digits). | ||||||
95 | |||||||
96 | B |
||||||
97 | with a zero if needed for 6 digits). | ||||||
98 | |||||||
99 | B |
||||||
100 | with a zero if needed for 4 digits). | ||||||
101 | |||||||
102 | B - Hour in common format, 1 or 2 digits, as needed, ie. 1-12. (see B |
||||||
103 | specifiers). | ||||||
104 | |||||||
105 | B |
||||||
106 | 4 digits as needed. | ||||||
107 | |||||||
108 | B |
||||||
109 | |||||||
110 | B- Hour in 24-hour format, 1 or 2 digits, as needed, ie. 0-23. |
||||||
111 | |||||||
112 | B |
||||||
113 | with a zeros if needed for 6 digits). | ||||||
114 | |||||||
115 | B |
||||||
116 | |||||||
117 | B |
||||||
118 | |||||||
119 | B |
||||||
120 | |||||||
121 | B |
||||||
122 | |||||||
123 | B |
||||||
124 | |||||||
125 | B |
||||||
126 | |||||||
127 | B |
||||||
128 | |||||||
129 | B |
||||||
130 | |||||||
131 | B |
||||||
132 | |||||||
133 | B |
||||||
134 | |||||||
135 | B |
||||||
136 | |||||||
137 | B |
||||||
138 | |||||||
139 | B |
||||||
140 | |||||||
141 | B |
||||||
142 | |||||||
143 | B |
||||||
144 | |||||||
145 | B |
||||||
146 | |||||||
147 | B- Number of the quarter of the year - (1-4). |
||||||
148 | |||||||
149 | B |
||||||
150 | |||||||
151 | B |
||||||
152 | |||||||
153 | B |
||||||
154 | |||||||
155 | B |
||||||
156 | |||||||
157 | B |
||||||
158 | |||||||
159 | B |
||||||
160 | |||||||
161 | B |
||||||
162 | |||||||
163 | B |
||||||
164 | |||||||
165 | B |
||||||
166 | |||||||
167 | B |
||||||
168 | |||||||
169 | B |
||||||
170 | |||||||
171 | B |
||||||
172 | |||||||
173 | B |
||||||
174 | |||||||
175 | B |
||||||
176 | |||||||
177 | B |
||||||
178 | |||||||
179 | =back | ||||||
180 | |||||||
181 | =back | ||||||
182 | |||||||
183 | =head1 DEPENDENCIES | ||||||
184 | |||||||
185 | Perl 5 | ||||||
186 | |||||||
187 | =head1 RECCOMENDS | ||||||
188 | |||||||
189 | L |
||||||
190 | |||||||
191 | =head1 BUGS | ||||||
192 | |||||||
193 | Please report any bugs or feature requests to C |
||||||
194 | the web interface at L |
||||||
195 | automatically be notified of progress on your bug as I make changes. | ||||||
196 | |||||||
197 | =head1 SUPPORT | ||||||
198 | |||||||
199 | You can find documentation for this module with the perldoc command. | ||||||
200 | |||||||
201 | perldoc Date::Time2fmtstr | ||||||
202 | |||||||
203 | You can also look for information at: | ||||||
204 | |||||||
205 | =over 4 | ||||||
206 | |||||||
207 | =item * RT: CPAN's request tracker (report bugs here) | ||||||
208 | |||||||
209 | L |
||||||
210 | |||||||
211 | =item * AnnoCPAN: Annotated CPAN documentation | ||||||
212 | |||||||
213 | L |
||||||
214 | |||||||
215 | =item * CPAN Ratings | ||||||
216 | |||||||
217 | L |
||||||
218 | |||||||
219 | =item * Search CPAN | ||||||
220 | |||||||
221 | L |
||||||
222 | |||||||
223 | =back | ||||||
224 | |||||||
225 | =head1 SEE ALSO | ||||||
226 | |||||||
227 | L |
||||||
228 | |||||||
229 | =head1 KEYWORDS | ||||||
230 | |||||||
231 | Date::Time2fmtstr, Date::Fmtstr2time, formatting, picture_clause, strings | ||||||
232 | |||||||
233 | =head1 LICENSE AND COPYRIGHT | ||||||
234 | |||||||
235 | Copyright (C) 2015-2019 Jim Turner | ||||||
236 | |||||||
237 | This program is free software; you can redistribute it and/or modify it | ||||||
238 | under the terms of the the Artistic License (2.0). You may obtain a | ||||||
239 | copy of the full license at: | ||||||
240 | |||||||
241 | L |
||||||
242 | |||||||
243 | Any use, modification, and distribution of the Standard or Modified | ||||||
244 | Versions is governed by this Artistic License. By using, modifying or | ||||||
245 | distributing the Package, you accept this license. Do not use, modify, | ||||||
246 | or distribute the Package, if you do not accept this license. | ||||||
247 | |||||||
248 | If your Modified Version has been derived from a Modified Version made | ||||||
249 | by someone other than you, you are nevertheless required to ensure that | ||||||
250 | your Modified Version complies with the requirements of this license. | ||||||
251 | |||||||
252 | This license does not grant you the right to use any trademark, service | ||||||
253 | mark, tradename, or logo of the Copyright Holder. | ||||||
254 | |||||||
255 | This license includes the non-exclusive, worldwide, free-of-charge | ||||||
256 | patent license to make, have made, use, offer to sell, sell, import and | ||||||
257 | otherwise transfer the Package with respect to any patent claims | ||||||
258 | licensable by the Copyright Holder that are necessarily infringed by the | ||||||
259 | Package. If you institute patent litigation (including a cross-claim or | ||||||
260 | counterclaim) against any party alleging that the Package constitutes | ||||||
261 | direct or contributory patent infringement, then this Artistic License | ||||||
262 | to you shall terminate on the date that such litigation is filed. | ||||||
263 | |||||||
264 | Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER | ||||||
265 | AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. | ||||||
266 | THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR | ||||||
267 | PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY | ||||||
268 | YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR | ||||||
269 | CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR | ||||||
270 | CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, | ||||||
271 | EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. | ||||||
272 | |||||||
273 | =cut | ||||||
274 | |||||||
275 | package Date::Time2fmtstr; | ||||||
276 | |||||||
277 | 1 | 1 | 59187 | use strict; | |||
1 | 2 | ||||||
1 | 27 | ||||||
278 | #use warnings; | ||||||
279 | 1 | 1 | 5 | use vars qw(@ISA @EXPORT $VERSION); | |||
1 | 2 | ||||||
1 | 257 | ||||||
280 | $VERSION = '1.11'; | ||||||
281 | |||||||
282 | require Exporter; | ||||||
283 | |||||||
284 | @ISA = qw(Exporter); | ||||||
285 | @EXPORT = qw(time2str); | ||||||
286 | |||||||
287 | my @inputs = (); | ||||||
288 | |||||||
289 | sub time2str | ||||||
290 | { | ||||||
291 | 0 | 0 | 0 | 1 | my $s = $_[0] || time; | ||
292 | 0 | 0 | return "e:Invalid Time ($s) not numeric!" if ($s =~ /\D/); | ||||
293 | |||||||
294 | 0 | 0 | my $f = $_[1] || 'yyyymmdd'; | ||||
295 | |||||||
296 | 0 | my @fmts = split(/\b/, $f); | |||||
297 | 0 | my @today = localtime(time); | |||||
298 | 0 | @inputs = localtime($s); | |||||
299 | 0 | my $resORerr = ''; | |||||
300 | 0 | my $rtnTime = ''; | |||||
301 | 0 | my $fn; | |||||
302 | |||||||
303 | 0 | OUTER1: for (my $i=0;$i<=$#fmts;$i++) | |||||
304 | { | ||||||
305 | 0 | 0 | if ($fmts[$i] =~ /\W/o) | ||||
306 | { | ||||||
307 | 0 | $resORerr .= $fmts[$i]; | |||||
308 | 0 | next; | |||||
309 | } | ||||||
310 | 0 | MIDDLE1: while ($fmts[$i] =~ /\w/o) | |||||
311 | { | ||||||
312 | 0 | foreach my $f (qw(month Month MONTH dayofweek Dayofweek DAYOFWEEK day Day DAY ddd | |||||
313 | dd d1 d0 mmddyyyy yyyymmddhhmiss yyyymmddhhmi yyyymmdd yyyymm yymmdd mmyyyy | ||||||
314 | mmddyy yyyy yymm mmyy yy mmdd hh24 HHmiss hhmiss HHmi h1mi hhmi hh HH H1 h1 mi | ||||||
315 | mmm0 mmmm mm mon Mon MON m1 ssss0 sssss ss am pm AM PM a p A P rm RM rr d | ||||||
316 | ww w q)) | ||||||
317 | { | ||||||
318 | 0 | 0 | if ($fmts[$i] =~ s/^$f//) | ||||
319 | { | ||||||
320 | 0 | $fn = '_toc_'.$f; | |||||
321 | 1 | 1 | 7 | no strict 'refs'; | |||
1 | 2 | ||||||
1 | 1693 | ||||||
322 | 0 | $resORerr .= &$fn(); | |||||
323 | 0 | next MIDDLE1; | |||||
324 | } | ||||||
325 | } | ||||||
326 | 0 | 0 | if ($fmts[$i] =~ s/^(\w)(\w+)$/$2/) | ||||
327 | { | ||||||
328 | 0 | $resORerr .= $1; | |||||
329 | 0 | next MIDDLE1; | |||||
330 | } | ||||||
331 | 0 | $resORerr .= $fmts[$i]; | |||||
332 | 0 | next OUTER1; | |||||
333 | } | ||||||
334 | } | ||||||
335 | |||||||
336 | 0 | return $resORerr; | |||||
337 | } | ||||||
338 | |||||||
339 | sub _toc_month | ||||||
340 | { | ||||||
341 | 0 | 0 | my @mthlist = (qw(january february march april may june july august september | ||||
342 | october november december)); | ||||||
343 | |||||||
344 | 0 | 0 | 0 | return "e:Invalid Month ($inputs[4])! " unless ($inputs[4] >= 0 && $inputs[4] < 12); | |||
345 | 0 | return $mthlist[$inputs[4]]; | |||||
346 | } | ||||||
347 | |||||||
348 | sub _toc_Month | ||||||
349 | { | ||||||
350 | 0 | 0 | my $mymonth = &_toc_month(); | ||||
351 | 0 | return "\u\L$mymonth\E" | |||||
352 | } | ||||||
353 | |||||||
354 | sub _toc_MONTH | ||||||
355 | { | ||||||
356 | 0 | 0 | my $mymonth = &_toc_month(); | ||||
357 | 0 | return "\U$mymonth\E"; | |||||
358 | } | ||||||
359 | |||||||
360 | sub _toc_mon | ||||||
361 | { | ||||||
362 | 0 | 0 | my @mthlist = (qw(jan feb mar apr may jun jul aug sep oct nov dec)); | ||||
363 | |||||||
364 | 0 | 0 | 0 | return "e:Invalid Month ($inputs[4])! " unless ($inputs[4] >= 0 && $inputs[4] < 12); | |||
365 | 0 | return $mthlist[$inputs[4]]; | |||||
366 | } | ||||||
367 | |||||||
368 | sub _toc_Mon | ||||||
369 | { | ||||||
370 | 0 | 0 | my $mymonth = &_toc_mon(); | ||||
371 | 0 | return "\u\L$mymonth\E"; | |||||
372 | } | ||||||
373 | |||||||
374 | sub _toc_MON | ||||||
375 | { | ||||||
376 | 0 | 0 | my $mymonth = &_toc_mon(); | ||||
377 | 0 | return "\U$mymonth\E"; | |||||
378 | } | ||||||
379 | |||||||
380 | sub _toc_rm #ROMAN NUMBER MONTH - LOWER CASE | ||||||
381 | { | ||||||
382 | 0 | 0 | my @mthlist = (qw(i ii iii iv v vi vii viii ix x xi xii)); | ||||
383 | |||||||
384 | 0 | 0 | 0 | return "e:Invalid Month ($inputs[4])! " unless ($inputs[4] >= 0 && $inputs[4] < 12); | |||
385 | 0 | return $mthlist[$inputs[4]]; | |||||
386 | } | ||||||
387 | |||||||
388 | sub _toc_RM #ROMAN NUMBER MONTH - UPPER CASE | ||||||
389 | { | ||||||
390 | 0 | 0 | my $mymonth = &_toc_rm(); | ||||
391 | 0 | return "\U$mymonth\E"; | |||||
392 | } | ||||||
393 | |||||||
394 | sub _toc_mm #MONTH (01-12) | ||||||
395 | { | ||||||
396 | 0 | 0 | my $mymth = $inputs[4] + 1; | ||||
397 | 0 | 0 | 0 | return "e:Invalid Month ($mymth)! " unless ($mymth >= 1 && $mymth <= 12); | |||
398 | 0 | 0 | return '0'.$mymth if ($mymth < 10); | ||||
399 | 0 | return $mymth; | |||||
400 | } | ||||||
401 | |||||||
402 | sub _toc_m1 #MONTH (1-12) | ||||||
403 | { | ||||||
404 | 0 | 0 | my $mymth = $inputs[4] + 1; | ||||
405 | 0 | 0 | 0 | return "e:Invalid Month ($mymth)! " unless ($mymth >= 1 && $mymth <= 12); | |||
406 | 0 | return $mymth; | |||||
407 | } | ||||||
408 | |||||||
409 | sub _toc_yy | ||||||
410 | { | ||||||
411 | 0 | 0 | my $myyr = $inputs[5]; | ||||
412 | 0 | 0 | return "e:Invalid Year ($myyr)! " unless ($myyr =~ /^[0-9]+$/o); | ||||
413 | 0 | $myyr -= 100 while ($myyr >= 100); | |||||
414 | 0 | 0 | return '0'.$myyr if ($myyr < 10); | ||||
415 | 0 | return $myyr; | |||||
416 | } | ||||||
417 | |||||||
418 | sub _toc_mmddyyyy | ||||||
419 | { | ||||||
420 | 0 | 0 | return &_toc_mm() . &_toc_dd() . &_toc_yyyy(); | ||||
421 | } | ||||||
422 | |||||||
423 | sub _toc_yyyymmdd | ||||||
424 | { | ||||||
425 | 0 | 0 | return &_toc_yyyy() . &_toc_mm() . &_toc_dd(); | ||||
426 | } | ||||||
427 | |||||||
428 | sub _toc_yyyymmddhhmiss | ||||||
429 | { | ||||||
430 | 0 | 0 | return &_toc_yyyy() . &_toc_mm() . &_toc_dd() . &_toc_HH() . &_toc_mi() . &_toc_ss(); | ||||
431 | } | ||||||
432 | |||||||
433 | sub _toc_yyyymmddhhmi | ||||||
434 | { | ||||||
435 | 0 | 0 | return &_toc_yyyy() . &_toc_mm() . &_toc_dd() . &_toc_HH() . &_toc_mi(); | ||||
436 | } | ||||||
437 | |||||||
438 | sub _toc_yyyymm | ||||||
439 | { | ||||||
440 | 0 | 0 | return &_toc_yyyy() . &_toc_mm(); | ||||
441 | } | ||||||
442 | |||||||
443 | sub _toc_yymmdd | ||||||
444 | { | ||||||
445 | 0 | 0 | return &_toc_yy() . &_toc_mm() . &_toc_dd(); | ||||
446 | } | ||||||
447 | |||||||
448 | sub _toc_mmyyyy | ||||||
449 | { | ||||||
450 | 0 | 0 | return &_toc_mm() . &_toc_yyyy(); | ||||
451 | } | ||||||
452 | |||||||
453 | sub _toc_mmddyy | ||||||
454 | { | ||||||
455 | 0 | 0 | return &_toc_mm() . &_toc_dd() . &_toc_yy(); | ||||
456 | } | ||||||
457 | |||||||
458 | sub _toc_yymm | ||||||
459 | { | ||||||
460 | 0 | 0 | return &_toc_yy() . &_toc_mm(); | ||||
461 | } | ||||||
462 | |||||||
463 | sub _toc_yyyy #4-DIGIT YEAR | ||||||
464 | { | ||||||
465 | 0 | 0 | return $inputs[5] + 1900; | ||||
466 | } | ||||||
467 | |||||||
468 | sub _toc_mmyy | ||||||
469 | { | ||||||
470 | 0 | 0 | return &_toc_mm() . &_toc_yy(); | ||||
471 | } | ||||||
472 | |||||||
473 | sub _toc_mmdd | ||||||
474 | { | ||||||
475 | 0 | 0 | return &_toc_mm() . &_toc_dd(); | ||||
476 | } | ||||||
477 | |||||||
478 | sub _toc_rr | ||||||
479 | { | ||||||
480 | 0 | 0 | return &_toc_yy(); | ||||
481 | } | ||||||
482 | |||||||
483 | sub _toc_rrrr | ||||||
484 | { | ||||||
485 | 0 | 0 | return &_toc_yyyy(); | ||||
486 | } | ||||||
487 | |||||||
488 | sub _toc_ddd #DAY OF YEAR (1-365) | ||||||
489 | { | ||||||
490 | 0 | 0 | return $inputs[7] + 1; | ||||
491 | } | ||||||
492 | |||||||
493 | sub _toc_dd #DAY OF MONTH (01-31) | ||||||
494 | { | ||||||
495 | 0 | 0 | 0 | return '0'.$inputs[3] if ($inputs[3] < 10); | |||
496 | 0 | return $inputs[3]; | |||||
497 | } | ||||||
498 | |||||||
499 | sub _toc_d1 #DAY OF MONTH (1-31) | ||||||
500 | { | ||||||
501 | 0 | 0 | return $inputs[3]; | ||||
502 | } | ||||||
503 | |||||||
504 | sub _toc_hh24 #24-HOUR MILITARY TIME (0000-2359): | ||||||
505 | { | ||||||
506 | 0 | 0 | return sprintf('%4.4d', ($inputs[2] * 100) + $inputs[1]); | ||||
507 | } | ||||||
508 | |||||||
509 | sub _toc_HH #HOUR (00-23) | ||||||
510 | { | ||||||
511 | 0 | 0 | 0 | return '0'.$inputs[2] if ($inputs[2] < 10); | |||
512 | 0 | return $inputs[2]; | |||||
513 | } | ||||||
514 | |||||||
515 | sub _toc_H1 #HOUR (0-23) | ||||||
516 | { | ||||||
517 | 0 | 0 | return $inputs[2]; | ||||
518 | } | ||||||
519 | |||||||
520 | sub _toc_hh #HOUR (01-12) | ||||||
521 | { | ||||||
522 | 0 | 0 | my $hr = $inputs[2]; | ||||
523 | 0 | 0 | return 12 unless ($hr); | ||||
524 | 0 | 0 | $hr -= 12 if ($hr > 12); | ||||
525 | 0 | 0 | return '0'.$hr if ($hr < 10); | ||||
526 | 0 | return $hr; | |||||
527 | } | ||||||
528 | |||||||
529 | sub _toc_h1 #HOUR (1-12) | ||||||
530 | { | ||||||
531 | 0 | 0 | my $hr = $inputs[2]; | ||||
532 | 0 | 0 | return 12 unless ($hr); | ||||
533 | 0 | 0 | $hr -= 12 if ($hr > 12); | ||||
534 | 0 | return $hr; | |||||
535 | } | ||||||
536 | |||||||
537 | sub HHmi { | ||||||
538 | 0 | 0 | 0 | return &_toc_HH24(); | |||
539 | } | ||||||
540 | |||||||
541 | sub hhmi { | ||||||
542 | 0 | 0 | 0 | return &_toc_hh() . &_toc_mi(); | |||
543 | } | ||||||
544 | |||||||
545 | sub h1mi { | ||||||
546 | 0 | 0 | 0 | return &_toc_h1() . &_toc_mi(); | |||
547 | } | ||||||
548 | |||||||
549 | sub HHmiss { | ||||||
550 | 0 | 0 | 0 | return &_toc_HH() . &_toc_mi() . &_toc_ss(); | |||
551 | } | ||||||
552 | |||||||
553 | sub hhmiss { | ||||||
554 | 0 | 0 | 0 | return &_toc_hh() . &_toc_mi() . &_toc_ss(); | |||
555 | } | ||||||
556 | |||||||
557 | sub _toc_a | ||||||
558 | { | ||||||
559 | 0 | 0 | 0 | return ($inputs[2] < 12) ? 'a' : 'p'; | |||
560 | } | ||||||
561 | |||||||
562 | sub _toc_p | ||||||
563 | { | ||||||
564 | 0 | 0 | return &_toc_a(); | ||||
565 | } | ||||||
566 | |||||||
567 | sub _toc_A | ||||||
568 | { | ||||||
569 | 0 | 0 | 0 | return ($inputs[2] < 12) ? 'A' : 'P'; | |||
570 | } | ||||||
571 | |||||||
572 | sub _toc_P | ||||||
573 | { | ||||||
574 | 0 | 0 | return &_toc_A(); | ||||
575 | } | ||||||
576 | |||||||
577 | sub _toc_am | ||||||
578 | { | ||||||
579 | 0 | 0 | return &_toc_a() . 'm'; | ||||
580 | } | ||||||
581 | |||||||
582 | sub _toc_pm | ||||||
583 | { | ||||||
584 | 0 | 0 | return &_toc_a() . 'm'; | ||||
585 | } | ||||||
586 | |||||||
587 | sub _toc_AM | ||||||
588 | { | ||||||
589 | 0 | 0 | return &_toc_A() . 'M'; | ||||
590 | } | ||||||
591 | |||||||
592 | sub _toc_PM | ||||||
593 | { | ||||||
594 | 0 | 0 | return &_toc_A() . 'M'; | ||||
595 | } | ||||||
596 | |||||||
597 | sub _toc_mi #MINUTES (00-59) | ||||||
598 | { | ||||||
599 | 0 | 0 | 0 | return '0'.$inputs[1] if ($inputs[1] < 10); | |||
600 | 0 | return $inputs[1]; | |||||
601 | } | ||||||
602 | |||||||
603 | sub _toc_ssss0 #SECONDS OF THE DAY (0-86399) | ||||||
604 | { | ||||||
605 | 0 | 0 | return ($inputs[2]*3600)+($inputs[1]*60)+$inputs[0]; | ||||
606 | } | ||||||
607 | |||||||
608 | sub _toc_sssss #SECONDS OF THE DAY (0-86399) | ||||||
609 | { | ||||||
610 | 0 | 0 | return sprintf('%5.5d', &_toc_ssss0); | ||||
611 | } | ||||||
612 | |||||||
613 | sub _toc_mmm0 #MINUTES OF THE DAY (0-3599) | ||||||
614 | { | ||||||
615 | 0 | 0 | return ($inputs[2]*60)+$inputs[1]; | ||||
616 | } | ||||||
617 | |||||||
618 | sub _toc_mmmm #MINUTES OF THE DAY (0-3599) | ||||||
619 | { | ||||||
620 | 0 | 0 | return sprintf('%4.4d', &_toc_mmm0); | ||||
621 | } | ||||||
622 | |||||||
623 | sub _toc_ss #SECONDS | ||||||
624 | { | ||||||
625 | 0 | 0 | 0 | return '0'.$inputs[0] if ($inputs[0] < 10); | |||
626 | 0 | return $inputs[0]; | |||||
627 | } | ||||||
628 | |||||||
629 | sub _toc_d #DAY OF WEEK (SUN=1..SAT=7 | ||||||
630 | { | ||||||
631 | 0 | 0 | return $inputs[6] + 1; | ||||
632 | } | ||||||
633 | |||||||
634 | sub _toc_d0 #DAY OF WEEK (SUN=0..SAT=6 | ||||||
635 | { | ||||||
636 | 0 | 0 | return $inputs[6]; | ||||
637 | } | ||||||
638 | |||||||
639 | sub _toc_day | ||||||
640 | { | ||||||
641 | 0 | 0 | my @daylist = (qw(sun mon tue wed thu fri sat)); | ||||
642 | |||||||
643 | 0 | 0 | 0 | return "e:Invalid Day ($inputs[6])! " unless ($inputs[6] >= 0 && $inputs[6] < 7); | |||
644 | 0 | return $daylist[$inputs[6]]; | |||||
645 | } | ||||||
646 | |||||||
647 | sub _toc_Day | ||||||
648 | { | ||||||
649 | 0 | 0 | my $myday = &_toc_day(); | ||||
650 | 0 | return "\u\L$myday\E"; | |||||
651 | } | ||||||
652 | |||||||
653 | sub _toc_DAY | ||||||
654 | { | ||||||
655 | 0 | 0 | my $myday = &_toc_day(); | ||||
656 | 0 | return "\U$myday\E"; | |||||
657 | } | ||||||
658 | |||||||
659 | sub _toc_dayofweek | ||||||
660 | { | ||||||
661 | 0 | 0 | my @daylist = (qw(sunday monday tuesday wednesday thursday friday saturday)); | ||||
662 | |||||||
663 | 0 | 0 | 0 | return "e:Invalid Day ($inputs[6])! " unless ($inputs[6] >= 0 && $inputs[6] < 7); | |||
664 | 0 | return $daylist[$inputs[6]]; | |||||
665 | } | ||||||
666 | |||||||
667 | sub _toc_Dayofweek | ||||||
668 | { | ||||||
669 | 0 | 0 | my $myday = &_toc_dayofweek(); | ||||
670 | 0 | return "\u\L$myday\E"; | |||||
671 | } | ||||||
672 | |||||||
673 | sub _toc_DAYOFWEEK | ||||||
674 | { | ||||||
675 | 0 | 0 | my $myday = &_toc_dayofweek(); | ||||
676 | 0 | return "\U$myday\E"; | |||||
677 | } | ||||||
678 | |||||||
679 | sub _toc_w #WEEK OF MONTH (1-5) | ||||||
680 | { | ||||||
681 | 0 | 0 | return int(&_toc_dd / 7) + 1; | ||||
682 | } | ||||||
683 | |||||||
684 | sub _toc_ww #WEEK OF YEAR (1-52) | ||||||
685 | { | ||||||
686 | 0 | 0 | return int(&_toc_ddd / 7) + 1; | ||||
687 | } | ||||||
688 | |||||||
689 | sub _toc_q #QUARTER (1-4): | ||||||
690 | { | ||||||
691 | 0 | 0 | return int(&_toc_mm / 4) + 1; | ||||
692 | } | ||||||
693 | |||||||
694 | 1 | ||||||
695 | |||||||
696 | __END__ |