line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Range::Object::Date; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# This is basically what common::sense does, but without the pragma itself |
4
|
|
|
|
|
|
|
# to remain compatible with Perls older than 5.8 |
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
45423
|
use strict; |
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
24
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
5
|
no warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
36
|
|
9
|
1
|
|
|
|
|
52
|
use warnings qw(FATAL closed internal debugging pack malloc portable |
10
|
|
|
|
|
|
|
prototype inplace io pipe unpack deprecated glob digit |
11
|
1
|
|
|
1
|
|
4
|
printf reserved taint closure semicolon); |
|
1
|
|
|
|
|
2
|
|
12
|
1
|
|
|
1
|
|
4
|
no warnings qw(exec newline unopened); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
23
|
|
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
4
|
use Carp; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
47
|
|
15
|
1
|
|
|
1
|
|
5
|
use List::Util qw( first ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
69
|
|
16
|
1
|
|
|
1
|
|
335
|
use Date::Simple; |
|
1
|
|
|
|
|
4729
|
|
|
1
|
|
|
|
|
30
|
|
17
|
1
|
|
|
1
|
|
229
|
use Date::Range; |
|
1
|
|
|
|
|
634
|
|
|
1
|
|
|
|
|
25
|
|
18
|
|
|
|
|
|
|
|
19
|
1
|
|
|
1
|
|
5
|
use base qw(Range::Object); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
276
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# Overload definitions |
22
|
|
|
|
|
|
|
|
23
|
1
|
|
|
|
|
5
|
use overload q{""} => 'stringify_collapsed', |
24
|
1
|
|
|
1
|
|
6
|
fallback => 1; |
|
1
|
|
|
|
|
1
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
### PUBLIC PACKAGE SUBROUTINE ### |
27
|
|
|
|
|
|
|
# |
28
|
|
|
|
|
|
|
# Returns regex used to check date validity, both for full dates |
29
|
|
|
|
|
|
|
# and month only dates. This implementation is reasonably simple |
30
|
|
|
|
|
|
|
# since Date::Simple constructor will check dates more strictly |
31
|
|
|
|
|
|
|
# in any case. |
32
|
|
|
|
|
|
|
# |
33
|
0
|
|
|
0
|
0
|
0
|
sub YYYYMMDD { qr/\A \d{4} - \d{2} -\d{2} \z/xms } |
34
|
201
|
|
|
201
|
0
|
785
|
sub YYYYMM { qr/\A \d{4} - \d{2} \z/xms } |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
### PUBLIC INSTANCE METHOD ### |
37
|
|
|
|
|
|
|
# |
38
|
|
|
|
|
|
|
# Returns the number of separate items in internal storage. |
39
|
|
|
|
|
|
|
# |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub size { |
42
|
6
|
|
|
6
|
1
|
2473
|
my ($self) = @_; |
43
|
|
|
|
|
|
|
|
44
|
6
|
|
|
|
|
11
|
my $size = 0; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
$size += (ref eq 'Date::Range' ? $_->length() : 1) |
47
|
6
|
100
|
|
|
|
7
|
for @{ $self->{range} }; |
|
6
|
|
|
|
|
35
|
|
48
|
|
|
|
|
|
|
|
49
|
6
|
|
|
|
|
71
|
return $size; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
### PUBLIC INSTANCE METHOD ### |
53
|
|
|
|
|
|
|
# |
54
|
|
|
|
|
|
|
# Returns array or string representation of internal storage. |
55
|
|
|
|
|
|
|
# |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub range { |
58
|
12
|
|
|
12
|
1
|
8584
|
my ($self, $separator) = @_; |
59
|
|
|
|
|
|
|
|
60
|
12
|
100
|
|
|
|
47
|
return $self->stringify($separator) unless wantarray; |
61
|
|
|
|
|
|
|
|
62
|
110
|
|
|
|
|
216
|
return sort { $a cmp $b } |
63
|
|
|
|
|
|
|
map { |
64
|
16
|
100
|
|
|
|
166
|
ref eq 'Date::Range' ? map { "$_" } $_->dates() |
|
68
|
|
|
|
|
1542
|
|
65
|
|
|
|
|
|
|
: "$_" |
66
|
|
|
|
|
|
|
} |
67
|
6
|
|
|
|
|
9
|
@{ $self->{range} }; |
|
6
|
|
|
|
|
14
|
|
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
### PUBLIC INSTANCE METHOD ### |
71
|
|
|
|
|
|
|
# |
72
|
|
|
|
|
|
|
# Returns sorted and collapsed representation of internal storage. |
73
|
|
|
|
|
|
|
# In list context, resulting list consists of separate values and/or |
74
|
|
|
|
|
|
|
# range hashrefs with three elements: start, end and count. |
75
|
|
|
|
|
|
|
# In scalar context, result is a string of separate values and/or |
76
|
|
|
|
|
|
|
# ranges separated by value returned by delimiter() method. |
77
|
|
|
|
|
|
|
# Optional list separator can be used instead of default one in |
78
|
|
|
|
|
|
|
# scalar context. |
79
|
|
|
|
|
|
|
# |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub collapsed { |
82
|
12
|
|
|
12
|
1
|
3482
|
my ($self, $separator) = @_; |
83
|
|
|
|
|
|
|
|
84
|
12
|
100
|
|
|
|
32
|
return $self->stringify_collapsed($separator) unless wantarray; |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
return |
87
|
16
|
100
|
|
|
|
91
|
map { ref($_) eq 'Date::Simple' ? "$_" |
88
|
|
|
|
|
|
|
: { |
89
|
|
|
|
|
|
|
start => ''.$_->start(), |
90
|
|
|
|
|
|
|
end => ''.$_->end(), |
91
|
|
|
|
|
|
|
count => $_->length(), |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
} |
94
|
6
|
|
|
|
|
10
|
@{ $self->{range} }; |
|
6
|
|
|
|
|
23
|
|
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
### PUBLIC INSTANCE METHOD ### |
98
|
|
|
|
|
|
|
# |
99
|
|
|
|
|
|
|
# Tests if items of @range are matching items in our internal storage. |
100
|
|
|
|
|
|
|
# Returns true/false in scalar context, list of mismatching items in list |
101
|
|
|
|
|
|
|
# context. |
102
|
|
|
|
|
|
|
# |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub in { |
105
|
81
|
|
|
81
|
1
|
22308
|
my ($self, @range) = @_; |
106
|
81
|
|
|
|
|
131
|
my $class = ref $self; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
# Normalize to array of Date::Simple objects |
109
|
81
|
|
|
|
|
147
|
my @objects = map { Date::Simple->new($_) } |
|
149
|
|
|
|
|
1766
|
|
110
|
|
|
|
|
|
|
$self->_validate_and_expand(@range); |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# In this class we're operating on Date::Simple |
113
|
|
|
|
|
|
|
# objects as opposed to scalar values |
114
|
81
|
100
|
|
|
|
2166
|
if ( wantarray ) { |
115
|
6
|
|
|
|
|
12
|
my @result = grep { !$self->_search_range($_) } @objects; |
|
74
|
|
|
|
|
740
|
|
116
|
6
|
|
|
|
|
92
|
return @result; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
else { |
119
|
75
|
|
|
75
|
|
302
|
my $result = defined first { $self->_search_range($_) } @objects; |
|
75
|
|
|
|
|
146
|
|
120
|
75
|
|
|
|
|
1178
|
return $result; |
121
|
|
|
|
|
|
|
}; |
122
|
|
|
|
|
|
|
|
123
|
0
|
|
|
|
|
0
|
return; # Just in case |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
### PUBLIC INSTANCE METHOD ### |
127
|
|
|
|
|
|
|
# |
128
|
|
|
|
|
|
|
# Returns string representation of collapsed current range. |
129
|
|
|
|
|
|
|
# |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
sub stringify_collapsed { |
132
|
12
|
|
|
12
|
1
|
28
|
my ($self, $separator) = @_; |
133
|
|
|
|
|
|
|
|
134
|
12
|
|
33
|
|
|
30
|
$separator ||= $self->_list_separator(); |
135
|
12
|
|
|
|
|
19
|
my $delimiter = $self->delimiter(); |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# Stringify into array |
138
|
|
|
|
|
|
|
my @collapsed_range |
139
|
32
|
100
|
|
|
|
128
|
= map { ref($_) eq 'Date::Simple' ? "$_" |
140
|
|
|
|
|
|
|
: $_->start() . |
141
|
|
|
|
|
|
|
$delimiter . |
142
|
|
|
|
|
|
|
$_->end() |
143
|
|
|
|
|
|
|
} |
144
|
12
|
|
|
|
|
15
|
@{ $self->{range} }; |
|
12
|
|
|
|
|
19
|
|
145
|
|
|
|
|
|
|
|
146
|
12
|
|
|
|
|
122
|
return join $separator, @collapsed_range; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
### PUBLIC INSTANCE METHOD ### |
150
|
|
|
|
|
|
|
# |
151
|
|
|
|
|
|
|
# Returns regex that is used to validate date items. Since Date::Simple |
152
|
|
|
|
|
|
|
# doesn't support date formats other than basic ISO 8601 (YYYY-MM-DD) we |
153
|
|
|
|
|
|
|
# don't have to support anything else. The only exception is YYYY-MM |
154
|
|
|
|
|
|
|
# format for month-only dates. |
155
|
|
|
|
|
|
|
# |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub pattern { |
158
|
91
|
|
|
91
|
1
|
243
|
return qr{ |
159
|
|
|
|
|
|
|
(?
|
160
|
|
|
|
|
|
|
(?: # Group but don't capture |
161
|
|
|
|
|
|
|
(?:\d{4}-\d{2}) # ... YYYY-MM |
162
|
|
|
|
|
|
|
| # or |
163
|
|
|
|
|
|
|
(?:\d{4}-\d{2}-\d{2}) # ... YYYY-MM-DD |
164
|
|
|
|
|
|
|
) # ... end group |
165
|
|
|
|
|
|
|
(?= # Can't have this group after |
166
|
|
|
|
|
|
|
(?: # Group but don't capture |
167
|
|
|
|
|
|
|
\s # ... a whitespace |
168
|
|
|
|
|
|
|
| # or |
169
|
|
|
|
|
|
|
/ # ... a forward slash [/] |
170
|
|
|
|
|
|
|
| # or |
171
|
|
|
|
|
|
|
\z # ... end of string |
172
|
|
|
|
|
|
|
) # ... end group |
173
|
|
|
|
|
|
|
) # ... end lookahead |
174
|
|
|
|
|
|
|
}xms; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
### PUBLIC INSTANCE METHOD ### |
178
|
|
|
|
|
|
|
# |
179
|
|
|
|
|
|
|
# Returns regex that is used to separate items in a range list. |
180
|
|
|
|
|
|
|
# Default is comma (,) or semicolon (;). |
181
|
|
|
|
|
|
|
# |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
sub separator { |
184
|
91
|
|
|
91
|
1
|
158
|
return qr/ |
185
|
|
|
|
|
|
|
[;,] # Comma or semicolon |
186
|
|
|
|
|
|
|
\s* # Greedy whitespace |
187
|
|
|
|
|
|
|
/xms |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
### PUBLIC INSTANCE METHOD ### |
191
|
|
|
|
|
|
|
# |
192
|
|
|
|
|
|
|
# For Range::Object::Date delimiter is forward slash (/) as per ISO 8601. |
193
|
|
|
|
|
|
|
# |
194
|
|
|
|
|
|
|
|
195
|
12
|
|
|
12
|
1
|
16
|
sub delimiter { '/' } |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
############## PRIVATE METHODS BELOW ############## |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
200
|
|
|
|
|
|
|
# |
201
|
|
|
|
|
|
|
# Returns default list separator for use with stingify() and |
202
|
|
|
|
|
|
|
# stringify_collapsed() |
203
|
|
|
|
|
|
|
# |
204
|
|
|
|
|
|
|
|
205
|
18
|
|
|
18
|
|
56
|
sub _list_separator { q{,} } |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
208
|
|
|
|
|
|
|
# |
209
|
|
|
|
|
|
|
# Uses Date::Simple and Date::Range to validate and unpack individual |
210
|
|
|
|
|
|
|
# date values and date ranges; returns full list of date strings. |
211
|
|
|
|
|
|
|
# |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub _validate_and_expand { |
214
|
91
|
|
|
91
|
|
147
|
my ($self, @input_range) = @_; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# Retrieve patterns |
217
|
91
|
|
|
|
|
145
|
my $pattern = $self->pattern(); |
218
|
91
|
|
|
|
|
152
|
my $separator = $self->separator(); |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# We use hash to avoid duplicates |
221
|
91
|
|
|
|
|
115
|
my %temp; |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# Go over each item |
224
|
|
|
|
|
|
|
ITEM: |
225
|
91
|
|
|
|
|
171
|
while ( @input_range ) { |
226
|
203
|
|
|
|
|
685
|
my $item = shift @input_range; |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# Expand on $separator |
229
|
203
|
100
|
66
|
|
|
944
|
if ( $separator && $item =~ $separator ) { |
230
|
4
|
|
|
|
|
36
|
unshift @input_range, split $separator, $item; |
231
|
4
|
|
|
|
|
11
|
next ITEM; |
232
|
|
|
|
|
|
|
}; |
233
|
|
|
|
|
|
|
|
234
|
199
|
100
|
66
|
|
|
1375
|
croak "Invalid input: $item" |
235
|
|
|
|
|
|
|
if $item && $item !~ $pattern; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# We use Date::Range to validate and expand dates |
238
|
197
|
100
|
|
|
|
1578
|
if ($item =~ m{ ($pattern) / ($pattern) }xms) { |
|
|
50
|
|
|
|
|
|
239
|
4
|
|
|
|
|
13
|
my ($first, $last) = ($1, $2); |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# Date::Simple doesn't support non-full dates so |
242
|
|
|
|
|
|
|
# we have to trick it a bit |
243
|
4
|
50
|
33
|
|
|
9
|
if ($first =~ YYYYMM || $last =~ YYYYMM) { |
244
|
|
|
|
|
|
|
# First check if *both* $first and $last are month-only |
245
|
0
|
0
|
0
|
|
|
0
|
croak "Can't mix YYYY-MM and YYYY-MM-DD input formats" |
246
|
|
|
|
|
|
|
unless $first =~ YYYYMM && $last =~ YYYYMM; |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
# Now add dates |
249
|
0
|
|
|
|
|
0
|
$first .= '-01'; |
250
|
0
|
|
|
|
|
0
|
$last .= '-01'; |
251
|
|
|
|
|
|
|
}; |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
# Create Date::Simple objects |
254
|
4
|
|
|
|
|
11
|
my ($date1, $date2) = eval { |
255
|
4
|
|
|
|
|
13
|
return Date::Simple->new($first), Date::Simple->new($last) |
256
|
|
|
|
|
|
|
}; |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
# Check that everything is OK |
259
|
4
|
50
|
|
|
|
249
|
croak "Invalid input date in range '$item': $@" if $@; |
260
|
4
|
50
|
|
|
|
9
|
croak "Invalid input date '$first'" if !defined $date1; |
261
|
4
|
50
|
|
|
|
8
|
croak "Invalid input date '$last'" if !defined $date2; |
262
|
4
|
50
|
|
|
|
14
|
croak "Last date in range cannot be earlier than first date" |
263
|
|
|
|
|
|
|
if $date1 > $date2; |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# Create Date::Range object |
266
|
4
|
|
|
|
|
7
|
my $range = eval { Date::Range->new($date1, $date2) }; |
|
4
|
|
|
|
|
13
|
|
267
|
4
|
50
|
33
|
|
|
90
|
$@ || !defined $range and |
268
|
|
|
|
|
|
|
croak "Invalid input range '$item': $@"; |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
# Expand Date::Range object and store resulting dates |
271
|
4
|
|
|
|
|
11
|
my @dates = $range->dates(); |
272
|
4
|
|
|
|
|
285131
|
@temp{ @dates } = (1) x @dates; |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
# See if that's an individual date |
276
|
|
|
|
|
|
|
elsif ($item =~ /\A ( $pattern ) \z/xms) { |
277
|
193
|
|
|
|
|
417
|
my $date = $1; |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# The same trick as with months range |
280
|
193
|
50
|
|
|
|
297
|
$date .= '-01' if $date =~ YYYYMM; |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
# Create Date::Simple object |
283
|
193
|
|
|
|
|
344
|
my $d = eval { Date::Simple->new($date) }; |
|
193
|
|
|
|
|
420
|
|
284
|
193
|
100
|
66
|
|
|
5719
|
$@ || !defined $d and |
285
|
|
|
|
|
|
|
croak "Invalid input date '$item': $@"; |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
# ... and store it |
288
|
191
|
|
|
|
|
969
|
$temp{ "$d" } = 1; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
# Didn't find anything useful |
292
|
|
|
|
|
|
|
else { |
293
|
0
|
|
|
|
|
0
|
croak "Invalid input '$item': no ISO 8601 dates found"; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
# Order matters for later _collapse_range() |
298
|
87
|
|
|
|
|
32502
|
my @dates = sort { $a cmp $b } keys %temp; |
|
200018
|
|
|
|
|
208163
|
|
299
|
|
|
|
|
|
|
|
300
|
87
|
|
|
|
|
3556
|
return @dates; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
304
|
|
|
|
|
|
|
# |
305
|
|
|
|
|
|
|
# Tests if a sigle value is in current range. |
306
|
|
|
|
|
|
|
# |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
sub _search_range { |
309
|
149
|
|
|
149
|
|
208
|
my ($self, $value) = @_; |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
return first { |
312
|
419
|
100
|
|
419
|
|
1439
|
ref eq 'Date::Range' ? $_->includes($value) |
313
|
|
|
|
|
|
|
: $_ == $value |
314
|
|
|
|
|
|
|
} |
315
|
149
|
|
|
|
|
317
|
@{ $self->{range} }; |
|
149
|
|
|
|
|
332
|
|
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
319
|
|
|
|
|
|
|
# |
320
|
|
|
|
|
|
|
# Returns sorted list of all single items within current range. |
321
|
|
|
|
|
|
|
# Default sort is string-based. |
322
|
|
|
|
|
|
|
# |
323
|
|
|
|
|
|
|
# Works in list context only, croaks if called otherwise. |
324
|
|
|
|
|
|
|
# |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
sub _sort_range { |
327
|
6
|
|
|
6
|
|
23
|
my ($self, @range) = @_; |
328
|
|
|
|
|
|
|
|
329
|
6
|
50
|
|
|
|
12
|
croak "_sort_range can only be used in list context" |
330
|
|
|
|
|
|
|
unless wantarray; |
331
|
|
|
|
|
|
|
|
332
|
110
|
|
|
|
|
1551
|
return sort { $a cmp $b } |
333
|
16
|
100
|
|
|
|
360
|
map { ref eq 'Date::Range' ? $_->dates : "$_" } |
334
|
6
|
|
33
|
|
|
14
|
@range || @{ $self->{range} }; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
338
|
|
|
|
|
|
|
# |
339
|
|
|
|
|
|
|
# Returns full list of items in current range. |
340
|
|
|
|
|
|
|
# |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
sub _full_range { |
343
|
6
|
|
|
6
|
|
15
|
my ($self) = @_; |
344
|
|
|
|
|
|
|
|
345
|
6
|
50
|
|
|
|
14
|
croak "_full_range can only be used in list context" |
346
|
|
|
|
|
|
|
unless wantarray; |
347
|
|
|
|
|
|
|
|
348
|
7
|
100
|
|
|
|
230
|
return map { ref($_) eq 'Date::Range' ? $_->dates() : "$_" } |
349
|
6
|
|
|
|
|
8
|
@{ $self->{range} }; |
|
6
|
|
|
|
|
45
|
|
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
353
|
|
|
|
|
|
|
# |
354
|
|
|
|
|
|
|
# Returns collapsed list of current range items. Individual dates are |
355
|
|
|
|
|
|
|
# returned as Date::Simple objects while ranges are collapsed to |
356
|
|
|
|
|
|
|
# Date::Range objects. |
357
|
|
|
|
|
|
|
# |
358
|
|
|
|
|
|
|
# Works in list context only, croaks if called otherwise. |
359
|
|
|
|
|
|
|
# |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
sub _collapse_range { |
362
|
6
|
|
|
6
|
|
21
|
my ($self, @range) = @_; |
363
|
|
|
|
|
|
|
|
364
|
6
|
50
|
|
|
|
11
|
croak "_collapse_range can only be used in list context" |
365
|
|
|
|
|
|
|
unless wantarray; |
366
|
|
|
|
|
|
|
|
367
|
6
|
|
|
|
|
11
|
my ($first, $last, @result); |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
ITEM: |
370
|
6
|
|
|
|
|
30
|
for my $item ( sort @range ) { |
371
|
|
|
|
|
|
|
# Create Date::Simple object |
372
|
76
|
|
|
|
|
97
|
$item = eval { Date::Simple->new($item) }; |
|
76
|
|
|
|
|
128
|
|
373
|
76
|
50
|
|
|
|
1932
|
croak "Internal error: can't create Date::Simple: $@" if $@; |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
# If $first is defined, it means range has started |
376
|
76
|
100
|
|
|
|
104
|
if ( !defined $first ) { |
377
|
6
|
|
|
|
|
10
|
$first = $last = $item; |
378
|
6
|
|
|
|
|
10
|
next ITEM; |
379
|
|
|
|
|
|
|
}; |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
# If $last immediately preceeds $item in range, |
382
|
|
|
|
|
|
|
# $item becomes next $last |
383
|
70
|
100
|
|
|
|
105
|
if ( $self->_next_in_range($last, $item) ) { |
384
|
60
|
|
|
|
|
1108
|
$last = $item; |
385
|
60
|
|
|
|
|
83
|
next ITEM; |
386
|
|
|
|
|
|
|
}; |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# If $item doesn't follow $last and $last is defined, |
389
|
|
|
|
|
|
|
# it means current contiguous range is complete |
390
|
10
|
100
|
|
|
|
208
|
if ( !$self->_equal_value($first, $last) ) { |
391
|
|
|
|
|
|
|
# Try to create range object which *should* go ok but still |
392
|
2
|
|
|
|
|
4
|
eval { |
393
|
2
|
|
|
|
|
6
|
push @result, Date::Range->new($first, $last); |
394
|
2
|
|
|
|
|
40
|
$first = $last = $item; |
395
|
2
|
|
|
|
|
5
|
next ITEM; |
396
|
|
|
|
|
|
|
}; |
397
|
|
|
|
|
|
|
# ... and rethrow if anything untowards happen |
398
|
0
|
0
|
|
|
|
0
|
croak "Internal error: can't create Date::Range: $@" if $@; |
399
|
|
|
|
|
|
|
}; |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
# If $last wasn't defined, range was never contiguous |
402
|
8
|
|
|
|
|
16
|
push @result, $first; |
403
|
8
|
|
|
|
|
11
|
$first = $last = $item; |
404
|
8
|
|
|
|
|
16
|
next ITEM; |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
# We're here when last item has been processed |
408
|
6
|
50
|
|
|
|
17
|
if ( $first eq $last ) { |
409
|
0
|
|
|
|
|
0
|
push @result, $first; |
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
else { |
412
|
6
|
|
|
|
|
10
|
eval { |
413
|
6
|
|
|
|
|
19
|
push @result, Date::Range->new($first, $last); |
414
|
|
|
|
|
|
|
}; |
415
|
6
|
50
|
|
|
|
123
|
croak "Internal error: can't create Date::Range: $@" if $@; |
416
|
|
|
|
|
|
|
}; |
417
|
|
|
|
|
|
|
|
418
|
6
|
|
|
|
|
17
|
return @result; |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
422
|
|
|
|
|
|
|
# |
423
|
|
|
|
|
|
|
# Tests if two items are equal. Since we're storing both Date::Simple |
424
|
|
|
|
|
|
|
# and Date::Range items, this method has to account for details. |
425
|
|
|
|
|
|
|
# |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
sub _equal_value { |
428
|
10
|
|
|
10
|
|
17
|
my ($self, $first, $last) = @_; |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
# Compare $last with $first |
431
|
10
|
50
|
33
|
|
|
32
|
if ( ref $first eq 'Date::Simple' && ref $last eq 'Date::Simple' ) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
432
|
10
|
|
|
|
|
37
|
return !!( $first == $last ); |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
# Compare last value in range with $last |
436
|
|
|
|
|
|
|
elsif ( ref $first eq 'Date::Range' && ref $last eq 'Date::Simple' ) { |
437
|
0
|
|
|
|
|
0
|
return !!( $first->end == $last ); |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
# Compare $last with first value in range |
441
|
|
|
|
|
|
|
elsif ( ref $first eq 'Date::Simple' && ref $last eq 'Date::Range' ) { |
442
|
0
|
|
|
|
|
0
|
return !!( $first == $last->start ); |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
# This can't happen (theoretically) but still check |
446
|
|
|
|
|
|
|
elsif ( ref $first eq 'Date::Range' && ref $last eq 'Date::Range' ) { |
447
|
0
|
|
|
|
|
0
|
return !!( $first->equals($last) ); |
448
|
|
|
|
|
|
|
}; |
449
|
|
|
|
|
|
|
|
450
|
10
|
|
|
|
|
0
|
return; # Just fail if something goes awry |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
454
|
|
|
|
|
|
|
# |
455
|
|
|
|
|
|
|
# Tests if two values are consequent. Same as with _equal_value(), this |
456
|
|
|
|
|
|
|
# method has to check item types first. |
457
|
|
|
|
|
|
|
# |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
sub _next_in_range { |
460
|
70
|
|
|
70
|
|
99
|
my ($self, $first, $last) = @_; |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
# Comparing apples to apples |
463
|
70
|
50
|
33
|
|
|
198
|
if ( ref $first eq 'Date::Simple' && ref $last eq 'Date::Simple' ) { |
464
|
70
|
|
|
|
|
187
|
return !!( $first + 1 == $last ); |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
# Apples to oranges |
468
|
0
|
0
|
0
|
|
|
|
if ( ref $first eq 'Date::Simple' && ref $last eq 'Date::Range' ) { |
469
|
0
|
|
|
|
|
|
return !!( $first + 1 == $last->begin ); |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
# Vice versa |
473
|
0
|
0
|
0
|
|
|
|
if ( ref $first eq 'Date::Range' && ref $last eq 'Date::Simple' ) { |
474
|
0
|
|
|
|
|
|
return !!( $first->end + 1 == $last ); |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
# Can't happen but still |
478
|
0
|
0
|
0
|
|
|
|
if ( ref $first eq 'Date::Range' && ref $last eq 'Date::Range' ) { |
479
|
0
|
|
|
|
|
|
return $first->abuts($last); |
480
|
|
|
|
|
|
|
}; |
481
|
|
|
|
|
|
|
|
482
|
0
|
|
|
|
|
|
return; # Quell the critics |
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
1; |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
__END__ |