line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Date::Manip::Recur; |
2
|
|
|
|
|
|
|
# Copyright (c) 1998-2022 Sullivan Beck. All rights reserved. |
3
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or modify |
4
|
|
|
|
|
|
|
# it under the same terms as Perl itself. |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
######################################################################## |
7
|
|
|
|
|
|
|
# Any routine that starts with an underscore (_) is NOT intended for |
8
|
|
|
|
|
|
|
# public use. They are for internal use in the the Date::Manip |
9
|
|
|
|
|
|
|
# modules and are subject to change without warning or notice. |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# ABSOLUTELY NO USER SUPPORT IS OFFERED FOR THESE ROUTINES! |
12
|
|
|
|
|
|
|
######################################################################## |
13
|
|
|
|
|
|
|
|
14
|
168
|
|
|
168
|
|
1219
|
use Date::Manip::Obj; |
|
168
|
|
|
|
|
692
|
|
|
168
|
|
|
|
|
8324
|
|
15
|
|
|
|
|
|
|
@ISA = ('Date::Manip::Obj'); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
require 5.010000; |
18
|
168
|
|
|
168
|
|
971
|
use warnings; |
|
168
|
|
|
|
|
366
|
|
|
168
|
|
|
|
|
5872
|
|
19
|
168
|
|
|
168
|
|
1046
|
use strict; |
|
168
|
|
|
|
|
406
|
|
|
168
|
|
|
|
|
4500
|
|
20
|
168
|
|
|
168
|
|
925
|
use integer; |
|
168
|
|
|
|
|
370
|
|
|
168
|
|
|
|
|
6053
|
|
21
|
168
|
|
|
168
|
|
4898
|
use utf8; |
|
168
|
|
|
|
|
397
|
|
|
168
|
|
|
|
|
943
|
|
22
|
168
|
|
|
168
|
|
4435
|
use IO::File; |
|
168
|
|
|
|
|
419
|
|
|
168
|
|
|
|
|
28071
|
|
23
|
|
|
|
|
|
|
#use re 'debug'; |
24
|
|
|
|
|
|
|
|
25
|
168
|
|
|
168
|
|
1184
|
use Date::Manip::Base; |
|
168
|
|
|
|
|
353
|
|
|
168
|
|
|
|
|
4217
|
|
26
|
168
|
|
|
168
|
|
953
|
use Date::Manip::TZ; |
|
168
|
|
|
|
|
472
|
|
|
168
|
|
|
|
|
2365528
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
our $VERSION; |
29
|
|
|
|
|
|
|
$VERSION='6.90'; |
30
|
168
|
|
|
168
|
|
2526
|
END { undef $VERSION; } |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
######################################################################## |
33
|
|
|
|
|
|
|
# BASE METHODS |
34
|
|
|
|
|
|
|
######################################################################## |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub is_recur { |
37
|
1
|
|
|
1
|
1
|
116
|
return 1; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# Call this every time a new recur is put in to make sure everything is |
41
|
|
|
|
|
|
|
# correctly initialized. |
42
|
|
|
|
|
|
|
# |
43
|
|
|
|
|
|
|
sub _init { |
44
|
1718
|
|
|
1718
|
|
2998
|
my($self) = @_; |
45
|
1718
|
|
|
|
|
3782
|
my $dmt = $$self{'tz'}; |
46
|
1718
|
|
|
|
|
2782
|
my $dmb = $$dmt{'base'}; |
47
|
|
|
|
|
|
|
|
48
|
1718
|
|
|
|
|
2890
|
$$self{'err'} = ''; |
49
|
|
|
|
|
|
|
|
50
|
1718
|
|
|
|
|
3031
|
$$self{'data'}{'freq'} = ''; # The frequency |
51
|
1718
|
|
|
|
|
3416
|
$$self{'data'}{'flags'} = []; # Modifiers |
52
|
1718
|
|
|
|
|
3848
|
$$self{'data'}{'base'} = undef; # The specified base date |
53
|
1718
|
|
|
|
|
2710
|
$$self{'data'}{'BASE'} = undef; # The actual base date |
54
|
1718
|
|
|
|
|
3511
|
$$self{'data'}{'start'} = undef; # Start and end date |
55
|
1718
|
|
|
|
|
3320
|
$$self{'data'}{'end'} = undef; |
56
|
1718
|
|
|
|
|
2644
|
$$self{'data'}{'unmod_range'} = 0; # If this is 1, the start/end range |
57
|
|
|
|
|
|
|
# refer to the unmodified dates, not the |
58
|
|
|
|
|
|
|
# final dates. |
59
|
|
|
|
|
|
|
|
60
|
1718
|
|
|
|
|
3373
|
$$self{'data'}{'interval'} = []; # (Y, M, ...) |
61
|
1718
|
|
|
|
|
3805
|
$$self{'data'}{'rtime'} = []; # ( [ VAL_OR_RANGE, VAL_OR_RANGE, ... ], |
62
|
|
|
|
|
|
|
# [ VAL_OR_RANGE, VAL_OR_RANGE, ... ], |
63
|
|
|
|
|
|
|
# ... ) |
64
|
1718
|
|
|
|
|
2717
|
$$self{'data'}{'slow'} = 0; # 1 if a range of the form 2--2 is |
65
|
|
|
|
|
|
|
# included. |
66
|
1718
|
|
|
|
|
2769
|
$$self{'data'}{'ev_per_d'} = 0; # The number of events per interval date. |
67
|
1718
|
|
|
|
|
4486
|
$$self{'data'}{'delta'} = undef; # The offset based on the interval. |
68
|
1718
|
|
|
|
|
2803
|
$$self{'data'}{'noint'} = 1; # 0 if an interval is present |
69
|
|
|
|
|
|
|
# 1 if no interval is present and dates |
70
|
|
|
|
|
|
|
# not done |
71
|
|
|
|
|
|
|
# 2 if no interval is present and dates |
72
|
|
|
|
|
|
|
# done |
73
|
|
|
|
|
|
|
|
74
|
1718
|
|
|
|
|
7201
|
$$self{'data'}{'idate'} = {}; # Non-slow: |
75
|
|
|
|
|
|
|
# { N => Nth interval date } |
76
|
|
|
|
|
|
|
# Slow: |
77
|
|
|
|
|
|
|
# { N => [Nth interval date,X,Y] } |
78
|
|
|
|
|
|
|
# [X,Y] are the first/last event indices |
79
|
|
|
|
|
|
|
# generated by this interval date. |
80
|
1718
|
|
|
|
|
6399
|
$$self{'data'}{'dates'} = {}; # { N => Nth recurring event } |
81
|
|
|
|
|
|
|
# N is relative to the base date and is |
82
|
|
|
|
|
|
|
# not affected by start/end |
83
|
1718
|
|
|
|
|
3267
|
$$self{'data'}{'curr'} = undef; # Iterator pointer |
84
|
1718
|
|
|
|
|
2699
|
$$self{'data'}{'first'} = undef; # N : the first date in a range |
85
|
1718
|
|
|
|
|
2649
|
$$self{'data'}{'last'} = undef; # N : the last date in a range |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# Get the default start/end dates |
88
|
|
|
|
|
|
|
|
89
|
1718
|
|
|
|
|
5447
|
my $range = $dmb->_config('recurrange'); |
90
|
|
|
|
|
|
|
|
91
|
1718
|
50
|
|
|
|
3904
|
if ($range eq 'none') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
92
|
1718
|
|
|
|
|
2746
|
$$self{'data'}{'start'} = undef; |
93
|
1718
|
|
|
|
|
3277
|
$$self{'data'}{'end'} = undef; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
} elsif ($range eq 'year') { |
96
|
0
|
|
|
|
|
0
|
my $y = $dmt->_now('y',1); |
97
|
0
|
|
|
|
|
0
|
my $start = $self->new_date(); |
98
|
0
|
|
|
|
|
0
|
my $end = $self->new_date(); |
99
|
0
|
|
|
|
|
0
|
$start->set('date',[$y, 1, 1,00,00,00]); |
100
|
0
|
|
|
|
|
0
|
$end->set ('date',[$y,12,31,23,59,59]); |
101
|
0
|
|
|
|
|
0
|
$$self{'data'}{'start'} = $start; |
102
|
0
|
|
|
|
|
0
|
$$self{'data'}{'end'} = $end; |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
} elsif ($range eq 'month') { |
105
|
0
|
|
|
|
|
0
|
my ($y,$m) = $dmt->_now('now',1); |
106
|
0
|
|
|
|
|
0
|
my $dim = $dmb->days_in_month($y,$m); |
107
|
0
|
|
|
|
|
0
|
my $start = $self->new_date(); |
108
|
0
|
|
|
|
|
0
|
my $end = $self->new_date(); |
109
|
0
|
|
|
|
|
0
|
$start->set('date',[$y,$m, 1,00,00,00]); |
110
|
0
|
|
|
|
|
0
|
$end->set ('date',[$y,$m,$dim,23,59,59]); |
111
|
0
|
|
|
|
|
0
|
$$self{'data'}{'start'} = $start; |
112
|
0
|
|
|
|
|
0
|
$$self{'data'}{'end'} = $end; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
} elsif ($range eq 'week') { |
115
|
0
|
|
|
|
|
0
|
my($y,$m,$d) = $dmt->_now('now',1); |
116
|
0
|
|
|
|
|
0
|
my $w; |
117
|
0
|
|
|
|
|
0
|
($y,$w) = $dmb->week_of_year([$y,$m,$d]); |
118
|
0
|
|
|
|
|
0
|
($y,$m,$d) = @{ $dmb->week_of_year($y,$w) }; |
|
0
|
|
|
|
|
0
|
|
119
|
|
|
|
|
|
|
my($yy,$mm,$dd) |
120
|
0
|
|
|
|
|
0
|
= @{ $dmb->_calc_date_ymwd([$y,$m,$d], [0,0,0,6], 0) }; |
|
0
|
|
|
|
|
0
|
|
121
|
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
0
|
my $start = $self->new_date(); |
123
|
0
|
|
|
|
|
0
|
my $end = $self->new_date(); |
124
|
0
|
|
|
|
|
0
|
$start->set('date',[$y, $m, $d, 00,00,00]); |
125
|
0
|
|
|
|
|
0
|
$end->set ('date',[$yy,$mm,$dd,23,59,59]); |
126
|
0
|
|
|
|
|
0
|
$$self{'data'}{'start'} = $start; |
127
|
0
|
|
|
|
|
0
|
$$self{'data'}{'end'} = $end; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
} elsif ($range eq 'day') { |
130
|
0
|
|
|
|
|
0
|
my($y,$m,$d) = $dmt->_now('now',1); |
131
|
0
|
|
|
|
|
0
|
my $start = $self->new_date(); |
132
|
0
|
|
|
|
|
0
|
my $end = $self->new_date(); |
133
|
0
|
|
|
|
|
0
|
$start->set('date',[$y,$m,$d,00,00,00]); |
134
|
0
|
|
|
|
|
0
|
$end->set ('date',[$y,$m,$d,23,59,59]); |
135
|
0
|
|
|
|
|
0
|
$$self{'data'}{'start'} = $start; |
136
|
0
|
|
|
|
|
0
|
$$self{'data'}{'end'} = $end; |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
} elsif ($range eq 'all') { |
139
|
0
|
|
|
|
|
0
|
my $start = $self->new_date(); |
140
|
0
|
|
|
|
|
0
|
my $end = $self->new_date(); |
141
|
0
|
|
|
|
|
0
|
$start->set('date',[0001,02,01,00,00,00]); |
142
|
0
|
|
|
|
|
0
|
$end->set ('date',[9999,11,30,23,59,59]); |
143
|
0
|
|
|
|
|
0
|
$$self{'data'}{'start'} = $start; |
144
|
0
|
|
|
|
|
0
|
$$self{'data'}{'end'} = $end; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# If $keep is 1, it will keep any existing base date and cached |
149
|
|
|
|
|
|
|
# dates, but it will reset other things. |
150
|
|
|
|
|
|
|
# |
151
|
|
|
|
|
|
|
sub _init_dates { |
152
|
1603
|
|
|
1603
|
|
3119
|
my($self,$keep) = @_; |
153
|
|
|
|
|
|
|
|
154
|
1603
|
100
|
|
|
|
3357
|
if (! $keep) { |
155
|
1097
|
|
|
|
|
3165
|
$$self{'data'}{'base'} = undef; |
156
|
1097
|
|
|
|
|
2102
|
$$self{'data'}{'BASE'} = undef; |
157
|
1097
|
|
|
|
|
13106
|
$$self{'data'}{'idate'} = {}; |
158
|
1097
|
|
|
|
|
8588
|
$$self{'data'}{'dates'} = {}; |
159
|
|
|
|
|
|
|
} |
160
|
1603
|
|
|
|
|
2809
|
$$self{'data'}{'curr'} = undef; |
161
|
1603
|
|
|
|
|
2599
|
$$self{'data'}{'first'} = undef; |
162
|
1603
|
|
|
|
|
3163
|
$$self{'data'}{'last'} = undef; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub _init_args { |
166
|
2
|
|
|
2
|
|
4
|
my($self) = @_; |
167
|
|
|
|
|
|
|
|
168
|
2
|
|
|
|
|
5
|
my @args = @{ $$self{'args'} }; |
|
2
|
|
|
|
|
5
|
|
169
|
2
|
|
|
|
|
8
|
$self->parse(@args); |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
######################################################################## |
173
|
|
|
|
|
|
|
# METHODS |
174
|
|
|
|
|
|
|
######################################################################## |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
sub parse { |
177
|
487
|
|
|
487
|
1
|
376472
|
my($self,$string,@args) = @_; |
178
|
487
|
|
|
|
|
1620
|
$self->_init(); |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
# Test if $string = FREQ |
181
|
|
|
|
|
|
|
|
182
|
487
|
|
|
|
|
1504
|
my $err = $self->frequency($string); |
183
|
487
|
100
|
|
|
|
1270
|
if (! $err) { |
184
|
364
|
|
|
|
|
677
|
$string = ''; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# Test if $string = "FREQ*..." and FREQ contains an '*'. |
188
|
|
|
|
|
|
|
|
189
|
487
|
100
|
|
|
|
1119
|
if ($err) { |
190
|
123
|
|
|
|
|
584
|
$self->err(1); |
191
|
|
|
|
|
|
|
|
192
|
123
|
|
|
|
|
864
|
$string =~ s/\s*\*\s*/\*/g; |
193
|
|
|
|
|
|
|
|
194
|
123
|
50
|
|
|
|
601
|
if ($string =~ /^([^*]*\*[^*]*)\*/) { |
195
|
|
|
|
|
|
|
# Everything up to the 2nd '*' |
196
|
123
|
|
|
|
|
370
|
my $freq = $1; |
197
|
123
|
|
|
|
|
365
|
$err = $self->frequency($freq); |
198
|
123
|
50
|
|
|
|
327
|
if (! $err) { |
199
|
123
|
|
|
|
|
2117
|
$string =~ s/^\Q$freq\E\*//; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
} else { |
202
|
0
|
|
|
|
|
0
|
$err = 1; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
# Test if $string = "FREQ*..." and FREQ does NOT contains an '*'. |
207
|
|
|
|
|
|
|
|
208
|
487
|
50
|
|
|
|
1258
|
if ($err) { |
209
|
0
|
|
|
|
|
0
|
$self->err(1); |
210
|
|
|
|
|
|
|
|
211
|
0
|
0
|
|
|
|
0
|
if ($string =~ s/^([^*]*)\*//) { |
212
|
|
|
|
|
|
|
# Everything up to he 1st '*' |
213
|
0
|
|
|
|
|
0
|
my $freq = $1; |
214
|
0
|
|
|
|
|
0
|
$err = $self->frequency($freq); |
215
|
0
|
0
|
|
|
|
0
|
if (! $err) { |
216
|
0
|
|
|
|
|
0
|
$string =~ s/^\Q$freq\E\*//; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
} else { |
219
|
0
|
|
|
|
|
0
|
$err = 1; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
487
|
50
|
|
|
|
1034
|
if ($err) { |
224
|
0
|
|
|
|
|
0
|
$$self{'err'} = "[parse] Invalid frequency string"; |
225
|
0
|
|
|
|
|
0
|
return 1; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# Handle MODIFIERS from string and arguments |
229
|
|
|
|
|
|
|
|
230
|
487
|
|
|
|
|
1282
|
my @string = split(/\*/,$string); |
231
|
|
|
|
|
|
|
|
232
|
487
|
100
|
|
|
|
1173
|
if (@string) { |
233
|
123
|
|
|
|
|
250
|
my $tmp = shift(@string); |
234
|
123
|
100
|
|
|
|
481
|
$err = $self->modifiers($tmp) if ($tmp); |
235
|
123
|
50
|
|
|
|
361
|
return 1 if ($err); |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
487
|
100
|
|
|
|
1066
|
if (@args) { |
239
|
266
|
|
|
|
|
486
|
my $tmp = $args[0]; |
240
|
266
|
100
|
66
|
|
|
1020
|
if ($tmp && ! ref($tmp)) { |
241
|
207
|
|
|
|
|
761
|
$err = $self->modifiers($tmp); |
242
|
207
|
100
|
|
|
|
589
|
shift(@args) if (! $err); |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
# Handle BASE |
247
|
|
|
|
|
|
|
|
248
|
487
|
100
|
|
|
|
1133
|
if (@string) { |
249
|
25
|
|
|
|
|
93
|
my $tmp = shift(@string); |
250
|
25
|
100
|
66
|
|
|
167
|
$err = $self->basedate($tmp) if (defined($tmp) && $tmp); |
251
|
25
|
50
|
|
|
|
80
|
return 1 if ($err); |
252
|
|
|
|
|
|
|
} |
253
|
487
|
100
|
|
|
|
1073
|
if (@args) { |
254
|
265
|
|
|
|
|
469
|
my $tmp = shift(@args); |
255
|
265
|
100
|
66
|
|
|
1163
|
$err = $self->basedate($tmp) if (defined($tmp) && $tmp); |
256
|
265
|
50
|
|
|
|
620
|
return 1 if ($err); |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
# Handle START, END, UNMOD |
260
|
|
|
|
|
|
|
|
261
|
487
|
100
|
|
|
|
1091
|
if (@string) { |
262
|
24
|
|
|
|
|
83
|
my($start) = shift(@string); |
263
|
24
|
|
|
|
|
60
|
my($end) = shift(@string); |
264
|
24
|
|
|
|
|
56
|
my($unmod) = shift(@string); |
265
|
|
|
|
|
|
|
|
266
|
24
|
50
|
33
|
|
|
230
|
$err = $self->start($start,$unmod) if (defined($start) && $start); |
267
|
24
|
50
|
|
|
|
95
|
return 1 if ($err); |
268
|
|
|
|
|
|
|
|
269
|
24
|
50
|
33
|
|
|
225
|
$err = $self->end($end) if (defined($end) && $end); |
270
|
24
|
50
|
|
|
|
115
|
return 1 if ($err); |
271
|
|
|
|
|
|
|
} |
272
|
487
|
100
|
|
|
|
1040
|
if (@args) { |
273
|
265
|
|
|
|
|
546
|
my($start) = shift(@args); |
274
|
265
|
|
|
|
|
510
|
my($end) = shift(@args); |
275
|
265
|
|
|
|
|
445
|
my($unmod) = shift(@args); |
276
|
|
|
|
|
|
|
|
277
|
265
|
100
|
66
|
|
|
1339
|
$err = $self->start($start,$unmod) if (defined($start) && $start); |
278
|
265
|
50
|
|
|
|
774
|
return 1 if ($err); |
279
|
|
|
|
|
|
|
|
280
|
265
|
100
|
66
|
|
|
1293
|
$err = $self->end($end) if (defined($end) && $end); |
281
|
265
|
50
|
|
|
|
818
|
return 1 if ($err); |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
# Remaining arguments are invalid. |
285
|
|
|
|
|
|
|
|
286
|
487
|
50
|
|
|
|
1146
|
if (@string) { |
287
|
0
|
|
|
|
|
0
|
$$self{'err'} = "[parse] String contains invalid elements"; |
288
|
0
|
|
|
|
|
0
|
return 1; |
289
|
|
|
|
|
|
|
} |
290
|
487
|
50
|
|
|
|
1066
|
if (@args) { |
291
|
0
|
|
|
|
|
0
|
$$self{'err'} = "[parse] Unknown arguments"; |
292
|
0
|
|
|
|
|
0
|
return 1; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
487
|
|
|
|
|
1351
|
return 0; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
sub frequency { |
299
|
942
|
|
|
942
|
1
|
370035
|
my($self,$string) = @_; |
300
|
942
|
50
|
|
|
|
2357
|
return $$self{'data'}{'freq'} if (! defined $string); |
301
|
|
|
|
|
|
|
|
302
|
942
|
|
|
|
|
2359
|
$self->_init(); |
303
|
942
|
|
|
|
|
1605
|
my (@int,@rtime); |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
PARSE: { |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
# Standard frequency notation |
308
|
|
|
|
|
|
|
|
309
|
942
|
|
|
|
|
1478
|
my $stdrx = $self->_rx('std'); |
|
942
|
|
|
|
|
2618
|
|
310
|
942
|
100
|
|
|
|
10219
|
if ($string =~ $stdrx) { |
311
|
782
|
|
|
|
|
8242
|
my($l,$r) = @+{qw(l r)}; |
312
|
|
|
|
|
|
|
|
313
|
782
|
50
|
|
|
|
2922
|
if (defined($l)) { |
314
|
782
|
|
|
|
|
1977
|
$l =~ s/^\s*:/0:/; |
315
|
782
|
|
|
|
|
1712
|
$l =~ s/:\s*$/:0/; |
316
|
782
|
|
|
|
|
1341
|
$l =~ s/::/:0:/g; |
317
|
|
|
|
|
|
|
|
318
|
782
|
|
|
|
|
2519
|
@int = split(/:/,$l); |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
782
|
50
|
|
|
|
1776
|
if (defined($r)) { |
322
|
782
|
|
|
|
|
1986
|
$r =~ s/^\s*:/0:/; |
323
|
782
|
|
|
|
|
2458
|
$r =~ s/:\s*$/:0/; |
324
|
782
|
|
|
|
|
1448
|
$r =~ s/::/:0:/g; |
325
|
|
|
|
|
|
|
|
326
|
782
|
|
|
|
|
2186
|
@rtime = split(/:/,$r); |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
|
329
|
782
|
|
|
|
|
1840
|
last PARSE; |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
# Other frequency strings |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# Strip out some words to ignore |
335
|
|
|
|
|
|
|
|
336
|
160
|
|
|
|
|
486
|
my $ignrx = $self->_rx('ignore'); |
337
|
160
|
|
|
|
|
1440
|
$string =~ s/$ignrx/ /g; |
338
|
|
|
|
|
|
|
|
339
|
160
|
|
|
|
|
426
|
my $eachrx = $self->_rx('each'); |
340
|
160
|
|
|
|
|
287
|
my $each = 0; |
341
|
160
|
100
|
|
|
|
1160
|
if ($string =~ s/$eachrx/ /g) { |
342
|
28
|
|
|
|
|
55
|
$each = 1; |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
|
345
|
160
|
|
|
|
|
1099
|
$string =~ s/\s*$//; |
346
|
|
|
|
|
|
|
|
347
|
160
|
50
|
|
|
|
433
|
if (! $string) { |
348
|
0
|
|
|
|
|
0
|
$$self{'err'} = "[frequency] Invalid frequency string"; |
349
|
0
|
|
|
|
|
0
|
return 1; |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
160
|
|
|
|
|
472
|
my $err = $self->_parse_lang($string); |
353
|
160
|
100
|
|
|
|
439
|
if ($err) { |
354
|
128
|
|
|
|
|
279
|
$$self{'err'} = "[frequency] Invalid frequency string"; |
355
|
128
|
|
|
|
|
336
|
return 1; |
356
|
|
|
|
|
|
|
} |
357
|
32
|
|
|
|
|
79
|
return 0; |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
# If the interval consists only of zeros, the last entry is changed |
361
|
|
|
|
|
|
|
# to 1. |
362
|
|
|
|
|
|
|
|
363
|
782
|
100
|
|
|
|
1953
|
if (@int) { |
364
|
552
|
|
|
|
|
1113
|
for my $i (@int) { |
365
|
1078
|
|
|
|
|
2001
|
$i += 0; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
TEST_INT: { |
369
|
552
|
|
|
|
|
789
|
for my $i (@int) { |
|
552
|
|
|
|
|
979
|
|
370
|
787
|
100
|
|
|
|
1875
|
last TEST_INT if ($i); |
371
|
|
|
|
|
|
|
} |
372
|
75
|
|
|
|
|
159
|
$int[$#int] = 1; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
# If @int contains 2 or 3 elements and ends in 0, move the trailing |
377
|
|
|
|
|
|
|
# 0 to the start of @rtime. |
378
|
|
|
|
|
|
|
# |
379
|
|
|
|
|
|
|
# Y:M:0 * D:H:MN:S => Y:M * 0:D:H:MN:S |
380
|
|
|
|
|
|
|
|
381
|
782
|
|
100
|
|
|
4756
|
while (@int && |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
382
|
|
|
|
|
|
|
($#int == 1 || $#int == 2) && |
383
|
|
|
|
|
|
|
($int[$#int] == 0)) { |
384
|
101
|
|
|
|
|
185
|
pop(@int); |
385
|
101
|
|
|
|
|
527
|
unshift(@rtime,0); |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# We need to know what the valid values of M, W, and D are. |
389
|
|
|
|
|
|
|
# |
390
|
|
|
|
|
|
|
# Month can be: |
391
|
|
|
|
|
|
|
# moy : 1 to 12 (month of the year) |
392
|
|
|
|
|
|
|
# |
393
|
|
|
|
|
|
|
# Week can be: |
394
|
|
|
|
|
|
|
# woy : 1 to 53 or -1 to -53 (week of the year) |
395
|
|
|
|
|
|
|
# wom : 1 to 5 or -1 to -5 (week of the month) |
396
|
|
|
|
|
|
|
# |
397
|
|
|
|
|
|
|
# Day can be: |
398
|
|
|
|
|
|
|
# doy : 1 to 366 or -1 to -366 (day of the year) |
399
|
|
|
|
|
|
|
# dom : 1 to DiM or -1 to -31 (day of the month) |
400
|
|
|
|
|
|
|
# dow : 1 to 7 (day of the week) |
401
|
|
|
|
|
|
|
# |
402
|
|
|
|
|
|
|
# Other values must be zero or positive. |
403
|
|
|
|
|
|
|
|
404
|
782
|
|
|
|
|
2474
|
my @ftype = ('y','m','w','d','h','mn','s'); |
405
|
782
|
|
|
|
|
1875
|
my @vtype = ('' ,'' ,'' ,'' ,'' ,'' ,''); |
406
|
|
|
|
|
|
|
|
407
|
782
|
|
|
|
|
2024
|
my ($y,$m,$w,$d,$h,$mn,$s) = (@int,@rtime); |
408
|
|
|
|
|
|
|
|
409
|
782
|
100
|
|
|
|
1875
|
if (@rtime == 7) { |
410
|
230
|
|
|
|
|
419
|
$vtype[0] = 'y'; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
782
|
100
|
|
|
|
1826
|
if (@rtime >= 6) { |
414
|
547
|
100
|
|
|
|
1135
|
if ($m) { |
415
|
371
|
|
|
|
|
625
|
$vtype[1] = 'moy'; |
416
|
|
|
|
|
|
|
} else { |
417
|
176
|
|
|
|
|
296
|
$vtype[1] = 'zero'; |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
|
421
|
782
|
100
|
|
|
|
1648
|
if (@rtime >= 5) { |
422
|
685
|
100
|
|
|
|
1316
|
if ($w) { |
423
|
329
|
100
|
|
|
|
687
|
if ($m) { |
424
|
226
|
|
|
|
|
385
|
$vtype[2] = 'wom'; |
425
|
|
|
|
|
|
|
} else { |
426
|
103
|
|
|
|
|
173
|
$vtype[2] = 'woy'; |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
} else { |
429
|
356
|
|
|
|
|
662
|
$vtype[2] = 'zero'; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
|
433
|
782
|
100
|
|
|
|
1727
|
if (@rtime >= 4) { |
434
|
727
|
100
|
|
|
|
1374
|
if ($d) { |
435
|
528
|
100
|
|
|
|
1203
|
if ($w) { |
|
|
100
|
|
|
|
|
|
436
|
226
|
|
|
|
|
407
|
$vtype[3] = 'dow'; |
437
|
|
|
|
|
|
|
} elsif ($m) { |
438
|
247
|
|
|
|
|
433
|
$vtype[3] = 'dom'; |
439
|
|
|
|
|
|
|
} else { |
440
|
55
|
|
|
|
|
110
|
$vtype[3] = 'doy'; |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
} else { |
443
|
199
|
|
|
|
|
315
|
$vtype[3] = 'zero'; |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
|
447
|
782
|
100
|
|
|
|
1690
|
if (@rtime >= 3) { |
448
|
766
|
|
|
|
|
1196
|
$vtype[4] = 'time'; |
449
|
|
|
|
|
|
|
} |
450
|
782
|
100
|
|
|
|
1705
|
if (@rtime >= 2) { |
451
|
771
|
|
|
|
|
1203
|
$vtype[5] = 'time'; |
452
|
|
|
|
|
|
|
} |
453
|
782
|
100
|
|
|
|
1602
|
if (@rtime) { |
454
|
771
|
|
|
|
|
1077
|
$vtype[6] = 'time'; |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
# Test the format of @rtime. |
458
|
|
|
|
|
|
|
# |
459
|
|
|
|
|
|
|
# Turn it to: |
460
|
|
|
|
|
|
|
# @rtime = ( NUM|RANGE, NUM|RANGE, ...) |
461
|
|
|
|
|
|
|
# where |
462
|
|
|
|
|
|
|
# NUM is an integer |
463
|
|
|
|
|
|
|
# RANGE is [NUM1,NUM2] |
464
|
|
|
|
|
|
|
|
465
|
782
|
|
|
|
|
1879
|
my $rfieldrx = $self->_rx('rfield'); |
466
|
782
|
|
|
|
|
1635
|
my $rrangerx = $self->_rx('rrange'); |
467
|
|
|
|
|
|
|
|
468
|
782
|
|
|
|
|
1254
|
my $i = -1; |
469
|
782
|
|
|
|
|
1548
|
foreach my $f (@int,@rtime) { |
470
|
4772
|
|
|
|
|
6175
|
$i++; |
471
|
4772
|
|
|
|
|
6775
|
my $vtype = $vtype[$i]; |
472
|
4772
|
|
|
|
|
6002
|
my $type = $ftype[$i]; |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
# $f 3 -6 2-3 1,5-6 |
475
|
|
|
|
|
|
|
# $type y m w d h mn s |
476
|
|
|
|
|
|
|
# $vtype '' dom woy time ('' is a frequency field) |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
# Ignore the frequency part |
479
|
4772
|
100
|
|
|
|
8332
|
next if (! $vtype); |
480
|
|
|
|
|
|
|
|
481
|
3795
|
100
|
100
|
|
|
20196
|
if ($f && $f !~ $rfieldrx) { |
482
|
1
|
|
|
|
|
5
|
$$self{'err'} = "[frequency] Invalid rtime string"; |
483
|
1
|
|
|
|
|
6
|
return 1; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
3794
|
|
|
|
|
8225
|
my @rfield = split(/,/,$f); |
487
|
3794
|
|
|
|
|
4987
|
my @val; |
488
|
|
|
|
|
|
|
|
489
|
3794
|
|
|
|
|
5478
|
foreach my $vals (@rfield) { |
490
|
3858
|
100
|
|
|
|
14702
|
if ($vals =~ $rrangerx) { |
491
|
73
|
|
|
|
|
374
|
my ($num1,$num2) = ($1+0,$2+0); |
492
|
|
|
|
|
|
|
|
493
|
73
|
|
|
|
|
236
|
my $err = $self->_frequency_values($num1,$type,$vtype); |
494
|
73
|
100
|
|
|
|
184
|
return $err if ($err); |
495
|
|
|
|
|
|
|
|
496
|
72
|
|
|
|
|
169
|
$err = $self->_frequency_values($num2,$type,$vtype); |
497
|
72
|
50
|
|
|
|
207
|
return $err if ($err); |
498
|
|
|
|
|
|
|
|
499
|
72
|
100
|
100
|
|
|
343
|
if ( ($num1 > 0 && $num2 > 0) || |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
500
|
|
|
|
|
|
|
($num1 < 0 && $num2 < 0) ) { |
501
|
66
|
100
|
|
|
|
155
|
if ($num1 > $num2) { |
502
|
2
|
|
|
|
|
7
|
$$self{'err'} = "[frequency] Invalid rtime range string"; |
503
|
2
|
|
|
|
|
13
|
return 1; |
504
|
|
|
|
|
|
|
} |
505
|
64
|
|
|
|
|
243
|
push(@val,$num1..$num2); |
506
|
|
|
|
|
|
|
} else { |
507
|
6
|
|
|
|
|
26
|
push(@val,[$num1,$num2]); |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
} else { |
511
|
3785
|
|
|
|
|
6341
|
$vals += 0; |
512
|
|
|
|
|
|
|
|
513
|
3785
|
|
|
|
|
7304
|
my $err = $self->_frequency_values($vals,$type,$vtype); |
514
|
3785
|
100
|
|
|
|
7345
|
return $err if ($err); |
515
|
|
|
|
|
|
|
|
516
|
3609
|
|
|
|
|
6635
|
push(@val,$vals); |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
|
520
|
3615
|
|
|
|
|
9004
|
$f = [ @val ]; |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
# Store it |
524
|
|
|
|
|
|
|
|
525
|
602
|
|
|
|
|
1617
|
$$self{'data'}{'interval'} = [ @int ]; |
526
|
602
|
|
|
|
|
1580
|
$$self{'data'}{'rtime'} = [ @rtime ]; |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
# Analyze the rtime to see if it's slow, and to get the number of |
529
|
|
|
|
|
|
|
# events per interval date. |
530
|
|
|
|
|
|
|
|
531
|
602
|
|
|
|
|
1562
|
my $freq = join(':',@int); |
532
|
602
|
|
|
|
|
957
|
my $slow = 0; |
533
|
602
|
|
|
|
|
855
|
my $n = 1; |
534
|
602
|
100
|
|
|
|
1328
|
if (@rtime) { |
535
|
591
|
|
|
|
|
1044
|
$freq .= '*'; |
536
|
591
|
|
|
|
|
794
|
my (@tmp); |
537
|
|
|
|
|
|
|
|
538
|
591
|
|
|
|
|
1080
|
foreach my $rtime (@rtime) { |
539
|
3418
|
|
|
|
|
4037
|
my @t2; |
540
|
3418
|
|
|
|
|
4712
|
foreach my $tmp (@$rtime) { |
541
|
3694
|
100
|
|
|
|
5368
|
if (ref($tmp)) { |
542
|
6
|
|
|
|
|
14
|
my($a,$b) = @$tmp; |
543
|
6
|
|
|
|
|
30
|
push(@t2,"$a-$b"); |
544
|
6
|
|
|
|
|
13
|
$slow = 1; |
545
|
|
|
|
|
|
|
} else { |
546
|
3688
|
|
|
|
|
5841
|
push(@t2,$tmp); |
547
|
|
|
|
|
|
|
} |
548
|
|
|
|
|
|
|
} |
549
|
3418
|
|
|
|
|
5687
|
my $tmp = join(',',@t2); |
550
|
3418
|
|
|
|
|
5133
|
push(@tmp,$tmp); |
551
|
3418
|
|
|
|
|
4286
|
my $nn = @t2; |
552
|
3418
|
|
|
|
|
5667
|
$n *= $nn; |
553
|
|
|
|
|
|
|
} |
554
|
591
|
|
|
|
|
1916
|
$freq .= join(':',@tmp); |
555
|
|
|
|
|
|
|
} |
556
|
602
|
|
|
|
|
1308
|
$$self{'data'}{'freq'} = $freq; |
557
|
602
|
|
|
|
|
1029
|
$$self{'data'}{'slow'} = $slow; |
558
|
602
|
100
|
|
|
|
1456
|
$$self{'data'}{'ev_per_d'} = $n if (! $slow); |
559
|
|
|
|
|
|
|
|
560
|
602
|
100
|
|
|
|
1238
|
if (@int) { |
561
|
436
|
|
|
|
|
739
|
$$self{'data'}{'noint'} = 0; |
562
|
|
|
|
|
|
|
|
563
|
436
|
|
|
|
|
1011
|
while (@int < 7) { |
564
|
2256
|
|
|
|
|
3995
|
push(@int,0); |
565
|
|
|
|
|
|
|
} |
566
|
436
|
|
|
|
|
1823
|
my $delta = $self->new_delta(); |
567
|
436
|
|
|
|
|
2422
|
$delta->set('delta',[@int]); |
568
|
436
|
|
|
|
|
1235
|
$$self{'data'}{'delta'} = $delta; |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
} else { |
571
|
166
|
|
|
|
|
275
|
$$self{'data'}{'noint'} = 1; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
|
574
|
602
|
|
|
|
|
2859
|
return 0; |
575
|
|
|
|
|
|
|
} |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
sub _frequency_values { |
578
|
3930
|
|
|
3930
|
|
7273
|
my($self,$num,$type,$vtype) = @_; |
579
|
3930
|
|
|
|
|
4839
|
my $err; |
580
|
|
|
|
|
|
|
|
581
|
3930
|
100
|
|
|
|
11378
|
if ($type eq 'y') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
582
|
248
|
50
|
|
|
|
540
|
if ($vtype eq 'y') { |
583
|
248
|
100
|
100
|
|
|
942
|
if ($num < 0 || $num > 9999) { |
584
|
16
|
|
|
|
|
42
|
$$self{'err'} = "[frequency] Year must be in the range 1-9999"; |
585
|
16
|
|
|
|
|
34
|
return 1; |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
} elsif ($type eq 'm') { |
590
|
572
|
100
|
|
|
|
1205
|
if ($vtype eq 'moy') { |
591
|
404
|
100
|
100
|
|
|
1529
|
if ($num < 1 || $num > 12) { |
592
|
34
|
|
|
|
|
74
|
$$self{'err'} = "[frequency] Month of year must be 1-12"; |
593
|
34
|
|
|
|
|
71
|
return 1; |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
} elsif ($type eq 'w') { |
598
|
670
|
100
|
|
|
|
2049
|
if ($vtype eq 'woy') { |
|
|
100
|
|
|
|
|
|
599
|
103
|
100
|
66
|
|
|
624
|
if ($num == 0 || $num > 53 || $num < -53) { |
|
|
|
100
|
|
|
|
|
600
|
22
|
|
|
|
|
43
|
$$self{'err'} = "[frequency] Week of year must be 1-53 or -1 to -53"; |
601
|
22
|
|
|
|
|
47
|
return 1; |
602
|
|
|
|
|
|
|
} |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
} elsif ($vtype eq 'wom') { |
605
|
235
|
100
|
66
|
|
|
1332
|
if ($num == 0 || $num > 5 || $num < -5) { |
|
|
|
100
|
|
|
|
|
606
|
31
|
|
|
|
|
53
|
$$self{'err'} = "[frequency] Week of month must be 1-5 or -1 to -5"; |
607
|
31
|
|
|
|
|
61
|
return 1; |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
} |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
} elsif ($type eq 'd') { |
613
|
635
|
100
|
|
|
|
1925
|
if ($vtype eq 'dow') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
614
|
190
|
100
|
100
|
|
|
897
|
if ($num < 1 || $num > 7) { |
615
|
36
|
|
|
|
|
67
|
$$self{'err'} = "[frequency] Day of week must be 1-7"; |
616
|
36
|
|
|
|
|
80
|
return 1; |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
} elsif ($vtype eq 'dom') { |
620
|
245
|
100
|
66
|
|
|
1614
|
if ($num == 0 || $num > 31 || $num < -31) { |
|
|
|
100
|
|
|
|
|
621
|
20
|
|
|
|
|
38
|
$$self{'err'} = "[frequency] Day of month must be 1-31 or -1 to -31"; |
622
|
20
|
|
|
|
|
44
|
return 1; |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
} elsif ($vtype eq 'doy') { |
626
|
55
|
100
|
66
|
|
|
362
|
if ($num == 0 || $num > 366 || $num < -366) { |
|
|
|
100
|
|
|
|
|
627
|
14
|
|
|
|
|
28
|
$$self{'err'} = "[frequency] Day of year must be 1-366 or -1 to -366"; |
628
|
14
|
|
|
|
|
29
|
return 1; |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
} elsif ($type eq 'h') { |
633
|
614
|
50
|
|
|
|
1439
|
if ($vtype eq 'time') { |
634
|
614
|
100
|
66
|
|
|
2287
|
if ($num < 0 || $num > 23) { |
635
|
1
|
|
|
|
|
9
|
$$self{'err'} = "[frequency] Hour must be 0-23"; |
636
|
1
|
|
|
|
|
8
|
return 1; |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
} else { |
641
|
1191
|
50
|
|
|
|
2436
|
if ($vtype eq 'time') { |
642
|
1191
|
100
|
66
|
|
|
3964
|
if ($num < 0 || $num > 59) { |
643
|
3
|
|
|
|
|
7
|
$$self{'err'} = "[frequency] Minute/second must be 0-59"; |
644
|
3
|
|
|
|
|
7
|
return 1; |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
|
649
|
3753
|
|
|
|
|
6904
|
return 0; |
650
|
|
|
|
|
|
|
} |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
sub _parse_lang { |
653
|
160
|
|
|
160
|
|
370
|
my($self,$string) = @_; |
654
|
160
|
|
|
|
|
294
|
my $dmt = $$self{'tz'}; |
655
|
160
|
|
|
|
|
263
|
my $dmb = $$dmt{'base'}; |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
# Test the regular expression |
658
|
|
|
|
|
|
|
|
659
|
160
|
|
|
|
|
387
|
my $rx = $self->_rx('every'); |
660
|
|
|
|
|
|
|
|
661
|
160
|
100
|
|
|
|
3010
|
return 1 if ($string !~ $rx); |
662
|
|
|
|
|
|
|
my($month,$week,$day,$last,$nth,$day_name,$day_abb,$mon_name,$mon_abb,$n,$y) = |
663
|
32
|
|
|
|
|
774
|
@+{qw(month week day last nth day_name day_abb mon_name mon_abb n y)}; |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
# Convert wordlist values to calendar values |
666
|
|
|
|
|
|
|
|
667
|
32
|
|
|
|
|
135
|
my $dow; |
668
|
32
|
100
|
66
|
|
|
170
|
if (defined($day_name) || defined($day_abb)) { |
669
|
16
|
50
|
|
|
|
44
|
if (defined($day_name)) { |
670
|
16
|
|
|
|
|
62
|
$dow = $$dmb{'data'}{'wordmatch'}{'day_name'}{lc($day_name)}; |
671
|
|
|
|
|
|
|
} else { |
672
|
0
|
|
|
|
|
0
|
$dow = $$dmb{'data'}{'wordmatch'}{'day_abb'}{lc($day_abb)}; |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
|
676
|
32
|
|
|
|
|
52
|
my $mmm; |
677
|
32
|
100
|
66
|
|
|
130
|
if (defined($mon_name) || defined($mon_abb)) { |
678
|
8
|
50
|
|
|
|
25
|
if (defined($mon_name)) { |
679
|
8
|
|
|
|
|
26
|
$mmm = $$dmb{'data'}{'wordmatch'}{'month_name'}{lc($mon_name)}; |
680
|
|
|
|
|
|
|
} else { |
681
|
0
|
|
|
|
|
0
|
$mmm = $$dmb{'data'}{'wordmatch'}{'month_abb'}{lc($mon_abb)}; |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
} |
684
|
|
|
|
|
|
|
|
685
|
32
|
100
|
|
|
|
86
|
if (defined($nth)) { |
686
|
14
|
|
|
|
|
62
|
$nth = $$dmb{'data'}{'wordmatch'}{'nth'}{lc($nth)}; |
687
|
|
|
|
|
|
|
} |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
# Get the frequencies |
690
|
|
|
|
|
|
|
|
691
|
32
|
|
|
|
|
50
|
my($freq); |
692
|
32
|
100
|
|
|
|
100
|
if (defined($dow)) { |
|
|
50
|
|
|
|
|
|
693
|
16
|
100
|
|
|
|
35
|
if (defined($mmm)) { |
694
|
8
|
100
|
|
|
|
24
|
if (defined($last)) { |
|
|
100
|
|
|
|
|
|
695
|
|
|
|
|
|
|
# last DoW in MMM [YY] |
696
|
2
|
|
|
|
|
12
|
$freq = "1*$mmm:-1:$dow:0:0:0"; |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
} elsif (defined($nth)) { |
699
|
|
|
|
|
|
|
# Nth DoW in MMM [YY] |
700
|
4
|
|
|
|
|
20
|
$freq = "1*$mmm:$nth:$dow:0:0:0"; |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
} else { |
703
|
|
|
|
|
|
|
# every DoW in MMM [YY] |
704
|
2
|
|
|
|
|
9
|
$freq = "1*$mmm:1-5:$dow:0:0:0"; |
705
|
|
|
|
|
|
|
} |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
} else { |
708
|
8
|
100
|
|
|
|
28
|
if (defined($last)) { |
|
|
100
|
|
|
|
|
|
709
|
|
|
|
|
|
|
# last DoW in every month [in YY] |
710
|
2
|
|
|
|
|
12
|
$freq = "0:1*-1:$dow:0:0:0"; |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
} elsif (defined($nth)) { |
713
|
|
|
|
|
|
|
# Nth DoW in every month [in YY] |
714
|
4
|
|
|
|
|
23
|
$freq = "0:1*$nth:$dow:0:0:0"; |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
} else { |
717
|
|
|
|
|
|
|
# every DoW in every month [in YY] |
718
|
2
|
|
|
|
|
7
|
$freq = "0:1*1-5:$dow:0:0:0"; |
719
|
|
|
|
|
|
|
} |
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
} elsif (defined($day)) { |
723
|
16
|
100
|
|
|
|
42
|
if (defined($month)) { |
724
|
8
|
100
|
|
|
|
22
|
if (defined($nth)) { |
|
|
100
|
|
|
|
|
|
725
|
|
|
|
|
|
|
# Nth day of every month [YY] |
726
|
4
|
|
|
|
|
18
|
$freq = "0:1*0:$nth:0:0:0"; |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
} elsif (defined($last)) { |
729
|
|
|
|
|
|
|
# last day of every month [YY] |
730
|
2
|
|
|
|
|
5
|
$freq = "0:1*0:-1:0:0:0"; |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
} else { |
733
|
|
|
|
|
|
|
# every day of every month [YY] |
734
|
2
|
|
|
|
|
5
|
$freq = "0:0:0:1*0:0:0"; |
735
|
|
|
|
|
|
|
} |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
} else { |
738
|
8
|
100
|
|
|
|
22
|
if (defined($nth)) { |
|
|
100
|
|
|
|
|
|
739
|
|
|
|
|
|
|
# every Nth day [YY] |
740
|
2
|
|
|
|
|
8
|
$freq = "0:0:0:$nth*0:0:0"; |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
} elsif (defined($n)) { |
743
|
|
|
|
|
|
|
# every N days [YY] |
744
|
4
|
|
|
|
|
19
|
$freq = "0:0:0:$n*0:0:0"; |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
} else { |
747
|
|
|
|
|
|
|
# every day [YY] |
748
|
2
|
|
|
|
|
5
|
$freq = "0:0:0:1*0:0:0"; |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
} |
751
|
|
|
|
|
|
|
} |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
# Get the range (if YY is included) |
754
|
|
|
|
|
|
|
|
755
|
32
|
100
|
|
|
|
72
|
if (defined($y)) { |
756
|
18
|
|
|
|
|
85
|
$y = $dmt->_fix_year($y); |
757
|
18
|
|
|
|
|
48
|
my $start = "${y}010100:00:00"; |
758
|
18
|
|
|
|
|
41
|
my $end = "${y}123123:59:59"; |
759
|
|
|
|
|
|
|
|
760
|
18
|
|
|
|
|
110
|
return $self->parse($freq,undef,$start,$end); |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
|
763
|
14
|
|
|
|
|
41
|
return $self->frequency($freq) |
764
|
|
|
|
|
|
|
} |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
sub _date { |
767
|
679
|
|
|
679
|
|
1301
|
my($self,$op,$date_or_string) = @_; |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
# Make sure the argument is a date |
770
|
|
|
|
|
|
|
|
771
|
679
|
50
|
|
|
|
1791
|
if (ref($date_or_string) eq 'Date::Manip::Date') { |
|
|
50
|
|
|
|
|
|
772
|
0
|
|
|
|
|
0
|
$$self{'data'}{$op} = $date_or_string; |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
} elsif (ref($date_or_string)) { |
775
|
0
|
|
|
|
|
0
|
$$self{'err'} = "[$op] Invalid date object"; |
776
|
0
|
|
|
|
|
0
|
return 1; |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
} else { |
779
|
679
|
|
|
|
|
2063
|
my $date = $self->new_date(); |
780
|
679
|
|
|
|
|
2062
|
my $err = $date->parse($date_or_string); |
781
|
679
|
50
|
|
|
|
1448
|
if ($err) { |
782
|
0
|
|
|
|
|
0
|
$$self{'err'} = "[$op] Invalid date string"; |
783
|
0
|
|
|
|
|
0
|
return 1; |
784
|
|
|
|
|
|
|
} |
785
|
679
|
|
|
|
|
1669
|
$$self{'data'}{$op} = $date; |
786
|
|
|
|
|
|
|
} |
787
|
|
|
|
|
|
|
|
788
|
679
|
|
|
|
|
1477
|
return 0; |
789
|
|
|
|
|
|
|
} |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
sub start { |
792
|
1019
|
|
|
1019
|
1
|
2932
|
my($self,$start,$unmod) = @_; |
793
|
1019
|
100
|
|
|
|
4393
|
return $$self{'data'}{'start'} if (! defined $start); |
794
|
|
|
|
|
|
|
|
795
|
253
|
|
|
|
|
768
|
$self->_init_dates(1); |
796
|
253
|
|
|
|
|
477
|
$$self{'data'}{'unmod_range'} = $unmod; |
797
|
253
|
|
|
|
|
728
|
$self->_date('start',$start); |
798
|
|
|
|
|
|
|
} |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
sub end { |
801
|
337
|
|
|
337
|
1
|
1275
|
my($self,$end) = @_; |
802
|
337
|
100
|
|
|
|
1251
|
return $$self{'data'}{'end'} if (! defined $end); |
803
|
|
|
|
|
|
|
|
804
|
253
|
|
|
|
|
718
|
$self->_init_dates(1); |
805
|
253
|
|
|
|
|
683
|
$self->_date('end',$end); |
806
|
|
|
|
|
|
|
} |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
sub basedate { |
809
|
173
|
|
|
173
|
1
|
2015
|
my($self,$base) = @_; |
810
|
173
|
50
|
|
|
|
409
|
return ($$self{'data'}{'base'},$$self{'data'}{'BASE'}) if (! defined $base); |
811
|
|
|
|
|
|
|
|
812
|
173
|
|
|
|
|
511
|
$self->_init_dates(); |
813
|
173
|
|
|
|
|
534
|
$self->_date('base',$base); |
814
|
|
|
|
|
|
|
} |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
sub modifiers { |
817
|
309
|
|
|
309
|
1
|
808
|
my($self,@flags) = @_; |
818
|
309
|
50
|
|
|
|
747
|
return @{ $$self{'data'}{'flags'} } if (! @flags); |
|
0
|
|
|
|
|
0
|
|
819
|
|
|
|
|
|
|
|
820
|
309
|
|
|
|
|
609
|
my $dmt = $$self{'tz'}; |
821
|
309
|
|
|
|
|
579
|
my $dmb = $$dmt{'base'}; |
822
|
309
|
50
|
|
|
|
767
|
if (@flags == 1) { |
823
|
309
|
|
|
|
|
1006
|
@flags = split(/,/,lc($flags[0])); |
824
|
|
|
|
|
|
|
} |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
# Add these flags to the list |
827
|
|
|
|
|
|
|
|
828
|
309
|
50
|
33
|
|
|
1421
|
if (@flags && $flags[0] eq "+") { |
829
|
0
|
|
|
|
|
0
|
shift(@flags); |
830
|
0
|
|
|
|
|
0
|
my @tmp = @{ $$self{'data'}{'flags'} }; |
|
0
|
|
|
|
|
0
|
|
831
|
0
|
0
|
|
|
|
0
|
@flags = (@tmp,@flags) if (@tmp); |
832
|
|
|
|
|
|
|
} |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
# Return an error if any modifier is unknown |
835
|
|
|
|
|
|
|
|
836
|
309
|
|
|
|
|
718
|
foreach my $flag (@flags) { |
837
|
322
|
100
|
|
|
|
1696
|
next if ($flag =~ /^([pn][dt][1-7]|wd[1-7]|[fb][dw]\d+|cw[dnp]|[npd]wd|[in]bd|[in]w[1-7]|easter)$/); |
838
|
151
|
|
|
|
|
486
|
$$self{'err'} = "[modifiers] Invalid modifier: $flag"; |
839
|
151
|
|
|
|
|
451
|
return 1; |
840
|
|
|
|
|
|
|
} |
841
|
|
|
|
|
|
|
|
842
|
158
|
|
|
|
|
482
|
$$self{'data'}{'flags'} = [ @flags ]; |
843
|
158
|
|
|
|
|
513
|
$self->_init_dates(); |
844
|
|
|
|
|
|
|
|
845
|
158
|
|
|
|
|
336
|
return 0; |
846
|
|
|
|
|
|
|
} |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
sub nth { |
849
|
2097
|
|
|
2097
|
1
|
7301
|
my($self,$n) = @_; |
850
|
2097
|
100
|
|
|
|
4136
|
$n = 0 if (! $n); |
851
|
|
|
|
|
|
|
return ($$self{'data'}{'dates'}{$n},0) |
852
|
2097
|
100
|
|
|
|
6590
|
if (exists $$self{'data'}{'dates'}{$n}); |
853
|
|
|
|
|
|
|
|
854
|
86
|
|
|
|
|
214
|
my ($err) = $self->_error(); |
855
|
86
|
50
|
|
|
|
209
|
return (undef,$err) if ($err); |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
return ($$self{'data'}{'dates'}{$n},0) |
858
|
86
|
100
|
|
|
|
223
|
if (exists $$self{'data'}{'dates'}{$n}); |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
# If there is no interval, then we've found every date that |
861
|
|
|
|
|
|
|
# can be found. |
862
|
84
|
100
|
|
|
|
205
|
if ($$self{'data'}{'noint'}) { |
863
|
4
|
|
|
|
|
9
|
return (undef,0); |
864
|
|
|
|
|
|
|
} |
865
|
|
|
|
|
|
|
|
866
|
80
|
100
|
|
|
|
197
|
if ($$self{'data'}{'slow'}) { |
867
|
2
|
|
|
|
|
4
|
my $nn = 0; |
868
|
2
|
|
|
|
|
4
|
while (1) { |
869
|
4
|
|
|
|
|
11
|
$self->_nth_interval($nn); |
870
|
|
|
|
|
|
|
return ($$self{'data'}{'dates'}{$n},0) |
871
|
4
|
100
|
|
|
|
25
|
if (exists $$self{'data'}{'dates'}{$n}); |
872
|
2
|
50
|
|
|
|
22
|
if ($n >= 0) { |
873
|
2
|
|
|
|
|
5
|
$nn++; |
874
|
|
|
|
|
|
|
} else { |
875
|
0
|
|
|
|
|
0
|
$nn--; |
876
|
|
|
|
|
|
|
} |
877
|
|
|
|
|
|
|
} |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
} else { |
880
|
78
|
|
|
|
|
119
|
my $nn; |
881
|
78
|
100
|
|
|
|
164
|
if ($n >= 0) { |
882
|
74
|
|
|
|
|
136
|
$nn = int($n/$$self{'data'}{'ev_per_d'}); |
883
|
|
|
|
|
|
|
} else { |
884
|
4
|
|
|
|
|
10
|
$nn = int(($n+1)/$$self{'data'}{'ev_per_d'}) -1; |
885
|
|
|
|
|
|
|
} |
886
|
78
|
|
|
|
|
211
|
$self->_nth_interval($nn); |
887
|
78
|
|
|
|
|
217
|
return ($$self{'data'}{'dates'}{$n},0); |
888
|
|
|
|
|
|
|
} |
889
|
|
|
|
|
|
|
} |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
sub next { |
892
|
8
|
|
|
8
|
1
|
1023
|
my($self) = @_; |
893
|
|
|
|
|
|
|
|
894
|
8
|
|
|
|
|
22
|
my ($err) = $self->_error(); |
895
|
8
|
50
|
|
|
|
21
|
return (undef,$err) if ($err); |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
# If curr is not set, we have to get it. |
898
|
|
|
|
|
|
|
|
899
|
8
|
100
|
|
|
|
24
|
if (! defined $$self{'data'}{'curr'}) { |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
CURR: |
902
|
5
|
|
|
|
|
18
|
while (1) { |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
# If no interval then |
905
|
|
|
|
|
|
|
# return base date |
906
|
|
|
|
|
|
|
|
907
|
5
|
100
|
|
|
|
19
|
if ($$self{'data'}{'noint'}) { |
908
|
1
|
|
|
|
|
2
|
$$self{'data'}{'curr'} = -1; |
909
|
1
|
|
|
|
|
3
|
last CURR; |
910
|
|
|
|
|
|
|
} |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
# If a range is defined |
913
|
|
|
|
|
|
|
# find first event in range and return it |
914
|
|
|
|
|
|
|
|
915
|
4
|
100
|
66
|
|
|
22
|
if (defined $$self{'data'}{'start'} && |
916
|
|
|
|
|
|
|
defined $$self{'data'}{'end'}) { |
917
|
|
|
|
|
|
|
|
918
|
2
|
|
|
|
|
9
|
my $n = $self->_locate_n('first'); |
919
|
2
|
100
|
66
|
|
|
18
|
return (undef,'Not found') if ($$self{'err'} || ! defined($n)); |
920
|
1
|
|
|
|
|
6
|
$$self{'data'}{'curr'} = $n-1; |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
} else { |
923
|
2
|
|
|
|
|
4
|
$$self{'data'}{'curr'} = -1; |
924
|
|
|
|
|
|
|
} |
925
|
3
|
|
|
|
|
6
|
last CURR; |
926
|
|
|
|
|
|
|
} |
927
|
|
|
|
|
|
|
} |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
# With curr set, find the next defined one |
930
|
|
|
|
|
|
|
|
931
|
7
|
|
|
|
|
12
|
while (1) { |
932
|
9
|
|
|
|
|
15
|
$$self{'data'}{'curr'}++; |
933
|
9
|
100
|
|
|
|
20
|
if ($$self{'data'}{'noint'}) { |
934
|
|
|
|
|
|
|
return (undef,0) |
935
|
3
|
100
|
|
|
|
11
|
if (! exists $$self{'data'}{'dates'}{$$self{'data'}{'curr'}}); |
936
|
|
|
|
|
|
|
} |
937
|
8
|
|
|
|
|
21
|
my ($d,$e) = $self->nth($$self{'data'}{'curr'}); |
938
|
8
|
50
|
|
|
|
19
|
return (undef,$e) if ($e); |
939
|
8
|
100
|
|
|
|
29
|
return ($d,0) if (defined $d); |
940
|
|
|
|
|
|
|
} |
941
|
|
|
|
|
|
|
} |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
sub prev { |
944
|
11
|
|
|
11
|
1
|
1388
|
my($self) = @_; |
945
|
|
|
|
|
|
|
|
946
|
11
|
|
|
|
|
26
|
my ($err) = $self->_error(); |
947
|
11
|
50
|
|
|
|
25
|
return (undef,$err) if ($err); |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
# If curr is not set, we have to get it. |
950
|
|
|
|
|
|
|
|
951
|
11
|
100
|
|
|
|
27
|
if (! defined $$self{'data'}{'curr'}) { |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
CURR: |
954
|
5
|
|
|
|
|
8
|
while (1) { |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
# If no interval then |
957
|
|
|
|
|
|
|
# return last one |
958
|
|
|
|
|
|
|
|
959
|
5
|
100
|
|
|
|
16
|
if ($$self{'data'}{'noint'}) { |
960
|
1
|
|
|
|
|
2
|
my @n = sort { $a <=> $b } keys %{ $$self{'data'}{'dates'} }; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
6
|
|
961
|
1
|
|
|
|
|
4
|
$$self{'data'}{'curr'} = pop(@n) + 1; |
962
|
1
|
|
|
|
|
3
|
last CURR; |
963
|
|
|
|
|
|
|
} |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
# If a range is defined |
966
|
|
|
|
|
|
|
# find last event in range and return it |
967
|
|
|
|
|
|
|
|
968
|
4
|
100
|
66
|
|
|
22
|
if (defined $$self{'data'}{'start'} && |
969
|
|
|
|
|
|
|
defined $$self{'data'}{'end'}) { |
970
|
|
|
|
|
|
|
|
971
|
2
|
|
|
|
|
9
|
my $n = $self->_locate_n('last'); |
972
|
2
|
100
|
66
|
|
|
16
|
return (undef,'Not found') if ($$self{'err'} || ! defined($n)); |
973
|
1
|
|
|
|
|
4
|
$$self{'data'}{'curr'} = $n+1; |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
} else { |
976
|
2
|
|
|
|
|
3
|
$$self{'data'}{'curr'} = 0; |
977
|
|
|
|
|
|
|
} |
978
|
3
|
|
|
|
|
7
|
last CURR; |
979
|
|
|
|
|
|
|
} |
980
|
|
|
|
|
|
|
} |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
# With curr set, find the previous defined one |
983
|
|
|
|
|
|
|
|
984
|
10
|
|
|
|
|
15
|
while (1) { |
985
|
11
|
|
|
|
|
17
|
$$self{'data'}{'curr'}--; |
986
|
11
|
100
|
|
|
|
25
|
if ($$self{'data'}{'noint'}) { |
987
|
|
|
|
|
|
|
return (undef,0) |
988
|
6
|
100
|
|
|
|
19
|
if (! exists $$self{'data'}{'dates'}{$$self{'data'}{'curr'}}); |
989
|
|
|
|
|
|
|
} |
990
|
9
|
|
|
|
|
26
|
my ($d,$e) = $self->nth($$self{'data'}{'curr'}); |
991
|
9
|
50
|
|
|
|
29
|
return (undef,$e) if ($e); |
992
|
9
|
100
|
|
|
|
33
|
return ($d,0) if (defined $d); |
993
|
|
|
|
|
|
|
} |
994
|
|
|
|
|
|
|
} |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
sub dates { |
997
|
1181
|
|
|
1181
|
1
|
3675
|
my($self,$start2,$end2,$unmod) = @_; |
998
|
1181
|
|
|
|
|
3864
|
$self->err(1); |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
# If $start2 or $end2 are provided, make sure they are valid. |
1001
|
|
|
|
|
|
|
# If either are provided, make a note of it ($tmp_limits). |
1002
|
|
|
|
|
|
|
|
1003
|
1181
|
|
|
|
|
1795
|
my $tmp_limits = 0; |
1004
|
1181
|
100
|
100
|
|
|
3767
|
$tmp_limits = 1 if ($start2 || $end2); |
1005
|
1181
|
100
|
|
|
|
2475
|
$unmod = 0 if (! $unmod); |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
# Check the recurrence for errors. If both $start2 and $end2 are |
1008
|
|
|
|
|
|
|
# provided, it's not necessary for a range to be in the recurrence. |
1009
|
|
|
|
|
|
|
|
1010
|
1181
|
|
|
|
|
1680
|
my $range_required; |
1011
|
1181
|
100
|
100
|
|
|
3907
|
if (defined($start2) && defined($end2)) { |
1012
|
735
|
|
|
|
|
1125
|
$range_required = 0; |
1013
|
|
|
|
|
|
|
} else { |
1014
|
446
|
|
|
|
|
706
|
$range_required = 1; |
1015
|
|
|
|
|
|
|
} |
1016
|
|
|
|
|
|
|
|
1017
|
1181
|
|
|
|
|
1607
|
my($err); |
1018
|
1181
|
|
|
|
|
3000
|
($err,$start2,$end2) = $self->_error($range_required,$start2,$end2); |
1019
|
1181
|
100
|
|
|
|
2637
|
return () if ($err); |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
# If $start2 or $end2 were provided, back up the data that applies |
1022
|
|
|
|
|
|
|
# to the current date range, and store the new date range in it's place. |
1023
|
|
|
|
|
|
|
|
1024
|
1174
|
|
|
|
|
2023
|
my ($old_start, $old_end, $old_first, $old_last, $old_unmod); |
1025
|
|
|
|
|
|
|
|
1026
|
1174
|
100
|
|
|
|
2393
|
if ($tmp_limits) { |
1027
|
737
|
|
|
|
|
1417
|
$old_start = $$self{'data'}{'start'}; |
1028
|
737
|
|
|
|
|
1317
|
$old_end = $$self{'data'}{'end'}; |
1029
|
737
|
|
|
|
|
1219
|
$old_first = $$self{'data'}{'first'}; |
1030
|
737
|
|
|
|
|
1247
|
$old_last = $$self{'data'}{'last'}; |
1031
|
737
|
|
|
|
|
1262
|
$old_unmod = $$self{'data'}{'unmod_range'}; |
1032
|
|
|
|
|
|
|
|
1033
|
737
|
|
|
|
|
1210
|
$$self{'data'}{'start'} = $start2; |
1034
|
737
|
|
|
|
|
1195
|
$$self{'data'}{'end'} = $end2; |
1035
|
737
|
|
|
|
|
1237
|
$$self{'data'}{'first'} = undef; |
1036
|
737
|
|
|
|
|
1163
|
$$self{'data'}{'last'} = undef; |
1037
|
737
|
|
|
|
|
1204
|
$$self{'data'}{'unmod_range'} = $unmod; |
1038
|
|
|
|
|
|
|
} |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
# Get all of the dates |
1041
|
|
|
|
|
|
|
|
1042
|
1174
|
|
|
|
|
1808
|
my($end,$first,$last,@dates); |
1043
|
|
|
|
|
|
|
|
1044
|
1174
|
|
|
|
|
3021
|
$first = $self->_locate_n('first'); |
1045
|
1174
|
100
|
|
|
|
3321
|
return () if ($$self{'err'}); |
1046
|
1173
|
|
|
|
|
3403
|
$last = $self->_locate_n('last'); |
1047
|
1173
|
50
|
|
|
|
3205
|
return () if ($$self{'err'}); |
1048
|
|
|
|
|
|
|
|
1049
|
1173
|
100
|
66
|
|
|
4071
|
if (defined($first) && defined($last)) { |
1050
|
1068
|
|
|
|
|
2758
|
for (my $n = $first; $n <= $last; $n++) { |
1051
|
2050
|
|
|
|
|
4551
|
my($date,$err) = $self->nth($n); |
1052
|
2050
|
100
|
|
|
|
6521
|
push(@dates,$date) if (defined $date); |
1053
|
|
|
|
|
|
|
} |
1054
|
|
|
|
|
|
|
} |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
# Restore the original date range values. |
1057
|
|
|
|
|
|
|
|
1058
|
1173
|
100
|
|
|
|
2711
|
if ($tmp_limits) { |
1059
|
737
|
|
|
|
|
1379
|
$$self{'data'}{'start'} = $old_start; |
1060
|
737
|
|
|
|
|
1258
|
$$self{'data'}{'end'} = $old_end; |
1061
|
737
|
|
|
|
|
1185
|
$$self{'data'}{'first'} = $old_first; |
1062
|
737
|
|
|
|
|
1145
|
$$self{'data'}{'last'} = $old_last; |
1063
|
737
|
|
|
|
|
1201
|
$$self{'data'}{'unmod_range'} = $old_unmod; |
1064
|
|
|
|
|
|
|
} |
1065
|
|
|
|
|
|
|
|
1066
|
1173
|
|
|
|
|
7712
|
return @dates; |
1067
|
|
|
|
|
|
|
} |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
######################################################################## |
1070
|
|
|
|
|
|
|
# MISC |
1071
|
|
|
|
|
|
|
######################################################################## |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
# This checks a recurrence for errors and completeness prior to |
1074
|
|
|
|
|
|
|
# extracting a date or dates from it. |
1075
|
|
|
|
|
|
|
# |
1076
|
|
|
|
|
|
|
sub _error { |
1077
|
1286
|
|
|
1286
|
|
2697
|
my($self,$range_required,$start2,$end2) = @_; |
1078
|
|
|
|
|
|
|
|
1079
|
1286
|
50
|
|
|
|
2768
|
return ('Invalid recurrence') if ($self->err()); |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
# All dates entered must be valid. |
1082
|
|
|
|
|
|
|
|
1083
|
1286
|
|
|
|
|
2302
|
my($start,$end); |
1084
|
1286
|
100
|
|
|
|
3294
|
if (defined $start2) { |
|
|
100
|
|
|
|
|
|
1085
|
736
|
100
|
|
|
|
2018
|
if (ref($start2) eq 'Date::Manip::Date') { |
|
|
50
|
|
|
|
|
|
1086
|
54
|
|
|
|
|
81
|
$start = $start2; |
1087
|
|
|
|
|
|
|
} elsif (! ref($start2)) { |
1088
|
682
|
|
|
|
|
1646
|
$start = $self->new_date(); |
1089
|
682
|
|
|
|
|
2242
|
$start->parse($start2); |
1090
|
|
|
|
|
|
|
} else { |
1091
|
0
|
|
|
|
|
0
|
return ('Invalid start argument'); |
1092
|
|
|
|
|
|
|
} |
1093
|
736
|
50
|
|
|
|
2255
|
return ('Start invalid') if ($start->err()); |
1094
|
|
|
|
|
|
|
} elsif (defined $$self{'data'}{'start'}) { |
1095
|
369
|
|
|
|
|
789
|
$start = $$self{'data'}{'start'}; |
1096
|
369
|
50
|
|
|
|
957
|
return ('Start invalid') if ($start->err()); |
1097
|
|
|
|
|
|
|
} |
1098
|
|
|
|
|
|
|
|
1099
|
1286
|
100
|
|
|
|
3550
|
if (defined $end2) { |
|
|
100
|
|
|
|
|
|
1100
|
736
|
100
|
|
|
|
2110
|
if (ref($end2) eq 'Date::Manip::Date') { |
|
|
50
|
|
|
|
|
|
1101
|
54
|
|
|
|
|
84
|
$end = $end2; |
1102
|
|
|
|
|
|
|
} elsif (! ref($end2)) { |
1103
|
682
|
|
|
|
|
1790
|
$end = $self->new_date(); |
1104
|
682
|
|
|
|
|
1995
|
$end->parse($end2); |
1105
|
|
|
|
|
|
|
} else { |
1106
|
0
|
|
|
|
|
0
|
return ('Invalid end argument'); |
1107
|
|
|
|
|
|
|
} |
1108
|
736
|
50
|
|
|
|
2317
|
return ('End invalid') if ($end->err()); |
1109
|
|
|
|
|
|
|
} elsif (defined $$self{'data'}{'end'}) { |
1110
|
369
|
|
|
|
|
739
|
$end = $$self{'data'}{'end'}; |
1111
|
369
|
50
|
|
|
|
846
|
return ('End invalid') if ($end->err()); |
1112
|
|
|
|
|
|
|
} |
1113
|
|
|
|
|
|
|
|
1114
|
1286
|
100
|
|
|
|
3520
|
if (defined $$self{'data'}{'base'}) { |
1115
|
227
|
|
|
|
|
470
|
my $base = $$self{'data'}{'base'}; |
1116
|
227
|
50
|
|
|
|
505
|
return ('Base invalid') if ($base->err()); |
1117
|
|
|
|
|
|
|
} |
1118
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
# *Y:M:W:D:H:MN:S is complete. |
1120
|
|
|
|
|
|
|
|
1121
|
1286
|
100
|
|
|
|
3237
|
if ($$self{'data'}{'noint'}) { |
1122
|
148
|
100
|
|
|
|
362
|
if ($$self{'data'}{'noint'} == 1) { |
1123
|
137
|
|
|
|
|
342
|
my @dates = $self->_apply_rtime_mods(); |
1124
|
137
|
|
|
|
|
293
|
$$self{'data'}{'noint'} = 2; |
1125
|
|
|
|
|
|
|
|
1126
|
137
|
|
|
|
|
217
|
my $n = 0; |
1127
|
137
|
|
|
|
|
241
|
foreach my $date (@dates) { |
1128
|
230
|
50
|
|
|
|
443
|
next if (! defined $date); |
1129
|
230
|
|
|
|
|
604
|
$$self{'data'}{'dates'}{$n++} = $date; |
1130
|
|
|
|
|
|
|
} |
1131
|
|
|
|
|
|
|
|
1132
|
137
|
50
|
|
|
|
317
|
return (0,$start,$end) if ($n == 0); |
1133
|
|
|
|
|
|
|
|
1134
|
137
|
100
|
66
|
|
|
397
|
if (defined $start && defined $end) { |
1135
|
5
|
|
|
|
|
14
|
my ($first,$last); |
1136
|
5
|
|
|
|
|
27
|
for (my $i=0; $i<$n; $i++) { |
1137
|
7
|
|
|
|
|
19
|
my $date = $$self{'data'}{'dates'}{$i}; |
1138
|
7
|
100
|
66
|
|
|
26
|
if ($start->cmp($date) <= 0 && |
1139
|
|
|
|
|
|
|
$end->cmp($date) >= 0) { |
1140
|
4
|
|
|
|
|
10
|
$first = $i; |
1141
|
4
|
|
|
|
|
10
|
last; |
1142
|
|
|
|
|
|
|
} |
1143
|
|
|
|
|
|
|
} |
1144
|
5
|
|
|
|
|
23
|
for (my $i=$n-1; $i>=0; $i--) { |
1145
|
8
|
|
|
|
|
22
|
my $date = $$self{'data'}{'dates'}{$i}; |
1146
|
8
|
100
|
100
|
|
|
23
|
if ($start->cmp($date) <= 0 && |
1147
|
|
|
|
|
|
|
$end->cmp($date) >= 0) { |
1148
|
4
|
|
|
|
|
13
|
$last = $i; |
1149
|
4
|
|
|
|
|
24
|
last; |
1150
|
|
|
|
|
|
|
} |
1151
|
|
|
|
|
|
|
} |
1152
|
|
|
|
|
|
|
|
1153
|
5
|
|
|
|
|
16
|
$$self{'data'}{'first'} = $first; |
1154
|
5
|
|
|
|
|
17
|
$$self{'data'}{'last'} = $last; |
1155
|
|
|
|
|
|
|
} else { |
1156
|
132
|
|
|
|
|
258
|
$$self{'data'}{'first'} = 0; |
1157
|
132
|
|
|
|
|
287
|
$$self{'data'}{'last'} = $n-1; |
1158
|
|
|
|
|
|
|
} |
1159
|
|
|
|
|
|
|
} |
1160
|
148
|
|
|
|
|
385
|
return (0,$start,$end); |
1161
|
|
|
|
|
|
|
} |
1162
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
# If a range is entered, it must be valid. Also |
1164
|
|
|
|
|
|
|
# a range is required if $range_required is given. |
1165
|
|
|
|
|
|
|
|
1166
|
1138
|
100
|
66
|
|
|
4015
|
if ($start && $end) { |
|
|
100
|
|
|
|
|
|
1167
|
1100
|
50
|
|
|
|
3168
|
return ('Range invalid') if ($start->cmp($end) == 1); |
1168
|
|
|
|
|
|
|
} elsif ($range_required) { |
1169
|
7
|
|
|
|
|
20
|
return ('Incomplete recurrence'); |
1170
|
|
|
|
|
|
|
} |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
# Check that the base date is available. |
1173
|
|
|
|
|
|
|
|
1174
|
1131
|
|
|
|
|
3912
|
$self->_actual_base($start); |
1175
|
|
|
|
|
|
|
|
1176
|
1131
|
50
|
|
|
|
3071
|
if (defined $$self{'data'}{'BASE'}) { |
1177
|
1131
|
|
|
|
|
2076
|
my $base = $$self{'data'}{'BASE'}; |
1178
|
1131
|
50
|
|
|
|
3372
|
return ('Base invalid') if ($base->err()); |
1179
|
1131
|
|
|
|
|
3512
|
return (0,$start,$end); |
1180
|
|
|
|
|
|
|
} |
1181
|
|
|
|
|
|
|
|
1182
|
0
|
|
|
|
|
0
|
return ('Incomplete recurrence'); |
1183
|
|
|
|
|
|
|
} |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
# This determines the actual base date from a specified base date (or |
1186
|
|
|
|
|
|
|
# start date). If a base date cannot be set, then |
1187
|
|
|
|
|
|
|
# $$self{'data'}{'BASE'} is NOT defined. |
1188
|
|
|
|
|
|
|
# |
1189
|
|
|
|
|
|
|
sub _actual_base { |
1190
|
1131
|
|
|
1131
|
|
2211
|
my($self,$start2) = @_; |
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
# Is the actual base date already defined? |
1193
|
|
|
|
|
|
|
|
1194
|
1131
|
100
|
|
|
|
2972
|
return if (defined $$self{'data'}{'BASE'}); |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
# Use the specified base date or start date. |
1197
|
|
|
|
|
|
|
|
1198
|
1011
|
|
|
|
|
1770
|
my $base = undef; |
1199
|
1011
|
100
|
|
|
|
2767
|
if (defined $$self{'data'}{'base'}) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1200
|
171
|
|
|
|
|
315
|
$base = $$self{'data'}{'base'}; |
1201
|
|
|
|
|
|
|
} elsif (defined $start2) { |
1202
|
840
|
|
|
|
|
1368
|
$base = $start2; |
1203
|
|
|
|
|
|
|
} elsif (defined $$self{'data'}{'start'}) { |
1204
|
0
|
|
|
|
|
0
|
$base = $$self{'data'}{'start'}; |
1205
|
|
|
|
|
|
|
} else { |
1206
|
0
|
|
|
|
|
0
|
return; |
1207
|
|
|
|
|
|
|
} |
1208
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
# Determine the actual base date from the specified base date. |
1210
|
|
|
|
|
|
|
|
1211
|
1011
|
|
|
|
|
1698
|
my $dmt = $$self{'tz'}; |
1212
|
1011
|
|
|
|
|
1609
|
my $dmb = $$dmt{'base'}; |
1213
|
1011
|
|
|
|
|
3263
|
$dmt->_update_now(); # Update NOW |
1214
|
1011
|
|
|
|
|
1508
|
my @int = @{ $$self{'data'}{'interval'} }; |
|
1011
|
|
|
|
|
3269
|
|
1215
|
1011
|
|
|
|
|
1641
|
my @rtime = @{ $$self{'data'}{'rtime'} }; |
|
1011
|
|
|
|
|
3395
|
|
1216
|
1011
|
|
|
|
|
2454
|
my ($yf,$mf,$wf,$df,$hf,$mnf,$sf) = (@int,@rtime); |
1217
|
1011
|
|
|
|
|
2520
|
my ($y,$m,$d,$h,$mn,$s) = $base->value(); |
1218
|
1011
|
|
|
|
|
2957
|
my $BASE = $self->new_date(); |
1219
|
1011
|
|
|
|
|
1901
|
my $n = @int; |
1220
|
|
|
|
|
|
|
|
1221
|
1011
|
50
|
|
|
|
3435
|
if ($n == 0) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
# *Y:M:W:D:H:MN:S |
1223
|
0
|
|
|
|
|
0
|
return; |
1224
|
|
|
|
|
|
|
|
1225
|
|
|
|
|
|
|
} elsif ($n == 1) { |
1226
|
|
|
|
|
|
|
# Y*M:W:D:H:MN:S |
1227
|
872
|
|
|
|
|
2956
|
$BASE->set('date',[$y,1,1,0,0,0]); |
1228
|
|
|
|
|
|
|
|
1229
|
|
|
|
|
|
|
} elsif ($n == 2) { |
1230
|
|
|
|
|
|
|
# Y:M*W:D:H:MN:S |
1231
|
78
|
|
|
|
|
328
|
$BASE->set('date',[$y,$m,1,0,0,0]); |
1232
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
} elsif ($n == 3) { |
1234
|
|
|
|
|
|
|
# Y:M:W*D:H:MN:S |
1235
|
19
|
|
|
|
|
96
|
my($yy,$w) = $dmb->week_of_year([$y,$m,$d,$h,$mn,$s]); |
1236
|
19
|
|
|
|
|
63
|
my($ymd) = $dmb->week_of_year($yy,$w); |
1237
|
19
|
|
|
|
|
94
|
$BASE->set('date',[@$ymd,0,0,0]); |
1238
|
|
|
|
|
|
|
|
1239
|
|
|
|
|
|
|
} elsif ($n == 4) { |
1240
|
|
|
|
|
|
|
# Y:M:W:D*H:MN:S |
1241
|
31
|
|
|
|
|
122
|
$BASE->set('date',[$y,$m,$d,0,0,0]); |
1242
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
} elsif ($n == 5) { |
1244
|
|
|
|
|
|
|
# Y:M:W:D:H*MN:S |
1245
|
5
|
|
|
|
|
24
|
$BASE->set('date',[$y,$m,$d,$h,0,0]); |
1246
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
} elsif ($n == 6) { |
1248
|
|
|
|
|
|
|
# Y:M:W:D:H:MN*S |
1249
|
0
|
|
|
|
|
0
|
$BASE->set('date',[$y,$m,$d,$h,$mn,0]); |
1250
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
} else { |
1252
|
|
|
|
|
|
|
# Y:M:W:D:H:MN:S |
1253
|
6
|
|
|
|
|
31
|
$BASE->set('date',[$y,$m,$d,$h,$mn,$s]); |
1254
|
|
|
|
|
|
|
} |
1255
|
|
|
|
|
|
|
|
1256
|
1011
|
|
|
|
|
3710
|
$$self{'data'}{'BASE'} = $BASE; |
1257
|
|
|
|
|
|
|
} |
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
sub _rx { |
1260
|
2986
|
|
|
2986
|
|
5645
|
my($self,$rx) = @_; |
1261
|
2986
|
|
|
|
|
4605
|
my $dmt = $$self{'tz'}; |
1262
|
2986
|
|
|
|
|
4111
|
my $dmb = $$dmt{'base'}; |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
return $$dmb{'data'}{'rx'}{'recur'}{$rx} |
1265
|
2986
|
100
|
|
|
|
9353
|
if (exists $$dmb{'data'}{'rx'}{'recur'}{$rx}); |
1266
|
|
|
|
|
|
|
|
1267
|
122
|
100
|
66
|
|
|
1035
|
if ($rx eq 'std') { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
|
1269
|
28
|
|
|
|
|
74
|
my $l = '[0-9]*'; |
1270
|
28
|
|
|
|
|
68
|
my $r = '[-,0-9]*'; |
1271
|
28
|
|
|
|
|
923
|
my $stdrx = "(?$l:$l:$l:$l:$l:$l:$l)(?)|" . |
1272
|
|
|
|
|
|
|
"(?$l:$l:$l:$l:$l:$l)\\*(?$r)|" . |
1273
|
|
|
|
|
|
|
"(?$l:$l:$l:$l:$l)\\*(?$r:$r)|" . |
1274
|
|
|
|
|
|
|
"(?$l:$l:$l:$l)\\*(?$r:$r:$r)|" . |
1275
|
|
|
|
|
|
|
"(?$l:$l:$l)\\*(?$r:$r:$r:$r)|" . |
1276
|
|
|
|
|
|
|
"(?$l:$l)\\*(?$r:$r:$r:$r:$r)|" . |
1277
|
|
|
|
|
|
|
"(?$l)\\*(?$r:$r:$r:$r:$r:$r)|" . |
1278
|
|
|
|
|
|
|
"(?)\\*(?$r:$r:$r:$r:$r:$r:$r)"; |
1279
|
28
|
|
|
|
|
3702
|
$$dmb{'data'}{'rx'}{'recur'}{$rx} = qr/^\s*(?:$stdrx)\s*$/; |
1280
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
} elsif ($rx eq 'rfield' || |
1282
|
|
|
|
|
|
|
$rx eq 'rnum' || |
1283
|
|
|
|
|
|
|
$rx eq 'rrange') { |
1284
|
|
|
|
|
|
|
|
1285
|
28
|
|
|
|
|
106
|
my $num = '[+-]?\d+'; |
1286
|
28
|
|
|
|
|
123
|
my $range = "$num\-$num"; |
1287
|
28
|
|
|
|
|
318
|
my $val = "(?:$range|$num)"; |
1288
|
28
|
|
|
|
|
138
|
my $vals = "$val(?:,$val)*"; |
1289
|
|
|
|
|
|
|
|
1290
|
28
|
|
|
|
|
1286
|
$$dmb{'data'}{'rx'}{'recur'}{'rfield'} = qr/^($vals)$/; |
1291
|
28
|
|
|
|
|
576
|
$$dmb{'data'}{'rx'}{'recur'}{'rnum'} = qr/^($num)$/; |
1292
|
28
|
|
|
|
|
767
|
$$dmb{'data'}{'rx'}{'recur'}{'rrange'} = qr/^($num)\-($num)$/; |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
} elsif ($rx eq 'each') { |
1295
|
|
|
|
|
|
|
|
1296
|
22
|
|
|
|
|
104
|
my $each = $$dmb{'data'}{'rx'}{'each'}; |
1297
|
|
|
|
|
|
|
|
1298
|
22
|
|
|
|
|
713
|
my $eachrx = qr/(?:^|\s+)(?:$each)(\s+|$)/i; |
1299
|
22
|
|
|
|
|
164
|
$$dmb{'data'}{'rx'}{'recur'}{$rx} = $eachrx; |
1300
|
|
|
|
|
|
|
|
1301
|
|
|
|
|
|
|
} elsif ($rx eq 'ignore') { |
1302
|
|
|
|
|
|
|
|
1303
|
22
|
|
|
|
|
96
|
my $of = $$dmb{'data'}{'rx'}{'of'}; |
1304
|
22
|
|
|
|
|
73
|
my $on = $$dmb{'data'}{'rx'}{'on'}; |
1305
|
|
|
|
|
|
|
|
1306
|
22
|
|
|
|
|
773
|
my $ignrx = qr/(?:^|\s+)(?:$on|$of)(\s+|$)/i; |
1307
|
22
|
|
|
|
|
131
|
$$dmb{'data'}{'rx'}{'recur'}{$rx} = $ignrx; |
1308
|
|
|
|
|
|
|
|
1309
|
|
|
|
|
|
|
} elsif ($rx eq 'every') { |
1310
|
|
|
|
|
|
|
|
1311
|
22
|
|
|
|
|
94
|
my $month = $$dmb{'data'}{'rx'}{'fields'}[2]; |
1312
|
22
|
|
|
|
|
67
|
my $week = $$dmb{'data'}{'rx'}{'fields'}[3]; |
1313
|
22
|
|
|
|
|
94
|
my $day = $$dmb{'data'}{'rx'}{'fields'}[4]; |
1314
|
|
|
|
|
|
|
|
1315
|
22
|
|
|
|
|
69
|
my $last = $$dmb{'data'}{'rx'}{'last'}; |
1316
|
22
|
|
|
|
|
71
|
my $nth = $$dmb{'data'}{'rx'}{'nth'}[0]; |
1317
|
22
|
|
|
|
|
65
|
my $nth_wom = $$dmb{'data'}{'rx'}{'nth_wom'}[0]; |
1318
|
22
|
|
|
|
|
74
|
my $nth_dom = $$dmb{'data'}{'rx'}{'nth_dom'}[0]; |
1319
|
|
|
|
|
|
|
|
1320
|
22
|
|
|
|
|
62
|
my $day_abb = $$dmb{'data'}{'rx'}{'day_abb'}[0]; |
1321
|
22
|
|
|
|
|
78
|
my $day_name = $$dmb{'data'}{'rx'}{'day_name'}[0]; |
1322
|
22
|
|
|
|
|
63
|
my $mon_abb = $$dmb{'data'}{'rx'}{'month_abb'}[0]; |
1323
|
22
|
|
|
|
|
66
|
my $mon_name = $$dmb{'data'}{'rx'}{'month_name'}[0]; |
1324
|
|
|
|
|
|
|
|
1325
|
22
|
|
|
|
|
48
|
my $beg = '(?:^|\s+)'; |
1326
|
22
|
|
|
|
|
54
|
my $end = '(?:\s*$)'; |
1327
|
|
|
|
|
|
|
|
1328
|
22
|
|
|
|
|
96
|
$month = "$beg(?$month)"; # months |
1329
|
22
|
|
|
|
|
72
|
$week = "$beg(?$week)"; # weeks |
1330
|
22
|
|
|
|
|
75
|
$day = "$beg(?$day)"; # days |
1331
|
|
|
|
|
|
|
|
1332
|
22
|
|
|
|
|
79
|
$last = "$beg(?$last)"; # last |
1333
|
22
|
|
|
|
|
135
|
$nth = "$beg(?$nth)"; # 1st,2nd,... |
1334
|
22
|
|
|
|
|
87
|
$nth_wom = "$beg(?$nth_wom)"; # 1st - 5th |
1335
|
22
|
|
|
|
|
105
|
$nth_dom = "$beg(?$nth_dom)"; # 1st - 31st |
1336
|
22
|
|
|
|
|
72
|
my $n = "$beg(?\\d+)"; # 1,2,... |
1337
|
|
|
|
|
|
|
|
1338
|
22
|
|
|
|
|
121
|
my $dow = "$beg(?:(?$day_name)|(?$day_abb))"; # Sun|Sunday |
1339
|
22
|
|
|
|
|
100
|
my $mmm = "$beg(?:(?$mon_name)|(?$mon_abb))"; # Jan|January |
1340
|
|
|
|
|
|
|
|
1341
|
22
|
|
|
|
|
89
|
my $y = "(?:$beg(?:(?\\d\\d\\d\\d)|(?\\d\\d)))?"; |
1342
|
|
|
|
|
|
|
|
1343
|
22
|
|
|
|
|
702
|
my $freqrx = |
1344
|
|
|
|
|
|
|
"$nth_wom?$dow$mmm$y|" . # every DoW in MMM [YY] |
1345
|
|
|
|
|
|
|
"$last$dow$mmm$y|" . # Nth DoW in MMM [YY] |
1346
|
|
|
|
|
|
|
# last DoW in MMM [YY] |
1347
|
|
|
|
|
|
|
# day_name|day_abb |
1348
|
|
|
|
|
|
|
# mon_name|mon_abb |
1349
|
|
|
|
|
|
|
# last*|nth* |
1350
|
|
|
|
|
|
|
# y* |
1351
|
|
|
|
|
|
|
"$nth_wom?$dow$month$y|" . # every DoW of every month [YY] |
1352
|
|
|
|
|
|
|
"$last$dow$month$y|" . # Nth DoW of every month [YY] |
1353
|
|
|
|
|
|
|
# last DoW of every month [YY] |
1354
|
|
|
|
|
|
|
# day_name|day_abb |
1355
|
|
|
|
|
|
|
# last*|nth* |
1356
|
|
|
|
|
|
|
# y* |
1357
|
|
|
|
|
|
|
"$nth_dom?$day$month$y|" . # every day of every month [YY] |
1358
|
|
|
|
|
|
|
"$last$day$month$y|" . # Nth day of every month [YY] |
1359
|
|
|
|
|
|
|
# last day of every month [YY] |
1360
|
|
|
|
|
|
|
# day |
1361
|
|
|
|
|
|
|
# month |
1362
|
|
|
|
|
|
|
# nth*|last* |
1363
|
|
|
|
|
|
|
# y* |
1364
|
|
|
|
|
|
|
"$nth*$day$y|" . # every day [YY] |
1365
|
|
|
|
|
|
|
"$n$day$y"; # every Nth day [YY] |
1366
|
|
|
|
|
|
|
# every N days [YY] |
1367
|
|
|
|
|
|
|
# day |
1368
|
|
|
|
|
|
|
# nth*|n* |
1369
|
|
|
|
|
|
|
# y* |
1370
|
|
|
|
|
|
|
|
1371
|
22
|
|
|
|
|
40096
|
$freqrx = qr/^(?:$freqrx)\s*$/i; |
1372
|
22
|
|
|
|
|
729
|
$$dmb{'data'}{'rx'}{'recur'}{$rx} = $freqrx; |
1373
|
|
|
|
|
|
|
} |
1374
|
|
|
|
|
|
|
|
1375
|
122
|
|
|
|
|
627
|
return $$dmb{'data'}{'rx'}{'recur'}{$rx}; |
1376
|
|
|
|
|
|
|
} |
1377
|
|
|
|
|
|
|
|
1378
|
|
|
|
|
|
|
# @dates = $self->_apply_rtime_mods(); |
1379
|
|
|
|
|
|
|
# |
1380
|
|
|
|
|
|
|
# Should only be called if there is no interval (*Y:M:W:D:H:MN:S). |
1381
|
|
|
|
|
|
|
# |
1382
|
|
|
|
|
|
|
# It will use rtime/modifiers to get a list of all events |
1383
|
|
|
|
|
|
|
# specified by the recurrence. This only needs to be done once. |
1384
|
|
|
|
|
|
|
# |
1385
|
|
|
|
|
|
|
# @dates = $self->_apply_rtime_mods($date); |
1386
|
|
|
|
|
|
|
# |
1387
|
|
|
|
|
|
|
# For all other types of recurrences, this will take a single |
1388
|
|
|
|
|
|
|
# date and apply all rtime/modifiers to it to get a list of |
1389
|
|
|
|
|
|
|
# events. |
1390
|
|
|
|
|
|
|
# |
1391
|
|
|
|
|
|
|
sub _apply_rtime_mods { |
1392
|
4050
|
|
|
4050
|
|
7483
|
my($self,$date) = @_; |
1393
|
4050
|
|
|
|
|
6448
|
my $dmt = $$self{'tz'}; |
1394
|
4050
|
|
|
|
|
6187
|
my $dmb = $$dmt{'base'}; |
1395
|
4050
|
|
|
|
|
5510
|
my @int = @{ $$self{'data'}{'interval'} }; |
|
4050
|
|
|
|
|
9001
|
|
1396
|
4050
|
|
|
|
|
6152
|
my @rtime = @{ $$self{'data'}{'rtime'} }; |
|
4050
|
|
|
|
|
9261
|
|
1397
|
4050
|
|
|
|
|
6152
|
my $n = @int; |
1398
|
|
|
|
|
|
|
|
1399
|
4050
|
|
|
|
|
8364
|
my ($yf,$mf,$wf,$df,$hf,$mnf,$sf) = (@int,@rtime); |
1400
|
4050
|
|
|
|
|
8533
|
my $m_empty = $self->_field_empty($mf); |
1401
|
4050
|
|
|
|
|
7481
|
my $w_empty = $self->_field_empty($wf); |
1402
|
4050
|
|
|
|
|
7647
|
my $d_empty = $self->_field_empty($df); |
1403
|
4050
|
|
|
|
|
7458
|
my ($err,$y,$m,$d,$h,$mn,$s,@y,@m,@w,@d,@h,@mn,@s,@doy,@woy,@dow,@n); |
1404
|
4050
|
100
|
|
|
|
13219
|
($y,$m,$d,$h,$mn,$s) = $date->value() if (defined $date); |
1405
|
4050
|
|
|
|
|
6733
|
my(@date); |
1406
|
|
|
|
|
|
|
|
1407
|
4050
|
100
|
|
|
|
8581
|
if ($n <= 1) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
# |
1409
|
|
|
|
|
|
|
# *Y:M:W:D:H:MN:S |
1410
|
|
|
|
|
|
|
# Y*M:W:D:H:MN:S |
1411
|
|
|
|
|
|
|
# |
1412
|
|
|
|
|
|
|
|
1413
|
3281
|
100
|
|
|
|
6383
|
if (@int == 0) { |
1414
|
137
|
|
|
|
|
292
|
($err,@y) = $self->_rtime_values('y',$yf); |
1415
|
137
|
50
|
|
|
|
334
|
return () if ($err); |
1416
|
|
|
|
|
|
|
} else { |
1417
|
3144
|
|
|
|
|
5669
|
@y = ($y); |
1418
|
|
|
|
|
|
|
} |
1419
|
|
|
|
|
|
|
|
1420
|
3281
|
100
|
100
|
|
|
17179
|
if ( ($m_empty && $w_empty && $d_empty) || |
|
|
100
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
1421
|
|
|
|
|
|
|
(! $m_empty && $w_empty) ) { |
1422
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
# *0:0:0:0 Jan 1 of the current year |
1424
|
|
|
|
|
|
|
# *1:0:0:0 Jan 1, 0001 |
1425
|
|
|
|
|
|
|
# *0:2:0:0 Feb 1 of the current year |
1426
|
|
|
|
|
|
|
# *1:2:0:0 Feb 1, 0001 |
1427
|
|
|
|
|
|
|
# *0:2:0:4 Feb 4th of the current year |
1428
|
|
|
|
|
|
|
# *1:2:0:4 Feb 4th, 0001 |
1429
|
|
|
|
|
|
|
# 1*0:0:0 every year on Jan 1 |
1430
|
|
|
|
|
|
|
# 1*2:0:0 every year on Feb 1 |
1431
|
|
|
|
|
|
|
# 1*2:0:4 every year on Feb 4th |
1432
|
|
|
|
|
|
|
|
1433
|
2480
|
100
|
|
|
|
4901
|
$mf = [1] if ($m_empty); |
1434
|
2480
|
100
|
|
|
|
4500
|
$df = [1] if ($d_empty); |
1435
|
|
|
|
|
|
|
|
1436
|
2480
|
|
|
|
|
5288
|
($err,@m) = $self->_rtime_values('m',$mf); |
1437
|
2480
|
50
|
|
|
|
4815
|
return () if ($err); |
1438
|
|
|
|
|
|
|
|
1439
|
2480
|
|
|
|
|
3923
|
foreach my $y (@y) { |
1440
|
2496
|
|
|
|
|
3614
|
foreach my $m (@m) { |
1441
|
2549
|
|
|
|
|
4835
|
($err,@d) = $self->_rtime_values('day_of_month',$df,$y,$m); |
1442
|
2549
|
50
|
|
|
|
4929
|
return () if ($err); |
1443
|
2549
|
|
|
|
|
3966
|
foreach my $d (@d) { |
1444
|
2429
|
|
|
|
|
7704
|
push(@date,[$y,$m,$d,0,0,0]); |
1445
|
|
|
|
|
|
|
} |
1446
|
|
|
|
|
|
|
} |
1447
|
|
|
|
|
|
|
} |
1448
|
|
|
|
|
|
|
|
1449
|
|
|
|
|
|
|
} elsif ($m_empty) { |
1450
|
|
|
|
|
|
|
|
1451
|
328
|
100
|
|
|
|
789
|
if ($w_empty) { |
|
|
100
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
# *0:0:0:4 the 4th day of the current year |
1454
|
|
|
|
|
|
|
# *1:0:0:4 the 4th day of 0001 |
1455
|
|
|
|
|
|
|
# 1*0:0:4 every year on the 4th day of the year |
1456
|
|
|
|
|
|
|
|
1457
|
151
|
|
|
|
|
297
|
foreach my $y (@y) { |
1458
|
171
|
|
|
|
|
377
|
($err,@doy) = $self->_rtime_values('day_of_year',$df,$y); |
1459
|
171
|
50
|
|
|
|
348
|
return () if ($err); |
1460
|
171
|
|
|
|
|
308
|
foreach my $doy (@doy) { |
1461
|
137
|
|
|
|
|
186
|
my($yy,$mm,$dd) = @{ $dmb->day_of_year($y,$doy) }; |
|
137
|
|
|
|
|
372
|
|
1462
|
137
|
|
|
|
|
489
|
push(@date,[$yy,$mm,$dd,0,0,0]); |
1463
|
|
|
|
|
|
|
} |
1464
|
|
|
|
|
|
|
} |
1465
|
|
|
|
|
|
|
|
1466
|
|
|
|
|
|
|
} elsif ($d_empty) { |
1467
|
|
|
|
|
|
|
|
1468
|
|
|
|
|
|
|
# *0:0:3:0 the first day of the 3rd week of the curr year |
1469
|
|
|
|
|
|
|
# *1:0:3:0 the first day of the 3rd week of 0001 |
1470
|
|
|
|
|
|
|
# 1*0:3:0 every year on the first day of 3rd week of year |
1471
|
|
|
|
|
|
|
|
1472
|
49
|
|
|
|
|
94
|
foreach my $y (@y) { |
1473
|
49
|
|
|
|
|
119
|
($err,@woy) = $self->_rtime_values('week_of_year',$wf,$y); |
1474
|
49
|
50
|
|
|
|
142
|
return () if ($err); |
1475
|
49
|
|
|
|
|
94
|
foreach my $woy (@woy) { |
1476
|
51
|
|
|
|
|
70
|
my ($yy,$mm,$dd) = @{ $dmb->week_of_year($y,$woy) }; |
|
51
|
|
|
|
|
142
|
|
1477
|
51
|
|
|
|
|
178
|
push(@date,[$yy,$mm,$dd,0,0,0]); |
1478
|
|
|
|
|
|
|
} |
1479
|
|
|
|
|
|
|
} |
1480
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
} else { |
1482
|
|
|
|
|
|
|
|
1483
|
|
|
|
|
|
|
# *1:0:3:4 in 0001 on the 3rd Thur of the year |
1484
|
|
|
|
|
|
|
# *0:0:3:4 on the 3rd Thur of the current year |
1485
|
|
|
|
|
|
|
# 1*0:3:4 every year on the 3rd Thur of the year |
1486
|
|
|
|
|
|
|
|
1487
|
128
|
|
|
|
|
330
|
($err,@dow) = $self->_rtime_values('day_of_week',$df); |
1488
|
128
|
50
|
|
|
|
343
|
return () if ($err); |
1489
|
128
|
|
|
|
|
220
|
foreach my $y (@y) { |
1490
|
164
|
|
|
|
|
302
|
foreach my $dow (@dow) { |
1491
|
164
|
|
|
|
|
351
|
($err,@n) = $self->_rtime_values('dow_of_year',$wf,$y,$dow); |
1492
|
164
|
50
|
|
|
|
392
|
return () if ($err); |
1493
|
164
|
|
|
|
|
349
|
foreach my $n (@n) { |
1494
|
82
|
|
|
|
|
237
|
my $ymd = $dmb->nth_day_of_week($y,$n,$dow); |
1495
|
82
|
|
|
|
|
176
|
my($yy,$mm,$dd) = @$ymd; |
1496
|
82
|
|
|
|
|
307
|
push(@date,[$yy,$mm,$dd,0,0,0]); |
1497
|
|
|
|
|
|
|
} |
1498
|
|
|
|
|
|
|
} |
1499
|
|
|
|
|
|
|
} |
1500
|
|
|
|
|
|
|
} |
1501
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
} else { |
1503
|
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
# *1:2:3:4 in Feb 0001 on the 3rd Thur of the month |
1505
|
|
|
|
|
|
|
# *0:2:3:4 on the 3rd Thur of Feb in the curr year |
1506
|
|
|
|
|
|
|
# *1:2:3:0 the 3rd occurrence of FirstDay in Feb 0001 |
1507
|
|
|
|
|
|
|
# *0:2:3:0 the 3rd occurrence of FirstDay in Feb of curr year |
1508
|
|
|
|
|
|
|
# 1*2:3:4 every year in Feb on the 3rd Thur |
1509
|
|
|
|
|
|
|
# 1*2:3:0 every year on the 3rd occurrence of FirstDay in Feb |
1510
|
|
|
|
|
|
|
|
1511
|
473
|
|
|
|
|
1331
|
($err,@m) = $self->_rtime_values('m',$mf); |
1512
|
473
|
50
|
|
|
|
1208
|
return () if ($err); |
1513
|
|
|
|
|
|
|
|
1514
|
473
|
100
|
|
|
|
918
|
if ($d_empty) { |
1515
|
76
|
|
|
|
|
254
|
@dow = ($dmb->_config('firstday')); |
1516
|
|
|
|
|
|
|
} else { |
1517
|
397
|
|
|
|
|
862
|
($err,@dow) = $self->_rtime_values('day_of_week',$df); |
1518
|
397
|
50
|
|
|
|
1031
|
return () if ($err); |
1519
|
|
|
|
|
|
|
} |
1520
|
|
|
|
|
|
|
|
1521
|
473
|
|
|
|
|
1043
|
foreach my $y (@y) { |
1522
|
477
|
|
|
|
|
799
|
foreach my $m (@m) { |
1523
|
639
|
|
|
|
|
987
|
foreach my $dow (@dow) { |
1524
|
639
|
|
|
|
|
1385
|
($err,@n) = $self->_rtime_values('dow_of_month', |
1525
|
|
|
|
|
|
|
$wf,$y,$m,$dow); |
1526
|
639
|
50
|
|
|
|
1462
|
return () if ($err); |
1527
|
639
|
|
|
|
|
1132
|
foreach my $n (@n) { |
1528
|
629
|
|
|
|
|
1880
|
my $ymd = $dmb->nth_day_of_week($y,$n,$dow,$m); |
1529
|
629
|
|
|
|
|
1362
|
my($yy,$mm,$dd) = @$ymd; |
1530
|
629
|
|
|
|
|
2288
|
push(@date,[$yy,$mm,$dd,0,0,0]); |
1531
|
|
|
|
|
|
|
} |
1532
|
|
|
|
|
|
|
} |
1533
|
|
|
|
|
|
|
} |
1534
|
|
|
|
|
|
|
} |
1535
|
|
|
|
|
|
|
} |
1536
|
|
|
|
|
|
|
|
1537
|
|
|
|
|
|
|
} elsif ($n == 2) { |
1538
|
|
|
|
|
|
|
|
1539
|
|
|
|
|
|
|
# |
1540
|
|
|
|
|
|
|
# Y:M*W:D:H:MN:S |
1541
|
|
|
|
|
|
|
# |
1542
|
|
|
|
|
|
|
|
1543
|
448
|
100
|
|
|
|
901
|
if ($w_empty) { |
1544
|
|
|
|
|
|
|
|
1545
|
|
|
|
|
|
|
# 0:2*0:0 every 2 months on the first day of the month |
1546
|
|
|
|
|
|
|
# 0:2*0:4 every 2 months on the 4th day of the month |
1547
|
|
|
|
|
|
|
# 1:2*0:0 every 1 year, 2 months on the first day of the month |
1548
|
|
|
|
|
|
|
# 1:2*0:4 every 1 year, 2 months on the 4th day of the month |
1549
|
|
|
|
|
|
|
|
1550
|
261
|
100
|
|
|
|
597
|
$df = [1] if ($d_empty); |
1551
|
|
|
|
|
|
|
|
1552
|
261
|
|
|
|
|
590
|
($err,@d) = $self->_rtime_values('day_of_month',$df,$y,$m); |
1553
|
261
|
50
|
|
|
|
550
|
return () if ($err); |
1554
|
261
|
|
|
|
|
424
|
foreach my $d (@d) { |
1555
|
271
|
|
|
|
|
815
|
push(@date,[$y,$m,$d,0,0,0]); |
1556
|
|
|
|
|
|
|
} |
1557
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
} else { |
1559
|
|
|
|
|
|
|
|
1560
|
|
|
|
|
|
|
# 0:2*3:0 every 2 months on the 3rd occurrence of FirstDay |
1561
|
|
|
|
|
|
|
# 0:2*3:4 every 2 months on the 3rd Thur of the month |
1562
|
|
|
|
|
|
|
# 1:2*3:0 every 1 year, 2 months on 3rd occurrence of FirstDay |
1563
|
|
|
|
|
|
|
# 1:2*3:4 every 1 year, 2 months on the 3rd Thur of the month |
1564
|
|
|
|
|
|
|
|
1565
|
187
|
100
|
|
|
|
392
|
if ($d_empty) { |
1566
|
51
|
|
|
|
|
152
|
@dow = ($dmb->_config('firstday')); |
1567
|
|
|
|
|
|
|
} else { |
1568
|
136
|
|
|
|
|
319
|
($err,@dow) = $self->_rtime_values('day_of_week',$df); |
1569
|
136
|
50
|
|
|
|
362
|
return () if ($err); |
1570
|
|
|
|
|
|
|
} |
1571
|
|
|
|
|
|
|
|
1572
|
187
|
|
|
|
|
343
|
foreach my $dow (@dow) { |
1573
|
187
|
|
|
|
|
396
|
($err,@n) = $self->_rtime_values('dow_of_month', |
1574
|
|
|
|
|
|
|
$wf,$y,$m,$dow); |
1575
|
187
|
50
|
|
|
|
396
|
return () if ($err); |
1576
|
187
|
|
|
|
|
315
|
foreach my $n (@n) { |
1577
|
237
|
|
|
|
|
633
|
my $ymd = $dmb->nth_day_of_week($y,$n,$dow,$m); |
1578
|
237
|
|
|
|
|
487
|
my($yy,$mm,$dd) = @$ymd; |
1579
|
237
|
|
|
|
|
759
|
push(@date,[$yy,$mm,$dd,0,0,0]); |
1580
|
|
|
|
|
|
|
} |
1581
|
|
|
|
|
|
|
} |
1582
|
|
|
|
|
|
|
} |
1583
|
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
|
} elsif ($n == 3) { |
1585
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
# |
1587
|
|
|
|
|
|
|
# Y:M:W*D:H:MN:S |
1588
|
|
|
|
|
|
|
# |
1589
|
|
|
|
|
|
|
|
1590
|
|
|
|
|
|
|
# 0:0:3*0 every 3 weeks on FirstDay |
1591
|
|
|
|
|
|
|
# 0:0:3*4 every 3 weeks on Thur |
1592
|
|
|
|
|
|
|
# 0:2:3*0 every 2 months, 3 weeks on FirstDay |
1593
|
|
|
|
|
|
|
# 0:2:3*4 every 2 months, 3 weeks on Thur |
1594
|
|
|
|
|
|
|
# 1:0:3*0 every 1 year, 3 weeks on FirstDay |
1595
|
|
|
|
|
|
|
# 1:0:3*4 every 1 year, 3 weeks on Thur |
1596
|
|
|
|
|
|
|
# 1:2:3*0 every 1 year, 2 months, 3 weeks on FirstDay |
1597
|
|
|
|
|
|
|
# 1:2:3*4 every 1 year, 2 months, 3 weeks on Thur |
1598
|
|
|
|
|
|
|
|
1599
|
100
|
|
|
|
|
312
|
my $fdow = $dmb->_config('firstday'); |
1600
|
100
|
100
|
|
|
|
287
|
if ($d_empty) { |
1601
|
35
|
|
|
|
|
75
|
@dow = ($fdow); |
1602
|
|
|
|
|
|
|
} else { |
1603
|
65
|
|
|
|
|
172
|
($err,@dow) = $self->_rtime_values('day_of_week',$df); |
1604
|
65
|
50
|
|
|
|
178
|
return () if ($err); |
1605
|
|
|
|
|
|
|
} |
1606
|
|
|
|
|
|
|
|
1607
|
100
|
|
|
|
|
149
|
my($mm,$dd); |
1608
|
100
|
|
|
|
|
345
|
my($yy,$ww) = $dmb->week_of_year([$y,$m,$d]); |
1609
|
100
|
|
|
|
|
187
|
($yy,$mm,$dd) = @{ $dmb->week_of_year($yy,$ww) }; |
|
100
|
|
|
|
|
220
|
|
1610
|
|
|
|
|
|
|
|
1611
|
100
|
|
|
|
|
228
|
foreach my $dow (@dow) { |
1612
|
112
|
50
|
|
|
|
255
|
$dow += 7 if ($dow < $fdow); |
1613
|
112
|
|
|
|
|
160
|
my($yyy,$mmm,$ddd) = @{ $dmb->calc_date_days([$yy,$mm,$dd],$dow-$fdow) }; |
|
112
|
|
|
|
|
372
|
|
1614
|
112
|
|
|
|
|
382
|
push(@date,[$yyy,$mmm,$ddd,0,0,0]); |
1615
|
|
|
|
|
|
|
} |
1616
|
|
|
|
|
|
|
|
1617
|
|
|
|
|
|
|
} elsif ($n == 4) { |
1618
|
|
|
|
|
|
|
|
1619
|
|
|
|
|
|
|
# |
1620
|
|
|
|
|
|
|
# Y:M:W:D*H:MN:S |
1621
|
|
|
|
|
|
|
# |
1622
|
|
|
|
|
|
|
|
1623
|
133
|
|
|
|
|
359
|
push(@date,[$y,$m,$d,0,0,0]); |
1624
|
|
|
|
|
|
|
|
1625
|
|
|
|
|
|
|
} elsif ($n == 5) { |
1626
|
|
|
|
|
|
|
|
1627
|
|
|
|
|
|
|
# |
1628
|
|
|
|
|
|
|
# Y:M:W:D:H*MN:S |
1629
|
|
|
|
|
|
|
# |
1630
|
|
|
|
|
|
|
|
1631
|
33
|
|
|
|
|
83
|
push(@date,[$y,$m,$d,$h,0,0]); |
1632
|
|
|
|
|
|
|
|
1633
|
|
|
|
|
|
|
} elsif ($n == 6) { |
1634
|
|
|
|
|
|
|
|
1635
|
|
|
|
|
|
|
# |
1636
|
|
|
|
|
|
|
# Y:M:W:D:H:MN*S |
1637
|
|
|
|
|
|
|
# |
1638
|
|
|
|
|
|
|
|
1639
|
0
|
|
|
|
|
0
|
push(@date,[$y,$m,$d,$h,$mn,0]); |
1640
|
|
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
} elsif ($n == 7) { |
1642
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
# |
1644
|
|
|
|
|
|
|
# Y:M:W:D:H:MN:S |
1645
|
|
|
|
|
|
|
# |
1646
|
|
|
|
|
|
|
|
1647
|
55
|
|
|
|
|
139
|
push(@date,[$y,$m,$d,$h,$mn,$s]); |
1648
|
|
|
|
|
|
|
} |
1649
|
|
|
|
|
|
|
|
1650
|
|
|
|
|
|
|
# |
1651
|
|
|
|
|
|
|
# Handle the H/MN/S portion. |
1652
|
|
|
|
|
|
|
# |
1653
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
# Do hours |
1655
|
4050
|
100
|
|
|
|
8695
|
if ($n <= 4 ) { |
1656
|
3962
|
|
|
|
|
7846
|
($err,@h) = $self->_rtime_values('h',$hf); |
1657
|
3962
|
50
|
|
|
|
7379
|
return () if ($err); |
1658
|
3962
|
|
|
|
|
9219
|
$self->_field_add_values(\@date,3,@h); |
1659
|
|
|
|
|
|
|
} |
1660
|
|
|
|
|
|
|
|
1661
|
|
|
|
|
|
|
# Do minutes |
1662
|
4050
|
100
|
|
|
|
8614
|
if ($n <= 5) { |
1663
|
3995
|
|
|
|
|
7579
|
($err,@mn) = $self->_rtime_values('mn',$mnf); |
1664
|
3995
|
50
|
|
|
|
7993
|
return () if ($err); |
1665
|
3995
|
|
|
|
|
9109
|
$self->_field_add_values(\@date,4,@mn); |
1666
|
|
|
|
|
|
|
} |
1667
|
|
|
|
|
|
|
|
1668
|
|
|
|
|
|
|
# Do seconds |
1669
|
4050
|
100
|
|
|
|
8214
|
if ($n <= 6) { |
1670
|
3995
|
|
|
|
|
7404
|
($err,@s) = $self->_rtime_values('s',$sf); |
1671
|
3995
|
50
|
|
|
|
7534
|
return () if ($err); |
1672
|
3995
|
|
|
|
|
7983
|
$self->_field_add_values(\@date,5,@s); |
1673
|
|
|
|
|
|
|
} |
1674
|
|
|
|
|
|
|
|
1675
|
|
|
|
|
|
|
# Sort the dates... just to be sure. |
1676
|
|
|
|
|
|
|
|
1677
|
4050
|
100
|
|
|
|
12942
|
@date = sort { $dmb->cmp($a,$b) } @date if (@date); |
|
507
|
|
|
|
|
1338
|
|
1678
|
|
|
|
|
|
|
|
1679
|
|
|
|
|
|
|
# |
1680
|
|
|
|
|
|
|
# Apply modifiers |
1681
|
|
|
|
|
|
|
# |
1682
|
|
|
|
|
|
|
|
1683
|
4050
|
|
|
|
|
5838
|
my @flags = @{ $$self{'data'}{'flags'} }; |
|
4050
|
|
|
|
|
9421
|
|
1684
|
4050
|
100
|
|
|
|
8164
|
if (@flags) { |
1685
|
2156
|
|
|
|
|
6419
|
my $obj = $self->new_date(); |
1686
|
|
|
|
|
|
|
|
1687
|
2156
|
|
|
|
|
3318
|
my @keep; |
1688
|
2156
|
|
|
|
|
3954
|
foreach my $date (@date) { |
1689
|
2192
|
|
|
|
|
4977
|
my ($y,$m,$d,$h,$mn,$s) = @$date; |
1690
|
|
|
|
|
|
|
|
1691
|
2192
|
|
|
|
|
3211
|
my $keep = 1; |
1692
|
|
|
|
|
|
|
|
1693
|
|
|
|
|
|
|
MODIFIER: |
1694
|
2192
|
|
|
|
|
3367
|
foreach my $flag (@flags) { |
1695
|
2343
|
|
|
|
|
3502
|
my(@wd,$today); |
1696
|
|
|
|
|
|
|
|
1697
|
2343
|
100
|
100
|
|
|
23969
|
if ($flag =~ /^([pn])([dt])([1-7])$/) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1698
|
56
|
|
|
|
|
187
|
my($forw,$today,$dow) = ($1,$2,$3); |
1699
|
56
|
100
|
|
|
|
138
|
$forw = ($forw eq 'p' ? 0 : 1); |
1700
|
56
|
100
|
|
|
|
111
|
$today = ($today eq 'd' ? 0 : 1); |
1701
|
|
|
|
|
|
|
($y,$m,$d,$h,$mn,$s) = |
1702
|
56
|
|
|
|
|
69
|
@{ $obj->__next_prev([$y,$m,$d,$h,$mn,$s],$forw,$dow,$today) }; |
|
56
|
|
|
|
|
207
|
|
1703
|
|
|
|
|
|
|
|
1704
|
|
|
|
|
|
|
} elsif ($flag =~ /^([fb])([dw])(\d+)$/) { |
1705
|
427
|
|
|
|
|
1760
|
my($prev,$business,$n) = ($1,$2,$3); |
1706
|
427
|
100
|
|
|
|
1125
|
$prev = ($prev eq 'b' ? 1 : 0); |
1707
|
427
|
100
|
|
|
|
890
|
$business = ($business eq 'w' ? 1 : 0); |
1708
|
|
|
|
|
|
|
|
1709
|
427
|
100
|
|
|
|
816
|
if ($business) { |
1710
|
|
|
|
|
|
|
($y,$m,$d,$h,$mn,$s) = |
1711
|
18
|
|
|
|
|
44
|
@{ $obj->__nextprev_business_day($prev,$n,0,[$y,$m,$d,$h,$mn,$s]) }; |
|
18
|
|
|
|
|
98
|
|
1712
|
|
|
|
|
|
|
} else { |
1713
|
409
|
|
|
|
|
571
|
($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],$n,$prev) }; |
|
409
|
|
|
|
|
1636
|
|
1714
|
|
|
|
|
|
|
} |
1715
|
|
|
|
|
|
|
|
1716
|
|
|
|
|
|
|
} elsif ($flag eq 'ibd' || |
1717
|
|
|
|
|
|
|
$flag eq 'nbd') { |
1718
|
243
|
|
|
|
|
966
|
my $bd = $obj->__is_business_day([$y,$m,$d,$h,$mn,$s],0); |
1719
|
|
|
|
|
|
|
|
1720
|
243
|
100
|
100
|
|
|
1482
|
if ( ($flag eq 'ibd' && ! $bd) || |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
1721
|
|
|
|
|
|
|
($flag eq 'nbd' && $bd) ) { |
1722
|
113
|
|
|
|
|
174
|
$keep = 0; |
1723
|
113
|
|
|
|
|
279
|
last MODIFIER; |
1724
|
|
|
|
|
|
|
} |
1725
|
|
|
|
|
|
|
|
1726
|
|
|
|
|
|
|
} elsif ($flag =~ /^([in])w([1-7])$/) { |
1727
|
99
|
|
|
|
|
379
|
my($is,$dow) = ($1,$2); |
1728
|
99
|
50
|
|
|
|
215
|
$is = ($is eq 'i' ? 1 : 0); |
1729
|
99
|
|
|
|
|
354
|
my $currdow = $dmb->day_of_week([$y,$m,$d]); # Current dow |
1730
|
99
|
100
|
66
|
|
|
539
|
if ( ($is && $dow != $currdow) || |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
1731
|
|
|
|
|
|
|
(! $is && $dow == $currdow) ) { |
1732
|
85
|
|
|
|
|
129
|
$keep = 0; |
1733
|
85
|
|
|
|
|
187
|
last MODIFIER; |
1734
|
|
|
|
|
|
|
} |
1735
|
|
|
|
|
|
|
|
1736
|
|
|
|
|
|
|
} elsif ($flag =~ /^wd([1-7])$/) { |
1737
|
9
|
|
|
|
|
29
|
my $dow = $1; # Dow wanted |
1738
|
9
|
|
|
|
|
53
|
my $currdow = $dmb->day_of_week([$y,$m,$d]); # Current dow |
1739
|
9
|
100
|
|
|
|
37
|
if ($dow != $currdow) { |
1740
|
7
|
|
|
|
|
24
|
my($yy,$ww) = $dmb->week_of_year([$y,$m,$d]); # What week is this |
1741
|
7
|
|
|
|
|
20
|
my $tmp = $dmb->week_of_year($yy,$ww); # First day of week |
1742
|
7
|
|
|
|
|
15
|
($y,$m,$d) = @$tmp; |
1743
|
7
|
|
|
|
|
15
|
$currdow = $dmb->_config('firstday'); |
1744
|
7
|
50
|
|
|
|
16
|
if ($dow > $currdow) { |
|
|
0
|
|
|
|
|
|
1745
|
7
|
|
|
|
|
23
|
$tmp = $dmb->calc_date_days([$y,$m,$d],$dow-$currdow); |
1746
|
7
|
|
|
|
|
25
|
($y,$m,$d) = @$tmp; |
1747
|
|
|
|
|
|
|
} elsif ($dow < $currdow) { |
1748
|
0
|
|
|
|
|
0
|
$tmp = $dmb->calc_date_days([$y,$m,$d],$dow-$currdow+7); |
1749
|
0
|
|
|
|
|
0
|
($y,$m,$d) = @$tmp; |
1750
|
|
|
|
|
|
|
} |
1751
|
|
|
|
|
|
|
} |
1752
|
|
|
|
|
|
|
|
1753
|
|
|
|
|
|
|
} elsif ($flag eq 'nwd') { |
1754
|
166
|
100
|
|
|
|
669
|
if (! $obj->__is_business_day([$y,$m,$d,$h,$mn,$s],0)) { |
1755
|
|
|
|
|
|
|
($y,$m,$d,$h,$mn,$s) = |
1756
|
78
|
|
|
|
|
121
|
@{ $obj->__nextprev_business_day(0,0,0,[$y,$m,$d,$h,$mn,$s]) }; |
|
78
|
|
|
|
|
352
|
|
1757
|
|
|
|
|
|
|
} |
1758
|
|
|
|
|
|
|
|
1759
|
|
|
|
|
|
|
} elsif ($flag eq 'pwd') { |
1760
|
10
|
100
|
|
|
|
47
|
if (! $obj->__is_business_day([$y,$m,$d,$h,$mn,$s],0)) { |
1761
|
|
|
|
|
|
|
($y,$m,$d,$h,$mn,$s) = |
1762
|
5
|
|
|
|
|
11
|
@{ $obj->__nextprev_business_day(1,1,0,[$y,$m,$d,$h,$mn,$s]) }; |
|
5
|
|
|
|
|
23
|
|
1763
|
|
|
|
|
|
|
} |
1764
|
|
|
|
|
|
|
|
1765
|
|
|
|
|
|
|
} elsif ($flag eq 'easter') { |
1766
|
21
|
|
|
|
|
62
|
($m,$d) = $self->_easter($y); |
1767
|
|
|
|
|
|
|
|
1768
|
|
|
|
|
|
|
} elsif ($flag eq 'dwd' && |
1769
|
|
|
|
|
|
|
$obj->__is_business_day([$y,$m,$d,$h,$mn,$s],0)) { |
1770
|
|
|
|
|
|
|
# nothing |
1771
|
|
|
|
|
|
|
|
1772
|
|
|
|
|
|
|
} else { |
1773
|
|
|
|
|
|
|
|
1774
|
626
|
100
|
100
|
|
|
2815
|
if ($flag eq 'cwd' || $flag eq 'dwd') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1775
|
608
|
50
|
|
|
|
1445
|
if ($dmb->_config('tomorrowfirst')) { |
1776
|
608
|
|
|
|
|
3036
|
@wd = ([$y,$m,$d,$h,$mn,$s],+1, [$y,$m,$d,$h,$mn,$s],-1); |
1777
|
|
|
|
|
|
|
} else { |
1778
|
0
|
|
|
|
|
0
|
@wd = ([$y,$m,$d,$h,$mn,$s],-1, [$y,$m,$d,$h,$mn,$s],+1); |
1779
|
|
|
|
|
|
|
} |
1780
|
|
|
|
|
|
|
|
1781
|
|
|
|
|
|
|
} elsif ($flag eq 'cwn') { |
1782
|
9
|
|
|
|
|
41
|
@wd = ([$y,$m,$d,$h,$mn,$s],+1, [$y,$m,$d,$h,$mn,$s],-1); |
1783
|
9
|
|
|
|
|
18
|
$today = 0; |
1784
|
|
|
|
|
|
|
|
1785
|
|
|
|
|
|
|
} elsif ($flag eq 'cwp') { |
1786
|
9
|
|
|
|
|
79
|
@wd = ([$y,$m,$d,$h,$mn,$s],-1, [$y,$m,$d,$h,$mn,$s],+1); |
1787
|
9
|
|
|
|
|
23
|
$today = 0; |
1788
|
|
|
|
|
|
|
} |
1789
|
|
|
|
|
|
|
|
1790
|
626
|
|
|
|
|
1200
|
while (1) { |
1791
|
739
|
|
|
|
|
1232
|
my(@d,$off); |
1792
|
|
|
|
|
|
|
|
1793
|
|
|
|
|
|
|
# Test in the first direction |
1794
|
|
|
|
|
|
|
|
1795
|
739
|
|
|
|
|
1077
|
@d = @{ $wd[0] }; |
|
739
|
|
|
|
|
2224
|
|
1796
|
739
|
|
|
|
|
1227
|
$off = $wd[1]; |
1797
|
739
|
|
|
|
|
1043
|
@d = @{ $dmb->calc_date_days(\@d,$off) }; |
|
739
|
|
|
|
|
2248
|
|
1798
|
|
|
|
|
|
|
|
1799
|
739
|
100
|
|
|
|
2591
|
if ($obj->__is_business_day(\@d,0)) { |
1800
|
396
|
|
|
|
|
1131
|
($y,$m,$d,$h,$mn,$s) = @d; |
1801
|
396
|
|
|
|
|
1599
|
last; |
1802
|
|
|
|
|
|
|
} |
1803
|
|
|
|
|
|
|
|
1804
|
343
|
|
|
|
|
1116
|
$wd[0] = [@d]; |
1805
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
# Test in the other direction |
1807
|
|
|
|
|
|
|
|
1808
|
343
|
|
|
|
|
645
|
@d = @{ $wd[2] }; |
|
343
|
|
|
|
|
842
|
|
1809
|
343
|
|
|
|
|
565
|
$off = $wd[3]; |
1810
|
343
|
|
|
|
|
525
|
@d = @{ $dmb->calc_date_days(\@d,$off) }; |
|
343
|
|
|
|
|
921
|
|
1811
|
|
|
|
|
|
|
|
1812
|
343
|
100
|
|
|
|
1164
|
if ($obj->__is_business_day(\@d,0)) { |
1813
|
230
|
|
|
|
|
641
|
($y,$m,$d,$h,$mn,$s) = @d; |
1814
|
230
|
|
|
|
|
914
|
last; |
1815
|
|
|
|
|
|
|
} |
1816
|
|
|
|
|
|
|
|
1817
|
113
|
|
|
|
|
441
|
$wd[2] = [@d]; |
1818
|
|
|
|
|
|
|
} |
1819
|
|
|
|
|
|
|
|
1820
|
|
|
|
|
|
|
} |
1821
|
|
|
|
|
|
|
} |
1822
|
|
|
|
|
|
|
|
1823
|
2192
|
100
|
|
|
|
4444
|
if ($keep) { |
1824
|
1994
|
|
|
|
|
5773
|
push(@keep,[$y,$m,$d,$h,$mn,$s]); |
1825
|
|
|
|
|
|
|
} |
1826
|
|
|
|
|
|
|
} |
1827
|
2156
|
|
|
|
|
11259
|
@date = @keep; |
1828
|
|
|
|
|
|
|
} |
1829
|
|
|
|
|
|
|
|
1830
|
|
|
|
|
|
|
# |
1831
|
|
|
|
|
|
|
# Convert the dates to objects. |
1832
|
|
|
|
|
|
|
# |
1833
|
|
|
|
|
|
|
|
1834
|
4050
|
|
|
|
|
6255
|
my(@ret); |
1835
|
|
|
|
|
|
|
|
1836
|
4050
|
|
|
|
|
6656
|
foreach my $date (@date) { |
1837
|
4039
|
|
|
|
|
9327
|
my @d = @$date; |
1838
|
|
|
|
|
|
|
|
1839
|
4039
|
|
|
|
|
11219
|
my $obj = $self->new_date(); |
1840
|
4039
|
|
|
|
|
13532
|
$obj->set('date',\@d); |
1841
|
4039
|
100
|
|
|
|
12431
|
if ($obj->err()) { |
1842
|
1
|
|
|
|
|
5
|
push(@ret,undef); |
1843
|
|
|
|
|
|
|
} else { |
1844
|
4038
|
|
|
|
|
9873
|
push(@ret,$obj); |
1845
|
|
|
|
|
|
|
} |
1846
|
|
|
|
|
|
|
} |
1847
|
|
|
|
|
|
|
|
1848
|
4050
|
|
|
|
|
19671
|
return @ret; |
1849
|
|
|
|
|
|
|
} |
1850
|
|
|
|
|
|
|
|
1851
|
|
|
|
|
|
|
# This calculates the Nth interval date (0 is the base date) and then |
1852
|
|
|
|
|
|
|
# calculates the recurring events produced by it. |
1853
|
|
|
|
|
|
|
# |
1854
|
|
|
|
|
|
|
sub _nth_interval { |
1855
|
7768
|
|
|
7768
|
|
13818
|
my($self,$n) = @_; |
1856
|
7768
|
100
|
|
|
|
19001
|
return if (exists $$self{'data'}{'idate'}{$n}); |
1857
|
3913
|
|
|
|
|
6250
|
my $base = $$self{'data'}{'BASE'}; |
1858
|
3913
|
|
|
|
|
5287
|
my $date; |
1859
|
|
|
|
|
|
|
|
1860
|
|
|
|
|
|
|
# Get the interval date. |
1861
|
|
|
|
|
|
|
|
1862
|
3913
|
100
|
|
|
|
7753
|
if ($n == 0) { |
1863
|
999
|
|
|
|
|
1490
|
$date = $base; |
1864
|
|
|
|
|
|
|
|
1865
|
|
|
|
|
|
|
} else { |
1866
|
2914
|
|
|
|
|
9418
|
my @delta = $$self{'data'}{'delta'}->value; |
1867
|
2914
|
|
|
|
|
5255
|
my $absn = abs($n); |
1868
|
2914
|
|
|
|
|
5706
|
@delta = map { $absn*$_ } @delta; |
|
20398
|
|
|
|
|
31587
|
|
1869
|
2914
|
|
|
|
|
8582
|
my $delta = $self->new_delta; |
1870
|
2914
|
|
|
|
|
11421
|
$delta->set('delta',[@delta]); |
1871
|
2914
|
100
|
|
|
|
12860
|
$date = $base->calc($delta, ($n>0 ? 0 : 2)); |
1872
|
|
|
|
|
|
|
} |
1873
|
|
|
|
|
|
|
|
1874
|
|
|
|
|
|
|
# For 'slow' recursion, we need to make sure we've got |
1875
|
|
|
|
|
|
|
# the n-1 or n+1 interval as appropriate. |
1876
|
|
|
|
|
|
|
|
1877
|
3913
|
100
|
|
|
|
10440
|
if ($$self{'data'}{'slow'}) { |
1878
|
|
|
|
|
|
|
|
1879
|
24
|
100
|
|
|
|
63
|
if ($n > 0) { |
|
|
100
|
|
|
|
|
|
1880
|
14
|
|
|
|
|
57
|
$self->_nth_interval($n-1); |
1881
|
|
|
|
|
|
|
} elsif ($n < 0) { |
1882
|
5
|
|
|
|
|
21
|
$self->_nth_interval($n+1); |
1883
|
|
|
|
|
|
|
} |
1884
|
|
|
|
|
|
|
} |
1885
|
|
|
|
|
|
|
|
1886
|
|
|
|
|
|
|
# Get the list of events associated with this interval date. |
1887
|
|
|
|
|
|
|
|
1888
|
3913
|
|
|
|
|
10057
|
my @date = $self->_apply_rtime_mods($date); |
1889
|
|
|
|
|
|
|
|
1890
|
|
|
|
|
|
|
# Determine the index of the earliest event associated with |
1891
|
|
|
|
|
|
|
# this interval date. |
1892
|
|
|
|
|
|
|
# |
1893
|
|
|
|
|
|
|
# Events are numbered [$n0...$n1] |
1894
|
|
|
|
|
|
|
|
1895
|
3913
|
|
|
|
|
6481
|
my($n0,$n1); |
1896
|
3913
|
100
|
|
|
|
8970
|
if ($$self{'data'}{'slow'}) { |
1897
|
|
|
|
|
|
|
|
1898
|
24
|
100
|
|
|
|
92
|
if (! @date) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1899
|
4
|
|
|
|
|
10
|
$n0 = undef; |
1900
|
4
|
|
|
|
|
9
|
$n1 = undef; |
1901
|
|
|
|
|
|
|
|
1902
|
|
|
|
|
|
|
} elsif ($n == 0) { |
1903
|
4
|
|
|
|
|
9
|
$n0 = 0; |
1904
|
4
|
|
|
|
|
11
|
$n1 = $#date; |
1905
|
|
|
|
|
|
|
|
1906
|
|
|
|
|
|
|
} elsif ($n > 0) { |
1907
|
11
|
|
|
|
|
88
|
foreach (my $i = $n-1; $i >= 0; $i--) { |
1908
|
14
|
100
|
|
|
|
53
|
next if (! defined $$self{'data'}{'idate'}{$i}[2]); |
1909
|
10
|
|
|
|
|
20
|
$n0 = $$self{'data'}{'idate'}{$i}[2] + 1; |
1910
|
10
|
|
|
|
|
18
|
last; |
1911
|
|
|
|
|
|
|
} |
1912
|
11
|
100
|
|
|
|
25
|
$n0 = 0 if (! defined $n0); |
1913
|
11
|
|
|
|
|
21
|
$n1 = $n0 + $#date; |
1914
|
|
|
|
|
|
|
|
1915
|
|
|
|
|
|
|
} else { |
1916
|
5
|
|
|
|
|
16
|
foreach (my $i = $n+1; $i <= 0; $i++) { |
1917
|
5
|
100
|
|
|
|
30
|
next if (! defined $$self{'data'}{'idate'}{$i}[1]); |
1918
|
4
|
|
|
|
|
10
|
$n1 = $$self{'data'}{'idate'}{$i}[1] - 1; |
1919
|
4
|
|
|
|
|
8
|
last; |
1920
|
|
|
|
|
|
|
} |
1921
|
5
|
100
|
|
|
|
39
|
$n1 = -1 if (! defined $n1); |
1922
|
5
|
|
|
|
|
13
|
$n0 = $n1 - $#date; |
1923
|
|
|
|
|
|
|
} |
1924
|
|
|
|
|
|
|
|
1925
|
|
|
|
|
|
|
} else { |
1926
|
|
|
|
|
|
|
|
1927
|
|
|
|
|
|
|
# ev_per_d = 3 |
1928
|
|
|
|
|
|
|
# idate = 0 1 2 |
1929
|
|
|
|
|
|
|
# events = 0 1 2 3 4 5 6 7 8 |
1930
|
|
|
|
|
|
|
|
1931
|
|
|
|
|
|
|
# ev_per_d = 3 |
1932
|
|
|
|
|
|
|
# idate = -1 -2 -3 |
1933
|
|
|
|
|
|
|
# events = -3 -2 -1 -6 -5 -4 -9 -8 -7 |
1934
|
|
|
|
|
|
|
|
1935
|
3889
|
|
|
|
|
6408
|
$n0 = $n * $$self{'data'}{'ev_per_d'}; |
1936
|
3889
|
|
|
|
|
6682
|
$n1 = $n0 + $$self{'data'}{'ev_per_d'} - 1; |
1937
|
|
|
|
|
|
|
} |
1938
|
|
|
|
|
|
|
|
1939
|
|
|
|
|
|
|
# Store the dates. |
1940
|
|
|
|
|
|
|
|
1941
|
3913
|
|
|
|
|
9675
|
for (my $i=0; $i<=$#date; $i++) { |
1942
|
3809
|
|
|
|
|
13881
|
$$self{'data'}{'dates'}{$n0+$i} = $date[$i]; |
1943
|
|
|
|
|
|
|
} |
1944
|
|
|
|
|
|
|
|
1945
|
|
|
|
|
|
|
# Store the idate. |
1946
|
|
|
|
|
|
|
|
1947
|
3913
|
100
|
|
|
|
8179
|
if ($$self{'data'}{'slow'}) { |
1948
|
24
|
|
|
|
|
107
|
$$self{'data'}{'idate'}{$n} = [$date,$n0,$n1]; |
1949
|
|
|
|
|
|
|
} else { |
1950
|
3889
|
|
|
|
|
9811
|
$$self{'data'}{'idate'}{$n} = $date; |
1951
|
|
|
|
|
|
|
} |
1952
|
|
|
|
|
|
|
} |
1953
|
|
|
|
|
|
|
|
1954
|
|
|
|
|
|
|
# This locates the first/last event in the range and returns $n. It |
1955
|
|
|
|
|
|
|
# returns undef if there is no date in the range. |
1956
|
|
|
|
|
|
|
# |
1957
|
|
|
|
|
|
|
sub _locate_n { |
1958
|
2351
|
|
|
2351
|
|
4626
|
my($self,$op) = @_; |
1959
|
|
|
|
|
|
|
|
1960
|
2351
|
100
|
|
|
|
6676
|
return $$self{'data'}{$op} if (defined $$self{'data'}{$op}); |
1961
|
|
|
|
|
|
|
|
1962
|
1152
|
|
|
|
|
2159
|
my $start = $$self{'data'}{'start'}; |
1963
|
1152
|
|
|
|
|
1909
|
my $end = $$self{'data'}{'end'}; |
1964
|
1152
|
|
|
|
|
1898
|
my $unmod = $$self{'data'}{'unmod_range'}; |
1965
|
1152
|
|
|
|
|
1838
|
my $dmt = $$self{'tz'}; |
1966
|
1152
|
|
|
|
|
1895
|
my $dmb = $$dmt{'base'}; |
1967
|
1152
|
|
|
|
|
3150
|
my $maxatt = $dmb->_config('maxrecurattempts'); |
1968
|
|
|
|
|
|
|
|
1969
|
1152
|
100
|
|
|
|
3056
|
if ($$self{'data'}{'noint'} == 2) { |
1970
|
|
|
|
|
|
|
# If there is no interval, then we have calculated all the dates |
1971
|
|
|
|
|
|
|
# possible. Work with them only. |
1972
|
|
|
|
|
|
|
|
1973
|
3
|
|
|
|
|
6
|
my($i,$first,$last); |
1974
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
# Find the first date in the interval |
1976
|
|
|
|
|
|
|
|
1977
|
3
|
|
|
|
|
10
|
$i = 0; |
1978
|
3
|
|
|
|
|
6
|
while (1) { |
1979
|
7
|
100
|
|
|
|
22
|
last if (! exists $$self{'data'}{'dates'}{$i}); |
1980
|
5
|
|
|
|
|
10
|
my $date = $$self{'data'}{'dates'}{$i}; |
1981
|
5
|
100
|
|
|
|
16
|
if ($date->cmp($start) == -1) { |
|
|
50
|
|
|
|
|
|
1982
|
|
|
|
|
|
|
# date < start : move to the next one |
1983
|
4
|
|
|
|
|
8
|
$i++; |
1984
|
4
|
|
|
|
|
12
|
next; |
1985
|
|
|
|
|
|
|
} elsif ($date->cmp($end) == 1) { |
1986
|
|
|
|
|
|
|
# date > end : we're done |
1987
|
0
|
|
|
|
|
0
|
last; |
1988
|
|
|
|
|
|
|
} else { |
1989
|
|
|
|
|
|
|
# start <= date <= end : this is the first one |
1990
|
1
|
|
|
|
|
9
|
$first = $i; |
1991
|
1
|
|
|
|
|
5
|
last; |
1992
|
|
|
|
|
|
|
} |
1993
|
|
|
|
|
|
|
} |
1994
|
|
|
|
|
|
|
|
1995
|
|
|
|
|
|
|
# If we found one, find the last one |
1996
|
|
|
|
|
|
|
|
1997
|
3
|
100
|
|
|
|
9
|
if (defined($first)) { |
1998
|
1
|
|
|
|
|
2
|
$i = $first; |
1999
|
1
|
|
|
|
|
3
|
$last = $i; |
2000
|
1
|
|
|
|
|
2
|
while (1) { |
2001
|
4
|
50
|
|
|
|
15
|
last if (! exists $$self{'data'}{'dates'}{$i}); |
2002
|
4
|
|
|
|
|
7
|
my $date = $$self{'data'}{'dates'}{$i}; |
2003
|
4
|
100
|
|
|
|
11
|
if ($date->cmp($end) == 1) { |
2004
|
|
|
|
|
|
|
# date > end : we're done |
2005
|
1
|
|
|
|
|
4
|
last; |
2006
|
|
|
|
|
|
|
} else { |
2007
|
|
|
|
|
|
|
# date <= end : this might be the last one |
2008
|
3
|
|
|
|
|
10
|
$last = $i; |
2009
|
3
|
|
|
|
|
5
|
$i++; |
2010
|
3
|
|
|
|
|
4
|
next; |
2011
|
|
|
|
|
|
|
} |
2012
|
|
|
|
|
|
|
} |
2013
|
|
|
|
|
|
|
} |
2014
|
|
|
|
|
|
|
|
2015
|
3
|
|
|
|
|
7
|
$$self{'data'}{'first'} = $first; |
2016
|
3
|
|
|
|
|
7
|
$$self{'data'}{'last'} = $last; |
2017
|
3
|
|
|
|
|
9
|
return $$self{'data'}{$op} |
2018
|
|
|
|
|
|
|
} |
2019
|
|
|
|
|
|
|
|
2020
|
|
|
|
|
|
|
|
2021
|
|
|
|
|
|
|
# Given interval date Idate(n) produces event dates: Date(f)..Date(l) |
2022
|
|
|
|
|
|
|
# |
2023
|
|
|
|
|
|
|
# If we're looking at unmodified dates: |
2024
|
|
|
|
|
|
|
# Find smallest n such that: |
2025
|
|
|
|
|
|
|
# Idate(n) >= start |
2026
|
|
|
|
|
|
|
# first=f |
2027
|
|
|
|
|
|
|
# Then find largest n such that: |
2028
|
|
|
|
|
|
|
# Idate(n) <= end |
2029
|
|
|
|
|
|
|
# last=l |
2030
|
|
|
|
|
|
|
# Otherwise |
2031
|
|
|
|
|
|
|
# Find smallest n such that |
2032
|
|
|
|
|
|
|
# Date(y) >= start |
2033
|
|
|
|
|
|
|
# first=z (smallest z) |
2034
|
|
|
|
|
|
|
# Where x <= z <= y and |
2035
|
|
|
|
|
|
|
# Date(z) >= start |
2036
|
|
|
|
|
|
|
# Then find largest n such that |
2037
|
|
|
|
|
|
|
# Date(x) <= end |
2038
|
|
|
|
|
|
|
# last=z (largest z) |
2039
|
|
|
|
|
|
|
# Where x <= z <= y and |
2040
|
|
|
|
|
|
|
# Date(z) <= end |
2041
|
|
|
|
|
|
|
|
2042
|
1149
|
|
|
|
|
2110
|
my($first_int,$last_int,$first,$last); |
2043
|
|
|
|
|
|
|
|
2044
|
1149
|
100
|
|
|
|
2821
|
if ($$self{'data'}{'slow'}) { |
2045
|
|
|
|
|
|
|
|
2046
|
|
|
|
|
|
|
# |
2047
|
|
|
|
|
|
|
# For a 'slow' recurrence, we have to start at 0 and work forwards |
2048
|
|
|
|
|
|
|
# or backwards. |
2049
|
|
|
|
|
|
|
# |
2050
|
|
|
|
|
|
|
|
2051
|
|
|
|
|
|
|
# Move backwards until we're completely before start |
2052
|
|
|
|
|
|
|
|
2053
|
4
|
|
|
|
|
8
|
$first_int = 0; |
2054
|
4
|
50
|
|
|
|
11
|
if ($unmod) { |
2055
|
0
|
|
|
|
|
0
|
my $n = 0; |
2056
|
0
|
|
|
|
|
0
|
while (1) { |
2057
|
0
|
0
|
|
|
|
0
|
if ($n > $maxatt) { |
2058
|
0
|
|
|
|
|
0
|
$$self{'err'} = |
2059
|
|
|
|
|
|
|
"[_locate_n] Unable to find an interval in $maxatt attempts"; |
2060
|
0
|
|
|
|
|
0
|
return; |
2061
|
|
|
|
|
|
|
} |
2062
|
0
|
|
|
|
|
0
|
$self->_nth_interval($first_int); |
2063
|
0
|
|
|
|
|
0
|
my $date = $$self{'data'}{'idate'}{$first_int}[0]; |
2064
|
0
|
0
|
|
|
|
0
|
if (defined($date)) { |
2065
|
0
|
|
|
|
|
0
|
$n = 0; |
2066
|
0
|
0
|
|
|
|
0
|
last if ($date->cmp($start) < 0); |
2067
|
|
|
|
|
|
|
} else { |
2068
|
0
|
|
|
|
|
0
|
$n++; |
2069
|
|
|
|
|
|
|
} |
2070
|
0
|
|
|
|
|
0
|
$first_int--; |
2071
|
|
|
|
|
|
|
} |
2072
|
|
|
|
|
|
|
|
2073
|
|
|
|
|
|
|
} else { |
2074
|
4
|
|
|
|
|
7
|
my $n = 0; |
2075
|
4
|
|
|
|
|
7
|
while (1) { |
2076
|
9
|
50
|
|
|
|
24
|
if ($n > $maxatt) { |
2077
|
0
|
|
|
|
|
0
|
$$self{'err'} = |
2078
|
|
|
|
|
|
|
"[_locate_n] Unable to find an interval in $maxatt attempts"; |
2079
|
0
|
|
|
|
|
0
|
return; |
2080
|
|
|
|
|
|
|
} |
2081
|
9
|
|
|
|
|
25
|
$self->_nth_interval($first_int); |
2082
|
9
|
|
|
|
|
22
|
my $ptr = $$self{'data'}{'idate'}{$first_int}[2]; |
2083
|
9
|
100
|
|
|
|
23
|
if (defined $ptr) { |
2084
|
8
|
|
|
|
|
14
|
my $date = $$self{'data'}{'dates'}{$ptr}; |
2085
|
8
|
50
|
|
|
|
17
|
if (defined($date)) { |
2086
|
8
|
|
|
|
|
13
|
$n = 0; |
2087
|
8
|
100
|
|
|
|
24
|
last if ($date->cmp($start) < 0); |
2088
|
|
|
|
|
|
|
} else { |
2089
|
0
|
|
|
|
|
0
|
$n++; |
2090
|
|
|
|
|
|
|
} |
2091
|
|
|
|
|
|
|
} else { |
2092
|
1
|
|
|
|
|
3
|
$n++; |
2093
|
|
|
|
|
|
|
} |
2094
|
5
|
|
|
|
|
12
|
$first_int--; |
2095
|
|
|
|
|
|
|
} |
2096
|
|
|
|
|
|
|
} |
2097
|
|
|
|
|
|
|
|
2098
|
|
|
|
|
|
|
# Then move forwards until we're after start |
2099
|
|
|
|
|
|
|
# i.e. Date(y) >= start for modified dates |
2100
|
|
|
|
|
|
|
|
2101
|
4
|
50
|
|
|
|
25
|
if ($unmod) { |
2102
|
0
|
|
|
|
|
0
|
my $n = 0; |
2103
|
0
|
|
|
|
|
0
|
while (1) { |
2104
|
0
|
0
|
|
|
|
0
|
if ($n > $maxatt) { |
2105
|
0
|
|
|
|
|
0
|
$$self{'err'} = |
2106
|
|
|
|
|
|
|
"[_locate_n] Unable to find an interval in $maxatt attempts"; |
2107
|
0
|
|
|
|
|
0
|
return; |
2108
|
|
|
|
|
|
|
} |
2109
|
0
|
|
|
|
|
0
|
$self->_nth_interval($first_int); |
2110
|
0
|
|
|
|
|
0
|
my $date = $$self{'data'}{'idate'}{$first_int}[0]; |
2111
|
0
|
0
|
|
|
|
0
|
if (defined($date)) { |
2112
|
0
|
|
|
|
|
0
|
$n = 0; |
2113
|
0
|
0
|
|
|
|
0
|
last if ($date->cmp($start) >= 0); |
2114
|
|
|
|
|
|
|
} else { |
2115
|
0
|
|
|
|
|
0
|
$n++; |
2116
|
|
|
|
|
|
|
} |
2117
|
0
|
|
|
|
|
0
|
$first_int++; |
2118
|
|
|
|
|
|
|
} |
2119
|
0
|
|
|
|
|
0
|
$first = $$self{'data'}{'idate'}{$first_int}[1]; |
2120
|
|
|
|
|
|
|
|
2121
|
|
|
|
|
|
|
} else { |
2122
|
4
|
|
|
|
|
8
|
my $n = 0; |
2123
|
4
|
|
|
|
|
8
|
while (1) { |
2124
|
11
|
50
|
|
|
|
24
|
if ($n > $maxatt) { |
2125
|
0
|
|
|
|
|
0
|
$$self{'err'} = |
2126
|
|
|
|
|
|
|
"[_locate_n] Unable to find an interval in $maxatt attempts"; |
2127
|
0
|
|
|
|
|
0
|
return; |
2128
|
|
|
|
|
|
|
} |
2129
|
11
|
|
|
|
|
31
|
$self->_nth_interval($first_int); |
2130
|
11
|
|
|
|
|
25
|
my $ptr = $$self{'data'}{'idate'}{$first_int}[2]; |
2131
|
11
|
100
|
|
|
|
22
|
if (defined $ptr) { |
2132
|
10
|
|
|
|
|
21
|
my $date = $$self{'data'}{'dates'}{$ptr}; |
2133
|
10
|
50
|
|
|
|
20
|
if (defined($date)) { |
2134
|
10
|
|
|
|
|
14
|
$n = 0; |
2135
|
10
|
100
|
|
|
|
26
|
last if ($date->cmp($start) >= 0); |
2136
|
|
|
|
|
|
|
} else { |
2137
|
0
|
|
|
|
|
0
|
$n++; |
2138
|
|
|
|
|
|
|
} |
2139
|
|
|
|
|
|
|
} else { |
2140
|
1
|
|
|
|
|
2
|
$n++; |
2141
|
|
|
|
|
|
|
} |
2142
|
7
|
|
|
|
|
20
|
$first_int++; |
2143
|
|
|
|
|
|
|
} |
2144
|
|
|
|
|
|
|
|
2145
|
4
|
|
|
|
|
24
|
foreach my $i ($$self{'data'}{'idate'}{$first_int}[1] .. |
2146
|
|
|
|
|
|
|
$$self{'data'}{'idate'}{$first_int}[2]) { |
2147
|
4
|
|
|
|
|
12
|
my $date = $$self{'data'}{'dates'}{$i}; |
2148
|
4
|
50
|
33
|
|
|
17
|
if (defined $date && $date->cmp($start) >= 0) { |
2149
|
4
|
|
|
|
|
14
|
$first = $i; |
2150
|
4
|
|
|
|
|
9
|
last; |
2151
|
|
|
|
|
|
|
} |
2152
|
|
|
|
|
|
|
} |
2153
|
|
|
|
|
|
|
} |
2154
|
|
|
|
|
|
|
|
2155
|
|
|
|
|
|
|
# Then move forwards until we're after end |
2156
|
|
|
|
|
|
|
# i.e. Date(x) > end for modified dates |
2157
|
|
|
|
|
|
|
|
2158
|
4
|
|
|
|
|
9
|
$last_int = $first_int; |
2159
|
|
|
|
|
|
|
|
2160
|
4
|
50
|
|
|
|
15
|
if ($unmod) { |
2161
|
0
|
|
|
|
|
0
|
my $n = 0; |
2162
|
0
|
|
|
|
|
0
|
while (1) { |
2163
|
0
|
0
|
|
|
|
0
|
if ($n > $maxatt) { |
2164
|
0
|
|
|
|
|
0
|
$$self{'err'} = |
2165
|
|
|
|
|
|
|
"[_locate_n] Unable to find an interval in $maxatt attempts"; |
2166
|
0
|
|
|
|
|
0
|
return; |
2167
|
|
|
|
|
|
|
} |
2168
|
0
|
|
|
|
|
0
|
$self->_nth_interval($last_int); |
2169
|
0
|
|
|
|
|
0
|
my $date = $$self{'data'}{'idate'}{$last_int}[0]; |
2170
|
0
|
0
|
|
|
|
0
|
if (defined($date)) { |
2171
|
0
|
|
|
|
|
0
|
$n = 0; |
2172
|
0
|
0
|
|
|
|
0
|
last if ($date->cmp($end) > 0); |
2173
|
|
|
|
|
|
|
} else { |
2174
|
0
|
|
|
|
|
0
|
$n++; |
2175
|
|
|
|
|
|
|
} |
2176
|
0
|
|
|
|
|
0
|
$last_int++; |
2177
|
|
|
|
|
|
|
} |
2178
|
0
|
|
|
|
|
0
|
$last_int--; |
2179
|
|
|
|
|
|
|
|
2180
|
0
|
|
|
|
|
0
|
for (my $i=$$self{'data'}{'idate'}{$last_int}[2]; |
2181
|
|
|
|
|
|
|
$i >= $$self{'data'}{'idate'}{$last_int}[1]; $i--) { |
2182
|
0
|
|
|
|
|
0
|
my $date = $$self{'data'}{'dates'}{$i}; |
2183
|
0
|
0
|
|
|
|
0
|
if (defined $date) { |
2184
|
0
|
|
|
|
|
0
|
$last = $i; |
2185
|
0
|
|
|
|
|
0
|
last; |
2186
|
|
|
|
|
|
|
} |
2187
|
|
|
|
|
|
|
} |
2188
|
|
|
|
|
|
|
|
2189
|
|
|
|
|
|
|
} else { |
2190
|
4
|
|
|
|
|
9
|
my $n = 0; |
2191
|
4
|
|
|
|
|
8
|
while (1) { |
2192
|
14
|
50
|
|
|
|
26
|
if ($n > $maxatt) { |
2193
|
0
|
|
|
|
|
0
|
$$self{'err'} = |
2194
|
|
|
|
|
|
|
"[_locate_n] Unable to find an interval in $maxatt attempts"; |
2195
|
0
|
|
|
|
|
0
|
return; |
2196
|
|
|
|
|
|
|
} |
2197
|
14
|
|
|
|
|
38
|
$self->_nth_interval($last_int); |
2198
|
14
|
|
|
|
|
33
|
my $ptr = $$self{'data'}{'idate'}{$last_int}[1]; |
2199
|
14
|
100
|
|
|
|
27
|
if (defined $ptr) { |
2200
|
12
|
|
|
|
|
60
|
my $date = $$self{'data'}{'dates'}{$ptr}; |
2201
|
12
|
50
|
|
|
|
22
|
if (defined($date)) { |
2202
|
12
|
|
|
|
|
18
|
$n = 0; |
2203
|
12
|
100
|
|
|
|
33
|
last if ($date->cmp($end) > 0); |
2204
|
|
|
|
|
|
|
} else { |
2205
|
0
|
|
|
|
|
0
|
$n++; |
2206
|
|
|
|
|
|
|
} |
2207
|
|
|
|
|
|
|
} else { |
2208
|
2
|
|
|
|
|
5
|
$n++; |
2209
|
|
|
|
|
|
|
} |
2210
|
10
|
|
|
|
|
22
|
$last_int++; |
2211
|
|
|
|
|
|
|
} |
2212
|
4
|
|
|
|
|
21
|
$last_int--; |
2213
|
|
|
|
|
|
|
|
2214
|
4
|
|
|
|
|
12
|
$last = undef; |
2215
|
4
|
|
|
|
|
10
|
my $i = $first; |
2216
|
4
|
|
|
|
|
8
|
while (1) { |
2217
|
17
|
50
|
|
|
|
50
|
last if (! exists $$self{'data'}{'dates'}{$i}); |
2218
|
17
|
|
|
|
|
27
|
my $date = $$self{'data'}{'dates'}{$i}; |
2219
|
17
|
50
|
|
|
|
32
|
next if (! defined $date); |
2220
|
17
|
100
|
|
|
|
38
|
last if ($date->cmp($end) > 0); |
2221
|
13
|
|
|
|
|
21
|
$last = $i; |
2222
|
13
|
|
|
|
|
17
|
$i++; |
2223
|
|
|
|
|
|
|
} |
2224
|
|
|
|
|
|
|
} |
2225
|
|
|
|
|
|
|
|
2226
|
4
|
50
|
33
|
|
|
27
|
return undef if (! defined $last || |
2227
|
|
|
|
|
|
|
$last < $first); |
2228
|
4
|
|
|
|
|
16
|
$$self{'data'}{'first'} = $first; |
2229
|
4
|
|
|
|
|
8
|
$$self{'data'}{'last'} = $last; |
2230
|
4
|
|
|
|
|
12
|
return $$self{'data'}{$op} |
2231
|
|
|
|
|
|
|
} |
2232
|
|
|
|
|
|
|
|
2233
|
|
|
|
|
|
|
# |
2234
|
|
|
|
|
|
|
# For a normal recurrence, we can estimate which interval date we're |
2235
|
|
|
|
|
|
|
# interested in and then move forward/backward from it. |
2236
|
|
|
|
|
|
|
# |
2237
|
|
|
|
|
|
|
# Calculate the interval date index ($nn) based on the length of |
2238
|
|
|
|
|
|
|
# the delta. |
2239
|
|
|
|
|
|
|
# |
2240
|
|
|
|
|
|
|
# For the Nth interval, the dates produced are: |
2241
|
|
|
|
|
|
|
# N*EV_PER_DAY to (N+1)EV_PER_DAY-1 |
2242
|
|
|
|
|
|
|
# |
2243
|
|
|
|
|
|
|
|
2244
|
1145
|
|
|
|
|
1949
|
my $base = $$self{'data'}{'BASE'}; |
2245
|
1145
|
|
|
|
|
1988
|
my $delta = $$self{'data'}{'delta'}; |
2246
|
|
|
|
|
|
|
# $len = 0 is when a recur contains no delta (i.e. *Y:M:W:D:H:Mn:S) |
2247
|
1145
|
50
|
|
|
|
4536
|
my $len = ($delta ? $delta->printf('%sys') : 0); |
2248
|
|
|
|
|
|
|
|
2249
|
1145
|
100
|
|
|
|
2774
|
my $targ = ($op eq 'first' ? $start : $end); |
2250
|
1145
|
|
|
|
|
3563
|
my $diff = $base->calc($targ); |
2251
|
1145
|
|
|
|
|
3497
|
my $tot = $diff->printf('%sys'); |
2252
|
1145
|
50
|
|
|
|
3983
|
my $nn = ($len ? int($tot/$len) : 1); |
2253
|
1145
|
|
|
|
|
2766
|
my $ev = $$self{'data'}{'ev_per_d'}; |
2254
|
|
|
|
|
|
|
|
2255
|
|
|
|
|
|
|
# Move backwards until we're completely before start |
2256
|
|
|
|
|
|
|
|
2257
|
1145
|
|
|
|
|
1878
|
$first_int = $nn; |
2258
|
1145
|
100
|
|
|
|
2392
|
if ($unmod) { |
2259
|
739
|
|
|
|
|
1054
|
my $n = 0; |
2260
|
739
|
|
|
|
|
1089
|
while (1) { |
2261
|
1492
|
50
|
|
|
|
3071
|
if ($n > $maxatt) { |
2262
|
0
|
|
|
|
|
0
|
$$self{'err'} = |
2263
|
|
|
|
|
|
|
"[_locate_n] Unable to find an interval in $maxatt attempts"; |
2264
|
0
|
|
|
|
|
0
|
return; |
2265
|
|
|
|
|
|
|
} |
2266
|
1492
|
|
|
|
|
4206
|
$self->_nth_interval($first_int); |
2267
|
1492
|
|
|
|
|
3197
|
my $date = $$self{'data'}{'idate'}{$first_int}; |
2268
|
1492
|
50
|
|
|
|
2870
|
if (defined($date)) { |
2269
|
1492
|
|
|
|
|
2029
|
$n = 0; |
2270
|
1492
|
100
|
|
|
|
3977
|
last if ($date->cmp($start) < 0); |
2271
|
|
|
|
|
|
|
} else { |
2272
|
0
|
|
|
|
|
0
|
$n++; |
2273
|
|
|
|
|
|
|
} |
2274
|
753
|
|
|
|
|
1475
|
$first_int--; |
2275
|
|
|
|
|
|
|
} |
2276
|
|
|
|
|
|
|
|
2277
|
|
|
|
|
|
|
} else { |
2278
|
406
|
|
|
|
|
828
|
my $n = 0; |
2279
|
|
|
|
|
|
|
LOOP: |
2280
|
406
|
|
|
|
|
684
|
while (1) { |
2281
|
885
|
100
|
|
|
|
2102
|
if ($n > $maxatt) { |
2282
|
1
|
|
|
|
|
7
|
$$self{'err'} = |
2283
|
|
|
|
|
|
|
"[_locate_n] Unable to find an interval in $maxatt attempts"; |
2284
|
1
|
|
|
|
|
19
|
return; |
2285
|
|
|
|
|
|
|
} |
2286
|
884
|
|
|
|
|
2621
|
$self->_nth_interval($first_int); |
2287
|
884
|
|
|
|
|
3201
|
for (my $i=($first_int+1)*$ev - 1; $i >= $first_int*$ev; $i--) { |
2288
|
1012
|
100
|
|
|
|
2532
|
if (exists $$self{'data'}{'dates'}{$i}) { |
2289
|
816
|
|
|
|
|
1494
|
my $date = $$self{'data'}{'dates'}{$i}; |
2290
|
816
|
50
|
|
|
|
1524
|
if (defined($date)) { |
2291
|
816
|
|
|
|
|
1255
|
$n = 0; |
2292
|
816
|
100
|
|
|
|
2349
|
last LOOP if ($date->cmp($start) < 0); |
2293
|
|
|
|
|
|
|
} else { |
2294
|
0
|
|
|
|
|
0
|
$n++; |
2295
|
|
|
|
|
|
|
} |
2296
|
|
|
|
|
|
|
} else { |
2297
|
196
|
|
|
|
|
459
|
$n++; |
2298
|
|
|
|
|
|
|
} |
2299
|
|
|
|
|
|
|
} |
2300
|
479
|
|
|
|
|
814
|
$first_int--; |
2301
|
|
|
|
|
|
|
} |
2302
|
|
|
|
|
|
|
} |
2303
|
|
|
|
|
|
|
|
2304
|
|
|
|
|
|
|
# Then move forwards until we're after start |
2305
|
|
|
|
|
|
|
# i.e. Date(y) >= start for modified dates |
2306
|
|
|
|
|
|
|
|
2307
|
1144
|
100
|
|
|
|
2901
|
if ($unmod) { |
2308
|
739
|
|
|
|
|
1209
|
my $n = 0; |
2309
|
739
|
|
|
|
|
1105
|
while (1) { |
2310
|
1478
|
50
|
|
|
|
3039
|
if ($n > $maxatt) { |
2311
|
0
|
|
|
|
|
0
|
$$self{'err'} = |
2312
|
|
|
|
|
|
|
"[_locate_n] Unable to find an interval in $maxatt attempts"; |
2313
|
0
|
|
|
|
|
0
|
return; |
2314
|
|
|
|
|
|
|
} |
2315
|
1478
|
|
|
|
|
3744
|
$self->_nth_interval($first_int); |
2316
|
1478
|
|
|
|
|
2625
|
my $date = $$self{'data'}{'idate'}{$first_int}; |
2317
|
1478
|
50
|
|
|
|
2722
|
if (defined($date)) { |
2318
|
1478
|
|
|
|
|
2066
|
$n = 0; |
2319
|
1478
|
100
|
|
|
|
3236
|
last if ($date->cmp($start) >= 0); |
2320
|
|
|
|
|
|
|
} else { |
2321
|
0
|
|
|
|
|
0
|
$n++; |
2322
|
|
|
|
|
|
|
} |
2323
|
739
|
|
|
|
|
1465
|
$first_int++; |
2324
|
|
|
|
|
|
|
} |
2325
|
|
|
|
|
|
|
|
2326
|
|
|
|
|
|
|
} else { |
2327
|
405
|
|
|
|
|
789
|
my $n = 0; |
2328
|
|
|
|
|
|
|
LOOP: |
2329
|
405
|
|
|
|
|
712
|
while (1) { |
2330
|
839
|
50
|
|
|
|
1975
|
if ($n > $maxatt) { |
2331
|
0
|
|
|
|
|
0
|
$$self{'err'} = |
2332
|
|
|
|
|
|
|
"[_locate_n] Unable to find an interval in $maxatt attempts"; |
2333
|
0
|
|
|
|
|
0
|
return; |
2334
|
|
|
|
|
|
|
} |
2335
|
839
|
|
|
|
|
2237
|
$self->_nth_interval($first_int); |
2336
|
839
|
|
|
|
|
2572
|
for (my $i=($first_int+1)*$ev - 1; $i >= $first_int*$ev; $i--) { |
2337
|
963
|
100
|
|
|
|
2091
|
if (exists $$self{'data'}{'dates'}{$i}) { |
2338
|
872
|
|
|
|
|
1619
|
my $date = $$self{'data'}{'dates'}{$i}; |
2339
|
872
|
50
|
|
|
|
1675
|
if (defined($date)) { |
2340
|
872
|
|
|
|
|
1256
|
$n = 0; |
2341
|
872
|
100
|
|
|
|
2018
|
last LOOP if ($date->cmp($start) >= 0); |
2342
|
|
|
|
|
|
|
} else { |
2343
|
0
|
|
|
|
|
0
|
$n++; |
2344
|
|
|
|
|
|
|
} |
2345
|
|
|
|
|
|
|
} else { |
2346
|
91
|
|
|
|
|
182
|
$n++; |
2347
|
|
|
|
|
|
|
} |
2348
|
|
|
|
|
|
|
} |
2349
|
434
|
|
|
|
|
777
|
$first_int++; |
2350
|
|
|
|
|
|
|
} |
2351
|
|
|
|
|
|
|
} |
2352
|
1144
|
|
|
|
|
2293
|
$first = $first_int*$ev; |
2353
|
|
|
|
|
|
|
|
2354
|
|
|
|
|
|
|
# Then move forwards until we're after end |
2355
|
|
|
|
|
|
|
# i.e. Date(y) > end for modified dates |
2356
|
|
|
|
|
|
|
|
2357
|
1144
|
|
|
|
|
1869
|
$last_int = $first_int; |
2358
|
|
|
|
|
|
|
|
2359
|
1144
|
100
|
|
|
|
2419
|
if ($unmod) { |
2360
|
739
|
|
|
|
|
1122
|
my $n = 0; |
2361
|
739
|
|
|
|
|
1061
|
while (1) { |
2362
|
1478
|
50
|
|
|
|
2857
|
if ($n > $maxatt) { |
2363
|
0
|
|
|
|
|
0
|
$$self{'err'} = |
2364
|
|
|
|
|
|
|
"[_locate_n] Unable to find an interval in $maxatt attempts"; |
2365
|
0
|
|
|
|
|
0
|
return; |
2366
|
|
|
|
|
|
|
} |
2367
|
1478
|
|
|
|
|
3598
|
$self->_nth_interval($last_int); |
2368
|
1478
|
|
|
|
|
2850
|
my $date = $$self{'data'}{'idate'}{$last_int}; |
2369
|
1478
|
50
|
|
|
|
2708
|
if (defined($date)) { |
2370
|
1478
|
|
|
|
|
2010
|
$n = 0; |
2371
|
1478
|
100
|
|
|
|
3538
|
last if ($date->cmp($end) > 0); |
2372
|
|
|
|
|
|
|
} else { |
2373
|
0
|
|
|
|
|
0
|
$n++; |
2374
|
|
|
|
|
|
|
} |
2375
|
739
|
|
|
|
|
1383
|
$last_int++; |
2376
|
|
|
|
|
|
|
} |
2377
|
739
|
|
|
|
|
1565
|
$last_int--; |
2378
|
|
|
|
|
|
|
|
2379
|
|
|
|
|
|
|
} else { |
2380
|
405
|
|
|
|
|
751
|
my $n = 0; |
2381
|
|
|
|
|
|
|
LOOP: |
2382
|
405
|
|
|
|
|
650
|
while (1) { |
2383
|
1462
|
50
|
|
|
|
2972
|
if ($n > $maxatt) { |
2384
|
0
|
|
|
|
|
0
|
$$self{'err'} = |
2385
|
|
|
|
|
|
|
"[_locate_n] Unable to find an interval in $maxatt attempts"; |
2386
|
0
|
|
|
|
|
0
|
return; |
2387
|
|
|
|
|
|
|
} |
2388
|
1462
|
|
|
|
|
3717
|
$self->_nth_interval($last_int); |
2389
|
1462
|
|
|
|
|
4632
|
for (my $i=($last_int+1)*$ev - 1; $i >= $last_int*$ev; $i--) { |
2390
|
1701
|
100
|
|
|
|
4284
|
next if (! exists $$self{'data'}{'dates'}{$i}); |
2391
|
1544
|
|
|
|
|
2609
|
my $date = $$self{'data'}{'dates'}{$i}; |
2392
|
1544
|
50
|
|
|
|
2875
|
if (defined($date)) { |
2393
|
1544
|
|
|
|
|
2277
|
$n = 0; |
2394
|
1544
|
100
|
|
|
|
3968
|
last LOOP if ($date->cmp($end) >= 0); |
2395
|
|
|
|
|
|
|
} else { |
2396
|
0
|
|
|
|
|
0
|
$n++; |
2397
|
|
|
|
|
|
|
} |
2398
|
|
|
|
|
|
|
} |
2399
|
1057
|
|
|
|
|
1746
|
$last_int++; |
2400
|
|
|
|
|
|
|
} |
2401
|
|
|
|
|
|
|
} |
2402
|
|
|
|
|
|
|
|
2403
|
1144
|
|
|
|
|
2563
|
$last = ($last_int+1)*$ev - 1; |
2404
|
|
|
|
|
|
|
|
2405
|
|
|
|
|
|
|
# Now get the actual first/last dates |
2406
|
|
|
|
|
|
|
|
2407
|
1144
|
100
|
|
|
|
2511
|
if ($unmod) { |
2408
|
739
|
|
|
|
|
1115
|
while (1) { |
2409
|
|
|
|
|
|
|
last if (exists $$self{'data'}{'dates'}{$first} && |
2410
|
739
|
100
|
66
|
|
|
3616
|
defined $$self{'data'}{'dates'}{$first}); |
2411
|
112
|
|
|
|
|
164
|
$first++; |
2412
|
112
|
50
|
|
|
|
1032
|
return undef if ($first > $last); |
2413
|
|
|
|
|
|
|
} |
2414
|
|
|
|
|
|
|
|
2415
|
627
|
|
|
|
|
941
|
while (1) { |
2416
|
|
|
|
|
|
|
last if (exists $$self{'data'}{'dates'}{$last} && |
2417
|
627
|
50
|
33
|
|
|
2670
|
defined $$self{'data'}{'dates'}{$last}); |
2418
|
0
|
|
|
|
|
0
|
$last--; |
2419
|
|
|
|
|
|
|
} |
2420
|
|
|
|
|
|
|
|
2421
|
|
|
|
|
|
|
} else { |
2422
|
405
|
|
|
|
|
717
|
while (1) { |
2423
|
|
|
|
|
|
|
last if (exists $$self{'data'}{'dates'}{$first} && |
2424
|
|
|
|
|
|
|
defined $$self{'data'}{'dates'}{$first} && |
2425
|
407
|
100
|
33
|
|
|
3168
|
$$self{'data'}{'dates'}{$first}->cmp($start) >= 0); |
|
|
|
66
|
|
|
|
|
2426
|
2
|
|
|
|
|
9
|
$first++; |
2427
|
2
|
50
|
|
|
|
9
|
return undef if ($first > $last); |
2428
|
|
|
|
|
|
|
} |
2429
|
|
|
|
|
|
|
|
2430
|
405
|
|
|
|
|
882
|
while (1) { |
2431
|
|
|
|
|
|
|
last if (exists $$self{'data'}{'dates'}{$last} && |
2432
|
|
|
|
|
|
|
defined $$self{'data'}{'dates'}{$last} && |
2433
|
954
|
100
|
66
|
|
|
5218
|
$$self{'data'}{'dates'}{$last}->cmp($end) <= 0); |
|
|
|
100
|
|
|
|
|
2434
|
549
|
|
|
|
|
1011
|
$last--; |
2435
|
|
|
|
|
|
|
} |
2436
|
|
|
|
|
|
|
} |
2437
|
|
|
|
|
|
|
|
2438
|
1032
|
100
|
66
|
|
|
4844
|
return undef if (! defined $last || |
2439
|
|
|
|
|
|
|
$last < $first); |
2440
|
934
|
|
|
|
|
2007
|
$$self{'data'}{'first'} = $first; |
2441
|
934
|
|
|
|
|
1778
|
$$self{'data'}{'last'} = $last; |
2442
|
934
|
|
|
|
|
9760
|
return $$self{'data'}{$op} |
2443
|
|
|
|
|
|
|
} |
2444
|
|
|
|
|
|
|
|
2445
|
|
|
|
|
|
|
# This returns the date easter occurs on for a given year as ($month,$day). |
2446
|
|
|
|
|
|
|
# This is from the Calendar FAQ. |
2447
|
|
|
|
|
|
|
# |
2448
|
|
|
|
|
|
|
sub _easter { |
2449
|
21
|
|
|
21
|
|
41
|
my($self,$y) = @_; |
2450
|
|
|
|
|
|
|
|
2451
|
21
|
|
|
|
|
39
|
my($c) = $y/100; |
2452
|
21
|
|
|
|
|
34
|
my($g) = $y % 19; |
2453
|
21
|
|
|
|
|
36
|
my($k) = ($c-17)/25; |
2454
|
21
|
|
|
|
|
47
|
my($i) = ($c - $c/4 - ($c-$k)/3 + 19*$g + 15) % 30; |
2455
|
21
|
|
|
|
|
47
|
$i = $i - ($i/28)*(1 - ($i/28)*(29/($i+1))*((21-$g)/11)); |
2456
|
21
|
|
|
|
|
41
|
my($j) = ($y + $y/4 + $i + 2 - $c + $c/4) % 7; |
2457
|
21
|
|
|
|
|
32
|
my($l) = $i-$j; |
2458
|
21
|
|
|
|
|
34
|
my($m) = 3 + ($l+40)/44; |
2459
|
21
|
|
|
|
|
38
|
my($d) = $l + 28 - 31*($m/4); |
2460
|
21
|
|
|
|
|
80
|
return ($m,$d); |
2461
|
|
|
|
|
|
|
} |
2462
|
|
|
|
|
|
|
|
2463
|
|
|
|
|
|
|
# This returns 1 if a field is empty. |
2464
|
|
|
|
|
|
|
# |
2465
|
|
|
|
|
|
|
sub _field_empty { |
2466
|
12150
|
|
|
12150
|
|
18219
|
my($self,$val) = @_; |
2467
|
|
|
|
|
|
|
|
2468
|
12150
|
100
|
|
|
|
20574
|
if (ref($val)) { |
2469
|
10839
|
|
|
|
|
17991
|
my @tmp = @$val; |
2470
|
10839
|
100
|
100
|
|
|
55069
|
return 1 if ($#tmp == -1 || |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
2471
|
|
|
|
|
|
|
($#tmp == 0 && ! ref($tmp[0]) && ! $tmp[0])); |
2472
|
7289
|
|
|
|
|
14590
|
return 0; |
2473
|
|
|
|
|
|
|
|
2474
|
|
|
|
|
|
|
} else { |
2475
|
1311
|
|
|
|
|
2210
|
return $val; |
2476
|
|
|
|
|
|
|
} |
2477
|
|
|
|
|
|
|
} |
2478
|
|
|
|
|
|
|
|
2479
|
|
|
|
|
|
|
# This returns a list of values that appear in a field in the rtime. |
2480
|
|
|
|
|
|
|
# |
2481
|
|
|
|
|
|
|
# $val is a listref, with each element being a value or a range. |
2482
|
|
|
|
|
|
|
# |
2483
|
|
|
|
|
|
|
# Usage: |
2484
|
|
|
|
|
|
|
# _rtime_values('y' ,$y); |
2485
|
|
|
|
|
|
|
# _rtime_values('m' ,$m); |
2486
|
|
|
|
|
|
|
# _rtime_values('week_of_year' ,$w ,$y); |
2487
|
|
|
|
|
|
|
# _rtime_values('dow_of_year' ,$w ,$y,$dow); |
2488
|
|
|
|
|
|
|
# _rtime_values('dow_of_month' ,$w ,$y,$m,$dow); |
2489
|
|
|
|
|
|
|
# _rtime_values('day_of_year' ,$d ,$y); |
2490
|
|
|
|
|
|
|
# _rtime_values('day_of_month' ,$d ,$y,$m); |
2491
|
|
|
|
|
|
|
# _rtime_values('day_of_week' ,$d); |
2492
|
|
|
|
|
|
|
# _rtime_values('h' ,$h); |
2493
|
|
|
|
|
|
|
# _rtime_values('mn' ,$mn); |
2494
|
|
|
|
|
|
|
# _rtime_values('s' ,$s); |
2495
|
|
|
|
|
|
|
# |
2496
|
|
|
|
|
|
|
# Returns ($err,@vals) |
2497
|
|
|
|
|
|
|
# |
2498
|
|
|
|
|
|
|
sub _rtime_values { |
2499
|
19788
|
|
|
19788
|
|
36264
|
my($self,$type,$val,@args) = @_; |
2500
|
19788
|
|
|
|
|
28519
|
my $dmt = $$self{'tz'}; |
2501
|
19788
|
|
|
|
|
26014
|
my $dmb = $$dmt{'base'}; |
2502
|
|
|
|
|
|
|
|
2503
|
19788
|
100
|
|
|
|
58102
|
if ($type eq 'h') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2504
|
3962
|
|
|
|
|
6994
|
@args = (0,0,23,23); |
2505
|
|
|
|
|
|
|
|
2506
|
|
|
|
|
|
|
} elsif ($type eq 'mn') { |
2507
|
3995
|
|
|
|
|
6840
|
@args = (0,0,59,59); |
2508
|
|
|
|
|
|
|
|
2509
|
|
|
|
|
|
|
} elsif ($type eq 's') { |
2510
|
3995
|
|
|
|
|
7233
|
@args = (0,0,59,59); |
2511
|
|
|
|
|
|
|
|
2512
|
|
|
|
|
|
|
} elsif ($type eq 'y') { |
2513
|
137
|
|
|
|
|
438
|
my $curry = $dmt->_now('y',1); |
2514
|
137
|
|
|
|
|
290
|
foreach my $y (@$val) { |
2515
|
213
|
100
|
66
|
|
|
784
|
$y = $curry if (! ref($y) && $y==0); |
2516
|
|
|
|
|
|
|
} |
2517
|
|
|
|
|
|
|
|
2518
|
137
|
|
|
|
|
332
|
@args = (0,1,9999,9999); |
2519
|
|
|
|
|
|
|
|
2520
|
|
|
|
|
|
|
} elsif ($type eq 'm') { |
2521
|
2953
|
|
|
|
|
5509
|
@args = (0,1,12,12); |
2522
|
|
|
|
|
|
|
|
2523
|
|
|
|
|
|
|
} elsif ($type eq 'week_of_year') { |
2524
|
49
|
|
|
|
|
85
|
my($y) = @args; |
2525
|
49
|
|
|
|
|
150
|
my $wiy = $dmb->weeks_in_year($y); |
2526
|
49
|
|
|
|
|
123
|
@args = (1,1,$wiy,53); |
2527
|
|
|
|
|
|
|
|
2528
|
|
|
|
|
|
|
} elsif ($type eq 'dow_of_year') { |
2529
|
164
|
|
|
|
|
280
|
my($y,$dow) = @args; |
2530
|
|
|
|
|
|
|
|
2531
|
|
|
|
|
|
|
# Get the 1st occurrence of $dow |
2532
|
164
|
|
|
|
|
238
|
my $d0 = 1; |
2533
|
164
|
|
|
|
|
542
|
my $dow0 = $dmb->day_of_week([$y,1,$d0]); |
2534
|
164
|
100
|
|
|
|
593
|
if ($dow > $dow0) { |
|
|
100
|
|
|
|
|
|
2535
|
15
|
|
|
|
|
90
|
$d0 += ($dow-$dow0); |
2536
|
|
|
|
|
|
|
} elsif ($dow < $dow0) { |
2537
|
119
|
|
|
|
|
190
|
$d0 += 7-($dow0-$dow); |
2538
|
|
|
|
|
|
|
} |
2539
|
|
|
|
|
|
|
|
2540
|
|
|
|
|
|
|
# Get the last occurrence of $dow |
2541
|
164
|
|
|
|
|
245
|
my $d1 = 31; |
2542
|
164
|
|
|
|
|
445
|
my $dow1 = $dmb->day_of_week([$y,12,$d1]); |
2543
|
164
|
100
|
|
|
|
450
|
if ($dow1 > $dow) { |
|
|
100
|
|
|
|
|
|
2544
|
121
|
|
|
|
|
212
|
$d1 -= ($dow1-$dow); |
2545
|
|
|
|
|
|
|
} elsif ($dow1 < $dow) { |
2546
|
15
|
|
|
|
|
25
|
$d1 -= 7-($dow-$dow1); |
2547
|
|
|
|
|
|
|
} |
2548
|
|
|
|
|
|
|
|
2549
|
|
|
|
|
|
|
# Find out the number of occurrenced of $dow |
2550
|
164
|
|
|
|
|
471
|
my $doy1 = $dmb->day_of_year([$y,12,$d1]); |
2551
|
164
|
|
|
|
|
341
|
my $n = ($doy1 - $d0)/7 + 1; |
2552
|
|
|
|
|
|
|
|
2553
|
|
|
|
|
|
|
# Get the list of @w |
2554
|
164
|
|
|
|
|
359
|
@args = (1,1,$n,53); |
2555
|
|
|
|
|
|
|
|
2556
|
|
|
|
|
|
|
} elsif ($type eq 'dow_of_month') { |
2557
|
826
|
|
|
|
|
1731
|
my($y,$m,$dow) = @args; |
2558
|
|
|
|
|
|
|
|
2559
|
|
|
|
|
|
|
# Get the 1st occurrence of $dow in the month |
2560
|
826
|
|
|
|
|
1179
|
my $d0 = 1; |
2561
|
826
|
|
|
|
|
2966
|
my $dow0 = $dmb->day_of_week([$y,$m,$d0]); |
2562
|
826
|
100
|
|
|
|
2920
|
if ($dow > $dow0) { |
|
|
100
|
|
|
|
|
|
2563
|
185
|
|
|
|
|
491
|
$d0 += ($dow-$dow0); |
2564
|
|
|
|
|
|
|
} elsif ($dow < $dow0) { |
2565
|
504
|
|
|
|
|
900
|
$d0 += 7-($dow0-$dow); |
2566
|
|
|
|
|
|
|
} |
2567
|
|
|
|
|
|
|
|
2568
|
|
|
|
|
|
|
# Get the last occurrence of $dow |
2569
|
826
|
|
|
|
|
1964
|
my $d1 = $dmb->days_in_month($y,$m); |
2570
|
826
|
|
|
|
|
2436
|
my $dow1 = $dmb->day_of_week([$y,$m,$d1]); |
2571
|
826
|
100
|
|
|
|
2478
|
if ($dow1 > $dow) { |
|
|
100
|
|
|
|
|
|
2572
|
526
|
|
|
|
|
920
|
$d1 -= ($dow1-$dow); |
2573
|
|
|
|
|
|
|
} elsif ($dow1 < $dow) { |
2574
|
180
|
|
|
|
|
414
|
$d1 -= 7-($dow-$dow1); |
2575
|
|
|
|
|
|
|
} |
2576
|
|
|
|
|
|
|
|
2577
|
|
|
|
|
|
|
# Find out the number of occurrenced of $dow |
2578
|
826
|
|
|
|
|
1443
|
my $n = ($d1 - $d0)/7 + 1; |
2579
|
|
|
|
|
|
|
|
2580
|
|
|
|
|
|
|
# Get the list of @w |
2581
|
826
|
|
|
|
|
1868
|
@args = (1,1,$n,5); |
2582
|
|
|
|
|
|
|
|
2583
|
|
|
|
|
|
|
} elsif ($type eq 'day_of_year') { |
2584
|
171
|
|
|
|
|
289
|
my($y) = @args; |
2585
|
171
|
|
|
|
|
515
|
my $diy = $dmb->days_in_year($y); |
2586
|
171
|
|
|
|
|
380
|
@args = (1,1,$diy,366); |
2587
|
|
|
|
|
|
|
|
2588
|
|
|
|
|
|
|
} elsif ($type eq 'day_of_month') { |
2589
|
2810
|
|
|
|
|
4905
|
my($y,$m) = @args; |
2590
|
2810
|
|
|
|
|
7716
|
my $dim = $dmb->days_in_month($y,$m); |
2591
|
2810
|
|
|
|
|
6201
|
@args = (1,1,$dim,31); |
2592
|
|
|
|
|
|
|
|
2593
|
|
|
|
|
|
|
} elsif ($type eq 'day_of_week') { |
2594
|
726
|
|
|
|
|
1331
|
@args = (0,1,7,7); |
2595
|
|
|
|
|
|
|
} |
2596
|
|
|
|
|
|
|
|
2597
|
19788
|
|
|
|
|
34244
|
my($err,@vals) = $self->__rtime_values($val,@args); |
2598
|
19788
|
50
|
|
|
|
36159
|
if ($err) { |
2599
|
0
|
|
|
|
|
0
|
$$self{'err'} = "[dates] $err [$type]"; |
2600
|
0
|
|
|
|
|
0
|
return (1); |
2601
|
|
|
|
|
|
|
} |
2602
|
19788
|
|
|
|
|
43006
|
return(0,@vals); |
2603
|
|
|
|
|
|
|
} |
2604
|
|
|
|
|
|
|
|
2605
|
|
|
|
|
|
|
# This returns the raw values for a list. |
2606
|
|
|
|
|
|
|
# |
2607
|
|
|
|
|
|
|
# If $allowneg is 0, only positive numbers are allowed, and they must be |
2608
|
|
|
|
|
|
|
# in the range [$min,$absmax]. If $allowneg is 1, positive numbers in the |
2609
|
|
|
|
|
|
|
# range [$min,$absmax] and negative numbers in the range [-$absmax,-$min] |
2610
|
|
|
|
|
|
|
# are allowed. An error occurs if a value falls outside the range. |
2611
|
|
|
|
|
|
|
# |
2612
|
|
|
|
|
|
|
# Only values in the range of [$min,$max] are actually kept. This allows |
2613
|
|
|
|
|
|
|
# a recurrence for day_of_month to be 1-31 and not fail for a month that |
2614
|
|
|
|
|
|
|
# has fewer than 31 days. Any value outside the [$min,$max] are silently |
2615
|
|
|
|
|
|
|
# discarded. |
2616
|
|
|
|
|
|
|
# |
2617
|
|
|
|
|
|
|
# Returns: |
2618
|
|
|
|
|
|
|
# ($err,@vals) |
2619
|
|
|
|
|
|
|
# |
2620
|
|
|
|
|
|
|
sub __rtime_values { |
2621
|
19788
|
|
|
19788
|
|
32948
|
my($self,$vals,$allowneg,$min,$max,$absmax) = @_; |
2622
|
19788
|
|
|
|
|
24662
|
my(@ret); |
2623
|
|
|
|
|
|
|
|
2624
|
19788
|
|
|
|
|
32118
|
foreach my $val (@$vals) { |
2625
|
|
|
|
|
|
|
|
2626
|
20337
|
100
|
|
|
|
30865
|
if (ref($val)) { |
2627
|
24
|
|
|
|
|
40
|
my($val1,$val2) = @$val; |
2628
|
|
|
|
|
|
|
|
2629
|
24
|
50
|
|
|
|
62
|
if ($allowneg) { |
2630
|
24
|
0
|
33
|
|
|
192
|
return ('Value outside range') |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
2631
|
|
|
|
|
|
|
if ( ($val1 >= 0 && ($val1 < $min || $val1 > $absmax) ) || |
2632
|
|
|
|
|
|
|
($val2 >= 0 && ($val2 < $min || $val2 > $absmax) ) ); |
2633
|
24
|
50
|
0
|
|
|
151
|
return ('Negative value outside range') |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
2634
|
|
|
|
|
|
|
if ( ($val1 <= 0 && ($val1 < -$absmax || $val1 > -$min) ) || |
2635
|
|
|
|
|
|
|
($val2 <= 0 && ($val2 < -$absmax || $val2 > -$min) ) ); |
2636
|
|
|
|
|
|
|
|
2637
|
|
|
|
|
|
|
} else { |
2638
|
0
|
0
|
0
|
|
|
0
|
return ('Value outside range') |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2639
|
|
|
|
|
|
|
if ( ($val1 < $min || $val1 > $absmax) || |
2640
|
|
|
|
|
|
|
($val2 < $min || $val2 > $absmax) ); |
2641
|
|
|
|
|
|
|
|
2642
|
|
|
|
|
|
|
} |
2643
|
|
|
|
|
|
|
|
2644
|
24
|
50
|
33
|
|
|
134
|
return ('Range values reversed') |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
2645
|
|
|
|
|
|
|
if ( ($val1 <= 0 && $val2 <= 0 && $val1 > $val2) || |
2646
|
|
|
|
|
|
|
($val1 >= 0 && $val2 >= 0 && $val1 > $val2) ); |
2647
|
|
|
|
|
|
|
|
2648
|
|
|
|
|
|
|
# Use $max instead of $absmax when converting negative numbers to |
2649
|
|
|
|
|
|
|
# positive ones. |
2650
|
|
|
|
|
|
|
|
2651
|
24
|
50
|
|
|
|
53
|
$val1 = $max + $val1 + 1 if ($val1 < 0); # day -10 |
2652
|
24
|
50
|
|
|
|
46
|
$val2 = $max + $val2 + 1 if ($val2 < 0); |
2653
|
|
|
|
|
|
|
|
2654
|
24
|
50
|
|
|
|
50
|
$val1 = $min if ($val1 < $min); # day -31 in a 30 day month |
2655
|
24
|
50
|
|
|
|
64
|
$val2 = $max if ($val2 > $max); |
2656
|
|
|
|
|
|
|
|
2657
|
24
|
100
|
|
|
|
53
|
next if ($val1 > $val2); |
2658
|
|
|
|
|
|
|
|
2659
|
20
|
|
|
|
|
56
|
push(@ret,$val1..$val2); |
2660
|
|
|
|
|
|
|
|
2661
|
|
|
|
|
|
|
} else { |
2662
|
|
|
|
|
|
|
|
2663
|
20313
|
100
|
|
|
|
30442
|
if ($allowneg) { |
2664
|
4193
|
50
|
33
|
|
|
17250
|
return ('Value outside range') |
|
|
|
66
|
|
|
|
|
2665
|
|
|
|
|
|
|
if ($val >= 0 && ($val < $min || $val > $absmax)); |
2666
|
4193
|
50
|
33
|
|
|
9440
|
return ('Negative value outside range') |
|
|
|
66
|
|
|
|
|
2667
|
|
|
|
|
|
|
if ($val <= 0 && ($val < -$absmax || $val > -$min)); |
2668
|
|
|
|
|
|
|
} else { |
2669
|
16120
|
50
|
33
|
|
|
47929
|
return ('Value outside range') |
2670
|
|
|
|
|
|
|
if ($val < $min || $val > $absmax); |
2671
|
|
|
|
|
|
|
} |
2672
|
|
|
|
|
|
|
|
2673
|
|
|
|
|
|
|
# Use $max instead of $absmax when converting negative numbers to |
2674
|
|
|
|
|
|
|
# positive ones. |
2675
|
|
|
|
|
|
|
|
2676
|
20313
|
|
|
|
|
25227
|
my $ret; |
2677
|
20313
|
100
|
|
|
|
29794
|
if ($val < 0 ) { |
2678
|
401
|
|
|
|
|
592
|
$ret = $max + $val + 1; |
2679
|
|
|
|
|
|
|
} else { |
2680
|
19912
|
|
|
|
|
25516
|
$ret = $val; |
2681
|
|
|
|
|
|
|
} |
2682
|
|
|
|
|
|
|
|
2683
|
20313
|
100
|
100
|
|
|
53670
|
next if ($ret > $max || $ret < $min); |
2684
|
19925
|
|
|
|
|
34655
|
push(@ret,$ret); |
2685
|
|
|
|
|
|
|
} |
2686
|
|
|
|
|
|
|
} |
2687
|
|
|
|
|
|
|
|
2688
|
19788
|
|
|
|
|
46686
|
return ('',@ret); |
2689
|
|
|
|
|
|
|
} |
2690
|
|
|
|
|
|
|
|
2691
|
|
|
|
|
|
|
# This takes a list of dates (each a listref of [y,m,d,h,mn,s]) and replaces |
2692
|
|
|
|
|
|
|
# the Nth field with all of the possible values passed in, creating a new |
2693
|
|
|
|
|
|
|
# list with all the dates. |
2694
|
|
|
|
|
|
|
# |
2695
|
|
|
|
|
|
|
sub _field_add_values { |
2696
|
11952
|
|
|
11952
|
|
21110
|
my($self,$datesref,$n,@val) = @_; |
2697
|
|
|
|
|
|
|
|
2698
|
11952
|
|
|
|
|
17188
|
my @dates = @$datesref; |
2699
|
11952
|
|
|
|
|
14390
|
my @tmp; |
2700
|
|
|
|
|
|
|
|
2701
|
11952
|
|
|
|
|
17953
|
foreach my $date (@dates) { |
2702
|
12397
|
|
|
|
|
21077
|
my @d = @$date; |
2703
|
12397
|
|
|
|
|
16842
|
foreach my $val (@val) { |
2704
|
12465
|
|
|
|
|
18417
|
$d[$n] = $val; |
2705
|
12465
|
|
|
|
|
34530
|
push(@tmp,[@d]); |
2706
|
|
|
|
|
|
|
} |
2707
|
|
|
|
|
|
|
} |
2708
|
|
|
|
|
|
|
|
2709
|
11952
|
|
|
|
|
28907
|
@$datesref = @tmp; |
2710
|
|
|
|
|
|
|
} |
2711
|
|
|
|
|
|
|
|
2712
|
|
|
|
|
|
|
1; |
2713
|
|
|
|
|
|
|
# Local Variables: |
2714
|
|
|
|
|
|
|
# mode: cperl |
2715
|
|
|
|
|
|
|
# indent-tabs-mode: nil |
2716
|
|
|
|
|
|
|
# cperl-indent-level: 3 |
2717
|
|
|
|
|
|
|
# cperl-continued-statement-offset: 2 |
2718
|
|
|
|
|
|
|
# cperl-continued-brace-offset: 0 |
2719
|
|
|
|
|
|
|
# cperl-brace-offset: 0 |
2720
|
|
|
|
|
|
|
# cperl-brace-imaginary-offset: 0 |
2721
|
|
|
|
|
|
|
# cperl-label-offset: 0 |
2722
|
|
|
|
|
|
|
# End: |