line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Time::ParseDate; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
require 5.000; |
4
|
|
|
|
|
|
|
|
5
|
4
|
|
|
4
|
|
43570
|
use Carp; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
295
|
|
6
|
4
|
|
|
4
|
|
1713
|
use Time::Timezone; |
|
4
|
|
|
|
|
13
|
|
|
4
|
|
|
|
|
308
|
|
7
|
4
|
|
|
4
|
|
1553
|
use Time::JulianDay; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
445
|
|
8
|
|
|
|
|
|
|
require Exporter; |
9
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
10
|
|
|
|
|
|
|
@EXPORT = qw(parsedate); |
11
|
|
|
|
|
|
|
@EXPORT_OK = qw(pd_raw %mtable %umult %wdays); |
12
|
|
|
|
|
|
|
|
13
|
4
|
|
|
4
|
|
36
|
use strict; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
99
|
|
14
|
|
|
|
|
|
|
#use diagnostics; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# constants |
17
|
4
|
|
|
4
|
|
16
|
use vars qw(%mtable %umult %wdays $VERSION); |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
257
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
$VERSION = 2015.1030; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# globals |
22
|
4
|
|
|
4
|
|
17
|
use vars qw($debug); |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
123
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# dynamically-scoped |
25
|
4
|
|
|
4
|
|
19
|
use vars qw($parse); |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
20549
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my %mtable; |
28
|
|
|
|
|
|
|
my %umult; |
29
|
|
|
|
|
|
|
my %wdays; |
30
|
|
|
|
|
|
|
my $y2k; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
CONFIG: { |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
%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
|
|
|
|
|
|
|
%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
|
|
|
|
|
|
|
%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
|
|
|
|
|
|
|
$y2k = 946684800; # turn of the century |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
my $break = qr{(?:\s+|\Z|\b(?![-:.,/]\d))}; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub parsedate |
70
|
|
|
|
|
|
|
{ |
71
|
287
|
|
|
287
|
0
|
256969
|
my ($t, %options) = @_; |
72
|
|
|
|
|
|
|
|
73
|
287
|
|
|
|
|
373
|
my ($y, $m, $d); # year, month - 1..12, day |
74
|
0
|
|
|
|
|
0
|
my ($H, $M, $S); # hour, minute, second |
75
|
0
|
|
|
|
|
0
|
my $tz; # timezone |
76
|
0
|
|
|
|
|
0
|
my $tzo; # timezone offset |
77
|
0
|
|
|
|
|
0
|
my ($rd, $rs); # relative days, relative seconds |
78
|
|
|
|
|
|
|
|
79
|
0
|
|
|
|
|
0
|
my $rel; # time&|date is relative |
80
|
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
0
|
my $isspec; |
82
|
287
|
100
|
|
|
|
710
|
my $now = defined($options{NOW}) ? $options{NOW} : time; |
83
|
287
|
|
|
|
|
371
|
my $passes = 0; |
84
|
287
|
100
|
|
|
|
554
|
my $uk = defined($options{UK}) ? $options{UK} : 0; |
85
|
|
|
|
|
|
|
|
86
|
287
|
|
|
|
|
452
|
local $parse = ''; # will be dynamically scoped. |
87
|
|
|
|
|
|
|
|
88
|
287
|
100
|
|
|
|
3020
|
if ($t =~ s#^ ([ \d]\d) |
|
|
100
|
|
|
|
|
|
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
|
9
|
100
|
50
|
|
|
62
|
($d, $m, $y, $H, $M, $S, $tzo) = ($1, $mtable{"\u\L$2"}, $3, $4, $5, $6, $7 ? &mkoff($7) : ($tzo || undef)); |
105
|
9
|
50
|
|
|
|
27
|
$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
|
1
|
|
|
|
|
4
|
($y, $m, $d, $H, $M, $S) = ($1, $2, $3, $4, $5, 0); |
112
|
1
|
50
|
|
|
|
20
|
$parse .= " ".__LINE__ if $debug; |
113
|
|
|
|
|
|
|
} else { |
114
|
277
|
|
|
|
|
351
|
while(1) { |
115
|
818
|
100
|
66
|
|
|
3522
|
if (! defined $m and ! defined $rd and ! defined $y |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
116
|
|
|
|
|
|
|
and ! ($passes == 0 and $options{'TIMEFIRST'})) |
117
|
|
|
|
|
|
|
{ |
118
|
|
|
|
|
|
|
# no month defined. |
119
|
315
|
100
|
|
|
|
864
|
if (&parse_date_only(\$t, \$y, \$m, \$d, $uk)) { |
120
|
195
|
50
|
|
|
|
451
|
$parse .= " ".__LINE__ if $debug; |
121
|
195
|
|
|
|
|
283
|
next; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
} |
124
|
623
|
100
|
66
|
|
|
1797
|
if (! defined $H and ! defined $rs) { |
125
|
322
|
100
|
|
|
|
954
|
if (&parse_time_only(\$t, \$H, \$M, \$S, |
126
|
|
|
|
|
|
|
\$tz, %options)) |
127
|
|
|
|
|
|
|
{ |
128
|
155
|
50
|
|
|
|
301
|
$parse .= " ".__LINE__ if $debug; |
129
|
155
|
|
|
|
|
237
|
next; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
} |
132
|
468
|
50
|
66
|
|
|
1211
|
next if $passes == 0 and $options{'TIMEFIRST'}; |
133
|
468
|
100
|
|
|
|
996
|
if (! defined $y) { |
134
|
246
|
100
|
|
|
|
685
|
if (&parse_year_only(\$t, \$y, $now, %options)) { |
135
|
31
|
50
|
|
|
|
66
|
$parse .= " ".__LINE__ if $debug; |
136
|
31
|
|
|
|
|
38
|
next; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
} |
139
|
437
|
100
|
100
|
|
|
3198
|
if (! defined $tz and ! defined $tzo and ! defined $rs |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
140
|
|
|
|
|
|
|
and (defined $m or defined $H)) |
141
|
|
|
|
|
|
|
{ |
142
|
197
|
100
|
|
|
|
424
|
if (&parse_tz_only(\$t, \$tz, \$tzo)) { |
143
|
63
|
50
|
|
|
|
135
|
$parse .= " ".__LINE__ if $debug; |
144
|
63
|
|
|
|
|
96
|
next; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
} |
147
|
374
|
100
|
66
|
|
|
1032
|
if (! defined $H and ! defined $rs) { |
148
|
167
|
100
|
|
|
|
487
|
if (&parse_time_offset(\$t, \$rs, %options)) { |
149
|
38
|
|
|
|
|
56
|
$rel = 1; |
150
|
38
|
50
|
|
|
|
90
|
$parse .= " ".__LINE__ if $debug; |
151
|
38
|
|
|
|
|
62
|
next; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
} |
154
|
336
|
50
|
66
|
|
|
1018
|
if (! defined $m and ! defined $rd and ! defined $y) { |
|
|
|
66
|
|
|
|
|
155
|
82
|
100
|
|
|
|
248
|
if (&parse_date_offset(\$t, $now, \$y, |
156
|
|
|
|
|
|
|
\$m, \$d, \$rd, \$rs, %options)) |
157
|
|
|
|
|
|
|
{ |
158
|
57
|
|
|
|
|
73
|
$rel = 1; |
159
|
57
|
50
|
|
|
|
113
|
$parse .= " ".__LINE__ if $debug; |
160
|
57
|
|
|
|
|
89
|
next; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
} |
163
|
279
|
100
|
100
|
|
|
977
|
if (defined $M or defined $rd) { |
164
|
199
|
100
|
|
|
|
988
|
if ($t =~ s/^\s*(?:at|\@|\+)($break)//x) { |
165
|
2
|
|
|
|
|
3
|
$rel = 1; |
166
|
2
|
50
|
|
|
|
6
|
$parse .= " ".__LINE__ if $debug; |
167
|
2
|
|
|
|
|
4
|
next; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
} |
170
|
277
|
|
|
|
|
440
|
last; |
171
|
|
|
|
|
|
|
} continue { |
172
|
541
|
|
|
|
|
662
|
$passes++; |
173
|
541
|
50
|
|
|
|
1637
|
&debug_display($tz, $tzo, $H, $M, $S, $m, $d, $y, $rs, $rd, $rel, $passes, $parse, $t) if $debug; |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
277
|
100
|
|
|
|
620
|
if ($passes == 0) { |
178
|
3
|
50
|
|
|
|
8
|
print "nothing matched\n" if $debug; |
179
|
3
|
50
|
|
|
|
7
|
return (undef, "no match on time/date") |
180
|
|
|
|
|
|
|
if wantarray(); |
181
|
3
|
|
|
|
|
11
|
return undef; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
284
|
50
|
|
|
|
636
|
&debug_display($tz, $tzo, $H, $M, $S, $m, $d, $y, $rs, $rd, $rel, $passes, $parse, $t) if $debug; |
186
|
|
|
|
|
|
|
|
187
|
284
|
|
|
|
|
358
|
$t =~ s/^\s+//; |
188
|
|
|
|
|
|
|
|
189
|
284
|
100
|
|
|
|
628
|
if ($t ne '') { |
190
|
|
|
|
|
|
|
# we didn't manage to eat the string |
191
|
15
|
50
|
|
|
|
34
|
print "NOT WHOLE\n" if $debug; |
192
|
15
|
100
|
|
|
|
41
|
if ($options{WHOLE}) { |
193
|
2
|
50
|
|
|
|
5
|
return (undef, "characters left over after parse") |
194
|
|
|
|
|
|
|
if wantarray(); |
195
|
|
|
|
|
|
|
return undef |
196
|
2
|
|
|
|
|
8
|
} |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# define a date if there isn't one already |
200
|
|
|
|
|
|
|
|
201
|
282
|
100
|
66
|
|
|
826
|
if (! defined $y and ! defined $m and ! defined $rd) { |
|
|
|
66
|
|
|
|
|
202
|
22
|
50
|
|
|
|
47
|
print "no date defined, trying to find one." if $debug; |
203
|
22
|
50
|
66
|
|
|
81
|
if (defined $rs or defined $H) { |
204
|
|
|
|
|
|
|
# we do have a time. |
205
|
22
|
50
|
|
|
|
61
|
if ($options{DATE_REQUIRED}) { |
206
|
0
|
0
|
|
|
|
0
|
return (undef, "no date specified") |
207
|
|
|
|
|
|
|
if wantarray(); |
208
|
0
|
|
|
|
|
0
|
return undef; |
209
|
|
|
|
|
|
|
} |
210
|
22
|
100
|
|
|
|
57
|
if (defined $rs) { |
211
|
17
|
50
|
|
|
|
37
|
print "simple offset: $rs\n" if $debug; |
212
|
17
|
|
|
|
|
35
|
my $rv = $now + $rs; |
213
|
17
|
50
|
|
|
|
45
|
return ($rv, $t) if wantarray(); |
214
|
17
|
|
|
|
|
99
|
return $rv; |
215
|
|
|
|
|
|
|
} |
216
|
5
|
|
|
|
|
6
|
$rd = 0; |
217
|
|
|
|
|
|
|
} else { |
218
|
0
|
0
|
|
|
|
0
|
print "no time either!\n" if $debug; |
219
|
0
|
0
|
|
|
|
0
|
return (undef, "no time specified") |
220
|
|
|
|
|
|
|
if wantarray(); |
221
|
0
|
|
|
|
|
0
|
return undef; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
265
|
50
|
66
|
|
|
701
|
if ($options{TIME_REQUIRED} && ! defined($rs) |
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
226
|
|
|
|
|
|
|
&& ! defined($H) && ! defined($rd)) |
227
|
|
|
|
|
|
|
{ |
228
|
0
|
0
|
|
|
|
0
|
return (undef, "no time found") |
229
|
|
|
|
|
|
|
if wantarray(); |
230
|
0
|
|
|
|
|
0
|
return undef; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
265
|
|
|
|
|
335
|
my $secs; |
234
|
|
|
|
|
|
|
my $jd; |
235
|
|
|
|
|
|
|
|
236
|
265
|
100
|
|
|
|
483
|
if (defined $rd) { |
237
|
49
|
100
|
66
|
|
|
315
|
if (defined $rs || ! (defined($H) || defined($M) || defined($S))) { |
|
|
|
100
|
|
|
|
|
238
|
42
|
50
|
|
|
|
88
|
print "fully relative\n" if $debug; |
239
|
42
|
|
|
|
|
45
|
my ($j, $in, $it); |
240
|
42
|
100
|
|
|
|
81
|
my $definedrs = defined($rs) ? $rs : 0; |
241
|
42
|
|
|
|
|
51
|
my ($isdst_now, $isdst_then); |
242
|
42
|
|
|
|
|
72
|
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
|
42
|
|
|
|
|
160
|
$isdst_now = (localtime($r))[8]; |
249
|
42
|
|
|
|
|
131
|
$isdst_then = (localtime($now))[8]; |
250
|
42
|
100
|
66
|
|
|
159
|
if (($isdst_now == $isdst_then) || $options{GMT}) |
251
|
|
|
|
|
|
|
{ |
252
|
28
|
50
|
|
|
|
56
|
return ($r, $t) if wantarray(); |
253
|
28
|
|
|
|
|
141
|
return $r |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
14
|
50
|
|
|
|
38
|
print "localtime changed DST during time period!\n" if $debug; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
21
|
50
|
|
|
|
42
|
print "relative date\n" if $debug; |
260
|
|
|
|
|
|
|
$jd = $options{GMT} |
261
|
21
|
100
|
|
|
|
88
|
? gm_julian_day($now) |
262
|
|
|
|
|
|
|
: local_julian_day($now); |
263
|
21
|
50
|
|
|
|
51
|
print "jd($now) = $jd\n" if $debug; |
264
|
21
|
|
|
|
|
33
|
$jd += $rd; |
265
|
|
|
|
|
|
|
} else { |
266
|
216
|
100
|
|
|
|
441
|
unless (defined $y) { |
267
|
19
|
100
|
|
|
|
57
|
if ($options{PREFER_PAST}) { |
|
|
100
|
|
|
|
|
|
268
|
4
|
|
|
|
|
7
|
my ($day, $mon011); |
269
|
4
|
|
|
|
|
8
|
($day, $mon011, $y) = (&righttime($now))[3,4,5]; |
270
|
|
|
|
|
|
|
|
271
|
4
|
50
|
|
|
|
30
|
print "calc year -past $day-$d $mon011-$m $y\n" if $debug; |
272
|
4
|
100
|
100
|
|
|
29
|
$y -= 1 if ($mon011+1 < $m) || |
|
|
|
66
|
|
|
|
|
273
|
|
|
|
|
|
|
(($mon011+1 == $m) && ($day < $d)); |
274
|
|
|
|
|
|
|
} elsif ($options{PREFER_FUTURE}) { |
275
|
3
|
50
|
|
|
|
8
|
print "calc year -future\n" if $debug; |
276
|
3
|
|
|
|
|
4
|
my ($day, $mon011); |
277
|
3
|
|
|
|
|
8
|
($day, $mon011, $y) = (&righttime($now))[3,4,5]; |
278
|
3
|
100
|
33
|
|
|
24
|
$y += 1 if ($mon011 >= $m) || |
|
|
|
66
|
|
|
|
|
279
|
|
|
|
|
|
|
(($mon011+1 == $m) && ($day > $d)); |
280
|
|
|
|
|
|
|
} else { |
281
|
12
|
50
|
|
|
|
29
|
print "calc year -this\n" if $debug; |
282
|
12
|
|
|
|
|
64
|
$y = (localtime($now))[5]; |
283
|
|
|
|
|
|
|
} |
284
|
19
|
|
|
|
|
43
|
$y += 1900; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
216
|
100
|
|
|
|
606
|
$y = expand_two_digit_year($y, $now, %options) |
288
|
|
|
|
|
|
|
if $y < 100; |
289
|
|
|
|
|
|
|
|
290
|
216
|
100
|
|
|
|
477
|
if ($options{VALIDATE}) { |
291
|
6
|
|
|
|
|
33
|
require Time::DaysInMonth; |
292
|
6
|
|
|
|
|
16
|
my $dim = Time::DaysInMonth::days_in($y, $m); |
293
|
6
|
100
|
33
|
|
|
88
|
if ($y < 1000 or $m < 1 or $d < 1 |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
294
|
|
|
|
|
|
|
or $y > 9999 or $m > 12 or $d > $dim) |
295
|
|
|
|
|
|
|
{ |
296
|
2
|
50
|
|
|
|
7
|
return (undef, "illegal YMD: $y, $m, $d") |
297
|
|
|
|
|
|
|
if wantarray(); |
298
|
2
|
|
|
|
|
8
|
return undef; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
} |
301
|
214
|
|
|
|
|
623
|
$jd = julian_day($y, $m, $d); |
302
|
214
|
50
|
|
|
|
526
|
print "jd($y, $m, $d) = $jd\n" if $debug; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# put time into HMS |
306
|
|
|
|
|
|
|
|
307
|
235
|
100
|
|
|
|
510
|
if (! defined($H)) { |
308
|
72
|
100
|
100
|
|
|
289
|
if (defined($rd) || defined($rs)) { |
309
|
28
|
|
|
|
|
72
|
($S, $M, $H) = &righttime($now, %options); |
310
|
28
|
50
|
|
|
|
93
|
print "HMS set to $H $M $S\n" if $debug; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
235
|
|
|
|
|
283
|
my $carry; |
315
|
|
|
|
|
|
|
|
316
|
235
|
0
|
|
|
|
463
|
print "before ", (defined($rs) ? "$rs" : ""), |
|
|
50
|
|
|
|
|
|
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
|
235
|
100
|
|
|
|
469
|
$S = 0 unless $S; # -w |
325
|
235
|
100
|
|
|
|
495
|
$M = 0 unless $M; # -w |
326
|
235
|
100
|
|
|
|
459
|
$H = 0 unless $H; # -w |
327
|
|
|
|
|
|
|
|
328
|
235
|
100
|
100
|
|
|
541
|
if ($options{VALIDATE} and |
|
|
|
66
|
|
|
|
|
329
|
|
|
|
|
|
|
($S < 0 or $M < 0 or $H < 0 or $S > 59 or $M > 59 or $H > 23)) |
330
|
|
|
|
|
|
|
{ |
331
|
2
|
50
|
|
|
|
6
|
return (undef, "illegal HMS: $H, $M, $S") if wantarray(); |
332
|
2
|
|
|
|
|
8
|
return undef; |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
233
|
100
|
|
|
|
483
|
$S += $rs if defined $rs; |
336
|
233
|
|
100
|
|
|
752
|
$carry = int($S / 60) - ($S < 0 && $S % 60 && 1); |
337
|
233
|
|
|
|
|
317
|
$S -= $carry * 60; |
338
|
233
|
|
|
|
|
340
|
$M += $carry; |
339
|
233
|
|
100
|
|
|
675
|
$carry = int($M / 60) - ($M < 0 && $M % 60 && 1); |
340
|
233
|
|
|
|
|
325
|
$M %= 60; |
341
|
233
|
|
|
|
|
299
|
$H += $carry; |
342
|
233
|
|
50
|
|
|
612
|
$carry = int($H / 24) - ($H < 0 && $H % 24 && 1); |
343
|
233
|
|
|
|
|
310
|
$H %= 24; |
344
|
233
|
|
|
|
|
298
|
$jd += $carry; |
345
|
|
|
|
|
|
|
|
346
|
233
|
50
|
|
|
|
513
|
print "after rs $jd $H $M $S\n" if $debug; |
347
|
|
|
|
|
|
|
|
348
|
233
|
|
|
|
|
694
|
$secs = jd_secondsgm($jd, $H, $M, $S); |
349
|
233
|
50
|
|
|
|
551
|
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
|
233
|
|
|
|
|
262
|
my $tzadj; |
358
|
233
|
100
|
|
|
|
550
|
if ($tz) { |
|
|
100
|
|
|
|
|
|
359
|
43
|
|
|
|
|
125
|
$tzadj = tz_offset($tz, $secs); |
360
|
43
|
50
|
|
|
|
105
|
if (defined $tzadj) { |
361
|
43
|
50
|
|
|
|
132
|
print "adjusting secs for $tz: $tzadj\n" if $debug; |
362
|
43
|
|
|
|
|
141
|
$tzadj = tz_offset($tz, $secs-$tzadj); |
363
|
43
|
|
|
|
|
90
|
$secs -= $tzadj; |
364
|
|
|
|
|
|
|
} else { |
365
|
0
|
0
|
|
|
|
0
|
print "unknown timezone: $tz\n" if $debug; |
366
|
0
|
|
|
|
|
0
|
undef $secs; |
367
|
0
|
|
|
|
|
0
|
undef $t; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
} elsif (defined $tzo) { |
370
|
27
|
50
|
|
|
|
55
|
print "adjusting time for offset: $tzo\n" if $debug; |
371
|
27
|
|
|
|
|
39
|
$secs -= $tzo; |
372
|
|
|
|
|
|
|
} else { |
373
|
163
|
100
|
|
|
|
390
|
unless ($options{GMT}) { |
374
|
160
|
100
|
|
|
|
319
|
if ($options{ZONE}) { |
375
|
38
|
|
100
|
|
|
125
|
$tzadj = tz_offset($options{ZONE}, $secs) || 0; |
376
|
38
|
|
|
|
|
133
|
$tzadj = tz_offset($options{ZONE}, $secs-$tzadj); |
377
|
38
|
50
|
|
|
|
97
|
unless (defined($tzadj)) { |
378
|
0
|
0
|
|
|
|
0
|
return (undef, "could not convert '$options{ZONE}' to time offset") |
379
|
|
|
|
|
|
|
if wantarray(); |
380
|
0
|
|
|
|
|
0
|
return undef; |
381
|
|
|
|
|
|
|
} |
382
|
38
|
50
|
|
|
|
86
|
print "adjusting secs for $options{ZONE}: $tzadj\n" if $debug; |
383
|
38
|
|
|
|
|
61
|
$secs -= $tzadj; |
384
|
|
|
|
|
|
|
} else { |
385
|
122
|
|
|
|
|
308
|
$tzadj = tz_local_offset($secs); |
386
|
122
|
50
|
|
|
|
367
|
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
|
122
|
|
|
|
|
358
|
$tzadj = tz_local_offset($secs-$tzadj); |
392
|
122
|
|
|
|
|
219
|
$secs -= $tzadj; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
|
397
|
233
|
50
|
|
|
|
465
|
print "returning $secs.\n" if $debug; |
398
|
|
|
|
|
|
|
|
399
|
233
|
100
|
|
|
|
469
|
return ($secs, $t) if wantarray(); |
400
|
232
|
|
|
|
|
1060
|
return $secs; |
401
|
|
|
|
|
|
|
} |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
sub mkoff |
405
|
|
|
|
|
|
|
{ |
406
|
28
|
|
|
28
|
0
|
49
|
my($offset) = @_; |
407
|
|
|
|
|
|
|
|
408
|
28
|
50
|
33
|
|
|
197
|
if (defined $offset and $offset =~ s#^([-+])(\d\d):?(\d\d)$##) { |
409
|
28
|
100
|
|
|
|
154
|
return ($1 eq '+' ? |
410
|
|
|
|
|
|
|
3600 * $2 + 60 * $3 |
411
|
|
|
|
|
|
|
: -3600 * $2 + -60 * $3 ); |
412
|
|
|
|
|
|
|
} |
413
|
0
|
|
|
|
|
0
|
return undef; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
sub parse_tz_only |
417
|
|
|
|
|
|
|
{ |
418
|
197
|
|
|
197
|
0
|
350
|
my($tr, $tz, $tzo) = @_; |
419
|
|
|
|
|
|
|
|
420
|
197
|
|
|
|
|
332
|
$$tr =~ s#^\s+##; |
421
|
197
|
|
|
|
|
232
|
my $o; |
422
|
|
|
|
|
|
|
|
423
|
197
|
100
|
|
|
|
2929
|
if ($$tr =~ s#^ |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
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
|
4
|
|
|
|
|
10
|
$$tzo = &mkoff($1); |
439
|
4
|
50
|
|
|
|
13
|
printf "matched at %d.\n", __LINE__ if $debug; |
440
|
4
|
|
|
|
|
15
|
return 1; |
441
|
|
|
|
|
|
|
} elsif ($$tr =~ s#^GMT\s*([-+]\d{1,2})($break)##x) { |
442
|
6
|
|
|
|
|
13
|
$o = $1; |
443
|
6
|
50
|
33
|
|
|
33
|
if ($o < 24 and $o !~ /^0/) { |
444
|
|
|
|
|
|
|
# probably hours. |
445
|
6
|
50
|
|
|
|
10
|
printf "adjusted at %d. ($o 00)\n", __LINE__ if $debug; |
446
|
6
|
|
|
|
|
24
|
$o = "${o}00"; |
447
|
|
|
|
|
|
|
} |
448
|
6
|
|
|
|
|
29
|
$o =~ s/\b(\d\d\d)/0$1/; |
449
|
6
|
|
|
|
|
15
|
$$tzo = &mkoff($o); |
450
|
6
|
50
|
|
|
|
29
|
printf "matched at %d. ($$tzo, $o)\n", __LINE__ if $debug; |
451
|
6
|
|
|
|
|
20
|
return 1; |
452
|
|
|
|
|
|
|
} elsif ($$tr =~ s#^(?:GMT\s*)?([-+]\d\d:?\d\d)($break)##x) { |
453
|
13
|
|
|
|
|
28
|
$o = $1; |
454
|
13
|
|
|
|
|
28
|
$$tzo = &mkoff($o); |
455
|
13
|
50
|
|
|
|
34
|
printf "matched at %d.\n", __LINE__ if $debug; |
456
|
13
|
|
|
|
|
48
|
return 1; |
457
|
|
|
|
|
|
|
} elsif ($$tr =~ s#^"?((?:[A-Z]{1,4}[TCW56])|IDLE)$break##x) { #" |
458
|
40
|
|
|
|
|
84
|
$$tz = $1; |
459
|
40
|
100
|
66
|
|
|
157
|
$$tz .= " DST" |
460
|
|
|
|
|
|
|
if $$tz eq 'MET' && $$tr =~ s#^DST$break##x; |
461
|
40
|
50
|
|
|
|
91
|
printf "matched at %d: '$$tz'.\n", __LINE__ if $debug; |
462
|
40
|
|
|
|
|
163
|
return 1; |
463
|
|
|
|
|
|
|
} |
464
|
134
|
|
|
|
|
504
|
return 0; |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
sub parse_date_only |
468
|
|
|
|
|
|
|
{ |
469
|
315
|
|
|
315
|
0
|
555
|
my ($tr, $yr, $mr, $dr, $uk) = @_; |
470
|
|
|
|
|
|
|
|
471
|
315
|
|
|
|
|
699
|
$$tr =~ s#^\s+##; |
472
|
|
|
|
|
|
|
|
473
|
315
|
100
|
|
|
|
10081
|
if ($$tr =~ s#^(\d\d\d\d)([-./])(\d\d?)\2(\d\d?)(T|$break)##) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
474
|
|
|
|
|
|
|
# yyyy/mm/dd |
475
|
|
|
|
|
|
|
|
476
|
39
|
|
|
|
|
192
|
($$yr, $$mr, $$dr) = ($1, $3, $4); |
477
|
39
|
50
|
|
|
|
113
|
printf "matched at %d.\n", __LINE__ if $debug; |
478
|
39
|
|
|
|
|
144
|
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
|
15
|
100
|
100
|
|
|
84
|
if ($uk || $1>12) { |
484
|
8
|
|
|
|
|
32
|
($$yr, $$mr, $$dr) = ($4, $3, $1); |
485
|
|
|
|
|
|
|
} else { |
486
|
7
|
|
|
|
|
33
|
($$yr, $$mr, $$dr) = ($4, $1, $3); |
487
|
|
|
|
|
|
|
} |
488
|
15
|
50
|
|
|
|
39
|
printf "matched at %d.\n", __LINE__ if $debug; |
489
|
15
|
|
|
|
|
57
|
return 1; |
490
|
|
|
|
|
|
|
} elsif ($$tr =~ s#^(\d\d\d\d)/(\d\d?)$break##x) { |
491
|
|
|
|
|
|
|
# yyyy/mm |
492
|
|
|
|
|
|
|
|
493
|
1
|
|
|
|
|
7
|
($$yr, $$mr, $$dr) = ($1, $2, 1); |
494
|
1
|
50
|
|
|
|
5
|
printf "matched at %d.\n", __LINE__ if $debug; |
495
|
1
|
|
|
|
|
6
|
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
|
26
|
|
|
|
|
152
|
($$yr, $$mr, $$dr) = ($4, $mtable{"\u\L$3"}, $1); |
514
|
|
|
|
|
|
|
|
515
|
26
|
50
|
|
|
|
69
|
printf "%d: %s - %s - %s\n", __LINE__, $1, $2, $3 if $debug; |
516
|
26
|
50
|
33
|
|
|
74
|
print "y undef\n" if ($debug && ! defined($$yr)); |
517
|
26
|
|
|
|
|
107
|
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
|
44
|
|
|
|
|
232
|
($$yr, $$mr, $$dr) = ($5, $mtable{"\u\L$1"}, $4); |
539
|
44
|
50
|
|
|
|
111
|
printf "%d: %s - %s - %s\n", __LINE__, $1, $2, $4 if $debug; |
540
|
44
|
50
|
33
|
|
|
114
|
print "y undef\n" if ($debug && ! defined($$yr)); |
541
|
44
|
|
|
|
|
172
|
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
|
9
|
|
66
|
|
|
67
|
($$yr, $$mr, $$dr) = ($3 || $4, $mtable{"\u\L$1"}, $2); |
564
|
9
|
50
|
|
|
|
26
|
printf "%d: %s - %s - %s - %s\n", __LINE__, $1, $2, $3, $4 if $debug; |
565
|
9
|
50
|
33
|
|
|
26
|
print "y undef\n" if ($debug && ! defined($$yr)); |
566
|
9
|
50
|
|
|
|
21
|
printf "matched at %d.\n", __LINE__ if $debug; |
567
|
9
|
|
|
|
|
39
|
return 1; |
568
|
|
|
|
|
|
|
} elsif ($$tr =~ s#^(\d\d?)([-/.])(\d\d?)\2(\d\d?)($break)##x) { |
569
|
46
|
100
|
100
|
|
|
391
|
if ($1 > 31 || (!$uk && $1 > 12 && $4 < 32)) { |
|
|
100
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
570
|
|
|
|
|
|
|
# yy/mm/dd |
571
|
17
|
|
|
|
|
74
|
($$yr, $$mr, $$dr) = ($1, $3, $4); |
572
|
|
|
|
|
|
|
} elsif ($1 > 12 || $uk) { |
573
|
|
|
|
|
|
|
# dd/mm/yy |
574
|
4
|
|
|
|
|
19
|
($$yr, $$mr, $$dr) = ($4, $3, $1); |
575
|
|
|
|
|
|
|
} else { |
576
|
|
|
|
|
|
|
# mm/dd/yy |
577
|
25
|
|
|
|
|
104
|
($$yr, $$mr, $$dr) = ($4, $1, $3); |
578
|
|
|
|
|
|
|
} |
579
|
46
|
50
|
|
|
|
115
|
printf "matched at %d.\n", __LINE__ if $debug; |
580
|
46
|
|
|
|
|
194
|
return 1; |
581
|
|
|
|
|
|
|
} elsif ($$tr =~ s#^(\d\d?)/(\d\d?)($break)##x) { |
582
|
5
|
100
|
33
|
|
|
75
|
if ($1 > 31 || (!$uk && $1 > 12)) { |
|
|
100
|
66
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
583
|
|
|
|
|
|
|
# yy/mm |
584
|
1
|
|
|
|
|
6
|
($$yr, $$mr, $$dr) = ($1, $2, 1); |
585
|
|
|
|
|
|
|
} elsif ($2 > 31 || ($uk && $2 > 12)) { |
586
|
|
|
|
|
|
|
# mm/yy |
587
|
1
|
|
|
|
|
7
|
($$yr, $$mr, $$dr) = ($2, $1, 1); |
588
|
|
|
|
|
|
|
} elsif ($1 > 12 || $uk) { |
589
|
|
|
|
|
|
|
# dd/mm |
590
|
0
|
|
|
|
|
0
|
($$mr, $$dr) = ($2, $1); |
591
|
|
|
|
|
|
|
} else { |
592
|
|
|
|
|
|
|
# mm/dd |
593
|
3
|
|
|
|
|
13
|
($$mr, $$dr) = ($1, $2); |
594
|
|
|
|
|
|
|
} |
595
|
5
|
50
|
|
|
|
16
|
printf "matched at %d.\n", __LINE__ if $debug; |
596
|
5
|
|
|
|
|
25
|
return 1; |
597
|
|
|
|
|
|
|
} elsif ($$tr =~ s#^(\d\d)(\d\d)(\d\d)($break)##x) { |
598
|
8
|
100
|
33
|
|
|
50
|
if ($1 > 31 || (!$uk && $1 > 12)) { |
|
|
50
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
599
|
|
|
|
|
|
|
# YYMMDD |
600
|
7
|
|
|
|
|
34
|
($$yr, $$mr, $$dr) = ($1, $2, $3); |
601
|
|
|
|
|
|
|
} elsif ($1 > 12 || $uk) { |
602
|
|
|
|
|
|
|
# DDMMYY |
603
|
0
|
|
|
|
|
0
|
($$yr, $$mr, $$dr) = ($3, $2, $1); |
604
|
|
|
|
|
|
|
} else { |
605
|
|
|
|
|
|
|
# MMDDYY |
606
|
1
|
|
|
|
|
5
|
($$yr, $$mr, $$dr) = ($3, $1, $2); |
607
|
|
|
|
|
|
|
} |
608
|
8
|
50
|
|
|
|
21
|
printf "matched at %d.\n", __LINE__ if $debug; |
609
|
8
|
|
|
|
|
42
|
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
|
1
|
|
|
|
|
7
|
($$yr, $$mr, $$dr) = ($4, $mtable{"\u\L$3"}, $1); |
627
|
1
|
50
|
|
|
|
4
|
printf "matched at %d.\n", __LINE__ if $debug; |
628
|
1
|
|
|
|
|
4
|
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
|
1
|
|
|
|
|
7
|
($$yr, $$mr, $$dr) = ($3, $mtable{"\u\L$2"}, $1); |
645
|
1
|
50
|
|
|
|
11
|
printf "%d: %s - %s - %s - %s\n", __LINE__, $1, $2, $3, $4 if $debug; |
646
|
1
|
50
|
33
|
|
|
5
|
print "y undef\n" if ($debug && ! defined($$yr)); |
647
|
1
|
50
|
|
|
|
4
|
printf "matched at %d.\n", __LINE__ if $debug; |
648
|
1
|
|
|
|
|
5
|
return 1; |
649
|
|
|
|
|
|
|
} |
650
|
120
|
|
|
|
|
601
|
return 0; |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
sub parse_time_only |
654
|
|
|
|
|
|
|
{ |
655
|
322
|
|
|
322
|
0
|
870
|
my ($tr, $hr, $mr, $sr, $tzr, %options) = @_; |
656
|
|
|
|
|
|
|
|
657
|
322
|
|
|
|
|
655
|
$$tr =~ s#^\s+##; |
658
|
|
|
|
|
|
|
|
659
|
322
|
100
|
|
|
|
3582
|
if ($$tr =~ s!^(?x) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
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
|
151
|
|
|
|
|
182
|
my $ampm; |
706
|
151
|
|
100
|
|
|
796
|
$$hr = $1 || $5 || $10 || 0; # 10 is undef, but 5 is defined.. |
707
|
151
|
|
100
|
|
|
677
|
$$mr = $2 || $6 || 0; |
708
|
151
|
|
100
|
|
|
716
|
$$sr = $3 || $7 || 0; |
709
|
151
|
50
|
66
|
|
|
423
|
if (defined($8) && exists($options{SUBSECOND}) && $options{SUBSECOND}) { |
|
|
|
66
|
|
|
|
|
710
|
7
|
|
|
|
|
13
|
my($frac) = $8; |
711
|
7
|
|
|
|
|
16
|
substr($frac,0,1) = '.'; |
712
|
7
|
|
|
|
|
21
|
$$sr += $frac; |
713
|
|
|
|
|
|
|
} |
714
|
151
|
50
|
|
|
|
320
|
print "S = $$sr\n" if $debug; |
715
|
151
|
|
100
|
|
|
1108
|
$ampm = $4 || $9 || $11 || ''; |
716
|
151
|
|
|
|
|
264
|
$$tzr = $12; |
717
|
151
|
100
|
100
|
|
|
440
|
$$hr += 12 if $ampm and "\U$ampm" eq "PM" && $$hr != 12; |
|
|
|
66
|
|
|
|
|
718
|
151
|
100
|
100
|
|
|
480
|
$$hr = 0 if $$hr == 12 && "\U$ampm" eq "AM"; |
719
|
151
|
50
|
|
|
|
309
|
printf "matched at %d, rem = %s.\n", __LINE__, $$tr if $debug; |
720
|
151
|
|
|
|
|
664
|
return 1; |
721
|
|
|
|
|
|
|
} elsif ($$tr =~ s#^noon$break##ix) { |
722
|
|
|
|
|
|
|
# noon |
723
|
2
|
|
|
|
|
7
|
($$hr, $$mr, $$sr) = (12, 0, 0); |
724
|
2
|
50
|
|
|
|
18
|
printf "matched at %d.\n", __LINE__ if $debug; |
725
|
2
|
|
|
|
|
13
|
return 1; |
726
|
|
|
|
|
|
|
} elsif ($$tr =~ s#^midnight$break##ix) { |
727
|
|
|
|
|
|
|
# midnight |
728
|
2
|
|
|
|
|
5
|
($$hr, $$mr, $$sr) = (0, 0, 0); |
729
|
2
|
50
|
|
|
|
9
|
printf "matched at %d.\n", __LINE__ if $debug; |
730
|
2
|
|
|
|
|
11
|
return 1; |
731
|
|
|
|
|
|
|
} |
732
|
167
|
|
|
|
|
762
|
return 0; |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
sub parse_time_offset |
736
|
|
|
|
|
|
|
{ |
737
|
167
|
|
|
167
|
0
|
397
|
my ($tr, $rsr, %options) = @_; |
738
|
|
|
|
|
|
|
|
739
|
167
|
|
|
|
|
293
|
$$tr =~ s/^\s+//; |
740
|
|
|
|
|
|
|
|
741
|
167
|
50
|
|
|
|
379
|
return 0 if $options{NO_RELATIVE}; |
742
|
|
|
|
|
|
|
|
743
|
167
|
100
|
|
|
|
1477
|
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
|
38
|
50
|
|
|
|
109
|
$$rsr = 0 unless defined $$rsr; |
765
|
38
|
50
|
66
|
|
|
140
|
return 0 if defined($5) && $5 == 0; |
766
|
38
|
100
|
|
|
|
121
|
my $num = defined($2) |
767
|
|
|
|
|
|
|
? $2 |
768
|
|
|
|
|
|
|
: $3 + $4/$5; |
769
|
38
|
100
|
|
|
|
135
|
$num = -$num if $1; |
770
|
38
|
|
|
|
|
221
|
$$rsr += $umult{"\L$6"} * $num; |
771
|
|
|
|
|
|
|
|
772
|
38
|
100
|
100
|
|
|
221
|
$$rsr = -$$rsr if $7 || |
773
|
|
|
|
|
|
|
$$tr =~ /\b(day|mon|month|year)s?\s*ago\b/; |
774
|
38
|
50
|
|
|
|
91
|
printf "matched at %d.\n", __LINE__ if $debug; |
775
|
38
|
|
|
|
|
177
|
return 1; |
776
|
|
|
|
|
|
|
} |
777
|
129
|
|
|
|
|
463
|
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
|
65
|
|
|
65
|
0
|
177
|
my ($yr, $now, %options) = @_; |
797
|
|
|
|
|
|
|
|
798
|
65
|
50
|
|
|
|
152
|
return $yr if $yr > 100; |
799
|
|
|
|
|
|
|
|
800
|
65
|
|
|
|
|
169
|
my ($y) = (&righttime($now, %options))[5]; |
801
|
65
|
|
|
|
|
233
|
$y += 1900; |
802
|
65
|
|
|
|
|
134
|
my $century = int($y / 100) * 100; |
803
|
65
|
|
|
|
|
91
|
my $within = $y % 100; |
804
|
|
|
|
|
|
|
|
805
|
65
|
|
|
|
|
95
|
my $r = $yr + $century; |
806
|
|
|
|
|
|
|
|
807
|
65
|
100
|
|
|
|
206
|
if ($options{PREFER_PAST}) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
808
|
3
|
100
|
|
|
|
9
|
if ($yr > $within) { |
809
|
2
|
|
|
|
|
5
|
$r = $yr + $century - 100; |
810
|
|
|
|
|
|
|
} |
811
|
|
|
|
|
|
|
} elsif ($options{PREFER_FUTURE}) { |
812
|
|
|
|
|
|
|
# being strict here would be silly |
813
|
3
|
100
|
|
|
|
10
|
if ($yr < $within-20) { |
814
|
|
|
|
|
|
|
# it's 2019 and the date is '08' |
815
|
1
|
|
|
|
|
2
|
$r = $yr + $century + 100; |
816
|
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
} elsif ($options{UNAMBIGUOUS}) { |
818
|
|
|
|
|
|
|
# we really shouldn't guess |
819
|
0
|
|
|
|
|
0
|
return undef; |
820
|
|
|
|
|
|
|
} else { |
821
|
|
|
|
|
|
|
# prefer the current century in most cases |
822
|
|
|
|
|
|
|
|
823
|
59
|
100
|
100
|
|
|
184
|
if ($within > 80 && $within - $yr > 60) { |
824
|
1
|
|
|
|
|
2
|
$r = $yr + $century + 100; |
825
|
|
|
|
|
|
|
} |
826
|
|
|
|
|
|
|
|
827
|
59
|
100
|
100
|
|
|
260
|
if ($within < 30 && $yr - $within > 59) { |
828
|
35
|
|
|
|
|
58
|
$r = $yr + $century - 100; |
829
|
|
|
|
|
|
|
} |
830
|
|
|
|
|
|
|
} |
831
|
65
|
50
|
|
|
|
143
|
print "two digit year '$yr' expanded into $r\n" if $debug; |
832
|
65
|
|
|
|
|
163
|
return $r; |
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
sub calc |
837
|
|
|
|
|
|
|
{ |
838
|
33
|
|
|
33
|
0
|
107
|
my ($rsr, $yr, $mr, $dr, $rdr, $now, $units, $count, %options) = @_; |
839
|
|
|
|
|
|
|
|
840
|
33
|
50
|
|
|
|
74
|
confess unless $units; |
841
|
33
|
|
|
|
|
49
|
$units = "\L$units"; |
842
|
33
|
50
|
|
|
|
76
|
print "calc based on $units\n" if $debug; |
843
|
|
|
|
|
|
|
|
844
|
33
|
100
|
66
|
|
|
137
|
if ($units eq 'day') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
845
|
17
|
|
|
|
|
29
|
$$rdr = $count; |
846
|
|
|
|
|
|
|
} elsif ($units eq 'week') { |
847
|
3
|
|
|
|
|
6
|
$$rdr = $count * 7; |
848
|
|
|
|
|
|
|
} elsif ($umult{$units}) { |
849
|
0
|
|
|
|
|
0
|
$$rsr = $count * $umult{$units}; |
850
|
|
|
|
|
|
|
} elsif ($units eq 'mon' || $units eq 'month') { |
851
|
7
|
|
|
|
|
20
|
($$yr, $$mr, $$dr) = &monthoff($now, $count, %options); |
852
|
7
|
100
|
|
|
|
22
|
$$rsr = 0 unless $$rsr; |
853
|
|
|
|
|
|
|
} elsif ($units eq 'year') { |
854
|
6
|
|
|
|
|
17
|
($$yr, $$mr, $$dr) = &monthoff($now, $count * 12, %options); |
855
|
6
|
50
|
|
|
|
18
|
$$rsr = 0 unless $$rsr; |
856
|
|
|
|
|
|
|
} else { |
857
|
0
|
|
|
|
|
0
|
carp "interal error"; |
858
|
|
|
|
|
|
|
} |
859
|
33
|
50
|
|
|
|
112
|
print "calced rsr $$rsr rdr $$rdr, yr $$yr mr $$mr dr $$dr.\n" if $debug; |
860
|
|
|
|
|
|
|
} |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
sub monthoff |
863
|
|
|
|
|
|
|
{ |
864
|
13
|
|
|
13
|
0
|
34
|
my ($now, $months, %options) = @_; |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
# months are 0..11 |
867
|
13
|
|
|
|
|
33
|
my ($d, $m11, $y) = (&righttime($now, %options)) [ 3,4,5 ] ; |
868
|
|
|
|
|
|
|
|
869
|
13
|
|
|
|
|
26
|
$y += 1900; |
870
|
|
|
|
|
|
|
|
871
|
13
|
50
|
|
|
|
29
|
print "m11 = $m11 + $months, y = $y\n" if $debug; |
872
|
|
|
|
|
|
|
|
873
|
13
|
|
|
|
|
14
|
$m11 += $months; |
874
|
|
|
|
|
|
|
|
875
|
13
|
50
|
|
|
|
27
|
print "m11 = $m11, y = $y\n" if $debug; |
876
|
13
|
100
|
100
|
|
|
58
|
if ($m11 > 11 || $m11 < 0) { |
877
|
6
|
100
|
100
|
|
|
28
|
$y -= 1 if $m11 < 0 && ($m11 % 12 != 0); |
878
|
6
|
|
|
|
|
9
|
$y += int($m11/12); |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
# this is required to work around a bug in perl 5.003 |
881
|
4
|
|
|
4
|
|
30
|
no integer; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
24
|
|
882
|
6
|
|
|
|
|
10
|
$m11 %= 12; |
883
|
|
|
|
|
|
|
} |
884
|
13
|
50
|
|
|
|
25
|
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
|
13
|
100
|
33
|
|
|
49
|
if ($d > 30 or ($d > 28 && $m11 == 1)) { |
|
|
|
66
|
|
|
|
|
896
|
4
|
|
|
|
|
859
|
require Time::DaysInMonth; |
897
|
4
|
|
|
|
|
14
|
my $dim = Time::DaysInMonth::days_in($y, $m11+1); |
898
|
4
|
50
|
|
|
|
11
|
print "dim($y,$m11+1)= $dim\n" if $debug; |
899
|
4
|
100
|
|
|
|
11
|
$d = $dim if $d > $dim; |
900
|
|
|
|
|
|
|
} |
901
|
13
|
|
|
|
|
46
|
return ($y, $m11+1, $d); |
902
|
|
|
|
|
|
|
} |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
sub righttime |
905
|
|
|
|
|
|
|
{ |
906
|
195
|
|
|
195
|
0
|
427
|
my ($time, %options) = @_; |
907
|
195
|
100
|
|
|
|
424
|
if ($options{GMT}) { |
908
|
3
|
|
|
|
|
14
|
return gmtime($time); |
909
|
|
|
|
|
|
|
} else { |
910
|
192
|
|
|
|
|
950
|
return localtime($time); |
911
|
|
|
|
|
|
|
} |
912
|
|
|
|
|
|
|
} |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
sub parse_year_only |
915
|
|
|
|
|
|
|
{ |
916
|
246
|
|
|
246
|
0
|
603
|
my ($tr, $yr, $now, %options) = @_; |
917
|
|
|
|
|
|
|
|
918
|
246
|
|
|
|
|
436
|
$$tr =~ s#^\s+##; |
919
|
|
|
|
|
|
|
|
920
|
246
|
100
|
|
|
|
1705
|
if ($$tr =~ s#^(\d\d\d\d)$break##) { |
|
|
50
|
|
|
|
|
|
921
|
31
|
|
|
|
|
61
|
$$yr = $1; |
922
|
31
|
50
|
|
|
|
64
|
printf "matched at %d.\n", __LINE__ if $debug; |
923
|
31
|
|
|
|
|
108
|
return 1; |
924
|
|
|
|
|
|
|
} elsif ($$tr =~ s#\'(\d\d)$break##) { |
925
|
0
|
|
|
|
|
0
|
$$yr = expand_two_digit_year($1, $now, %options); |
926
|
0
|
0
|
|
|
|
0
|
printf "matched at %d.\n", __LINE__ if $debug; |
927
|
0
|
|
|
|
|
0
|
return 1; |
928
|
|
|
|
|
|
|
} |
929
|
215
|
|
|
|
|
842
|
return 0; |
930
|
|
|
|
|
|
|
} |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
sub parse_date_offset |
933
|
|
|
|
|
|
|
{ |
934
|
82
|
|
|
82
|
0
|
227
|
my ($tr, $now, $yr, $mr, $dr, $rdr, $rsr, %options) = @_; |
935
|
|
|
|
|
|
|
|
936
|
82
|
50
|
|
|
|
191
|
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
|
82
|
|
|
|
|
88
|
my $j; |
946
|
82
|
|
|
|
|
213
|
my $wday = (&righttime($now, %options))[6]; |
947
|
|
|
|
|
|
|
|
948
|
82
|
|
|
|
|
205
|
$$tr =~ s#^\s+##; |
949
|
|
|
|
|
|
|
|
950
|
82
|
100
|
66
|
|
|
3599
|
if ($$tr =~ s#^(?xi) |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
951
|
|
|
|
|
|
|
\s* |
952
|
|
|
|
|
|
|
(\d+) |
953
|
|
|
|
|
|
|
\s* |
954
|
|
|
|
|
|
|
(day|week|month|year)s? |
955
|
|
|
|
|
|
|
( |
956
|
|
|
|
|
|
|
\s+ |
957
|
|
|
|
|
|
|
ago |
958
|
|
|
|
|
|
|
)? |
959
|
|
|
|
|
|
|
$break |
960
|
|
|
|
|
|
|
##) { |
961
|
10
|
|
|
|
|
28
|
my $amt = $1 + 0; |
962
|
10
|
|
|
|
|
19
|
my $units = $2; |
963
|
10
|
100
|
100
|
|
|
59
|
$amt = -$amt if $3 || |
964
|
|
|
|
|
|
|
$$tr =~ m#\b(sec|second|min|minute|hour)s?\s*ago\b#; |
965
|
10
|
|
|
|
|
32
|
&calc($rsr, $yr, $mr, $dr, $rdr, $now, $units, |
966
|
|
|
|
|
|
|
$amt, %options); |
967
|
10
|
50
|
|
|
|
27
|
printf "matched at %d.\n", __LINE__ if $debug; |
968
|
10
|
|
|
|
|
38
|
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
|
16
|
|
50
|
|
|
60
|
my $one = $1 || ''; |
984
|
16
|
|
50
|
|
|
42
|
my $two = $2 || ''; |
985
|
16
|
|
|
|
|
43
|
my $amt = "$one$two"+0; |
986
|
16
|
|
|
|
|
49
|
&calc($rsr, $yr, $mr, $dr, $rdr, $now, $3, |
987
|
|
|
|
|
|
|
$amt, %options); |
988
|
16
|
50
|
|
|
|
42
|
printf "matched at %d.\n", __LINE__ if $debug; |
989
|
16
|
|
|
|
|
73
|
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
|
1
|
50
|
|
|
|
7
|
$$rdr = $wdays{"\L$1"} - $wday + ( $wdays{"\L$1"} > $wday ? 7 : 14); |
1001
|
1
|
50
|
|
|
|
4
|
printf "matched at %d.\n", __LINE__ if $debug; |
1002
|
1
|
|
|
|
|
5
|
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
|
2
|
100
|
|
|
|
17
|
$$rdr = $wdays{"\L$1"} - $wday - ( $wdays{"\L$1"} < $wday ? 7 : 14); |
1014
|
2
|
50
|
|
|
|
8
|
printf "matched at %d.\n", __LINE__ if $debug; |
1015
|
2
|
|
|
|
|
12
|
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
|
4
|
100
|
|
|
|
21
|
+ ( $wdays{"\L$1"} > $wday ? 0 : 7); |
1025
|
4
|
50
|
|
|
|
8
|
printf "matched at %d.\n", __LINE__ if $debug; |
1026
|
4
|
|
|
|
|
19
|
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
|
3
|
50
|
|
|
|
9
|
printf "c %d - %d + ( %d < %d ? 0 : -7 \n", $wdays{"\L$1"}, $wday, $wdays{"\L$1"}, $wday if $debug; |
1034
|
3
|
100
|
|
|
|
14
|
$$rdr = $wdays{"\L$1"} - $wday + ( $wdays{"\L$1"} < $wday ? 0 : -7); |
1035
|
3
|
50
|
|
|
|
7
|
printf "matched at %d.\n", __LINE__ if $debug; |
1036
|
3
|
|
|
|
|
14
|
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
|
3
|
50
|
|
|
|
7
|
printf "c %d - %d + ( %d < %d ? 0 : -7 \n", $wdays{"\L$1"}, $wday, $wdays{"\L$1"}, $wday if $debug; |
1043
|
3
|
100
|
|
|
|
15
|
$$rdr = $wdays{"\L$1"} - $wday + ( $wdays{"\L$1"} < $wday ? 0 : -7); |
1044
|
3
|
50
|
|
|
|
7
|
printf "matched at %d.\n", __LINE__ if $debug; |
1045
|
3
|
|
|
|
|
15
|
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
|
3
|
100
|
|
|
|
12
|
+ ( $wdays{"\L$1"} > $wday ? 0 : 7); |
1054
|
3
|
50
|
|
|
|
9
|
printf "matched at %d.\n", __LINE__ if $debug; |
1055
|
3
|
|
|
|
|
15
|
return 1; |
1056
|
|
|
|
|
|
|
} elsif ($$tr =~ s#^today$break##xi) { |
1057
|
|
|
|
|
|
|
# today |
1058
|
1
|
|
|
|
|
2
|
$$rdr = 0; |
1059
|
1
|
50
|
|
|
|
4
|
printf "matched at %d.\n", __LINE__ if $debug; |
1060
|
1
|
|
|
|
|
5
|
return 1; |
1061
|
|
|
|
|
|
|
} elsif ($$tr =~ s#^tomorrow$break##xi) { |
1062
|
1
|
|
|
|
|
2
|
$$rdr = 1; |
1063
|
1
|
50
|
|
|
|
4
|
printf "matched at %d.\n", __LINE__ if $debug; |
1064
|
1
|
|
|
|
|
4
|
return 1; |
1065
|
|
|
|
|
|
|
} elsif ($$tr =~ s#^yesterday$break##xi) { |
1066
|
1
|
|
|
|
|
3
|
$$rdr = -1; |
1067
|
1
|
50
|
|
|
|
3
|
printf "matched at %d.\n", __LINE__ if $debug; |
1068
|
1
|
|
|
|
|
5
|
return 1; |
1069
|
|
|
|
|
|
|
} elsif ($$tr =~ s#^last\s+(week|month|year)$break##xi) { |
1070
|
4
|
|
|
|
|
13
|
&calc($rsr, $yr, $mr, $dr, $rdr, $now, $1, -1, %options); |
1071
|
4
|
50
|
|
|
|
11
|
printf "matched at %d.\n", __LINE__ if $debug; |
1072
|
4
|
|
|
|
|
17
|
return 1; |
1073
|
|
|
|
|
|
|
} elsif ($$tr =~ s#^next\s+(week|month|year)$break##xi) { |
1074
|
3
|
|
|
|
|
11
|
&calc($rsr, $yr, $mr, $dr, $rdr, $now, $1, 1, %options); |
1075
|
3
|
50
|
|
|
|
8
|
printf "matched at %d.\n", __LINE__ if $debug; |
1076
|
3
|
|
|
|
|
15
|
return 1; |
1077
|
|
|
|
|
|
|
} elsif ($$tr =~ s#^now $break##x) { |
1078
|
5
|
|
|
|
|
9
|
$$rdr = 0; |
1079
|
5
|
|
|
|
|
39
|
return 1; |
1080
|
|
|
|
|
|
|
} |
1081
|
25
|
|
|
|
|
161
|
return 0; |
1082
|
|
|
|
|
|
|
} |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
sub debug_display |
1085
|
|
|
|
|
|
|
{ |
1086
|
0
|
|
|
0
|
0
|
|
my ($tz, $tzo, $H, $M, $S, $m, $d, $y, $rs, $rd, $rel, $passes, $parse, $t) = @_; |
1087
|
0
|
|
|
|
|
|
print "---------<<\n"; |
1088
|
0
|
0
|
|
|
|
|
print defined($tz) ? "tz: $tz.\n" : "no tz\n"; |
1089
|
0
|
0
|
|
|
|
|
print defined($tzo) ? "tzo: $tzo.\n" : "no tzo\n"; |
1090
|
0
|
|
|
|
|
|
print "HMS: "; |
1091
|
0
|
0
|
|
|
|
|
print defined($H) ? "$H, " : "no H, "; |
1092
|
0
|
0
|
|
|
|
|
print defined($M) ? "$M, " : "no M, "; |
1093
|
0
|
0
|
|
|
|
|
print defined($S) ? "$S\n" : "no S.\n"; |
1094
|
0
|
|
|
|
|
|
print "mdy: "; |
1095
|
0
|
0
|
|
|
|
|
print defined($m) ? "$m, " : "no m, "; |
1096
|
0
|
0
|
|
|
|
|
print defined($d) ? "$d, " : "no d, "; |
1097
|
0
|
0
|
|
|
|
|
print defined($y) ? "$y\n" : "no y.\n"; |
1098
|
0
|
0
|
|
|
|
|
print defined($rs) ? "rs: $rs.\n" : "no rs\n"; |
1099
|
0
|
0
|
|
|
|
|
print defined($rd) ? "rd: $rd.\n" : "no rd\n"; |
1100
|
0
|
0
|
|
|
|
|
print $rel ? "relative\n" : "not relative\n"; |
1101
|
0
|
|
|
|
|
|
print "passes: $passes\n"; |
1102
|
0
|
|
|
|
|
|
print "parse:$parse\n"; |
1103
|
0
|
|
|
|
|
|
print "t: $t.\n"; |
1104
|
0
|
|
|
|
|
|
print "--------->>\n"; |
1105
|
|
|
|
|
|
|
} |
1106
|
|
|
|
|
|
|
1; |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
__END__ |