| 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: |