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