Mandanten-WebDAV-Upgrade: nicht an Konfigurationseinstellung sondern Existenz von...
[kivitendo-erp.git] / modules / fallback / DateTime / Span.pm
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::Span;
6
7 use strict;
8
9 use DateTime::Set;
10 use DateTime::SpanSet;
11
12 use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF );
13 use vars qw( $VERSION );
14
15 use constant INFINITY     => DateTime::INFINITY;
16 use constant NEG_INFINITY => DateTime::NEG_INFINITY;
17 $VERSION = $DateTime::Set::VERSION;
18
19 sub set_time_zone {
20     my ( $self, $tz ) = @_;
21
22     $self->{set} = $self->{set}->iterate( 
23         sub {
24             my %tmp = %{ $_[0]->{list}[0] };
25             $tmp{a} = $tmp{a}->clone->set_time_zone( $tz ) if ref $tmp{a};
26             $tmp{b} = $tmp{b}->clone->set_time_zone( $tz ) if ref $tmp{b};
27             \%tmp;
28         }
29     );
30     return $self;
31 }
32
33 # note: the constructor must clone its DateTime parameters, such that
34 # the set elements become immutable
35 sub from_datetimes {
36     my $class = shift;
37     my %args = validate( @_,
38                          { start =>
39                            { type => OBJECT,
40                              optional => 1,
41                            },
42                            end =>
43                            { type => OBJECT,
44                              optional => 1,
45                            },
46                            after =>
47                            { type => OBJECT,
48                              optional => 1,
49                            },
50                            before =>
51                            { type => OBJECT,
52                              optional => 1,
53                            },
54                          }
55                        );
56     my $self = {};
57     my $set;
58
59     die "No arguments given to DateTime::Span->from_datetimes\n"
60         unless keys %args;
61
62     if ( exists $args{start} && exists $args{after} ) {
63         die "Cannot give both start and after arguments to DateTime::Span->from_datetimes\n";
64     }
65     if ( exists $args{end} && exists $args{before} ) {
66         die "Cannot give both end and before arguments to DateTime::Span->from_datetimes\n";
67     }
68
69     my ( $start, $open_start, $end, $open_end );
70     ( $start, $open_start ) = ( NEG_INFINITY,  0 );
71     ( $start, $open_start ) = ( $args{start},  0 ) if exists $args{start};
72     ( $start, $open_start ) = ( $args{after},  1 ) if exists $args{after};
73     ( $end,   $open_end   ) = ( INFINITY,      0 );
74     ( $end,   $open_end   ) = ( $args{end},    0 ) if exists $args{end};
75     ( $end,   $open_end   ) = ( $args{before}, 1 ) if exists $args{before};
76
77     if ( $start > $end ) {
78         die "Span cannot start after the end in DateTime::Span->from_datetimes\n";
79     }
80     $set = Set::Infinite::_recurrence->new( $start, $end );
81     if ( $start != $end ) {
82         # remove start, such that we have ">" instead of ">="
83         $set = $set->complement( $start ) if $open_start;  
84         # remove end, such that we have "<" instead of "<="
85         $set = $set->complement( $end )   if $open_end;    
86     }
87
88     $self->{set} = $set;
89     bless $self, $class;
90     return $self;
91 }
92
93 sub from_datetime_and_duration {
94     my $class = shift;
95     my %args = @_;
96
97     my $key;
98     my $dt;
99     # extract datetime parameters
100     for ( qw( start end before after ) ) {
101         if ( exists $args{$_} ) {
102            $key = $_;
103            $dt = delete $args{$_};
104        }
105     }
106
107     # extract duration parameters
108     my $dt_duration;
109     if ( exists $args{duration} ) {
110         $dt_duration = $args{duration};
111     }
112     else {
113         $dt_duration = DateTime::Duration->new( %args );
114     }
115     # warn "Creating span from $key => ".$dt->datetime." and $dt_duration";
116     my $other_date = $dt->clone->add_duration( $dt_duration );
117     # warn "Creating span from $key => ".$dt->datetime." and ".$other_date->datetime;
118     my $other_key;
119     if ( $dt_duration->is_positive ) {
120         # check if have to invert keys
121         $key = 'after' if $key eq 'end';
122         $key = 'start' if $key eq 'before';
123         $other_key = 'before';
124     }
125     else {
126         # check if have to invert keys
127         $other_key = 'end' if $key eq 'after';
128         $other_key = 'before' if $key eq 'start';
129         $key = 'start';
130     }
131     return $class->new( $key => $dt, $other_key => $other_date ); 
132 }
133
134 # This method is intentionally not documented.  It's really only for
135 # use by ::Set and ::SpanSet's as_list() and iterator() methods.
136 sub new {
137     my $class = shift;
138     my %args = @_;
139
140     # If we find anything _not_ appropriate for from_datetimes, we
141     # assume it must be for durations, and call this constructor.
142     # This way, we don't need to hardcode the DateTime::Duration
143     # parameters.
144     foreach ( keys %args )
145     {
146         return $class->from_datetime_and_duration(%args)
147             unless /^(?:before|after|start|end)$/;
148     }
149
150     return $class->from_datetimes(%args);
151 }
152
153 sub clone { 
154     bless { 
155         set => $_[0]->{set}->copy,
156         }, ref $_[0];
157 }
158
159 # Set::Infinite methods
160
161 sub intersection {
162     my ($set1, $set2) = @_;
163     my $class = ref($set1);
164     my $tmp = {};  # $class->new();
165     $set2 = $set2->as_spanset
166         if $set2->can( 'as_spanset' );
167     $set2 = $set2->as_set
168         if $set2->can( 'as_set' );
169     $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) 
170         unless $set2->can( 'union' );
171     $tmp->{set} = $set1->{set}->intersection( $set2->{set} );
172
173     # intersection() can generate something more complex than a span.
174     bless $tmp, 'DateTime::SpanSet';
175
176     return $tmp;
177 }
178
179 sub intersects {
180     my ($set1, $set2) = @_;
181     my $class = ref($set1);
182     $set2 = $set2->as_spanset
183         if $set2->can( 'as_spanset' );
184     $set2 = $set2->as_set
185         if $set2->can( 'as_set' );
186     $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) 
187         unless $set2->can( 'union' );
188     return $set1->{set}->intersects( $set2->{set} );
189 }
190
191 sub contains {
192     my ($set1, $set2) = @_;
193     my $class = ref($set1);
194     $set2 = $set2->as_spanset
195         if $set2->can( 'as_spanset' );
196     $set2 = $set2->as_set
197         if $set2->can( 'as_set' );
198     $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) 
199         unless $set2->can( 'union' );
200     return $set1->{set}->contains( $set2->{set} );
201 }
202
203 sub union {
204     my ($set1, $set2) = @_;
205     my $class = ref($set1);
206     my $tmp = {};   # $class->new();
207     $set2 = $set2->as_spanset
208         if $set2->can( 'as_spanset' );
209     $set2 = $set2->as_set
210         if $set2->can( 'as_set' );
211     $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) 
212         unless $set2->can( 'union' );
213     $tmp->{set} = $set1->{set}->union( $set2->{set} );
214  
215     # union() can generate something more complex than a span.
216     bless $tmp, 'DateTime::SpanSet';
217
218     # # We have to check it's internal structure to find out.
219     # if ( $#{ $tmp->{set}->{list} } != 0 ) {
220     #    bless $tmp, 'Date::SpanSet';
221     # }
222
223     return $tmp;
224 }
225
226 sub complement {
227     my ($set1, $set2) = @_;
228     my $class = ref($set1);
229     my $tmp = {};   # $class->new;
230     if (defined $set2) {
231         $set2 = $set2->as_spanset
232             if $set2->can( 'as_spanset' );
233         $set2 = $set2->as_set
234             if $set2->can( 'as_set' );
235         $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) 
236             unless $set2->can( 'union' );
237         $tmp->{set} = $set1->{set}->complement( $set2->{set} );
238     }
239     else {
240         $tmp->{set} = $set1->{set}->complement;
241     }
242
243     # complement() can generate something more complex than a span.
244     bless $tmp, 'DateTime::SpanSet';
245
246     # # We have to check it's internal structure to find out.
247     # if ( $#{ $tmp->{set}->{list} } != 0 ) {
248     #    bless $tmp, 'Date::SpanSet';
249     # }
250
251     return $tmp;
252 }
253
254 sub start { 
255     return DateTime::Set::_fix_datetime( $_[0]->{set}->min );
256 }
257
258 *min = \&start;
259
260 sub end { 
261     return DateTime::Set::_fix_datetime( $_[0]->{set}->max );
262 }
263
264 *max = \&end;
265
266 sub start_is_open {
267     # min_a returns info about the set boundary 
268     my ($min, $open) = $_[0]->{set}->min_a;
269     return $open;
270 }
271
272 sub start_is_closed { $_[0]->start_is_open ? 0 : 1 }
273
274 sub end_is_open {
275     # max_a returns info about the set boundary 
276     my ($max, $open) = $_[0]->{set}->max_a;
277     return $open;
278 }
279
280 sub end_is_closed { $_[0]->end_is_open ? 0 : 1 }
281
282
283 # span == $self
284 sub span { @_ }
285
286 sub duration { 
287     my $dur;
288
289     local $@;
290     eval {
291         local $SIG{__DIE__};   # don't want to trap this (rt ticket 5434)
292         $dur = $_[0]->end->subtract_datetime_absolute( $_[0]->start )
293     };
294     
295     return $dur if defined $dur;
296
297     return DateTime::Infinite::Future->new -
298            DateTime::Infinite::Past->new;
299 }
300 *size = \&duration;
301
302 1;
303
304 __END__
305
306 =head1 NAME
307
308 DateTime::Span - Datetime spans
309
310 =head1 SYNOPSIS
311
312     use DateTime;
313     use DateTime::Span;
314
315     $date1 = DateTime->new( year => 2002, month => 3, day => 11 );
316     $date2 = DateTime->new( year => 2003, month => 4, day => 12 );
317     $set2 = DateTime::Span->from_datetimes( start => $date1, end => $date2 );
318     #  set2 = 2002-03-11 until 2003-04-12
319
320     $set = $set1->union( $set2 );         # like "OR", "insert", "both"
321     $set = $set1->complement( $set2 );    # like "delete", "remove"
322     $set = $set1->intersection( $set2 );  # like "AND", "while"
323     $set = $set1->complement;             # like "NOT", "negate", "invert"
324
325     if ( $set1->intersects( $set2 ) ) { ...  # like "touches", "interferes"
326     if ( $set1->contains( $set2 ) ) { ...    # like "is-fully-inside"
327
328     # data extraction 
329     $date = $set1->start;           # first date of the span
330     $date = $set1->end;             # last date of the span
331
332 =head1 DESCRIPTION
333
334 C<DateTime::Span> is a module for handling datetime spans, otherwise
335 known as ranges or periods ("from X to Y, inclusive of all datetimes
336 in between").
337
338 This is different from a C<DateTime::Set>, which is made of individual
339 datetime points as opposed to a range. There is also a module
340 C<DateTime::SpanSet> to handle sets of spans.
341
342 =head1 METHODS
343
344 =over 4
345
346 =item * from_datetimes
347
348 Creates a new span based on a starting and ending datetime.
349
350 A 'closed' span includes its end-dates:
351
352    $span = DateTime::Span->from_datetimes( start => $dt1, end => $dt2 );
353
354 An 'open' span does not include its end-dates:
355
356    $span = DateTime::Span->from_datetimes( after => $dt1, before => $dt2 );
357
358 A 'semi-open' span includes one of its end-dates:
359
360    $span = DateTime::Span->from_datetimes( start => $dt1, before => $dt2 );
361    $span = DateTime::Span->from_datetimes( after => $dt1, end => $dt2 );
362
363 A span might have just a beginning date, or just an ending date.
364 These spans end, or start, in an imaginary 'forever' date:
365
366    $span = DateTime::Span->from_datetimes( start => $dt1 );
367    $span = DateTime::Span->from_datetimes( end => $dt2 );
368    $span = DateTime::Span->from_datetimes( after => $dt1 );
369    $span = DateTime::Span->from_datetimes( before => $dt2 );
370
371 You cannot give both a "start" and "after" argument, nor can you give
372 both an "end" and "before" argument.  Either of these conditions will
373 cause the C<from_datetimes()> method to die.
374
375 To summarize, a datetime passed as either "start" or "end" is included
376 in the span.  A datetime passed as either "after" or "before" is
377 excluded from the span.
378
379 =item * from_datetime_and_duration
380
381 Creates a new span.
382
383    $span = DateTime::Span->from_datetime_and_duration( 
384        start => $dt1, duration => $dt_dur1 );
385    $span = DateTime::Span->from_datetime_and_duration( 
386        after => $dt1, hours => 12 );
387
388 The new "end of the set" is I<open> by default.
389
390 =item * clone
391
392 This object method returns a replica of the given object.
393
394 =item * set_time_zone( $tz )
395
396 This method accepts either a time zone object or a string that can be
397 passed as the "name" parameter to C<< DateTime::TimeZone->new() >>.
398 If the new time zone's offset is different from the old time zone,
399 then the I<local> time is adjusted accordingly.
400
401 If the old time zone was a floating time zone, then no adjustments to
402 the local time are made, except to account for leap seconds.  If the
403 new time zone is floating, then the I<UTC> time is adjusted in order
404 to leave the local time untouched.
405
406 =item * duration
407
408 The total size of the set, as a C<DateTime::Duration> object, or as a
409 scalar containing infinity.
410
411 Also available as C<size()>.
412
413 =item * start
414
415 =item * end
416
417 First or last dates in the span.
418
419 It is possible that the return value from these methods may be a
420 C<DateTime::Infinite::Future> or a C<DateTime::Infinite::Past>xs object.
421
422 If the set ends C<before> a date C<$dt>, it returns C<$dt>. Note that
423 in this case C<$dt> is not a set element - but it is a set boundary.
424
425 =cut
426
427 # scalar containing either negative infinity
428 # or positive infinity.
429
430 =item * start_is_closed
431
432 =item * end_is_closed
433
434 Returns true if the first or last dates belong to the span ( begin <= x <= end ).
435
436 =item * start_is_open
437
438 =item * end_is_open
439
440 Returns true if the first or last dates are excluded from the span ( begin < x < end ).
441
442 =item * union
443
444 =item * intersection
445
446 =item * complement
447
448 Set operations may be performed not only with C<DateTime::Span>
449 objects, but also with C<DateTime::Set> and C<DateTime::SpanSet>
450 objects.  These set operations always return a C<DateTime::SpanSet>
451 object.
452
453     $set = $span->union( $set2 );         # like "OR", "insert", "both"
454     $set = $span->complement( $set2 );    # like "delete", "remove"
455     $set = $span->intersection( $set2 );  # like "AND", "while"
456     $set = $span->complement;             # like "NOT", "negate", "invert"
457
458 =item * intersects
459
460 =item * contains
461
462 These set functions return a boolean value.
463
464     if ( $span->intersects( $set2 ) ) { ...  # like "touches", "interferes"
465     if ( $span->contains( $dt ) ) { ...    # like "is-fully-inside"
466
467 These methods can accept a C<DateTime>, C<DateTime::Set>,
468 C<DateTime::Span>, or C<DateTime::SpanSet> object as an argument.
469
470 =back
471
472 =head1 SUPPORT
473
474 Support is offered through the C<datetime@perl.org> mailing list.
475
476 Please report bugs using rt.cpan.org
477
478 =head1 AUTHOR
479
480 Flavio Soibelmann Glock <fglock@pucrs.br>
481
482 The API was developed together with Dave Rolsky and the DateTime Community.
483
484 =head1 COPYRIGHT
485
486 Copyright (c) 2003-2006 Flavio Soibelmann Glock. All rights reserved.
487 This program is free software; you can distribute it and/or modify it
488 under the same terms as Perl itself.
489
490 The full text of the license can be found in the LICENSE file
491 included with this module.
492
493 =head1 SEE ALSO
494
495 Set::Infinite
496
497 For details on the Perl DateTime Suite project please see
498 L<http://datetime.perl.org>.
499
500 =cut
501