line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved. |
2
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or |
3
|
|
|
|
|
|
|
# modify it under the same terms as Perl itself. |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package DateTime::SpanSet; |
6
|
|
|
|
|
|
|
|
7
|
23
|
|
|
23
|
|
1044352
|
use strict; |
|
23
|
|
|
|
|
31
|
|
|
23
|
|
|
|
|
543
|
|
8
|
|
|
|
|
|
|
|
9
|
23
|
|
|
23
|
|
1214
|
use DateTime::Set; |
|
23
|
|
|
|
|
135
|
|
|
23
|
|
|
|
|
335
|
|
10
|
23
|
|
|
23
|
|
76
|
use DateTime::Infinite; |
|
23
|
|
|
|
|
23
|
|
|
23
|
|
|
|
|
442
|
|
11
|
|
|
|
|
|
|
|
12
|
23
|
|
|
23
|
|
112
|
use Carp; |
|
23
|
|
|
|
|
24
|
|
|
23
|
|
|
|
|
1098
|
|
13
|
23
|
|
|
23
|
|
81
|
use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF ); |
|
23
|
|
|
|
|
29
|
|
|
23
|
|
|
|
|
1083
|
|
14
|
23
|
|
|
23
|
|
74
|
use vars qw( $VERSION ); |
|
23
|
|
|
|
|
23
|
|
|
23
|
|
|
|
|
922
|
|
15
|
|
|
|
|
|
|
|
16
|
23
|
|
|
23
|
|
80
|
use constant INFINITY => 100 ** 100 ** 100 ; |
|
23
|
|
|
|
|
24
|
|
|
23
|
|
|
|
|
1457
|
|
17
|
23
|
|
|
23
|
|
77
|
use constant NEG_INFINITY => -1 * (100 ** 100 ** 100); |
|
23
|
|
|
|
|
24
|
|
|
23
|
|
|
|
|
51159
|
|
18
|
|
|
|
|
|
|
$VERSION = $DateTime::Set::VERSION; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub iterate { |
21
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $callback ) = @_; |
22
|
0
|
|
|
|
|
0
|
my $class = ref( $self ); |
23
|
0
|
|
|
|
|
0
|
my $return = $class->empty_set; |
24
|
|
|
|
|
|
|
$return->{set} = $self->{set}->iterate( |
25
|
|
|
|
|
|
|
sub { |
26
|
0
|
|
|
0
|
|
0
|
my $span = bless { set => $_[0] }, 'DateTime::Span'; |
27
|
0
|
|
|
|
|
0
|
$callback->( $span->clone ); |
28
|
|
|
|
|
|
|
$span = $span->{set} |
29
|
0
|
0
|
|
|
|
0
|
if UNIVERSAL::can( $span, 'union' ); |
30
|
0
|
|
|
|
|
0
|
return $span; |
31
|
|
|
|
|
|
|
} |
32
|
0
|
|
|
|
|
0
|
); |
33
|
0
|
|
|
|
|
0
|
$return; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub map { |
37
|
1
|
|
|
1
|
1
|
13
|
my ( $self, $callback ) = @_; |
38
|
1
|
|
|
|
|
2
|
my $class = ref( $self ); |
39
|
1
|
50
|
|
|
|
4
|
die "The callback parameter to map() must be a subroutine reference" |
40
|
|
|
|
|
|
|
unless ref( $callback ) eq 'CODE'; |
41
|
1
|
|
|
|
|
4
|
my $return = $class->empty_set; |
42
|
|
|
|
|
|
|
$return->{set} = $self->{set}->iterate( |
43
|
|
|
|
|
|
|
sub { |
44
|
2
|
|
|
2
|
|
62
|
local $_ = bless { set => $_[0]->clone }, 'DateTime::Span'; |
45
|
2
|
|
|
|
|
44
|
my @list = $callback->(); |
46
|
2
|
|
|
|
|
15
|
my $set = $class->empty_set; |
47
|
2
|
|
|
|
|
33
|
$set = $set->union( $_ ) for @list; |
48
|
2
|
|
|
|
|
15
|
return $set->{set}; |
49
|
|
|
|
|
|
|
} |
50
|
1
|
|
|
|
|
21
|
); |
51
|
1
|
|
|
|
|
100
|
$return; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub grep { |
55
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $callback ) = @_; |
56
|
0
|
|
|
|
|
0
|
my $class = ref( $self ); |
57
|
0
|
0
|
|
|
|
0
|
die "The callback parameter to grep() must be a subroutine reference" |
58
|
|
|
|
|
|
|
unless ref( $callback ) eq 'CODE'; |
59
|
0
|
|
|
|
|
0
|
my $return = $class->empty_set; |
60
|
|
|
|
|
|
|
$return->{set} = $self->{set}->iterate( |
61
|
|
|
|
|
|
|
sub { |
62
|
0
|
|
|
0
|
|
0
|
local $_ = bless { set => $_[0]->clone }, 'DateTime::Span'; |
63
|
0
|
|
|
|
|
0
|
my $result = $callback->(); |
64
|
0
|
0
|
0
|
|
|
0
|
return $_->{set} if $result && $_; |
65
|
0
|
|
|
|
|
0
|
return; |
66
|
|
|
|
|
|
|
} |
67
|
0
|
|
|
|
|
0
|
); |
68
|
0
|
|
|
|
|
0
|
$return; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub set_time_zone { |
72
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $tz ) = @_; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# TODO - use iterate() instead |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
my $result = $self->{set}->iterate( |
77
|
|
|
|
|
|
|
sub { |
78
|
0
|
|
|
0
|
|
0
|
my %tmp = %{ $_[0]->{list}[0] }; |
|
0
|
|
|
|
|
0
|
|
79
|
0
|
0
|
|
|
|
0
|
$tmp{a} = $tmp{a}->clone->set_time_zone( $tz ) if ref $tmp{a}; |
80
|
0
|
0
|
|
|
|
0
|
$tmp{b} = $tmp{b}->clone->set_time_zone( $tz ) if ref $tmp{b}; |
81
|
0
|
|
|
|
|
0
|
\%tmp; |
82
|
|
|
|
|
|
|
}, |
83
|
|
|
|
|
|
|
backtrack_callback => sub { |
84
|
0
|
|
|
0
|
|
0
|
my ( $min, $max ) = ( $_[0]->min, $_[0]->max ); |
85
|
0
|
0
|
|
|
|
0
|
if ( ref($min) ) |
86
|
|
|
|
|
|
|
{ |
87
|
0
|
|
|
|
|
0
|
$min = $min->clone; |
88
|
0
|
|
|
|
|
0
|
$min->set_time_zone( 'floating' ); |
89
|
|
|
|
|
|
|
} |
90
|
0
|
0
|
|
|
|
0
|
if ( ref($max) ) |
91
|
|
|
|
|
|
|
{ |
92
|
0
|
|
|
|
|
0
|
$max = $max->clone; |
93
|
0
|
|
|
|
|
0
|
$max->set_time_zone( 'floating' ); |
94
|
|
|
|
|
|
|
} |
95
|
0
|
|
|
|
|
0
|
return Set::Infinite::_recurrence->new( $min, $max ); |
96
|
|
|
|
|
|
|
}, |
97
|
0
|
|
|
|
|
0
|
); |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
### this code enables 'subroutine method' behaviour |
100
|
0
|
|
|
|
|
0
|
$self->{set} = $result; |
101
|
0
|
|
|
|
|
0
|
return $self; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub from_spans { |
105
|
5
|
|
|
5
|
1
|
267
|
my $class = shift; |
106
|
5
|
|
|
|
|
65
|
my %args = validate( @_, |
107
|
|
|
|
|
|
|
{ spans => |
108
|
|
|
|
|
|
|
{ type => ARRAYREF, |
109
|
|
|
|
|
|
|
optional => 1, |
110
|
|
|
|
|
|
|
}, |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
); |
113
|
5
|
|
|
|
|
16
|
my $self = {}; |
114
|
5
|
|
|
|
|
12
|
my $set = Set::Infinite::_recurrence->new(); |
115
|
5
|
|
|
|
|
51
|
$set = $set->union( $_->{set} ) for @{ $args{spans} }; |
|
5
|
|
|
|
|
21
|
|
116
|
5
|
|
|
|
|
223
|
$self->{set} = $set; |
117
|
5
|
|
|
|
|
6
|
bless $self, $class; |
118
|
5
|
|
|
|
|
18
|
return $self; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub from_set_and_duration { |
122
|
|
|
|
|
|
|
# set => $dt_set, days => 1 |
123
|
3
|
|
|
3
|
1
|
19
|
my $class = shift; |
124
|
3
|
|
|
|
|
7
|
my %args = @_; |
125
|
|
|
|
|
|
|
my $set = delete $args{set} || |
126
|
3
|
|
33
|
|
|
12
|
carp "from_set_and_duration needs a 'set' parameter"; |
127
|
|
|
|
|
|
|
|
128
|
3
|
50
|
|
|
|
19
|
$set = $set->as_set |
129
|
|
|
|
|
|
|
if UNIVERSAL::can( $set, 'as_set' ); |
130
|
3
|
50
|
|
|
|
19
|
unless ( UNIVERSAL::can( $set, 'union' ) ) { |
131
|
0
|
|
|
|
|
0
|
carp "'set' must be a set" }; |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
my $duration = delete $args{duration} || |
134
|
3
|
|
66
|
|
|
14
|
new DateTime::Duration( %args ); |
135
|
3
|
|
|
|
|
124
|
my $end_set = $set->clone->add_duration( $duration ); |
136
|
3
|
|
|
|
|
9
|
return $class->from_sets( start_set => $set, |
137
|
|
|
|
|
|
|
end_set => $end_set ); |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub from_sets { |
141
|
13
|
|
|
13
|
1
|
1447
|
my $class = shift; |
142
|
13
|
|
|
|
|
207
|
my %args = validate( @_, |
143
|
|
|
|
|
|
|
{ start_set => |
144
|
|
|
|
|
|
|
{ # can => 'union', |
145
|
|
|
|
|
|
|
optional => 0, |
146
|
|
|
|
|
|
|
}, |
147
|
|
|
|
|
|
|
end_set => |
148
|
|
|
|
|
|
|
{ # can => 'union', |
149
|
|
|
|
|
|
|
optional => 0, |
150
|
|
|
|
|
|
|
}, |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
); |
153
|
13
|
|
|
|
|
45
|
my $start_set = delete $args{start_set}; |
154
|
13
|
|
|
|
|
13
|
my $end_set = delete $args{end_set}; |
155
|
|
|
|
|
|
|
|
156
|
13
|
50
|
|
|
|
50
|
$start_set = $start_set->as_set |
157
|
|
|
|
|
|
|
if UNIVERSAL::can( $start_set, 'as_set' ); |
158
|
13
|
50
|
|
|
|
27
|
$end_set = $end_set->as_set |
159
|
|
|
|
|
|
|
if UNIVERSAL::can( $end_set, 'as_set' ); |
160
|
|
|
|
|
|
|
|
161
|
13
|
50
|
|
|
|
36
|
unless ( UNIVERSAL::can( $start_set, 'union' ) ) { |
162
|
0
|
|
|
|
|
0
|
carp "'start_set' must be a set" }; |
163
|
13
|
50
|
|
|
|
26
|
unless ( UNIVERSAL::can( $end_set, 'union' ) ) { |
164
|
0
|
|
|
|
|
0
|
carp "'end_set' must be a set" }; |
165
|
|
|
|
|
|
|
|
166
|
13
|
|
|
|
|
13
|
my $self; |
167
|
|
|
|
|
|
|
$self->{set} = $start_set->{set}->until( |
168
|
13
|
|
|
|
|
46
|
$end_set->{set} ); |
169
|
13
|
|
|
|
|
1227
|
bless $self, $class; |
170
|
13
|
|
|
|
|
37
|
return $self; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub start_set { |
174
|
8
|
100
|
66
|
8
|
1
|
583
|
if ( exists $_[0]->{set}{method} && |
175
|
|
|
|
|
|
|
$_[0]->{set}{method} eq 'until' ) |
176
|
|
|
|
|
|
|
{ |
177
|
5
|
|
|
|
|
16
|
return bless { set => $_[0]->{set}{parent}[0] }, 'DateTime::Set'; |
178
|
|
|
|
|
|
|
} |
179
|
3
|
|
|
|
|
12
|
my $return = DateTime::Set->empty_set; |
180
|
3
|
|
|
|
|
46
|
$return->{set} = $_[0]->{set}->start_set; |
181
|
3
|
|
|
|
|
404
|
$return; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub end_set { |
185
|
7
|
100
|
66
|
7
|
1
|
915
|
if ( exists $_[0]->{set}{method} && |
186
|
|
|
|
|
|
|
$_[0]->{set}{method} eq 'until' ) |
187
|
|
|
|
|
|
|
{ |
188
|
5
|
|
|
|
|
10
|
return bless { set => $_[0]->{set}{parent}[1] }, 'DateTime::Set'; |
189
|
|
|
|
|
|
|
} |
190
|
2
|
|
|
|
|
6
|
my $return = DateTime::Set->empty_set; |
191
|
2
|
|
|
|
|
31
|
$return->{set} = $_[0]->{set}->end_set; |
192
|
2
|
|
|
|
|
270
|
$return; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub empty_set { |
196
|
34
|
|
|
34
|
1
|
36
|
my $class = shift; |
197
|
|
|
|
|
|
|
|
198
|
34
|
|
|
|
|
59
|
return bless { set => Set::Infinite::_recurrence->new }, $class; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub is_empty_set { |
202
|
0
|
|
|
0
|
1
|
0
|
my $set = $_[0]; |
203
|
0
|
|
|
|
|
0
|
$set->{set}->is_null; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub clone { |
207
|
|
|
|
|
|
|
bless { |
208
|
|
|
|
|
|
|
set => $_[0]->{set}->copy, |
209
|
9
|
|
|
9
|
1
|
24
|
}, ref $_[0]; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub iterator { |
214
|
12
|
|
|
12
|
1
|
510
|
my $self = shift; |
215
|
|
|
|
|
|
|
|
216
|
12
|
|
|
|
|
16
|
my %args = @_; |
217
|
12
|
|
|
|
|
11
|
my $span; |
218
|
12
|
|
|
|
|
12
|
$span = delete $args{span}; |
219
|
12
|
100
|
|
|
|
28
|
$span = DateTime::Span->new( %args ) if %args; |
220
|
|
|
|
|
|
|
|
221
|
12
|
100
|
|
|
|
23
|
return $self->intersection( $span ) if $span; |
222
|
8
|
|
|
|
|
13
|
return $self->clone; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# next() gets the next element from an iterator() |
227
|
|
|
|
|
|
|
sub next { |
228
|
48
|
|
|
48
|
1
|
5417
|
my ($self) = shift; |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
# TODO: this is fixing an error from elsewhere |
231
|
|
|
|
|
|
|
# - find out what's going on! (with "sunset.pl") |
232
|
48
|
100
|
|
|
|
135
|
return undef unless ref $self->{set}; |
233
|
|
|
|
|
|
|
|
234
|
45
|
100
|
|
|
|
62
|
if ( @_ ) |
235
|
|
|
|
|
|
|
{ |
236
|
6
|
|
|
|
|
7
|
my $max; |
237
|
6
|
100
|
|
|
|
20
|
$max = $_[0]->max if UNIVERSAL::can( $_[0], 'union' ); |
238
|
6
|
100
|
|
|
|
19
|
$max = $_[0] if ! defined $max; |
239
|
|
|
|
|
|
|
|
240
|
6
|
50
|
33
|
|
|
12
|
return undef if ! ref( $max ) && $max == INFINITY; |
241
|
|
|
|
|
|
|
|
242
|
6
|
|
|
|
|
16
|
my $span = DateTime::Span->from_datetimes( start => $max ); |
243
|
6
|
|
|
|
|
12
|
my $iterator = $self->intersection( $span ); |
244
|
6
|
|
|
|
|
12
|
my $return = $iterator->next; |
245
|
|
|
|
|
|
|
|
246
|
6
|
50
|
|
|
|
10
|
return $return if ! defined $return; |
247
|
6
|
100
|
|
|
|
15
|
return $return if ! $return->intersects( $max ); |
248
|
|
|
|
|
|
|
|
249
|
1
|
|
|
|
|
216
|
return $iterator->next; |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
39
|
|
|
|
|
78
|
my ($head, $tail) = $self->{set}->first; |
253
|
39
|
|
|
|
|
2432
|
$self->{set} = $tail; |
254
|
39
|
50
|
|
|
|
133
|
return $head unless ref $head; |
255
|
39
|
|
|
|
|
51
|
my $return = { |
256
|
|
|
|
|
|
|
set => $head, |
257
|
|
|
|
|
|
|
}; |
258
|
39
|
|
|
|
|
42
|
bless $return, 'DateTime::Span'; |
259
|
39
|
|
|
|
|
79
|
return $return; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# previous() gets the last element from an iterator() |
263
|
|
|
|
|
|
|
sub previous { |
264
|
17
|
|
|
17
|
1
|
808
|
my ($self) = shift; |
265
|
|
|
|
|
|
|
|
266
|
17
|
100
|
|
|
|
41
|
return undef unless ref $self->{set}; |
267
|
|
|
|
|
|
|
|
268
|
15
|
100
|
|
|
|
23
|
if ( @_ ) |
269
|
|
|
|
|
|
|
{ |
270
|
3
|
|
|
|
|
1
|
my $min; |
271
|
3
|
100
|
|
|
|
13
|
$min = $_[0]->min if UNIVERSAL::can( $_[0], 'union' ); |
272
|
3
|
100
|
|
|
|
12
|
$min = $_[0] if ! defined $min; |
273
|
|
|
|
|
|
|
|
274
|
3
|
50
|
33
|
|
|
7
|
return undef if ! ref( $min ) && $min == INFINITY; |
275
|
|
|
|
|
|
|
|
276
|
3
|
|
|
|
|
9
|
my $span = DateTime::Span->from_datetimes( end => $min ); |
277
|
3
|
|
|
|
|
7
|
my $iterator = $self->intersection( $span ); |
278
|
3
|
|
|
|
|
6
|
my $return = $iterator->previous; |
279
|
|
|
|
|
|
|
|
280
|
3
|
50
|
|
|
|
4
|
return $return if ! defined $return; |
281
|
3
|
100
|
|
|
|
7
|
return $return if ! $return->intersects( $min ); |
282
|
|
|
|
|
|
|
|
283
|
2
|
|
|
|
|
439
|
return $iterator->previous; |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
12
|
|
|
|
|
29
|
my ($head, $tail) = $self->{set}->last; |
287
|
12
|
|
|
|
|
423
|
$self->{set} = $tail; |
288
|
12
|
50
|
|
|
|
29
|
return $head unless ref $head; |
289
|
12
|
|
|
|
|
14
|
my $return = { |
290
|
|
|
|
|
|
|
set => $head, |
291
|
|
|
|
|
|
|
}; |
292
|
12
|
|
|
|
|
13
|
bless $return, 'DateTime::Span'; |
293
|
12
|
|
|
|
|
17
|
return $return; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
# "current" means less-or-equal to a DateTime |
297
|
|
|
|
|
|
|
sub current { |
298
|
4
|
|
|
4
|
1
|
356
|
my $self = shift; |
299
|
|
|
|
|
|
|
|
300
|
4
|
|
|
|
|
4
|
my $previous; |
301
|
|
|
|
|
|
|
my $next; |
302
|
|
|
|
|
|
|
{ |
303
|
4
|
|
|
|
|
3
|
my $min; |
|
4
|
|
|
|
|
4
|
|
304
|
4
|
50
|
|
|
|
14
|
$min = $_[0]->min if UNIVERSAL::can( $_[0], 'union' ); |
305
|
4
|
50
|
|
|
|
8
|
$min = $_[0] if ! defined $min; |
306
|
4
|
50
|
33
|
|
|
9
|
return undef if ! ref( $min ) && $min == INFINITY; |
307
|
4
|
|
|
|
|
11
|
my $span = DateTime::Span->from_datetimes( end => $min ); |
308
|
4
|
|
|
|
|
8
|
my $iterator = $self->intersection( $span ); |
309
|
4
|
|
|
|
|
8
|
$previous = $iterator->previous; |
310
|
4
|
|
|
|
|
12
|
$span = DateTime::Span->from_datetimes( start => $min ); |
311
|
4
|
|
|
|
|
11
|
$iterator = $self->intersection( $span ); |
312
|
4
|
|
|
|
|
14
|
$next = $iterator->next; |
313
|
|
|
|
|
|
|
} |
314
|
4
|
50
|
|
|
|
6
|
return $previous unless defined $next; |
315
|
|
|
|
|
|
|
|
316
|
4
|
50
|
|
|
|
14
|
my $dt1 = defined $previous |
317
|
|
|
|
|
|
|
? $next->union( $previous ) |
318
|
|
|
|
|
|
|
: $next; |
319
|
|
|
|
|
|
|
|
320
|
4
|
|
|
|
|
7
|
my $return = $dt1->intersected_spans( $_[0] ); |
321
|
|
|
|
|
|
|
|
322
|
4
|
100
|
|
|
|
7
|
$return = $previous |
323
|
|
|
|
|
|
|
if !defined $return->max; |
324
|
|
|
|
|
|
|
|
325
|
4
|
50
|
|
|
|
31
|
bless $return, 'DateTime::SpanSet' |
326
|
|
|
|
|
|
|
if defined $return; |
327
|
4
|
|
|
|
|
15
|
return $return; |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
sub closest { |
331
|
3
|
|
|
3
|
1
|
1461
|
my $self = shift; |
332
|
3
|
|
|
|
|
1
|
my $dt = shift; |
333
|
|
|
|
|
|
|
|
334
|
3
|
|
|
|
|
7
|
my $dt1 = $self->current( $dt ); |
335
|
3
|
|
|
|
|
6
|
my $dt2 = $self->next( $dt ); |
336
|
3
|
100
|
|
|
|
182
|
bless $dt2, 'DateTime::SpanSet' |
337
|
|
|
|
|
|
|
if defined $dt2; |
338
|
|
|
|
|
|
|
|
339
|
3
|
50
|
|
|
|
6
|
return $dt2 unless defined $dt1; |
340
|
3
|
100
|
|
|
|
5
|
return $dt1 unless defined $dt2; |
341
|
|
|
|
|
|
|
|
342
|
2
|
50
|
|
|
|
11
|
$dt = DateTime::Set->from_datetimes( dates => [ $dt ] ) |
343
|
|
|
|
|
|
|
unless UNIVERSAL::can( $dt, 'union' ); |
344
|
|
|
|
|
|
|
|
345
|
2
|
50
|
|
|
|
6
|
return $dt1 if $dt1->contains( $dt ); |
346
|
|
|
|
|
|
|
|
347
|
2
|
|
|
|
|
367
|
my $delta = $dt->min - $dt1->max; |
348
|
2
|
100
|
|
|
|
416
|
return $dt1 if ( $dt2->min - $delta ) >= $dt->max; |
349
|
|
|
|
|
|
|
|
350
|
1
|
|
|
|
|
52
|
return $dt2; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
sub as_list { |
354
|
1
|
|
|
1
|
1
|
326
|
my $self = shift; |
355
|
1
|
50
|
|
|
|
5
|
return undef unless ref( $self->{set} ); |
356
|
|
|
|
|
|
|
|
357
|
1
|
|
|
|
|
2
|
my %args = @_; |
358
|
1
|
|
|
|
|
1
|
my $span; |
359
|
1
|
|
|
|
|
1
|
$span = delete $args{span}; |
360
|
1
|
50
|
|
|
|
4
|
$span = DateTime::Span->new( %args ) if %args; |
361
|
|
|
|
|
|
|
|
362
|
1
|
|
|
|
|
3
|
my $set = $self->clone; |
363
|
1
|
50
|
|
|
|
23
|
$set = $set->intersection( $span ) if $span; |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
# Note: removing this line means we may end up in an infinite loop! |
366
|
1
|
50
|
|
|
|
6
|
return undef if $set->{set}->is_too_complex; # undef = no start/end |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
# return if $set->{set}->is_null; # nothing = empty |
369
|
1
|
|
|
|
|
4
|
my @result; |
370
|
|
|
|
|
|
|
# we should extract _copies_ of the set elements, |
371
|
|
|
|
|
|
|
# such that the user can't modify the set indirectly |
372
|
|
|
|
|
|
|
|
373
|
1
|
|
|
|
|
2
|
my $iter = $set->iterator; |
374
|
1
|
|
|
|
|
19
|
while ( my $dt = $iter->next ) |
375
|
|
|
|
|
|
|
{ |
376
|
3
|
50
|
|
|
|
8
|
push @result, $dt |
377
|
|
|
|
|
|
|
if ref( $dt ); # we don't want to return INFINITY value |
378
|
|
|
|
|
|
|
}; |
379
|
|
|
|
|
|
|
|
380
|
1
|
|
|
|
|
5
|
return @result; |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
# Set::Infinite methods |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
sub intersection { |
386
|
22
|
|
|
22
|
1
|
21
|
my ($set1, $set2) = ( shift, shift ); |
387
|
22
|
|
|
|
|
20
|
my $class = ref($set1); |
388
|
22
|
|
|
|
|
35
|
my $tmp = $class->empty_set(); |
389
|
22
|
50
|
|
|
|
251
|
$set2 = $set2->as_spanset |
390
|
|
|
|
|
|
|
if $set2->can( 'as_spanset' ); |
391
|
22
|
50
|
|
|
|
48
|
$set2 = $set2->as_set |
392
|
|
|
|
|
|
|
if $set2->can( 'as_set' ); |
393
|
22
|
50
|
|
|
|
52
|
$set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) |
394
|
|
|
|
|
|
|
unless $set2->can( 'union' ); |
395
|
22
|
|
|
|
|
56
|
$tmp->{set} = $set1->{set}->intersection( $set2->{set} ); |
396
|
22
|
|
|
|
|
7342
|
return $tmp; |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
sub intersected_spans { |
400
|
5
|
|
|
5
|
1
|
352
|
my ($set1, $set2) = ( shift, shift ); |
401
|
5
|
|
|
|
|
6
|
my $class = ref($set1); |
402
|
5
|
|
|
|
|
9
|
my $tmp = $class->empty_set(); |
403
|
5
|
50
|
|
|
|
62
|
$set2 = $set2->as_spanset |
404
|
|
|
|
|
|
|
if $set2->can( 'as_spanset' ); |
405
|
5
|
50
|
|
|
|
10
|
$set2 = $set2->as_set |
406
|
|
|
|
|
|
|
if $set2->can( 'as_set' ); |
407
|
5
|
50
|
|
|
|
25
|
$set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) |
408
|
|
|
|
|
|
|
unless $set2->can( 'union' ); |
409
|
5
|
|
|
|
|
15
|
$tmp->{set} = $set1->{set}->intersected_spans( $set2->{set} ); |
410
|
5
|
|
|
|
|
1078
|
return $tmp; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
sub intersects { |
414
|
1
|
|
|
1
|
1
|
180
|
my ($set1, $set2) = ( shift, shift ); |
415
|
|
|
|
|
|
|
|
416
|
1
|
50
|
|
|
|
5
|
unless ( $set2->can( 'union' ) ) |
417
|
|
|
|
|
|
|
{ |
418
|
1
|
|
|
|
|
3
|
for ( $set2, @_ ) |
419
|
|
|
|
|
|
|
{ |
420
|
1
|
50
|
|
|
|
2
|
return 1 if $set1->contains( $_ ); |
421
|
|
|
|
|
|
|
} |
422
|
1
|
|
|
|
|
48
|
return 0; |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
|
425
|
0
|
|
|
|
|
0
|
my $class = ref($set1); |
426
|
0
|
0
|
|
|
|
0
|
$set2 = $set2->as_spanset |
427
|
|
|
|
|
|
|
if $set2->can( 'as_spanset' ); |
428
|
0
|
0
|
|
|
|
0
|
$set2 = $set2->as_set |
429
|
|
|
|
|
|
|
if $set2->can( 'as_set' ); |
430
|
0
|
0
|
|
|
|
0
|
$set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) |
431
|
|
|
|
|
|
|
unless $set2->can( 'union' ); |
432
|
0
|
|
|
|
|
0
|
return $set1->{set}->intersects( $set2->{set} ); |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
sub contains { |
436
|
6
|
|
|
6
|
1
|
726
|
my ($set1, $set2) = ( shift, shift ); |
437
|
|
|
|
|
|
|
|
438
|
6
|
100
|
|
|
|
21
|
unless ( $set2->can( 'union' ) ) |
439
|
|
|
|
|
|
|
{ |
440
|
4
|
50
|
33
|
|
|
23
|
if ( exists $set1->{set}{method} && |
441
|
|
|
|
|
|
|
$set1->{set}{method} eq 'until' ) |
442
|
|
|
|
|
|
|
{ |
443
|
4
|
|
|
|
|
6
|
my $start_set = $set1->start_set; |
444
|
4
|
|
|
|
|
6
|
my $end_set = $set1->end_set; |
445
|
|
|
|
|
|
|
|
446
|
4
|
|
|
|
|
5
|
for ( $set2, @_ ) |
447
|
|
|
|
|
|
|
{ |
448
|
4
|
|
|
|
|
11
|
my $start = $start_set->next( $set2 ); |
449
|
4
|
|
|
|
|
16
|
my $end = $end_set->next( $set2 ); |
450
|
|
|
|
|
|
|
|
451
|
4
|
50
|
33
|
|
|
44
|
goto ABORT unless defined $start && defined $end; |
452
|
|
|
|
|
|
|
|
453
|
4
|
100
|
|
|
|
6
|
return 0 if $start < $end; |
454
|
|
|
|
|
|
|
} |
455
|
1
|
|
|
|
|
44
|
return 1; |
456
|
|
|
|
|
|
|
|
457
|
0
|
|
|
|
|
0
|
ABORT: ; |
458
|
|
|
|
|
|
|
# don't know |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
2
|
|
|
|
|
3
|
my $class = ref($set1); |
463
|
2
|
50
|
|
|
|
7
|
$set2 = $set2->as_spanset |
464
|
|
|
|
|
|
|
if $set2->can( 'as_spanset' ); |
465
|
2
|
50
|
|
|
|
7
|
$set2 = $set2->as_set |
466
|
|
|
|
|
|
|
if $set2->can( 'as_set' ); |
467
|
2
|
50
|
|
|
|
4
|
$set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) |
468
|
|
|
|
|
|
|
unless $set2->can( 'union' ); |
469
|
2
|
|
|
|
|
8
|
return $set1->{set}->contains( $set2->{set} ); |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
sub union { |
473
|
4
|
|
|
4
|
1
|
5
|
my ($set1, $set2) = ( shift, shift ); |
474
|
4
|
|
|
|
|
6
|
my $class = ref($set1); |
475
|
4
|
|
|
|
|
5
|
my $tmp = $class->empty_set(); |
476
|
4
|
50
|
|
|
|
49
|
$set2 = $set2->as_spanset |
477
|
|
|
|
|
|
|
if $set2->can( 'as_spanset' ); |
478
|
4
|
50
|
|
|
|
13
|
$set2 = $set2->as_set |
479
|
|
|
|
|
|
|
if $set2->can( 'as_set' ); |
480
|
4
|
100
|
|
|
|
20
|
$set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) |
481
|
|
|
|
|
|
|
unless $set2->can( 'union' ); |
482
|
4
|
|
|
|
|
11
|
$tmp->{set} = $set1->{set}->union( $set2->{set} ); |
483
|
4
|
|
|
|
|
626
|
return $tmp; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
sub complement { |
487
|
0
|
|
|
0
|
1
|
0
|
my ($set1, $set2) = ( shift, shift ); |
488
|
0
|
|
|
|
|
0
|
my $class = ref($set1); |
489
|
0
|
|
|
|
|
0
|
my $tmp = $class->empty_set(); |
490
|
0
|
0
|
|
|
|
0
|
if (defined $set2) { |
491
|
0
|
0
|
|
|
|
0
|
$set2 = $set2->as_spanset |
492
|
|
|
|
|
|
|
if $set2->can( 'as_spanset' ); |
493
|
0
|
0
|
|
|
|
0
|
$set2 = $set2->as_set |
494
|
|
|
|
|
|
|
if $set2->can( 'as_set' ); |
495
|
0
|
0
|
|
|
|
0
|
$set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) |
496
|
|
|
|
|
|
|
unless $set2->can( 'union' ); |
497
|
0
|
|
|
|
|
0
|
$tmp->{set} = $set1->{set}->complement( $set2->{set} ); |
498
|
|
|
|
|
|
|
} |
499
|
|
|
|
|
|
|
else { |
500
|
0
|
|
|
|
|
0
|
$tmp->{set} = $set1->{set}->complement; |
501
|
|
|
|
|
|
|
} |
502
|
0
|
|
|
|
|
0
|
return $tmp; |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
sub start { |
506
|
16
|
|
|
16
|
1
|
923
|
return DateTime::Set::_fix_datetime( $_[0]->{set}->min ); |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
*min = \&start; |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
sub end { |
512
|
20
|
|
|
20
|
1
|
1467
|
return DateTime::Set::_fix_datetime( $_[0]->{set}->max ); |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
*max = \&end; |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
# returns a DateTime::Span |
518
|
|
|
|
|
|
|
sub span { |
519
|
0
|
|
|
0
|
1
|
0
|
my $set = $_[0]->{set}->span; |
520
|
0
|
|
|
|
|
0
|
my $self = bless { set => $set }, 'DateTime::Span'; |
521
|
0
|
|
|
|
|
0
|
return $self; |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
# returns a DateTime::Duration |
525
|
|
|
|
|
|
|
sub duration { |
526
|
3
|
|
|
3
|
1
|
390
|
my $dur; |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
return DateTime::Duration->new( seconds => 0 ) |
529
|
3
|
100
|
|
|
|
19
|
if $_[0]->{set}->is_empty; |
530
|
|
|
|
|
|
|
|
531
|
2
|
|
|
|
|
24
|
local $@; |
532
|
2
|
|
|
|
|
3
|
eval { |
533
|
2
|
|
|
|
|
6
|
local $SIG{__DIE__}; # don't want to trap this (rt ticket 5434) |
534
|
|
|
|
|
|
|
$dur = $_[0]->{set}->size |
535
|
2
|
|
|
|
|
10
|
}; |
536
|
|
|
|
|
|
|
|
537
|
2
|
50
|
66
|
|
|
243
|
return $dur if defined $dur && ref( $dur ); |
538
|
2
|
|
|
|
|
7
|
return DateTime::Infinite::Future->new - |
539
|
|
|
|
|
|
|
DateTime::Infinite::Past->new; |
540
|
|
|
|
|
|
|
# return INFINITY; |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
*size = \&duration; |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
1; |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
__END__ |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
=head1 NAME |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
DateTime::SpanSet - set of DateTime spans |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
=head1 SYNOPSIS |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
$spanset = DateTime::SpanSet->from_spans( spans => [ $dt_span, $dt_span ] ); |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
$set = $spanset->union( $set2 ); # like "OR", "insert", "both" |
557
|
|
|
|
|
|
|
$set = $spanset->complement( $set2 ); # like "delete", "remove" |
558
|
|
|
|
|
|
|
$set = $spanset->intersection( $set2 ); # like "AND", "while" |
559
|
|
|
|
|
|
|
$set = $spanset->complement; # like "NOT", "negate", "invert" |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
if ( $spanset->intersects( $set2 ) ) { ... # like "touches", "interferes" |
562
|
|
|
|
|
|
|
if ( $spanset->contains( $set2 ) ) { ... # like "is-fully-inside" |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
# data extraction |
565
|
|
|
|
|
|
|
$date = $spanset->min; # first date of the set |
566
|
|
|
|
|
|
|
$date = $spanset->max; # last date of the set |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
$iter = $spanset->iterator; |
569
|
|
|
|
|
|
|
while ( $dt = $iter->next ) { |
570
|
|
|
|
|
|
|
# $dt is a DateTime::Span |
571
|
|
|
|
|
|
|
print $dt->start->ymd; # first date of span |
572
|
|
|
|
|
|
|
print $dt->end->ymd; # last date of span |
573
|
|
|
|
|
|
|
}; |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
=head1 DESCRIPTION |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
C<DateTime::SpanSet> is a class that represents sets of datetime |
578
|
|
|
|
|
|
|
spans. An example would be a recurring meeting that occurs from |
579
|
|
|
|
|
|
|
13:00-15:00 every Friday. |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
This is different from a C<DateTime::Set>, which is made of individual |
582
|
|
|
|
|
|
|
datetime points as opposed to ranges. |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
=head1 METHODS |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
=over 4 |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
=item * from_spans |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
Creates a new span set from one or more C<DateTime::Span> objects. |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
$spanset = DateTime::SpanSet->from_spans( spans => [ $dt_span ] ); |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
=item * from_set_and_duration |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
Creates a new span set from one or more C<DateTime::Set> objects and a |
597
|
|
|
|
|
|
|
duration. |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
The duration can be a C<DateTime::Duration> object, or the parameters |
600
|
|
|
|
|
|
|
to create a new C<DateTime::Duration> object, such as "days", |
601
|
|
|
|
|
|
|
"months", etc. |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
$spanset = |
604
|
|
|
|
|
|
|
DateTime::SpanSet->from_set_and_duration |
605
|
|
|
|
|
|
|
( set => $dt_set, days => 1 ); |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
=item * from_sets |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
Creates a new span set from two C<DateTime::Set> objects. |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
One set defines the I<starting dates>, and the other defines the I<end |
612
|
|
|
|
|
|
|
dates>. |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
$spanset = |
615
|
|
|
|
|
|
|
DateTime::SpanSet->from_sets |
616
|
|
|
|
|
|
|
( start_set => $dt_set1, end_set => $dt_set2 ); |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
The spans have the starting date C<closed>, and the end date C<open>, |
619
|
|
|
|
|
|
|
like in C<[$dt1, $dt2)>. |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
If an end date comes without a starting date before it, then it |
622
|
|
|
|
|
|
|
defines a span like C<(-inf, $dt)>. |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
If a starting date comes without an end date after it, then it defines |
625
|
|
|
|
|
|
|
a span like C<[$dt, inf)>. |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
=item * empty_set |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
Creates a new empty set. |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
=item * is_empty_set |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
Returns true is the set is empty; false otherwise. |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
print "nothing" if $set->is_empty_set; |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
=item * clone |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
This object method returns a replica of the given object. |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
=item * set_time_zone( $tz ) |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
This method accepts either a time zone object or a string that can be |
644
|
|
|
|
|
|
|
passed as the "name" parameter to C<< DateTime::TimeZone->new() >>. |
645
|
|
|
|
|
|
|
If the new time zone's offset is different from the old time zone, |
646
|
|
|
|
|
|
|
then the I<local> time is adjusted accordingly. |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
If the old time zone was a floating time zone, then no adjustments to |
649
|
|
|
|
|
|
|
the local time are made, except to account for leap seconds. If the |
650
|
|
|
|
|
|
|
new time zone is floating, then the I<UTC> time is adjusted in order |
651
|
|
|
|
|
|
|
to leave the local time untouched. |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
=item * start, min |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
=item * end, max |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
First or last dates in the set. |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
It is possible that the return value from these methods may be a |
661
|
|
|
|
|
|
|
C<DateTime::Infinite::Future> or a C<DateTime::Infinite::Past> object. |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
If the set ends C<before> a date C<$dt>, it returns C<$dt>. Note that |
664
|
|
|
|
|
|
|
in this case C<$dt> is not a set element - but it is a set boundary. |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
These methods may return C<undef> if the set is empty. |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
These methods return just a I<copy> of the actual boundary value. |
669
|
|
|
|
|
|
|
If you modify the result, the set will not be modified. |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
=item * duration |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
The total size of the set, as a C<DateTime::Duration> object. |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
The duration may be infinite. |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
Also available as C<size()>. |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
=item * span |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
The total span of the set, as a C<DateTime::Span> object. |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
=item * next |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
my $span = $set->next( $dt ); |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
This method is used to find the next span in the set, |
689
|
|
|
|
|
|
|
after a given datetime or span. |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
The return value is a C<DateTime::Span>, or C<undef> if there is no matching |
692
|
|
|
|
|
|
|
span in the set. |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
=item * previous |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
my $span = $set->previous( $dt ); |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
This method is used to find the previous span in the set, |
699
|
|
|
|
|
|
|
before a given datetime or span. |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
The return value is a C<DateTime::Span>, or C<undef> if there is no matching |
702
|
|
|
|
|
|
|
span in the set. |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
=item * current |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
my $span = $set->current( $dt ); |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
This method is used to find the "current" span in the set, |
710
|
|
|
|
|
|
|
that intersects a given datetime or span. If no current span |
711
|
|
|
|
|
|
|
is found, then the "previous" span is returned. |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
The return value is a C<DateTime::SpanSet>, or C<undef> if there is no |
714
|
|
|
|
|
|
|
matching span in the set. |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
If a span parameter is given, it may happen that "current" returns |
717
|
|
|
|
|
|
|
more than one span. |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
See also: C<intersected_spans()> method. |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
=item * closest |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
my $span = $set->closest( $dt ); |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
This method is used to find the "closest" span in the set, given a |
726
|
|
|
|
|
|
|
datetime or span. |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
The return value is a C<DateTime::SpanSet>, or C<undef> if the set is |
729
|
|
|
|
|
|
|
empty. |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
If a span parameter is given, it may happen that "closest" returns |
732
|
|
|
|
|
|
|
more than one span. |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
=item * as_list |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
Returns a list of C<DateTime::Span> objects. |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
my @dt_span = $set->as_list( span => $span ); |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
Just as with the C<iterator()> method, the C<as_list()> method can be |
741
|
|
|
|
|
|
|
limited by a span. |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
Applying C<as_list()> to a large recurring spanset is a very expensive |
744
|
|
|
|
|
|
|
operation, both in CPU time and in the memory used. |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
For this reason, when C<as_list()> operates on large recurrence sets, |
747
|
|
|
|
|
|
|
it will return at most approximately 200 spans. For larger sets, and |
748
|
|
|
|
|
|
|
for I<infinite> sets, C<as_list()> will return C<undef>. |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
Please note that this is explicitly not an empty list, since an empty |
751
|
|
|
|
|
|
|
list is a valid return value for empty sets! |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
If you I<really> need to extract spans from a large set, you can: |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
- limit the set with a shorter span: |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
my @short_list = $large_set->as_list( span => $short_span ); |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
- use an iterator: |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
my @large_list; |
762
|
|
|
|
|
|
|
my $iter = $large_set->iterator; |
763
|
|
|
|
|
|
|
push @large_list, $dt while $dt = $iter->next; |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
=item * union |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=item * intersection |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
=item * complement |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
Set operations may be performed not only with C<DateTime::SpanSet> |
772
|
|
|
|
|
|
|
objects, but also with C<DateTime>, C<DateTime::Set> and |
773
|
|
|
|
|
|
|
C<DateTime::Span> objects. These set operations always return a |
774
|
|
|
|
|
|
|
C<DateTime::SpanSet> object. |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
$set = $spanset->union( $set2 ); # like "OR", "insert", "both" |
777
|
|
|
|
|
|
|
$set = $spanset->complement( $set2 ); # like "delete", "remove" |
778
|
|
|
|
|
|
|
$set = $spanset->intersection( $set2 ); # like "AND", "while" |
779
|
|
|
|
|
|
|
$set = $spanset->complement; # like "NOT", "negate", "invert" |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
=item * intersected_spans |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
This method can accept a C<DateTime> list, a C<DateTime::Set>, a |
784
|
|
|
|
|
|
|
C<DateTime::Span>, or a C<DateTime::SpanSet> object as an argument. |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
$set = $set1->intersected_spans( $set2 ); |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
The method always returns a C<DateTime::SpanSet> object, containing |
789
|
|
|
|
|
|
|
all spans that are intersected by the given set. |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
Unlike the C<intersection> method, the spans are not modified. See |
792
|
|
|
|
|
|
|
diagram below: |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
set1 [....] [....] [....] [....] |
795
|
|
|
|
|
|
|
set2 [................] |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
intersection [.] [....] [.] |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
intersected_spans [....] [....] [....] |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
=item * intersects |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=item * contains |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
These set functions return a boolean value. |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
if ( $spanset->intersects( $set2 ) ) { ... # like "touches", "interferes" |
808
|
|
|
|
|
|
|
if ( $spanset->contains( $dt ) ) { ... # like "is-fully-inside" |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
These methods can accept a C<DateTime>, C<DateTime::Set>, |
811
|
|
|
|
|
|
|
C<DateTime::Span>, or C<DateTime::SpanSet> object as an argument. |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
intersects() returns 1 for true, and 0 for false. In a few cases |
814
|
|
|
|
|
|
|
the algorithm can't decide if the sets intersect at all, and |
815
|
|
|
|
|
|
|
intersects() will return C<undef>. |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
=item * iterator / next / previous |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
This method can be used to iterate over the spans in a set. |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
$iter = $spanset->iterator; |
822
|
|
|
|
|
|
|
while ( $dt = $iter->next ) { |
823
|
|
|
|
|
|
|
# $dt is a DateTime::Span |
824
|
|
|
|
|
|
|
print $dt->min->ymd; # first date of span |
825
|
|
|
|
|
|
|
print $dt->max->ymd; # last date of span |
826
|
|
|
|
|
|
|
} |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
The boundaries of the iterator can be limited by passing it a C<span> |
829
|
|
|
|
|
|
|
parameter. This should be a C<DateTime::Span> object which delimits |
830
|
|
|
|
|
|
|
the iterator's boundaries. Optionally, instead of passing an object, |
831
|
|
|
|
|
|
|
you can pass any parameters that would work for one of the |
832
|
|
|
|
|
|
|
C<DateTime::Span> class's constructors, and an object will be created |
833
|
|
|
|
|
|
|
for you. |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
Obviously, if the span you specify does is not restricted both at the |
836
|
|
|
|
|
|
|
start and end, then your iterator may iterate forever, depending on |
837
|
|
|
|
|
|
|
the nature of your set. User beware! |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
The C<next()> or C<previous()> methods will return C<undef> when there |
840
|
|
|
|
|
|
|
are no more spans in the iterator. |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
=item * start_set |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
=item * end_set |
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
These methods do the inverse of the C<from_sets> method: |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
C<start_set> retrieves a DateTime::Set with the start datetime of each |
849
|
|
|
|
|
|
|
span. |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
C<end_set> retrieves a DateTime::Set with the end datetime of each |
852
|
|
|
|
|
|
|
span. |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
=item * map ( sub { ... } ) |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
# example: enlarge the spans |
857
|
|
|
|
|
|
|
$set = $set2->map( |
858
|
|
|
|
|
|
|
sub { |
859
|
|
|
|
|
|
|
my $start = $_->start; |
860
|
|
|
|
|
|
|
my $end = $_->end; |
861
|
|
|
|
|
|
|
return DateTime::Span->from_datetimes( |
862
|
|
|
|
|
|
|
start => $start, |
863
|
|
|
|
|
|
|
before => $end, |
864
|
|
|
|
|
|
|
); |
865
|
|
|
|
|
|
|
} |
866
|
|
|
|
|
|
|
); |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
This method is the "set" version of Perl "map". |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
It evaluates a subroutine for each element of the set (locally setting |
871
|
|
|
|
|
|
|
"$_" to each DateTime::Span) and returns the set composed of the |
872
|
|
|
|
|
|
|
results of each such evaluation. |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
Like Perl "map", each element of the set may produce zero, one, or |
875
|
|
|
|
|
|
|
more elements in the returned value. |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
Unlike Perl "map", changing "$_" does not change the original |
878
|
|
|
|
|
|
|
set. This means that calling map in void context has no effect. |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
The callback subroutine may not be called immediately. Don't count on |
881
|
|
|
|
|
|
|
subroutine side-effects. For example, a C<print> inside the subroutine |
882
|
|
|
|
|
|
|
may happen later than you expect. |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
The callback return value is expected to be within the span of the |
885
|
|
|
|
|
|
|
C<previous> and the C<next> element in the original set. |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
For example: given the set C<[ 2001, 2010, 2015 ]>, the callback |
888
|
|
|
|
|
|
|
result for the value C<2010> is expected to be within the span C<[ |
889
|
|
|
|
|
|
|
2001 .. 2015 ]>. |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=item * grep ( sub { ... } ) |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
# example: filter out all spans happening today |
894
|
|
|
|
|
|
|
my $today = DateTime->today; |
895
|
|
|
|
|
|
|
$set = $set2->grep( |
896
|
|
|
|
|
|
|
sub { |
897
|
|
|
|
|
|
|
return ( ! $_->contains( $today ) ); |
898
|
|
|
|
|
|
|
} |
899
|
|
|
|
|
|
|
); |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
This method is the "set" version of Perl "grep". |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
It evaluates a subroutine for each element of the set (locally setting |
904
|
|
|
|
|
|
|
"$_" to each DateTime::Span) and returns the set consisting of those |
905
|
|
|
|
|
|
|
elements for which the expression evaluated to true. |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
Unlike Perl "grep", changing "$_" does not change the original |
908
|
|
|
|
|
|
|
set. This means that calling grep in void context has no effect. |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
Changing "$_" does change the resulting set. |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
The callback subroutine may not be called immediately. Don't count on |
913
|
|
|
|
|
|
|
subroutine side-effects. For example, a C<print> inside the subroutine |
914
|
|
|
|
|
|
|
may happen later than you expect. |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
=item * iterate |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
I<Internal method - use "map" or "grep" instead.> |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
This function apply a callback subroutine to all elements of a set and |
921
|
|
|
|
|
|
|
returns the resulting set. |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
The parameter C<$_[0]> to the callback subroutine is a |
924
|
|
|
|
|
|
|
C<DateTime::Span> object. |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
If the callback returns C<undef>, the datetime is removed from the |
927
|
|
|
|
|
|
|
set: |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
sub remove_sundays { |
930
|
|
|
|
|
|
|
$_[0] unless $_[0]->start->day_of_week == 7; |
931
|
|
|
|
|
|
|
} |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
The callback return value is expected to be within the span of the |
934
|
|
|
|
|
|
|
C<previous> and the C<next> element in the original set. |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
For example: given the set C<[ 2001, 2010, 2015 ]>, the callback |
937
|
|
|
|
|
|
|
result for the value C<2010> is expected to be within the span C<[ |
938
|
|
|
|
|
|
|
2001 .. 2015 ]>. |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
The callback subroutine may not be called immediately. Don't count on |
941
|
|
|
|
|
|
|
subroutine side-effects. For example, a C<print> inside the subroutine |
942
|
|
|
|
|
|
|
may happen later than you expect. |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
=back |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
=head1 SUPPORT |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
Support is offered through the C<datetime@perl.org> mailing list. |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
Please report bugs using rt.cpan.org |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
=head1 AUTHOR |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
Flavio Soibelmann Glock <fglock@gmail.com> |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
The API was developed together with Dave Rolsky and the DateTime Community. |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
=head1 COPYRIGHT |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved. |
961
|
|
|
|
|
|
|
This program is free software; you can distribute it and/or |
962
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
The full text of the license can be found in the LICENSE file |
965
|
|
|
|
|
|
|
included with this module. |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
=head1 SEE ALSO |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
Set::Infinite |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
For details on the Perl DateTime Suite project please see |
972
|
|
|
|
|
|
|
L<http://datetime.perl.org>. |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
=cut |
975
|
|
|
|
|
|
|
|