Changeset 24440

Show
Ignore:
Timestamp:
11/20/08 15:15:43 (6 years ago)
Author:
daisuke
Message:

make subtraction work

Location:
lang/perl/DateTime-Lite/trunk
Files:
5 modified

Legend:

Unmodified
Added
Removed
  • lang/perl/DateTime-Lite/trunk/lib/DateTime/Lite.pm

    r24439 r24440  
    1111use Time::Local qw( timegm_nocheck ); 
    1212 
     13use overload ( 
     14    fallback => 1, 
     15    '<=>' => '_compare_overload', 
     16    'cmp' => '_compare_overload', 
     17    '""'  => '_stringify', 
     18    'eq'  => '_string_equals_overload', 
     19    'ne'  => '_string_not_equals_overload', 
     20); 
     21 
    1322use constant INFINITY     =>      (9 ** 9 ** 9); 
    1423use constant NEG_INFINITY => -1 * (9 ** 9 ** 9); 
     
    3847sub utc_rd_values { @{ $_[0] }{ 'utc_rd_days', 'utc_rd_secs', 'rd_nanosecs' } } 
    3948sub local_rd_values { @{ $_[0] }{ 'local_rd_days', 'local_rd_secs', 'rd_nanosecs' } } 
     49 
     50# NOTE: no nanoseconds, no leap seconds 
     51sub utc_rd_as_seconds   { ( $_[0]->{utc_rd_days} * SECONDS_PER_DAY ) + $_[0]->{utc_rd_secs} } 
     52 
     53# NOTE: no nanoseconds, no leap seconds 
     54sub local_rd_as_seconds { ( $_[0]->{local_rd_days} * SECONDS_PER_DAY ) + $_[0]->{local_rd_secs} } 
     55 
     56# RD 1 is JD 1,721,424.5 - a simple offset 
     57sub jd 
     58{ 
     59    my $self = shift; 
     60 
     61    my $jd = $self->{utc_rd_days} + 1_721_424.5; 
     62 
     63    my $day_length = $self->_day_length( $self->{utc_rd_days} ); 
     64 
     65    return ( $jd + 
     66             ( $self->{utc_rd_secs} / $day_length )  + 
     67             ( $self->{rd_nanosecs} / $day_length / MAX_NANOSECONDS ) 
     68           ); 
     69} 
     70 
     71sub mjd { $_[0]->jd - 2_400_000.5 } 
     72 
    4073 
    4174# XXX Prime candidate for SelfLoading 
     
    282315    my $leap_seconds = 0; 
    283316    if ( $object->can('time_zone') && ! $object->time_zone->is_floating 
    284          && $rd_secs > 86399 && $rd_secs <= $class->_day_length($rd_days) ) 
     317         && $rd_secs > 86399 && $rd_secs <= DateTime::Lite::LeapSecond::day_length($rd_days) ) 
    285318    { 
    286319        $leap_seconds = $rd_secs - 86399; 
     
    315348    return $class->new(%p, day => DateTime::Lite::Util::month_length($p{year}, $p{month})); 
    316349} 
     350 
     351# These can't go to SelfLoader section, as it needs to be present when  
     352# overload.pm attempts to look for it 
     353sub _stringify { 
     354    my $self = shift; 
     355 
     356    return $self->iso8601 unless $self->{formatter}; 
     357    return $self->{formatter}->format_datetime($self); 
     358} 
     359 
     360sub _compare_overload 
     361{ 
     362    # note: $_[1]->compare( $_[0] ) is an error when $_[1] is not a 
     363    # DateTime (such as the INFINITY value) 
     364    return $_[2] ? - $_[0]->compare( $_[1] ) : $_[0]->compare( $_[1] ); 
     365} 
     366 
     367sub _string_equals_overload { 
     368    my ( $class, $dt1, $dt2 ) = ref $_[0] ? ( undef, @_ ) : @_; 
     369 
     370    return unless( 
     371        blessed $dt1 && $dt1->can('utc_rd_values') && 
     372        blessed $dt2 && $dt2->can('utc_rd_values') 
     373    ); 
     374 
     375    $class ||= ref $dt1; 
     376    return ! $class->compare( $dt1, $dt2 ); 
     377} 
     378 
     379sub _string_not_equals_overload { 
     380    return ! _string_equals_overload(@_); 
     381} 
     382 
     383 
    317384 
    3183851; 
     
    674741} 
    675742 
     743sub compare 
     744{ 
     745    shift->_compare( @_, 0 ); 
     746} 
     747 
     748sub compare_ignore_floating 
     749{ 
     750    shift->_compare( @_, 1 ); 
     751} 
     752 
     753sub _compare 
     754{ 
     755    my ( $class, $dt1, $dt2, $consistent ) = ref $_[0] ? ( undef, @_ ) : @_; 
     756 
     757    return undef unless defined $dt2; 
     758 
     759    if ( ! ref $dt2 && ( $dt2 == INFINITY || $dt2 == NEG_INFINITY ) ) 
     760    { 
     761        return $dt1->{utc_rd_days} <=> $dt2; 
     762    } 
     763 
     764    unless ( (blessed $dt1 && $dt1->can( 'utc_rd_values' )) &&  
     765        (blessed $dt2 && $dt2->can( 'utc_rd_values' ) )) 
     766    { 
     767        my $dt1_string = overload::StrVal($dt1); 
     768        my $dt2_string = overload::StrVal($dt2); 
     769 
     770        Carp::croak( "A DateTime object can only be compared to" 
     771                     . " another DateTime object ($dt1_string, $dt2_string)." ); 
     772    } 
     773 
     774    if ( ! $consistent && 
     775         (blessed $dt1 && $dt1->can( 'time_zone' )) && 
     776         (blessed $dt2 && $dt2->can( 'time_zone' )) 
     777       ) 
     778    { 
     779        my $is_floating1 = $dt1->time_zone->is_floating; 
     780        my $is_floating2 = $dt2->time_zone->is_floating; 
     781 
     782        if ( $is_floating1 && ! $is_floating2 ) 
     783        { 
     784            $dt1 = $dt1->clone->set_time_zone( $dt2->time_zone ); 
     785        } 
     786        elsif ( $is_floating2 && ! $is_floating1 ) 
     787        { 
     788            $dt2 = $dt2->clone->set_time_zone( $dt1->time_zone ); 
     789        } 
     790    } 
     791 
     792    my @dt1_components = $dt1->utc_rd_values; 
     793    my @dt2_components = $dt2->utc_rd_values; 
     794 
     795    foreach my $i ( 0..2 ) 
     796    { 
     797        return $dt1_components[$i] <=> $dt2_components[$i] 
     798            if $dt1_components[$i] != $dt2_components[$i] 
     799    } 
     800 
     801    return 0; 
     802} 
     803 
    676804 
    677805 
  • lang/perl/DateTime-Lite/trunk/lib/DateTime/Lite/Arithmetic.pm

    r24439 r24440  
    44use warnings; 
    55use Scalar::Util qw(blessed); 
     6use overload ( 'fallback' => 1, 
     7               '-'   => '_subtract_overload', 
     8               '+'   => '_add_overload', 
     9             ); 
     10 
    611 
    712sub subtract_datetime 
     
    3944            # floating, we just assume a minute is 60 seconds. 
    4045 
    41             $minute_length = $dt1->_day_length($utc_rd_days) - 86340; 
     46            $minute_length = DateTime::Lite::LeapSecond::day_length($utc_rd_days) - 86340; 
    4247        } 
    4348    } 
     
    98103              # somewhat arbitrary, we could also use the bigger - 
    99104              # either way we have reversibility problems 
    100               $dt1->_month_length( $smaller->year, $smaller->month ), 
     105              DateTime::Lite::Util::month_length( $smaller->year, $smaller->month ), 
    101106            ); 
    102107 
     
    172177 
    173178    my $utc_rd_secs1 = $self->utc_rd_as_seconds; 
    174     $utc_rd_secs1 += DateTime->_accumulated_leap_seconds( $self->{utc_rd_days} ) 
     179    $utc_rd_secs1 += DateTime::Lite::LeapSecond::leap_seconds( $self->{utc_rd_days} ) 
    175180        if ! $self->time_zone->is_floating; 
    176181 
    177182    my $utc_rd_secs2 = $dt->utc_rd_as_seconds; 
    178     $utc_rd_secs2 += DateTime->_accumulated_leap_seconds( $dt->{utc_rd_days} ) 
     183    $utc_rd_secs2 += DateTime::Lite::LeapSecond::leap_seconds( $dt->{utc_rd_days} ) 
    179184        if ! $dt->time_zone->is_floating; 
    180185 
     
    289294        return $new; 
    290295    } 
    291     elsif ( blessed $date2 && $date2->isa( 'DateTime' ) ) 
     296    elsif ( blessed $date2 && $date2->isa( 'DateTime::Lite' ) ) 
    292297    { 
    293298        return $date1->subtract_datetime($date2); 
     
    299304 
    300305        Carp::croak( "Cannot subtract $date2 from a $class object ($dt_string).\n" 
    301                      . " Only a DateTime::Lite::Duration or DateTime object can " 
     306                     . " Only a DateTime::Lite::Duration or DateTime::Lite object can " 
    302307                     . " be subtracted from a $class object." ); 
    303308    } 
  • lang/perl/DateTime-Lite/trunk/lib/DateTime/Lite/Util.pm

    r24438 r24440  
    279279    my $new_day = $_[1] + $delta_days; 
    280280    my $delta_seconds = ( 86400 * $delta_days ) + 
    281                         DateTime::LeapSecond::leap_seconds( $new_day ) - 
    282                         DateTime::LeapSecond::leap_seconds( $_[1] ); 
     281                        DateTime::Lite::LeapSecond::leap_seconds( $new_day ) - 
     282                        DateTime::Lite::LeapSecond::leap_seconds( $_[1] ); 
    283283 
    284284    $_[2] -= $delta_seconds; 
     
    286286 
    287287    # fine adjust - up to 1 day 
    288     my $day_length = DateTime::LeapSecond::day_length( $new_day ); 
     288    my $day_length = DateTime::Lite::LeapSecond::day_length( $new_day ); 
    289289    if ( $_[2] >= $day_length ) 
    290290    { 
     
    294294    elsif ( $_[2] < 0 ) 
    295295    { 
    296         $day_length = DateTime::LeapSecond::day_length( $new_day - 1 ); 
     296        $day_length = DateTime::Lite::LeapSecond::day_length( $new_day - 1 ); 
    297297        $_[2] += $day_length; 
    298298        $_[1]--; 
  • lang/perl/DateTime-Lite/trunk/t/04epoch.t

    r24439 r24440  
    55use Test::More tests => 28; 
    66 
    7 use DateTime::Lite; 
     7use DateTime::Lite qw(Arithmetic); 
    88 
    99{ 
  • lang/perl/DateTime-Lite/trunk/t/10subtract.t

    r24240 r24440  
    33use strict; 
    44 
    5 use Test::More skip_all => "arithmetic not implemented"; # tests => 105; 
    6  
    7 use DateTime::Lite; 
     5use Test::More tests => 105; 
     6 
     7use DateTime::Lite qw(Arithmetic); 
    88 
    99{