X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/782fd7884fb686cd2e336756dadeb4ab5d05a415..03fc848dccbb1c0100b1f72a899b7087234b7029:/modules/fallback/DateTime/Span.pm?ds=inline diff --git a/modules/fallback/DateTime/Span.pm b/modules/fallback/DateTime/Span.pm new file mode 100644 index 000000000..5917a8a19 --- /dev/null +++ b/modules/fallback/DateTime/Span.pm @@ -0,0 +1,501 @@ +# Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + +package DateTime::Span; + +use strict; + +use DateTime::Set; +use DateTime::SpanSet; + +use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF ); +use vars qw( $VERSION ); + +use constant INFINITY => DateTime::INFINITY; +use constant NEG_INFINITY => DateTime::NEG_INFINITY; +$VERSION = $DateTime::Set::VERSION; + +sub set_time_zone { + my ( $self, $tz ) = @_; + + $self->{set} = $self->{set}->iterate( + sub { + my %tmp = %{ $_[0]->{list}[0] }; + $tmp{a} = $tmp{a}->clone->set_time_zone( $tz ) if ref $tmp{a}; + $tmp{b} = $tmp{b}->clone->set_time_zone( $tz ) if ref $tmp{b}; + \%tmp; + } + ); + return $self; +} + +# note: the constructor must clone its DateTime parameters, such that +# the set elements become immutable +sub from_datetimes { + my $class = shift; + my %args = validate( @_, + { start => + { type => OBJECT, + optional => 1, + }, + end => + { type => OBJECT, + optional => 1, + }, + after => + { type => OBJECT, + optional => 1, + }, + before => + { type => OBJECT, + optional => 1, + }, + } + ); + my $self = {}; + my $set; + + die "No arguments given to DateTime::Span->from_datetimes\n" + unless keys %args; + + if ( exists $args{start} && exists $args{after} ) { + die "Cannot give both start and after arguments to DateTime::Span->from_datetimes\n"; + } + if ( exists $args{end} && exists $args{before} ) { + die "Cannot give both end and before arguments to DateTime::Span->from_datetimes\n"; + } + + my ( $start, $open_start, $end, $open_end ); + ( $start, $open_start ) = ( NEG_INFINITY, 0 ); + ( $start, $open_start ) = ( $args{start}, 0 ) if exists $args{start}; + ( $start, $open_start ) = ( $args{after}, 1 ) if exists $args{after}; + ( $end, $open_end ) = ( INFINITY, 0 ); + ( $end, $open_end ) = ( $args{end}, 0 ) if exists $args{end}; + ( $end, $open_end ) = ( $args{before}, 1 ) if exists $args{before}; + + if ( $start > $end ) { + die "Span cannot start after the end in DateTime::Span->from_datetimes\n"; + } + $set = Set::Infinite::_recurrence->new( $start, $end ); + if ( $start != $end ) { + # remove start, such that we have ">" instead of ">=" + $set = $set->complement( $start ) if $open_start; + # remove end, such that we have "<" instead of "<=" + $set = $set->complement( $end ) if $open_end; + } + + $self->{set} = $set; + bless $self, $class; + return $self; +} + +sub from_datetime_and_duration { + my $class = shift; + my %args = @_; + + my $key; + my $dt; + # extract datetime parameters + for ( qw( start end before after ) ) { + if ( exists $args{$_} ) { + $key = $_; + $dt = delete $args{$_}; + } + } + + # extract duration parameters + my $dt_duration; + if ( exists $args{duration} ) { + $dt_duration = $args{duration}; + } + else { + $dt_duration = DateTime::Duration->new( %args ); + } + # warn "Creating span from $key => ".$dt->datetime." and $dt_duration"; + my $other_date = $dt->clone->add_duration( $dt_duration ); + # warn "Creating span from $key => ".$dt->datetime." and ".$other_date->datetime; + my $other_key; + if ( $dt_duration->is_positive ) { + # check if have to invert keys + $key = 'after' if $key eq 'end'; + $key = 'start' if $key eq 'before'; + $other_key = 'before'; + } + else { + # check if have to invert keys + $other_key = 'end' if $key eq 'after'; + $other_key = 'before' if $key eq 'start'; + $key = 'start'; + } + return $class->new( $key => $dt, $other_key => $other_date ); +} + +# This method is intentionally not documented. It's really only for +# use by ::Set and ::SpanSet's as_list() and iterator() methods. +sub new { + my $class = shift; + my %args = @_; + + # If we find anything _not_ appropriate for from_datetimes, we + # assume it must be for durations, and call this constructor. + # This way, we don't need to hardcode the DateTime::Duration + # parameters. + foreach ( keys %args ) + { + return $class->from_datetime_and_duration(%args) + unless /^(?:before|after|start|end)$/; + } + + return $class->from_datetimes(%args); +} + +sub clone { + bless { + set => $_[0]->{set}->copy, + }, ref $_[0]; +} + +# Set::Infinite methods + +sub intersection { + my ($set1, $set2) = @_; + my $class = ref($set1); + my $tmp = {}; # $class->new(); + $set2 = $set2->as_spanset + if $set2->can( 'as_spanset' ); + $set2 = $set2->as_set + if $set2->can( 'as_set' ); + $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) + unless $set2->can( 'union' ); + $tmp->{set} = $set1->{set}->intersection( $set2->{set} ); + + # intersection() can generate something more complex than a span. + bless $tmp, 'DateTime::SpanSet'; + + return $tmp; +} + +sub intersects { + my ($set1, $set2) = @_; + my $class = ref($set1); + $set2 = $set2->as_spanset + if $set2->can( 'as_spanset' ); + $set2 = $set2->as_set + if $set2->can( 'as_set' ); + $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) + unless $set2->can( 'union' ); + return $set1->{set}->intersects( $set2->{set} ); +} + +sub contains { + my ($set1, $set2) = @_; + my $class = ref($set1); + $set2 = $set2->as_spanset + if $set2->can( 'as_spanset' ); + $set2 = $set2->as_set + if $set2->can( 'as_set' ); + $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) + unless $set2->can( 'union' ); + return $set1->{set}->contains( $set2->{set} ); +} + +sub union { + my ($set1, $set2) = @_; + my $class = ref($set1); + my $tmp = {}; # $class->new(); + $set2 = $set2->as_spanset + if $set2->can( 'as_spanset' ); + $set2 = $set2->as_set + if $set2->can( 'as_set' ); + $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) + unless $set2->can( 'union' ); + $tmp->{set} = $set1->{set}->union( $set2->{set} ); + + # union() can generate something more complex than a span. + bless $tmp, 'DateTime::SpanSet'; + + # # We have to check it's internal structure to find out. + # if ( $#{ $tmp->{set}->{list} } != 0 ) { + # bless $tmp, 'Date::SpanSet'; + # } + + return $tmp; +} + +sub complement { + my ($set1, $set2) = @_; + my $class = ref($set1); + my $tmp = {}; # $class->new; + if (defined $set2) { + $set2 = $set2->as_spanset + if $set2->can( 'as_spanset' ); + $set2 = $set2->as_set + if $set2->can( 'as_set' ); + $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) + unless $set2->can( 'union' ); + $tmp->{set} = $set1->{set}->complement( $set2->{set} ); + } + else { + $tmp->{set} = $set1->{set}->complement; + } + + # complement() can generate something more complex than a span. + bless $tmp, 'DateTime::SpanSet'; + + # # We have to check it's internal structure to find out. + # if ( $#{ $tmp->{set}->{list} } != 0 ) { + # bless $tmp, 'Date::SpanSet'; + # } + + return $tmp; +} + +sub start { + return DateTime::Set::_fix_datetime( $_[0]->{set}->min ); +} + +*min = \&start; + +sub end { + return DateTime::Set::_fix_datetime( $_[0]->{set}->max ); +} + +*max = \&end; + +sub start_is_open { + # min_a returns info about the set boundary + my ($min, $open) = $_[0]->{set}->min_a; + return $open; +} + +sub start_is_closed { $_[0]->start_is_open ? 0 : 1 } + +sub end_is_open { + # max_a returns info about the set boundary + my ($max, $open) = $_[0]->{set}->max_a; + return $open; +} + +sub end_is_closed { $_[0]->end_is_open ? 0 : 1 } + + +# span == $self +sub span { @_ } + +sub duration { + my $dur; + + local $@; + eval { + local $SIG{__DIE__}; # don't want to trap this (rt ticket 5434) + $dur = $_[0]->end->subtract_datetime_absolute( $_[0]->start ) + }; + + return $dur if defined $dur; + + return DateTime::Infinite::Future->new - + DateTime::Infinite::Past->new; +} +*size = \&duration; + +1; + +__END__ + +=head1 NAME + +DateTime::Span - Datetime spans + +=head1 SYNOPSIS + + use DateTime; + use DateTime::Span; + + $date1 = DateTime->new( year => 2002, month => 3, day => 11 ); + $date2 = DateTime->new( year => 2003, month => 4, day => 12 ); + $set2 = DateTime::Span->from_datetimes( start => $date1, end => $date2 ); + # set2 = 2002-03-11 until 2003-04-12 + + $set = $set1->union( $set2 ); # like "OR", "insert", "both" + $set = $set1->complement( $set2 ); # like "delete", "remove" + $set = $set1->intersection( $set2 ); # like "AND", "while" + $set = $set1->complement; # like "NOT", "negate", "invert" + + if ( $set1->intersects( $set2 ) ) { ... # like "touches", "interferes" + if ( $set1->contains( $set2 ) ) { ... # like "is-fully-inside" + + # data extraction + $date = $set1->start; # first date of the span + $date = $set1->end; # last date of the span + +=head1 DESCRIPTION + +C is a module for handling datetime spans, otherwise +known as ranges or periods ("from X to Y, inclusive of all datetimes +in between"). + +This is different from a C, which is made of individual +datetime points as opposed to a range. There is also a module +C to handle sets of spans. + +=head1 METHODS + +=over 4 + +=item * from_datetimes + +Creates a new span based on a starting and ending datetime. + +A 'closed' span includes its end-dates: + + $span = DateTime::Span->from_datetimes( start => $dt1, end => $dt2 ); + +An 'open' span does not include its end-dates: + + $span = DateTime::Span->from_datetimes( after => $dt1, before => $dt2 ); + +A 'semi-open' span includes one of its end-dates: + + $span = DateTime::Span->from_datetimes( start => $dt1, before => $dt2 ); + $span = DateTime::Span->from_datetimes( after => $dt1, end => $dt2 ); + +A span might have just a beginning date, or just an ending date. +These spans end, or start, in an imaginary 'forever' date: + + $span = DateTime::Span->from_datetimes( start => $dt1 ); + $span = DateTime::Span->from_datetimes( end => $dt2 ); + $span = DateTime::Span->from_datetimes( after => $dt1 ); + $span = DateTime::Span->from_datetimes( before => $dt2 ); + +You cannot give both a "start" and "after" argument, nor can you give +both an "end" and "before" argument. Either of these conditions will +cause the C method to die. + +To summarize, a datetime passed as either "start" or "end" is included +in the span. A datetime passed as either "after" or "before" is +excluded from the span. + +=item * from_datetime_and_duration + +Creates a new span. + + $span = DateTime::Span->from_datetime_and_duration( + start => $dt1, duration => $dt_dur1 ); + $span = DateTime::Span->from_datetime_and_duration( + after => $dt1, hours => 12 ); + +The new "end of the set" is I by default. + +=item * clone + +This object method returns a replica of the given object. + +=item * set_time_zone( $tz ) + +This method accepts either a time zone object or a string that can be +passed as the "name" parameter to C<< DateTime::TimeZone->new() >>. +If the new time zone's offset is different from the old time zone, +then the I time is adjusted accordingly. + +If the old time zone was a floating time zone, then no adjustments to +the local time are made, except to account for leap seconds. If the +new time zone is floating, then the I time is adjusted in order +to leave the local time untouched. + +=item * duration + +The total size of the set, as a C object, or as a +scalar containing infinity. + +Also available as C. + +=item * start + +=item * end + +First or last dates in the span. + +It is possible that the return value from these methods may be a +C or a Cxs object. + +If the set ends C a date C<$dt>, it returns C<$dt>. Note that +in this case C<$dt> is not a set element - but it is a set boundary. + +=cut + +# scalar containing either negative infinity +# or positive infinity. + +=item * start_is_closed + +=item * end_is_closed + +Returns true if the first or last dates belong to the span ( begin <= x <= end ). + +=item * start_is_open + +=item * end_is_open + +Returns true if the first or last dates are excluded from the span ( begin < x < end ). + +=item * union + +=item * intersection + +=item * complement + +Set operations may be performed not only with C +objects, but also with C and C +objects. These set operations always return a C +object. + + $set = $span->union( $set2 ); # like "OR", "insert", "both" + $set = $span->complement( $set2 ); # like "delete", "remove" + $set = $span->intersection( $set2 ); # like "AND", "while" + $set = $span->complement; # like "NOT", "negate", "invert" + +=item * intersects + +=item * contains + +These set functions return a boolean value. + + if ( $span->intersects( $set2 ) ) { ... # like "touches", "interferes" + if ( $span->contains( $dt ) ) { ... # like "is-fully-inside" + +These methods can accept a C, C, +C, or C object as an argument. + +=back + +=head1 SUPPORT + +Support is offered through the C mailing list. + +Please report bugs using rt.cpan.org + +=head1 AUTHOR + +Flavio Soibelmann Glock + +The API was developed together with Dave Rolsky and the DateTime Community. + +=head1 COPYRIGHT + +Copyright (c) 2003-2006 Flavio Soibelmann Glock. All rights reserved. +This program is free software; you can distribute it and/or modify it +under the same terms as Perl itself. + +The full text of the license can be found in the LICENSE file +included with this module. + +=head1 SEE ALSO + +Set::Infinite + +For details on the Perl DateTime Suite project please see +L. + +=cut +