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