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