← Index
NYTProf Performance Profile   « line view »
For ./view
  Run on Fri Jul 31 19:05:14 2015
Reported on Fri Jul 31 19:08:10 2015

Filename/usr/share/perl5/vendor_perl/Time/ParseDate.pm
StatementsExecuted 149 statements in 5.68ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1111.21ms1.39msTime::ParseDate::::BEGIN@6Time::ParseDate::BEGIN@6
111868µs1.11msTime::ParseDate::::BEGIN@7Time::ParseDate::BEGIN@7
211226µs226µsTime::ParseDate::::parse_date_onlyTime::ParseDate::parse_date_only
211170µs182µsTime::ParseDate::::parse_date_offsetTime::ParseDate::parse_date_offset
211148µs687µsTime::ParseDate::::parsedateTime::ParseDate::parsedate
21165µs65µsTime::ParseDate::::parse_time_onlyTime::ParseDate::parse_time_only
21138µs38µsTime::ParseDate::::parse_time_offsetTime::ParseDate::parse_time_offset
21127µs27µsTime::ParseDate::::parse_year_onlyTime::ParseDate::parse_year_only
11115µs40µsTime::ParseDate::::BEGIN@5Time::ParseDate::BEGIN@5
11112µs15µsTime::ParseDate::::BEGIN@881Time::ParseDate::BEGIN@881
21112µs12µsTime::ParseDate::::righttimeTime::ParseDate::righttime
1119µs41µsTime::ParseDate::::BEGIN@17Time::ParseDate::BEGIN@17
1119µs22µsTime::ParseDate::::BEGIN@22Time::ParseDate::BEGIN@22
1118µs20µsTime::ParseDate::::BEGIN@13Time::ParseDate::BEGIN@13
1118µs21µsTime::ParseDate::::BEGIN@25Time::ParseDate::BEGIN@25
0000s0sTime::ParseDate::::calcTime::ParseDate::calc
0000s0sTime::ParseDate::::debug_displayTime::ParseDate::debug_display
0000s0sTime::ParseDate::::expand_two_digit_yearTime::ParseDate::expand_two_digit_year
0000s0sTime::ParseDate::::mkoffTime::ParseDate::mkoff
0000s0sTime::ParseDate::::monthoffTime::ParseDate::monthoff
0000s0sTime::ParseDate::::parse_tz_onlyTime::ParseDate::parse_tz_only
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Time::ParseDate;
2
3110µsrequire 5.000;
4
5231µs266µs
# spent 40µs (15+25) within Time::ParseDate::BEGIN@5 which was called: # once (15µs+25µs) by Foswiki::Plugins::TimeCalcPlugin::BEGIN@39 at line 5
use Carp;
# spent 40µs making 1 call to Time::ParseDate::BEGIN@5 # spent 25µs making 1 call to Exporter::import
62137µs21.42ms
# spent 1.39ms (1.21+185µs) within Time::ParseDate::BEGIN@6 which was called: # once (1.21ms+185µs) by Foswiki::Plugins::TimeCalcPlugin::BEGIN@39 at line 6
use Time::Timezone;
# spent 1.39ms making 1 call to Time::ParseDate::BEGIN@6 # spent 32µs making 1 call to Exporter::import
72139µs21.15ms
# spent 1.11ms (868µs+241µs) within Time::ParseDate::BEGIN@7 which was called: # once (868µs+241µs) by Foswiki::Plugins::TimeCalcPlugin::BEGIN@39 at line 7
use Time::JulianDay;
# spent 1.11ms making 1 call to Time::ParseDate::BEGIN@7 # spent 39µs making 1 call to Exporter::import
81400nsrequire Exporter;
916µs@ISA = qw(Exporter);
101700ns@EXPORT = qw(parsedate);
1111µs@EXPORT_OK = qw(pd_raw %mtable %umult %wdays);
12
13232µs232µs
# spent 20µs (8+12) within Time::ParseDate::BEGIN@13 which was called: # once (8µs+12µs) by Foswiki::Plugins::TimeCalcPlugin::BEGIN@39 at line 13
use strict;
# spent 20µs making 1 call to Time::ParseDate::BEGIN@13 # spent 12µs making 1 call to strict::import
14#use diagnostics;
15
16# constants
17235µs273µs
# spent 41µs (9+32) within Time::ParseDate::BEGIN@17 which was called: # once (9µs+32µs) by Foswiki::Plugins::TimeCalcPlugin::BEGIN@39 at line 17
use vars qw(%mtable %umult %wdays $VERSION);
# spent 41µs making 1 call to Time::ParseDate::BEGIN@17 # spent 32µs making 1 call to vars::import
18
191200ns$VERSION = 2013.1113;
20
21# globals
22226µs234µs
# spent 22µs (9+13) within Time::ParseDate::BEGIN@22 which was called: # once (9µs+13µs) by Foswiki::Plugins::TimeCalcPlugin::BEGIN@39 at line 22
use vars qw($debug);
# spent 22µs making 1 call to Time::ParseDate::BEGIN@22 # spent 13µs making 1 call to vars::import
23
24# dynamically-scoped
2523.39ms233µs
# spent 21µs (8+12) within Time::ParseDate::BEGIN@25 which was called: # once (8µs+12µs) by Foswiki::Plugins::TimeCalcPlugin::BEGIN@39 at line 25
use vars qw($parse);
# spent 21µs making 1 call to Time::ParseDate::BEGIN@25 # spent 12µs making 1 call to vars::import
26
271200nsmy %mtable;
281100nsmy %umult;
2910smy %wdays;
301100nsmy $y2k;
31
32116µsCONFIG: {
33
341300ns %mtable = qw(
35 Jan 1 Jan. 1 January 1
36 Feb 2 Feb. 2 February 2
37 Mar 3 Mar. 3 March 3
38 Apr 4 Apr. 4 April 4
39 May 5
40 Jun 6 Jun. 6 June 6
41 Jul 7 Jul. 7 July 7
42 Aug 8 Aug. 8 August 8
43 Sep 9 Sep. 9 September 9 Sept 9
44 Oct 10 Oct. 10 October 10
45 Nov 11 Nov. 11 November 11
46 Dec 12 Dec. 12 December 12 );
4715µs %umult = qw(
48 sec 1 second 1
49 min 60 minute 60
50 hour 3600
51 day 86400
52 week 604800
53 fortnight 1209600);
5414µs %wdays = qw(
55 sun 0 sunday 0
56 mon 1 monday 1
57 tue 2 tuesday 2
58 wed 3 wednesday 3
59 thu 4 thursday 4
60 fri 5 friday 5
61 sat 6 saturday 6
62 );
63
641500ns $y2k = 946684800; # turn of the century
65}
66
6712µsmy $break = qr{(?:\s+|\Z|\b(?![-:.,/]\d))};
68
69sub parsedate
70
# spent 687µs (148+538) within Time::ParseDate::parsedate which was called 2 times, avg 343µs/call: # 2 times (148µs+538µs) by Foswiki::Plugins::TimeCalcPlugin::_TIMESHOWSTORE at line 384 of /var/www/foswiki11/lib/Foswiki/Plugins/TimeCalcPlugin.pm, avg 343µs/call
{
7125µs my ($t, %options) = @_;
72
732800ns my ($y, $m, $d); # year, month - 1..12, day
742600ns my ($H, $M, $S); # hour, minute, second
752300ns my $tz; # timezone
7621µs my $tzo; # timezone offset
772600ns my ($rd, $rs); # relative days, relative seconds
78
792100ns my $rel; # time&|date is relative
80
812200ns my $isspec;
8222µs my $now = defined($options{NOW}) ? $options{NOW} : time;
832600ns my $passes = 0;
8421µs my $uk = defined($options{UK}) ? $options{UK} : 0;
85
8622µs local $parse = ''; # will be dynamically scoped.
87
88254µs if ($t =~ s#^ ([ \d]\d)
89 / (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)
90 / (\d\d\d\d)
91 : (\d\d)
92 : (\d\d)
93 : (\d\d)
94 (?:
95 [ ]
96 ([-+] \d\d\d\d)
97 (?: \("?(?:(?:[A-Z]{1,4}[TCW56])|IDLE)\))?
98 )?
99 $break
100 ##xi) { #"emacs
101 # [ \d]/Mon/yyyy:hh:mm:ss [-+]\d\d\d\d
102 # This is the format for www server logging.
103
104 ($d, $m, $y, $H, $M, $S, $tzo) = ($1, $mtable{"\u\L$2"}, $3, $4, $5, $6, $7 ? &mkoff($7) : ($tzo || undef));
105 $parse .= " ".__LINE__ if $debug;
106 } elsif ($t =~ s#^(\d\d)/(\d\d)/(\d\d)\.(\d\d)\:(\d\d)($break)##) {
107 # yy/mm/dd.hh:mm
108 # I support this format because it's used by wbak/rbak
109 # on Apollo Domain OS. Silly, but historical.
110
111 ($y, $m, $d, $H, $M, $S) = ($1, $2, $3, $4, $5, 0);
112 $parse .= " ".__LINE__ if $debug;
113 } else {
11421µs while(1) {
11524µs if (! defined $m and ! defined $rd and ! defined $y
116 and ! ($passes == 0 and $options{'TIMEFIRST'}))
117 {
118 # no month defined.
11926µs2226µs if (&parse_date_only(\$t, \$y, \$m, \$d, $uk)) {
# spent 226µs making 2 calls to Time::ParseDate::parse_date_only, avg 113µs/call
120 $parse .= " ".__LINE__ if $debug;
121 next;
122 }
123 }
12422µs if (! defined $H and ! defined $rs) {
12528µs265µs if (&parse_time_only(\$t, \$H, \$M, \$S,
# spent 65µs making 2 calls to Time::ParseDate::parse_time_only, avg 32µs/call
126 \$tz, %options))
127 {
128 $parse .= " ".__LINE__ if $debug;
129 next;
130 }
131 }
13222µs next if $passes == 0 and $options{'TIMEFIRST'};
13322µs if (! defined $y) {
13426µs227µs if (&parse_year_only(\$t, \$y, $now, %options)) {
# spent 27µs making 2 calls to Time::ParseDate::parse_year_only, avg 14µs/call
135 $parse .= " ".__LINE__ if $debug;
136 next;
137 }
138 }
13922µs if (! defined $tz and ! defined $tzo and ! defined $rs
140 and (defined $m or defined $H))
141 {
142 if (&parse_tz_only(\$t, \$tz, \$tzo)) {
143 $parse .= " ".__LINE__ if $debug;
144 next;
145 }
146 }
14722µs if (! defined $H and ! defined $rs) {
14826µs238µs if (&parse_time_offset(\$t, \$rs, %options)) {
# spent 38µs making 2 calls to Time::ParseDate::parse_time_offset, avg 19µs/call
149 $rel = 1;
150 $parse .= " ".__LINE__ if $debug;
151 next;
152 }
153 }
15422µs if (! defined $m and ! defined $rd and ! defined $y) {
15526µs2182µs if (&parse_date_offset(\$t, $now, \$y,
# spent 182µs making 2 calls to Time::ParseDate::parse_date_offset, avg 91µs/call
156 \$m, \$d, \$rd, \$rs, %options))
157 {
158 $rel = 1;
159 $parse .= " ".__LINE__ if $debug;
160 next;
161 }
162 }
1632600ns if (defined $M or defined $rd) {
164 if ($t =~ s/^\s*(?:at|\@|\+)($break)//x) {
165 $rel = 1;
166 $parse .= " ".__LINE__ if $debug;
167 next;
168 }
169 }
17021µs last;
171 } continue {
172 $passes++;
173 &debug_display($tz, $tzo, $H, $M, $S, $m, $d, $y, $rs, $rd, $rel, $passes, $parse, $t) if $debug;
174
175 }
176
1772900ns if ($passes == 0) {
1782700ns print "nothing matched\n" if $debug;
1792300ns return (undef, "no match on time/date")
180 if wantarray();
18128µs return undef;
182 }
183 }
184
185 &debug_display($tz, $tzo, $H, $M, $S, $m, $d, $y, $rs, $rd, $rel, $passes, $parse, $t) if $debug;
186
187 $t =~ s/^\s+//;
188
189 if ($t ne '') {
190 # we didn't manage to eat the string
191 print "NOT WHOLE\n" if $debug;
192 if ($options{WHOLE}) {
193 return (undef, "characters left over after parse")
194 if wantarray();
195 return undef
196 }
197 }
198
199 # define a date if there isn't one already
200
201 if (! defined $y and ! defined $m and ! defined $rd) {
202 print "no date defined, trying to find one." if $debug;
203 if (defined $rs or defined $H) {
204 # we do have a time.
205 if ($options{DATE_REQUIRED}) {
206 return (undef, "no date specified")
207 if wantarray();
208 return undef;
209 }
210 if (defined $rs) {
211 print "simple offset: $rs\n" if $debug;
212 my $rv = $now + $rs;
213 return ($rv, $t) if wantarray();
214 return $rv;
215 }
216 $rd = 0;
217 } else {
218 print "no time either!\n" if $debug;
219 return (undef, "no time specified")
220 if wantarray();
221 return undef;
222 }
223 }
224
225 if ($options{TIME_REQUIRED} && ! defined($rs)
226 && ! defined($H) && ! defined($rd))
227 {
228 return (undef, "no time found")
229 if wantarray();
230 return undef;
231 }
232
233 my $secs;
234 my $jd;
235
236 if (defined $rd) {
237 if (defined $rs || ! (defined($H) || defined($M) || defined($S))) {
238 print "fully relative\n" if $debug;
239 my ($j, $in, $it);
240 my $definedrs = defined($rs) ? $rs : 0;
241 my ($isdst_now, $isdst_then);
242 my $r = $now + $rd * 86400 + $definedrs;
243 #
244 # It's possible that there was a timezone shift
245 # during the time specified. If so, keep the
246 # hours the "same".
247 #
248 $isdst_now = (localtime($r))[8];
249 $isdst_then = (localtime($now))[8];
250 if (($isdst_now == $isdst_then) || $options{GMT})
251 {
252 return ($r, $t) if wantarray();
253 return $r
254 }
255
256 print "localtime changed DST during time period!\n" if $debug;
257 }
258
259 print "relative date\n" if $debug;
260 $jd = $options{GMT}
261 ? gm_julian_day($now)
262 : local_julian_day($now);
263 print "jd($now) = $jd\n" if $debug;
264 $jd += $rd;
265 } else {
266 unless (defined $y) {
267 if ($options{PREFER_PAST}) {
268 my ($day, $mon011);
269 ($day, $mon011, $y) = (&righttime($now))[3,4,5];
270
271 print "calc year -past $day-$d $mon011-$m $y\n" if $debug;
272 $y -= 1 if ($mon011+1 < $m) ||
273 (($mon011+1 == $m) && ($day < $d));
274 } elsif ($options{PREFER_FUTURE}) {
275 print "calc year -future\n" if $debug;
276 my ($day, $mon011);
277 ($day, $mon011, $y) = (&righttime($now))[3,4,5];
278 $y += 1 if ($mon011 >= $m) ||
279 (($mon011+1 == $m) && ($day > $d));
280 } else {
281 print "calc year -this\n" if $debug;
282 $y = (localtime($now))[5];
283 }
284 $y += 1900;
285 }
286
287 $y = expand_two_digit_year($y, $now, %options)
288 if $y < 100;
289
290 if ($options{VALIDATE}) {
291 require Time::DaysInMonth;
292 my $dim = Time::DaysInMonth::days_in($y, $m);
293 if ($y < 1000 or $m < 1 or $d < 1
294 or $y > 9999 or $m > 12 or $d > $dim)
295 {
296 return (undef, "illegal YMD: $y, $m, $d")
297 if wantarray();
298 return undef;
299 }
300 }
301 $jd = julian_day($y, $m, $d);
302 print "jd($y, $m, $d) = $jd\n" if $debug;
303 }
304
305 # put time into HMS
306
307 if (! defined($H)) {
308 if (defined($rd) || defined($rs)) {
309 ($S, $M, $H) = &righttime($now, %options);
310 print "HMS set to $H $M $S\n" if $debug;
311 }
312 }
313
314 my $carry;
315
316 print "before ", (defined($rs) ? "$rs" : ""),
317 " $jd $H $M $S\n"
318 if $debug;
319 #
320 # add in relative seconds. Do it this way because we want to
321 # preserve the localtime across DST changes.
322 #
323
324 $S = 0 unless $S; # -w
325 $M = 0 unless $M; # -w
326 $H = 0 unless $H; # -w
327
328 if ($options{VALIDATE} and
329 ($S < 0 or $M < 0 or $H < 0 or $S > 59 or $M > 59 or $H > 23))
330 {
331 return (undef, "illegal HMS: $H, $M, $S") if wantarray();
332 return undef;
333 }
334
335 $S += $rs if defined $rs;
336 $carry = int($S / 60) - ($S < 0 && $S % 60 && 1);
337 $S -= $carry * 60;
338 $M += $carry;
339 $carry = int($M / 60) - ($M < 0 && $M % 60 && 1);
340 $M %= 60;
341 $H += $carry;
342 $carry = int($H / 24) - ($H < 0 && $H % 24 && 1);
343 $H %= 24;
344 $jd += $carry;
345
346 print "after rs $jd $H $M $S\n" if $debug;
347
348 $secs = jd_secondsgm($jd, $H, $M, $S);
349 print "jd_secondsgm($jd, $H, $M, $S) = $secs\n" if $debug;
350
351 #
352 # If we see something link 3pm CST then and we want to end
353 # up with a GMT seconds, then we convert the 3pm to GMT and
354 # subtract in the offset for CST. We subtract because we
355 # are converting from CST to GMT.
356 #
357 my $tzadj;
358 if ($tz) {
359 $tzadj = tz_offset($tz, $secs);
360 if (defined $tzadj) {
361 print "adjusting secs for $tz: $tzadj\n" if $debug;
362 $tzadj = tz_offset($tz, $secs-$tzadj);
363 $secs -= $tzadj;
364 } else {
365 print "unknown timezone: $tz\n" if $debug;
366 undef $secs;
367 undef $t;
368 }
369 } elsif (defined $tzo) {
370 print "adjusting time for offset: $tzo\n" if $debug;
371 $secs -= $tzo;
372 } else {
373 unless ($options{GMT}) {
374 if ($options{ZONE}) {
375 $tzadj = tz_offset($options{ZONE}, $secs) || 0;
376 $tzadj = tz_offset($options{ZONE}, $secs-$tzadj);
377 unless (defined($tzadj)) {
378 return (undef, "could not convert '$options{ZONE}' to time offset")
379 if wantarray();
380 return undef;
381 }
382 print "adjusting secs for $options{ZONE}: $tzadj\n" if $debug;
383 $secs -= $tzadj;
384 } else {
385 $tzadj = tz_local_offset($secs);
386 print "adjusting secs for local offset: $tzadj\n" if $debug;
387 #
388 # Just in case we are very close to a time
389 # change...
390 #
391 $tzadj = tz_local_offset($secs-$tzadj);
392 $secs -= $tzadj;
393 }
394 }
395 }
396
397 print "returning $secs.\n" if $debug;
398
399 return ($secs, $t) if wantarray();
400 return $secs;
401}
402
403
404sub mkoff
405{
406 my($offset) = @_;
407
408 if (defined $offset and $offset =~ s#^([-+])(\d\d):?(\d\d)$##) {
409 return ($1 eq '+' ?
410 3600 * $2 + 60 * $3
411 : -3600 * $2 + -60 * $3 );
412 }
413 return undef;
414}
415
416sub parse_tz_only
417{
418 my($tr, $tz, $tzo) = @_;
419
420 $$tr =~ s#^\s+##;
421 my $o;
422
423 if ($$tr =~ s#^
424 ([-+]\d\d:?\d\d)
425 \s+
426 \(
427 "?
428 (?:
429 (?:
430 [A-Z]{1,4}[TCW56]
431 )
432 |
433 IDLE
434 )
435 \)
436 $break
437 ##x) { #"emacs
438 $$tzo = &mkoff($1);
439 printf "matched at %d.\n", __LINE__ if $debug;
440 return 1;
441 } elsif ($$tr =~ s#^GMT\s*([-+]\d{1,2})($break)##x) {
442 $o = $1;
443 if ($o < 24 and $o !~ /^0/) {
444 # probably hours.
445 printf "adjusted at %d. ($o 00)\n", __LINE__ if $debug;
446 $o = "${o}00";
447 }
448 $o =~ s/\b(\d\d\d)/0$1/;
449 $$tzo = &mkoff($o);
450 printf "matched at %d. ($$tzo, $o)\n", __LINE__ if $debug;
451 return 1;
452 } elsif ($$tr =~ s#^(?:GMT\s*)?([-+]\d\d:?\d\d)($break)##x) {
453 $o = $1;
454 $$tzo = &mkoff($o);
455 printf "matched at %d.\n", __LINE__ if $debug;
456 return 1;
457 } elsif ($$tr =~ s#^"?((?:[A-Z]{1,4}[TCW56])|IDLE)$break##x) { #"
458 $$tz = $1;
459 $$tz .= " DST"
460 if $$tz eq 'MET' && $$tr =~ s#^DST$break##x;
461 printf "matched at %d: '$$tz'.\n", __LINE__ if $debug;
462 return 1;
463 }
464 return 0;
465}
466
467sub parse_date_only
468
# spent 226µs within Time::ParseDate::parse_date_only which was called 2 times, avg 113µs/call: # 2 times (226µs+0s) by Time::ParseDate::parsedate at line 119, avg 113µs/call
{
46922µs my ($tr, $yr, $mr, $dr, $uk) = @_;
470
47124µs $$tr =~ s#^\s+##;
472
4732215µs if ($$tr =~ s#^(\d\d\d\d)([-./])(\d\d?)\2(\d\d?)(T|$break)##) {
474 # yyyy/mm/dd
475
476 ($$yr, $$mr, $$dr) = ($1, $3, $4);
477 printf "matched at %d.\n", __LINE__ if $debug;
478 return 1;
479 } elsif ($$tr =~ s#^(\d\d?)([-./])(\d\d?)\2(\d\d\d\d?)($break)##) {
480 # mm/dd/yyyy - is this safe? No.
481 # -- or dd/mm/yyyy! If $1>12, then it's unambiguous.
482 # Otherwise check option UK for UK style date.
483 if ($uk || $1>12) {
484 ($$yr, $$mr, $$dr) = ($4, $3, $1);
485 } else {
486 ($$yr, $$mr, $$dr) = ($4, $1, $3);
487 }
488 printf "matched at %d.\n", __LINE__ if $debug;
489 return 1;
490 } elsif ($$tr =~ s#^(\d\d\d\d)/(\d\d?)$break##x) {
491 # yyyy/mm
492
493 ($$yr, $$mr, $$dr) = ($1, $2, 1);
494 printf "matched at %d.\n", __LINE__ if $debug;
495 return 1;
496 } elsif ($$tr =~ s#^(?xi)
497 (?:
498 (?:Mon|Monday|Tue|Tuesday|Wed|Wednesday|
499 Thu|Thursday|Fri|Friday|
500 Sat|Saturday|Sun|Sunday),?
501 \s+
502 )?
503 (\d\d?)
504 (\s+ | - | \. | /)
505 (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\.?
506 (?:
507 \2
508 (\d\d (?:\d\d)? )
509 )?
510 $break
511 ##) {
512 # [Dow,] dd Mon [yy[yy]]
513 ($$yr, $$mr, $$dr) = ($4, $mtable{"\u\L$3"}, $1);
514
515 printf "%d: %s - %s - %s\n", __LINE__, $1, $2, $3 if $debug;
516 print "y undef\n" if ($debug && ! defined($$yr));
517 return 1;
518 } elsif ($$tr =~ s#^(?xi)
519 (?:
520 (?:Mon|Monday|Tue|Tuesday|Wed|Wednesday|
521 Thu|Thursday|Fri|Friday|
522 Sat|Saturday|Sun|Sunday),?
523 \s+
524 )?
525 (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\.?
526 ((\s)+ | - | \. | /)
527
528 (\d\d?)
529 ,?
530 (?:
531 (?: \2|\3+)
532 (\d\d (?: \d\d)?)
533 )?
534 $break
535 ##) {
536 # [Dow,] Mon dd [yyyy]
537 # [Dow,] Mon d, [yy]
538 ($$yr, $$mr, $$dr) = ($5, $mtable{"\u\L$1"}, $4);
539 printf "%d: %s - %s - %s\n", __LINE__, $1, $2, $4 if $debug;
540 print "y undef\n" if ($debug && ! defined($$yr));
541 return 1;
542 } elsif ($$tr =~ s#^(?xi)
543 (January|Jan\.?|February|Feb\.?|March|Mar\.?|April|Apr\.?|May|
544 June|Jun\.?|July|Jul\.?|August|Aug\.?|September|Sep\.?|
545 October|Oct\.?|November|Nov\.?|December|Dec\.?)
546 \s+
547 (\d+)
548 (?:st|nd|rd|th)?
549 \,?
550 (?:
551 \s+
552 (?:
553 (\d\d\d\d)
554 |(?:\' (\d\d))
555 )
556 )?
557 $break
558 ##) {
559 # Month day{st,nd,rd,th}, 'yy
560 # Month day{st,nd,rd,th}, year
561 # Month day, year
562 # Mon. day, year
563 ($$yr, $$mr, $$dr) = ($3 || $4, $mtable{"\u\L$1"}, $2);
564 printf "%d: %s - %s - %s - %s\n", __LINE__, $1, $2, $3, $4 if $debug;
565 print "y undef\n" if ($debug && ! defined($$yr));
566 printf "matched at %d.\n", __LINE__ if $debug;
567 return 1;
568 } elsif ($$tr =~ s#^(\d\d?)([-/.])(\d\d?)\2(\d\d?)($break)##x) {
569 if ($1 > 31 || (!$uk && $1 > 12 && $4 < 32)) {
570 # yy/mm/dd
571 ($$yr, $$mr, $$dr) = ($1, $3, $4);
572 } elsif ($1 > 12 || $uk) {
573 # dd/mm/yy
574 ($$yr, $$mr, $$dr) = ($4, $3, $1);
575 } else {
576 # mm/dd/yy
577 ($$yr, $$mr, $$dr) = ($4, $1, $3);
578 }
579 printf "matched at %d.\n", __LINE__ if $debug;
580 return 1;
581 } elsif ($$tr =~ s#^(\d\d?)/(\d\d?)($break)##x) {
582 if ($1 > 31 || (!$uk && $1 > 12)) {
583 # yy/mm
584 ($$yr, $$mr, $$dr) = ($1, $2, 1);
585 } elsif ($2 > 31 || ($uk && $2 > 12)) {
586 # mm/yy
587 ($$yr, $$mr, $$dr) = ($2, $1, 1);
588 } elsif ($1 > 12 || $uk) {
589 # dd/mm
590 ($$mr, $$dr) = ($2, $1);
591 } else {
592 # mm/dd
593 ($$mr, $$dr) = ($1, $2);
594 }
595 printf "matched at %d.\n", __LINE__ if $debug;
596 return 1;
597 } elsif ($$tr =~ s#^(\d\d)(\d\d)(\d\d)($break)##x) {
598 if ($1 > 31 || (!$uk && $1 > 12)) {
599 # YYMMDD
600 ($$yr, $$mr, $$dr) = ($1, $2, $3);
601 } elsif ($1 > 12 || $uk) {
602 # DDMMYY
603 ($$yr, $$mr, $$dr) = ($3, $2, $1);
604 } else {
605 # MMDDYY
606 ($$yr, $$mr, $$dr) = ($3, $1, $2);
607 }
608 printf "matched at %d.\n", __LINE__ if $debug;
609 return 1;
610 } elsif ($$tr =~ s#^(?xi)
611 (\d{1,2})
612 (\s+ | - | \. | /)
613 (January|Jan\.?|February|Feb\.?|March|Mar\.?|April|Apr\.?|May|
614 June|Jun\.?|July|Jul\.?|August|Aug\.?|September|Sep\.?|
615 October|Oct\.?|November|Nov\.?|December|Dec\.?)
616 (?:
617 \2
618 (
619 \d\d
620 (?:\d\d)?
621 )
622 )
623 $break
624 ##) {
625 # dd Month [yr]
626 ($$yr, $$mr, $$dr) = ($4, $mtable{"\u\L$3"}, $1);
627 printf "matched at %d.\n", __LINE__ if $debug;
628 return 1;
629 } elsif ($$tr =~ s#^(?xi)
630 (\d+)
631 (?:st|nd|rd|th)?
632 \s+
633 (January|Jan\.?|February|Feb\.?|March|Mar\.?|April|Apr\.?|May|
634 June|Jun\.?|July|Jul\.?|August|Aug\.?|September|Sep\.?|
635 October|Oct\.?|November|Nov\.?|December|Dec\.?)
636 (?:
637 \,?
638 \s+
639 (\d\d\d\d)
640 )?
641 $break
642 ##) {
643 # day{st,nd,rd,th}, Month year
644 ($$yr, $$mr, $$dr) = ($3, $mtable{"\u\L$2"}, $1);
645 printf "%d: %s - %s - %s - %s\n", __LINE__, $1, $2, $3, $4 if $debug;
646 print "y undef\n" if ($debug && ! defined($$yr));
647 printf "matched at %d.\n", __LINE__ if $debug;
648 return 1;
649 }
650210µs return 0;
651}
652
653sub parse_time_only
654
# spent 65µs within Time::ParseDate::parse_time_only which was called 2 times, avg 32µs/call: # 2 times (65µs+0s) by Time::ParseDate::parsedate at line 125, avg 32µs/call
{
65525µs my ($tr, $hr, $mr, $sr, $tzr, %options) = @_;
656
65723µs $$tr =~ s#^\s+##;
658
659251µs if ($$tr =~ s!^(?x)
660 (?:
661 (?:
662 ([012]\d) (?# $1)
663 (?:
664 ([0-5]\d) (?# $2)
665 (?:
666 ([0-5]\d) (?# $3)
667 )?
668 )
669 \s*
670 ([apAP][mM])? (?# $4)
671 ) | (?:
672 (\d{1,2}) (?# $5)
673 (?:
674 \:
675 (\d\d) (?# $6)
676 (?:
677 \:
678 (\d\d) (?# $7)
679 (
680 (?# don't barf on database sub-second timings)
681 [:.,]
682 \d+
683 )? (?# $8)
684 )?
685 )
686 \s*
687 ([apAP][mM])? (?# $9)
688 ) | (?:
689 (\d{1,2}) (?# $10)
690 ([apAP][mM]) (?# ${11})
691 )
692 )
693 (?:
694 \s+
695 "?
696 ( (?# ${12})
697 (?: [A-Z]{1,4}[TCW56] )
698 |
699 IDLE
700 )
701 )?
702 $break
703 !!) { #"emacs
704 # HH[[:]MM[:SS]]meridian [zone]
705 my $ampm;
706 $$hr = $1 || $5 || $10 || 0; # 10 is undef, but 5 is defined..
707 $$mr = $2 || $6 || 0;
708 $$sr = $3 || $7 || 0;
709 if (defined($8) && exists($options{SUBSECOND}) && $options{SUBSECOND}) {
710 my($frac) = $8;
711 substr($frac,0,1) = '.';
712 $$sr += $frac;
713 }
714 print "S = $$sr\n" if $debug;
715 $ampm = $4 || $9 || $11 || '';
716 $$tzr = $12;
717 $$hr += 12 if $ampm and "\U$ampm" eq "PM" && $$hr != 12;
718 $$hr = 0 if $$hr == 12 && "\U$ampm" eq "AM";
719 printf "matched at %d, rem = %s.\n", __LINE__, $$tr if $debug;
720 return 1;
721 } elsif ($$tr =~ s#^noon$break##ix) {
722 # noon
723 ($$hr, $$mr, $$sr) = (12, 0, 0);
724 printf "matched at %d.\n", __LINE__ if $debug;
725 return 1;
726 } elsif ($$tr =~ s#^midnight$break##ix) {
727 # midnight
728 ($$hr, $$mr, $$sr) = (0, 0, 0);
729 printf "matched at %d.\n", __LINE__ if $debug;
730 return 1;
731 }
73228µs return 0;
733}
734
735sub parse_time_offset
736
# spent 38µs within Time::ParseDate::parse_time_offset which was called 2 times, avg 19µs/call: # 2 times (38µs+0s) by Time::ParseDate::parsedate at line 148, avg 19µs/call
{
73723µs my ($tr, $rsr, %options) = @_;
738
73923µs $$tr =~ s/^\s+//;
740
7412600ns return 0 if $options{NO_RELATIVE};
742
743226µs if ($$tr =~ s{^(?xi)
744 (?:
745 (-) (?# 1)
746 |
747 [+]
748 )?
749 \s*
750 (?:
751 (\d+(?:\.\d+)?) (?# 2)
752 |
753 (?:(\d+)\s+(\d+)/(\d+)) (?# 3 4/5)
754 )
755 \s*
756 (sec|second|min|minute|hour)s? (?# 6)
757 (
758 \s+
759 ago (?# 7)
760 )?
761 $break
762 }{}) {
763 # count units
764 $$rsr = 0 unless defined $$rsr;
765 return 0 if defined($5) && $5 == 0;
766 my $num = defined($2)
767 ? $2
768 : $3 + $4/$5;
769 $num = -$num if $1;
770 $$rsr += $umult{"\L$6"} * $num;
771
772 $$rsr = -$$rsr if $7 ||
773 $$tr =~ /\b(day|mon|month|year)s?\s*ago\b/;
774 printf "matched at %d.\n", __LINE__ if $debug;
775 return 1;
776 }
77728µs return 0;
778}
779
780#
781# What to you do with a date that has a two-digit year?
782# There's not much that can be done except make a guess.
783#
784# Some example situations to handle:
785#
786# now year
787#
788# 1999 01
789# 1999 71
790# 2010 71
791# 2110 09
792#
793
794sub expand_two_digit_year
795{
796 my ($yr, $now, %options) = @_;
797
798 return $yr if $yr > 100;
799
800 my ($y) = (&righttime($now, %options))[5];
801 $y += 1900;
802 my $century = int($y / 100) * 100;
803 my $within = $y % 100;
804
805 my $r = $yr + $century;
806
807 if ($options{PREFER_PAST}) {
808 if ($yr > $within) {
809 $r = $yr + $century - 100;
810 }
811 } elsif ($options{PREFER_FUTURE}) {
812 # being strict here would be silly
813 if ($yr < $within-20) {
814 # it's 2019 and the date is '08'
815 $r = $yr + $century + 100;
816 }
817 } elsif ($options{UNAMBIGUOUS}) {
818 # we really shouldn't guess
819 return undef;
820 } else {
821 # prefer the current century in most cases
822
823 if ($within > 80 && $within - $yr > 60) {
824 $r = $yr + $century + 100;
825 }
826
827 if ($within < 30 && $yr - $within > 59) {
828 $r = $yr + $century - 100;
829 }
830 }
831 print "two digit year '$yr' expanded into $r\n" if $debug;
832 return $r;
833}
834
835
836sub calc
837{
838 my ($rsr, $yr, $mr, $dr, $rdr, $now, $units, $count, %options) = @_;
839
840 confess unless $units;
841 $units = "\L$units";
842 print "calc based on $units\n" if $debug;
843
844 if ($units eq 'day') {
845 $$rdr = $count;
846 } elsif ($units eq 'week') {
847 $$rdr = $count * 7;
848 } elsif ($umult{$units}) {
849 $$rsr = $count * $umult{$units};
850 } elsif ($units eq 'mon' || $units eq 'month') {
851 ($$yr, $$mr, $$dr) = &monthoff($now, $count, %options);
852 $$rsr = 0 unless $$rsr;
853 } elsif ($units eq 'year') {
854 ($$yr, $$mr, $$dr) = &monthoff($now, $count * 12, %options);
855 $$rsr = 0 unless $$rsr;
856 } else {
857 carp "interal error";
858 }
859 print "calced rsr $$rsr rdr $$rdr, yr $$yr mr $$mr dr $$dr.\n" if $debug;
860}
861
862sub monthoff
863{
864 my ($now, $months, %options) = @_;
865
866 # months are 0..11
867 my ($d, $m11, $y) = (&righttime($now, %options)) [ 3,4,5 ] ;
868
869 $y += 1900;
870
871 print "m11 = $m11 + $months, y = $y\n" if $debug;
872
873 $m11 += $months;
874
875 print "m11 = $m11, y = $y\n" if $debug;
876 if ($m11 > 11 || $m11 < 0) {
877 $y -= 1 if $m11 < 0 && ($m11 % 12 != 0);
878 $y += int($m11/12);
879
880 # this is required to work around a bug in perl 5.003
88121.14ms217µs
# spent 15µs (12+2) within Time::ParseDate::BEGIN@881 which was called: # once (12µs+2µs) by Foswiki::Plugins::TimeCalcPlugin::BEGIN@39 at line 881
no integer;
# spent 15µs making 1 call to Time::ParseDate::BEGIN@881 # spent 2µs making 1 call to integer::unimport
882 $m11 %= 12;
883 }
884 print "m11 = $m11, y = $y\n" if $debug;
885
886 #
887 # What is "1 month from January 31st?"
888 # I think the answer is February 28th most years.
889 #
890 # Similarly, what is one year from February 29th, 1980?
891 # I think it's February 28th, 1981.
892 #
893 # If you disagree, change the following code.
894 #
895 if ($d > 30 or ($d > 28 && $m11 == 1)) {
896 require Time::DaysInMonth;
897 my $dim = Time::DaysInMonth::days_in($y, $m11+1);
898 print "dim($y,$m11+1)= $dim\n" if $debug;
899 $d = $dim if $d > $dim;
900 }
901 return ($y, $m11+1, $d);
902}
903
904sub righttime
905
# spent 12µs within Time::ParseDate::righttime which was called 2 times, avg 6µs/call: # 2 times (12µs+0s) by Time::ParseDate::parse_date_offset at line 946, avg 6µs/call
{
90624µs my ($time, %options) = @_;
907211µs if ($options{GMT}) {
908 return gmtime($time);
909 } else {
910 return localtime($time);
911 }
912}
913
914sub parse_year_only
915
# spent 27µs within Time::ParseDate::parse_year_only which was called 2 times, avg 14µs/call: # 2 times (27µs+0s) by Time::ParseDate::parsedate at line 134, avg 14µs/call
{
91624µs my ($tr, $yr, $now, %options) = @_;
917
91823µs $$tr =~ s#^\s+##;
919
920216µs if ($$tr =~ s#^(\d\d\d\d)$break##) {
921 $$yr = $1;
922 printf "matched at %d.\n", __LINE__ if $debug;
923 return 1;
924 } elsif ($$tr =~ s#\'(\d\d)$break##) {
925 $$yr = expand_two_digit_year($1, $now, %options);
926 printf "matched at %d.\n", __LINE__ if $debug;
927 return 1;
928 }
929214µs return 0;
930}
931
932sub parse_date_offset
933
# spent 182µs (170+12) within Time::ParseDate::parse_date_offset which was called 2 times, avg 91µs/call: # 2 times (170µs+12µs) by Time::ParseDate::parsedate at line 155, avg 91µs/call
{
93424µs my ($tr, $now, $yr, $mr, $dr, $rdr, $rsr, %options) = @_;
935
9362600ns return 0 if $options{NO_RELATIVE};
937
938 # now - current seconds_since_epoch
939 # yr - year return
940 # mr - month return
941 # dr - day return
942 # rdr - relative day return
943 # rsr - relative second return
944
9452300ns my $j;
94626µs212µs my $wday = (&righttime($now, %options))[6];
# spent 12µs making 2 calls to Time::ParseDate::righttime, avg 6µs/call
947
94823µs $$tr =~ s#^\s+##;
949
9502148µs if ($$tr =~ s#^(?xi)
951 \s*
952 (\d+)
953 \s*
954 (day|week|month|year)s?
955 (
956 \s+
957 ago
958 )?
959 $break
960 ##) {
961 my $amt = $1 + 0;
962 my $units = $2;
963 $amt = -$amt if $3 ||
964 $$tr =~ m#\b(sec|second|min|minute|hour)s?\s*ago\b#;
965 &calc($rsr, $yr, $mr, $dr, $rdr, $now, $units,
966 $amt, %options);
967 printf "matched at %d.\n", __LINE__ if $debug;
968 return 1;
969 } elsif ($$tr =~ s#^(?xi)
970 (?:
971 (?:
972 now
973 \s+
974 )?
975 (\+ | \-)
976 \s*
977 )?
978 (\d+)
979 \s*
980 (day|week|month|year)s?
981 $break
982 ##) {
983 my $one = $1 || '';
984 my $two = $2 || '';
985 my $amt = "$one$two"+0;
986 &calc($rsr, $yr, $mr, $dr, $rdr, $now, $3,
987 $amt, %options);
988 printf "matched at %d.\n", __LINE__ if $debug;
989 return 1;
990 } elsif ($$tr =~ s#^(?xi)
991 (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday
992 |Wednesday|Thursday|Friday|Saturday|Sunday)
993 \s+
994 after
995 \s+
996 next
997 $break
998 ##) {
999 # Dow "after next"
1000 $$rdr = $wdays{"\L$1"} - $wday + ( $wdays{"\L$1"} > $wday ? 7 : 14);
1001 printf "matched at %d.\n", __LINE__ if $debug;
1002 return 1;
1003 } elsif ($$tr =~ s#^(?xi)
1004 (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday
1005 |Wednesday|Thursday|Friday|Saturday|Sunday)
1006 \s+
1007 before
1008 \s+
1009 last
1010 $break
1011 ##) {
1012 # Dow "before last"
1013 $$rdr = $wdays{"\L$1"} - $wday - ( $wdays{"\L$1"} < $wday ? 7 : 14);
1014 printf "matched at %d.\n", __LINE__ if $debug;
1015 return 1;
1016 } elsif ($$tr =~ s#^(?xi)
1017 next\s+
1018 (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday
1019 |Wednesday|Thursday|Friday|Saturday|Sunday)
1020 $break
1021 ##) {
1022 # "next" Dow
1023 $$rdr = $wdays{"\L$1"} - $wday
1024 + ( $wdays{"\L$1"} > $wday ? 0 : 7);
1025 printf "matched at %d.\n", __LINE__ if $debug;
1026 return 1;
1027 } elsif ($$tr =~ s#^(?xi)
1028 last\s+
1029 (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday
1030 |Wednesday|Thursday|Friday|Saturday|Sunday)
1031 $break##) {
1032 # "last" Dow
1033 printf "c %d - %d + ( %d < %d ? 0 : -7 \n", $wdays{"\L$1"}, $wday, $wdays{"\L$1"}, $wday if $debug;
1034 $$rdr = $wdays{"\L$1"} - $wday + ( $wdays{"\L$1"} < $wday ? 0 : -7);
1035 printf "matched at %d.\n", __LINE__ if $debug;
1036 return 1;
1037 } elsif ($options{PREFER_PAST} and $$tr =~ s#^(?xi)
1038 (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday
1039 |Wednesday|Thursday|Friday|Saturday|Sunday)
1040 $break##) {
1041 # Dow
1042 printf "c %d - %d + ( %d < %d ? 0 : -7 \n", $wdays{"\L$1"}, $wday, $wdays{"\L$1"}, $wday if $debug;
1043 $$rdr = $wdays{"\L$1"} - $wday + ( $wdays{"\L$1"} < $wday ? 0 : -7);
1044 printf "matched at %d.\n", __LINE__ if $debug;
1045 return 1;
1046 } elsif ($options{PREFER_FUTURE} and $$tr =~ s#^(?xi)
1047 (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday
1048 |Wednesday|Thursday|Friday|Saturday|Sunday)
1049 $break
1050 ##) {
1051 # Dow
1052 $$rdr = $wdays{"\L$1"} - $wday
1053 + ( $wdays{"\L$1"} > $wday ? 0 : 7);
1054 printf "matched at %d.\n", __LINE__ if $debug;
1055 return 1;
1056 } elsif ($$tr =~ s#^today$break##xi) {
1057 # today
1058 $$rdr = 0;
1059 printf "matched at %d.\n", __LINE__ if $debug;
1060 return 1;
1061 } elsif ($$tr =~ s#^tomorrow$break##xi) {
1062 $$rdr = 1;
1063 printf "matched at %d.\n", __LINE__ if $debug;
1064 return 1;
1065 } elsif ($$tr =~ s#^yesterday$break##xi) {
1066 $$rdr = -1;
1067 printf "matched at %d.\n", __LINE__ if $debug;
1068 return 1;
1069 } elsif ($$tr =~ s#^last\s+(week|month|year)$break##xi) {
1070 &calc($rsr, $yr, $mr, $dr, $rdr, $now, $1, -1, %options);
1071 printf "matched at %d.\n", __LINE__ if $debug;
1072 return 1;
1073 } elsif ($$tr =~ s#^next\s+(week|month|year)$break##xi) {
1074 &calc($rsr, $yr, $mr, $dr, $rdr, $now, $1, 1, %options);
1075 printf "matched at %d.\n", __LINE__ if $debug;
1076 return 1;
1077 } elsif ($$tr =~ s#^now $break##x) {
1078 $$rdr = 0;
1079 return 1;
1080 }
1081210µs return 0;
1082}
1083
1084sub debug_display
1085{
1086 my ($tz, $tzo, $H, $M, $S, $m, $d, $y, $rs, $rd, $rel, $passes, $parse, $t) = @_;
1087 print "---------<<\n";
1088 print defined($tz) ? "tz: $tz.\n" : "no tz\n";
1089 print defined($tzo) ? "tzo: $tzo.\n" : "no tzo\n";
1090 print "HMS: ";
1091 print defined($H) ? "$H, " : "no H, ";
1092 print defined($M) ? "$M, " : "no M, ";
1093 print defined($S) ? "$S\n" : "no S.\n";
1094 print "mdy: ";
1095 print defined($m) ? "$m, " : "no m, ";
1096 print defined($d) ? "$d, " : "no d, ";
1097 print defined($y) ? "$y\n" : "no y.\n";
1098 print defined($rs) ? "rs: $rs.\n" : "no rs\n";
1099 print defined($rd) ? "rd: $rd.\n" : "no rd\n";
1100 print $rel ? "relative\n" : "not relative\n";
1101 print "passes: $passes\n";
1102 print "parse:$parse\n";
1103 print "t: $t.\n";
1104 print "--------->>\n";
1105}
1106116µs1;
1107
1108__END__