Filename | /usr/share/perl5/vendor_perl/Time/ParseDate.pm |
Statements | Executed 149 statements in 5.68ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 1.21ms | 1.39ms | BEGIN@6 | Time::ParseDate::
1 | 1 | 1 | 868µs | 1.11ms | BEGIN@7 | Time::ParseDate::
2 | 1 | 1 | 226µs | 226µs | parse_date_only | Time::ParseDate::
2 | 1 | 1 | 170µs | 182µs | parse_date_offset | Time::ParseDate::
2 | 1 | 1 | 148µs | 687µs | parsedate | Time::ParseDate::
2 | 1 | 1 | 65µs | 65µs | parse_time_only | Time::ParseDate::
2 | 1 | 1 | 38µs | 38µs | parse_time_offset | Time::ParseDate::
2 | 1 | 1 | 27µs | 27µs | parse_year_only | Time::ParseDate::
1 | 1 | 1 | 15µs | 40µs | BEGIN@5 | Time::ParseDate::
1 | 1 | 1 | 12µs | 15µs | BEGIN@881 | Time::ParseDate::
2 | 1 | 1 | 12µs | 12µs | righttime | Time::ParseDate::
1 | 1 | 1 | 9µs | 41µs | BEGIN@17 | Time::ParseDate::
1 | 1 | 1 | 9µs | 22µs | BEGIN@22 | Time::ParseDate::
1 | 1 | 1 | 8µs | 20µs | BEGIN@13 | Time::ParseDate::
1 | 1 | 1 | 8µs | 21µs | BEGIN@25 | Time::ParseDate::
0 | 0 | 0 | 0s | 0s | calc | Time::ParseDate::
0 | 0 | 0 | 0s | 0s | debug_display | Time::ParseDate::
0 | 0 | 0 | 0s | 0s | expand_two_digit_year | Time::ParseDate::
0 | 0 | 0 | 0s | 0s | mkoff | Time::ParseDate::
0 | 0 | 0 | 0s | 0s | monthoff | Time::ParseDate::
0 | 0 | 0 | 0s | 0s | parse_tz_only | Time::ParseDate::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Time::ParseDate; | ||||
2 | |||||
3 | 1 | 10µs | require 5.000; | ||
4 | |||||
5 | 2 | 31µs | 2 | 66µ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 # spent 40µs making 1 call to Time::ParseDate::BEGIN@5
# spent 25µs making 1 call to Exporter::import |
6 | 2 | 137µs | 2 | 1.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 # spent 1.39ms making 1 call to Time::ParseDate::BEGIN@6
# spent 32µs making 1 call to Exporter::import |
7 | 2 | 139µs | 2 | 1.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 # spent 1.11ms making 1 call to Time::ParseDate::BEGIN@7
# spent 39µs making 1 call to Exporter::import |
8 | 1 | 400ns | require Exporter; | ||
9 | 1 | 6µs | @ISA = qw(Exporter); | ||
10 | 1 | 700ns | @EXPORT = qw(parsedate); | ||
11 | 1 | 1µs | @EXPORT_OK = qw(pd_raw %mtable %umult %wdays); | ||
12 | |||||
13 | 2 | 32µs | 2 | 32µ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 # 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 | ||||
17 | 2 | 35µs | 2 | 73µ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 # spent 41µs making 1 call to Time::ParseDate::BEGIN@17
# spent 32µs making 1 call to vars::import |
18 | |||||
19 | 1 | 200ns | $VERSION = 2013.1113; | ||
20 | |||||
21 | # globals | ||||
22 | 2 | 26µs | 2 | 34µ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 # spent 22µs making 1 call to Time::ParseDate::BEGIN@22
# spent 13µs making 1 call to vars::import |
23 | |||||
24 | # dynamically-scoped | ||||
25 | 2 | 3.39ms | 2 | 33µ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 # spent 21µs making 1 call to Time::ParseDate::BEGIN@25
# spent 12µs making 1 call to vars::import |
26 | |||||
27 | 1 | 200ns | my %mtable; | ||
28 | 1 | 100ns | my %umult; | ||
29 | 1 | 0s | my %wdays; | ||
30 | 1 | 100ns | my $y2k; | ||
31 | |||||
32 | 1 | 16µs | CONFIG: { | ||
33 | |||||
34 | 1 | 300ns | %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 ); | ||||
47 | 1 | 5µ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); | ||||
54 | 1 | 4µ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 | |||||
64 | 1 | 500ns | $y2k = 946684800; # turn of the century | ||
65 | } | ||||
66 | |||||
67 | 1 | 2µs | my $break = qr{(?:\s+|\Z|\b(?![-:.,/]\d))}; | ||
68 | |||||
69 | sub 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 | ||||
71 | 2 | 5µs | my ($t, %options) = @_; | ||
72 | |||||
73 | 2 | 800ns | my ($y, $m, $d); # year, month - 1..12, day | ||
74 | 2 | 600ns | my ($H, $M, $S); # hour, minute, second | ||
75 | 2 | 300ns | my $tz; # timezone | ||
76 | 2 | 1µs | my $tzo; # timezone offset | ||
77 | 2 | 600ns | my ($rd, $rs); # relative days, relative seconds | ||
78 | |||||
79 | 2 | 100ns | my $rel; # time&|date is relative | ||
80 | |||||
81 | 2 | 200ns | my $isspec; | ||
82 | 2 | 2µs | my $now = defined($options{NOW}) ? $options{NOW} : time; | ||
83 | 2 | 600ns | my $passes = 0; | ||
84 | 2 | 1µs | my $uk = defined($options{UK}) ? $options{UK} : 0; | ||
85 | |||||
86 | 2 | 2µs | local $parse = ''; # will be dynamically scoped. | ||
87 | |||||
88 | 2 | 54µ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 { | ||||
114 | 2 | 1µs | while(1) { | ||
115 | 2 | 4µs | if (! defined $m and ! defined $rd and ! defined $y | ||
116 | and ! ($passes == 0 and $options{'TIMEFIRST'})) | ||||
117 | { | ||||
118 | # no month defined. | ||||
119 | 2 | 6µs | 2 | 226µ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 | } | ||||
124 | 2 | 2µs | if (! defined $H and ! defined $rs) { | ||
125 | 2 | 8µs | 2 | 65µ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 | } | ||||
132 | 2 | 2µs | next if $passes == 0 and $options{'TIMEFIRST'}; | ||
133 | 2 | 2µs | if (! defined $y) { | ||
134 | 2 | 6µs | 2 | 27µ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 | } | ||||
139 | 2 | 2µ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 | } | ||||
147 | 2 | 2µs | if (! defined $H and ! defined $rs) { | ||
148 | 2 | 6µs | 2 | 38µ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 | } | ||||
154 | 2 | 2µs | if (! defined $m and ! defined $rd and ! defined $y) { | ||
155 | 2 | 6µs | 2 | 182µ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 | } | ||||
163 | 2 | 600ns | 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 | } | ||||
170 | 2 | 1µ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 | |||||
177 | 2 | 900ns | if ($passes == 0) { | ||
178 | 2 | 700ns | print "nothing matched\n" if $debug; | ||
179 | 2 | 300ns | return (undef, "no match on time/date") | ||
180 | if wantarray(); | ||||
181 | 2 | 8µ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 | |||||
404 | sub 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 | |||||
416 | sub 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 | |||||
467 | sub 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 | ||||
469 | 2 | 2µs | my ($tr, $yr, $mr, $dr, $uk) = @_; | ||
470 | |||||
471 | 2 | 4µs | $$tr =~ s#^\s+##; | ||
472 | |||||
473 | 2 | 215µ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 | } | ||||
650 | 2 | 10µs | return 0; | ||
651 | } | ||||
652 | |||||
653 | sub 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 | ||||
655 | 2 | 5µs | my ($tr, $hr, $mr, $sr, $tzr, %options) = @_; | ||
656 | |||||
657 | 2 | 3µs | $$tr =~ s#^\s+##; | ||
658 | |||||
659 | 2 | 51µ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 | } | ||||
732 | 2 | 8µs | return 0; | ||
733 | } | ||||
734 | |||||
735 | sub 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 | ||||
737 | 2 | 3µs | my ($tr, $rsr, %options) = @_; | ||
738 | |||||
739 | 2 | 3µs | $$tr =~ s/^\s+//; | ||
740 | |||||
741 | 2 | 600ns | return 0 if $options{NO_RELATIVE}; | ||
742 | |||||
743 | 2 | 26µ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 | } | ||||
777 | 2 | 8µ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 | |||||
794 | sub 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 | |||||
836 | sub 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 | |||||
862 | sub 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 | ||||
881 | 2 | 1.14ms | 2 | 17µ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 # 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 | |||||
904 | sub 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 | ||||
906 | 2 | 4µs | my ($time, %options) = @_; | ||
907 | 2 | 11µs | if ($options{GMT}) { | ||
908 | return gmtime($time); | ||||
909 | } else { | ||||
910 | return localtime($time); | ||||
911 | } | ||||
912 | } | ||||
913 | |||||
914 | sub 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 | ||||
916 | 2 | 4µs | my ($tr, $yr, $now, %options) = @_; | ||
917 | |||||
918 | 2 | 3µs | $$tr =~ s#^\s+##; | ||
919 | |||||
920 | 2 | 16µ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 | } | ||||
929 | 2 | 14µs | return 0; | ||
930 | } | ||||
931 | |||||
932 | sub 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 | ||||
934 | 2 | 4µs | my ($tr, $now, $yr, $mr, $dr, $rdr, $rsr, %options) = @_; | ||
935 | |||||
936 | 2 | 600ns | 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 | |||||
945 | 2 | 300ns | my $j; | ||
946 | 2 | 6µs | 2 | 12µs | my $wday = (&righttime($now, %options))[6]; # spent 12µs making 2 calls to Time::ParseDate::righttime, avg 6µs/call |
947 | |||||
948 | 2 | 3µs | $$tr =~ s#^\s+##; | ||
949 | |||||
950 | 2 | 148µ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 | } | ||||
1081 | 2 | 10µs | return 0; | ||
1082 | } | ||||
1083 | |||||
1084 | sub 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 | } | ||||
1106 | 1 | 16µs | 1; | ||
1107 | |||||
1108 | __END__ |