Changeset 24440

Timestamp:

11/20/08 15:15:43 (5 years ago)

Author:

daisuke

Message:

make subtraction work

Location:

lang/perl/DateTime-Lite/trunk

Files:

• lib/DateTime/Lite.pm (modified) (5 diffs)
• lib/DateTime/Lite/Arithmetic.pm (modified) (6 diffs)
• lib/DateTime/Lite/Util.pm (modified) (3 diffs)
• t/04epoch.t (modified) (1 diff)
• t/10subtract.t (modified) (1 diff)

lang/perl/DateTime-Lite/trunk/lib/DateTime/Lite.pm

@@ -11 +11 @@
 use Time::Local qw( timegm_nocheck );
 
+use overload (
+    fallback => 1,
+    '<=>' => '_compare_overload',
+    'cmp' => '_compare_overload',
+    '""'  => '_stringify',
+    'eq'  => '_string_equals_overload',
+    'ne'  => '_string_not_equals_overload',
+);
+
 use constant INFINITY     =>      (9 ** 9 ** 9);
 use constant NEG_INFINITY => -1 * (9 ** 9 ** 9);
@@ -38 +47 @@
 sub utc_rd_values { @{ $_[0] }{ 'utc_rd_days', 'utc_rd_secs', 'rd_nanosecs' } }
 sub local_rd_values { @{ $_[0] }{ 'local_rd_days', 'local_rd_secs', 'rd_nanosecs' } }
+
+# NOTE: no nanoseconds, no leap seconds
+sub utc_rd_as_seconds   { ( $_[0]->{utc_rd_days} * SECONDS_PER_DAY ) + $_[0]->{utc_rd_secs} }
+
+# NOTE: no nanoseconds, no leap seconds
+sub local_rd_as_seconds { ( $_[0]->{local_rd_days} * SECONDS_PER_DAY ) + $_[0]->{local_rd_secs} }
+
+# RD 1 is JD 1,721,424.5 - a simple offset
+sub jd
+{
+    my $self = shift;
+
+    my $jd = $self->{utc_rd_days} + 1_721_424.5;
+
+    my $day_length = $self->_day_length( $self->{utc_rd_days} );
+
+    return ( $jd +
+             ( $self->{utc_rd_secs} / $day_length )  +
+             ( $self->{rd_nanosecs} / $day_length / MAX_NANOSECONDS )
+           );
+}
+
+sub mjd { $_[0]->jd - 2_400_000.5 }
+
 
 # XXX Prime candidate for SelfLoading
@@ -282 +315 @@
     my $leap_seconds = 0;
     if ( $object->can('time_zone') && ! $object->time_zone->is_floating
-         && $rd_secs > 86399 && $rd_secs <= $class->_day_length($rd_days) )
+         && $rd_secs > 86399 && $rd_secs <= DateTime::Lite::LeapSecond::day_length($rd_days) )
     {
         $leap_seconds = $rd_secs - 86399;
@@ -315 +348 @@
     return $class->new(%p, day => DateTime::Lite::Util::month_length($p{year}, $p{month}));
 }
+
+# These can't go to SelfLoader section, as it needs to be present when 
+# overload.pm attempts to look for it
+sub _stringify {
+    my $self = shift;
+
+    return $self->iso8601 unless $self->{formatter};
+    return $self->{formatter}->format_datetime($self);
+}
+
+sub _compare_overload
+{
+    # note: $_[1]->compare( $_[0] ) is an error when $_[1] is not a
+    # DateTime (such as the INFINITY value)
+    return $_[2] ? - $_[0]->compare( $_[1] ) : $_[0]->compare( $_[1] );
+}
+
+sub _string_equals_overload {
+    my ( $class, $dt1, $dt2 ) = ref $_[0] ? ( undef, @_ ) : @_;
+
+    return unless(
+        blessed $dt1 && $dt1->can('utc_rd_values') &&
+        blessed $dt2 && $dt2->can('utc_rd_values')
+    );
+
+    $class ||= ref $dt1;
+    return ! $class->compare( $dt1, $dt2 );
+}
+
+sub _string_not_equals_overload {
+    return ! _string_equals_overload(@_);
+}
+
+
 
 1;
@@ -674 +741 @@
 }
 
+sub compare
+{
+    shift->_compare( @_, 0 );
+}
+
+sub compare_ignore_floating
+{
+    shift->_compare( @_, 1 );
+}
+
+sub _compare
+{
+    my ( $class, $dt1, $dt2, $consistent ) = ref $_[0] ? ( undef, @_ ) : @_;
+
+    return undef unless defined $dt2;
+
+    if ( ! ref $dt2 && ( $dt2 == INFINITY || $dt2 == NEG_INFINITY ) )
+    {
+        return $dt1->{utc_rd_days} <=> $dt2;
+    }
+
+    unless ( (blessed $dt1 && $dt1->can( 'utc_rd_values' )) && 
+        (blessed $dt2 && $dt2->can( 'utc_rd_values' ) ))
+    {
+        my $dt1_string = overload::StrVal($dt1);
+        my $dt2_string = overload::StrVal($dt2);
+
+        Carp::croak( "A DateTime object can only be compared to"
+                     . " another DateTime object ($dt1_string, $dt2_string)." );
+    }
+
+    if ( ! $consistent &&
+         (blessed $dt1 && $dt1->can( 'time_zone' )) &&
+         (blessed $dt2 && $dt2->can( 'time_zone' ))
+       )
+    {
+        my $is_floating1 = $dt1->time_zone->is_floating;
+        my $is_floating2 = $dt2->time_zone->is_floating;
+
+        if ( $is_floating1 && ! $is_floating2 )
+        {
+            $dt1 = $dt1->clone->set_time_zone( $dt2->time_zone );
+        }
+        elsif ( $is_floating2 && ! $is_floating1 )
+        {
+            $dt2 = $dt2->clone->set_time_zone( $dt1->time_zone );
+        }
+    }
+
+    my @dt1_components = $dt1->utc_rd_values;
+    my @dt2_components = $dt2->utc_rd_values;
+
+    foreach my $i ( 0..2 )
+    {
+        return $dt1_components[$i] <=> $dt2_components[$i]
+            if $dt1_components[$i] != $dt2_components[$i]
+    }
+
+    return 0;
+}
+
 
 

lang/perl/DateTime-Lite/trunk/lib/DateTime/Lite/Arithmetic.pm

@@ -4 +4 @@
 use warnings;
 use Scalar::Util qw(blessed);
+use overload ( 'fallback' => 1,
+               '-'   => '_subtract_overload',
+               '+'   => '_add_overload',
+             );
+
 
 sub subtract_datetime
@@ -39 +44 @@
             # floating, we just assume a minute is 60 seconds.
 
-            $minute_length = $dt1->_day_length($utc_rd_days) - 86340;
+            $minute_length = DateTime::Lite::LeapSecond::day_length($utc_rd_days) - 86340;
         }
     }
@@ -98 +103 @@
               # somewhat arbitrary, we could also use the bigger -
               # either way we have reversibility problems
-              $dt1->_month_length( $smaller->year, $smaller->month ),
+              DateTime::Lite::Util::month_length( $smaller->year, $smaller->month ),
             );
 
@@ -172 +177 @@
 
     my $utc_rd_secs1 = $self->utc_rd_as_seconds;
-    $utc_rd_secs1 += DateTime->_accumulated_leap_seconds( $self->{utc_rd_days} )
+    $utc_rd_secs1 += DateTime::Lite::LeapSecond::leap_seconds( $self->{utc_rd_days} )
         if ! $self->time_zone->is_floating;
 
     my $utc_rd_secs2 = $dt->utc_rd_as_seconds;
-    $utc_rd_secs2 += DateTime->_accumulated_leap_seconds( $dt->{utc_rd_days} )
+    $utc_rd_secs2 += DateTime::Lite::LeapSecond::leap_seconds( $dt->{utc_rd_days} )
         if ! $dt->time_zone->is_floating;
 
@@ -289 +294 @@
         return $new;
     }
-    elsif ( blessed $date2 && $date2->isa( 'DateTime' ) )
+    elsif ( blessed $date2 && $date2->isa( 'DateTime::Lite' ) )
     {
         return $date1->subtract_datetime($date2);
@@ -299 +304 @@
 
         Carp::croak( "Cannot subtract $date2 from a $class object ($dt_string).\n"
-                     . " Only a DateTime::Lite::Duration or DateTime object can "
+                     . " Only a DateTime::Lite::Duration or DateTime::Lite object can "
                      . " be subtracted from a $class object." );
     }

lang/perl/DateTime-Lite/trunk/lib/DateTime/Lite/Util.pm

@@ -279 +279 @@
     my $new_day = $_[1] + $delta_days;
     my $delta_seconds = ( 86400 * $delta_days ) +
-                        DateTime::LeapSecond::leap_seconds( $new_day ) -
-                        DateTime::LeapSecond::leap_seconds( $_[1] );
+                        DateTime::Lite::LeapSecond::leap_seconds( $new_day ) -
+                        DateTime::Lite::LeapSecond::leap_seconds( $_[1] );
 
     $_[2] -= $delta_seconds;
@@ -286 +286 @@
 
     # fine adjust - up to 1 day
-    my $day_length = DateTime::LeapSecond::day_length( $new_day );
+    my $day_length = DateTime::Lite::LeapSecond::day_length( $new_day );
     if ( $_[2] >= $day_length )
     {
@@ -294 +294 @@
     elsif ( $_[2] < 0 )
     {
-        $day_length = DateTime::LeapSecond::day_length( $new_day - 1 );
+        $day_length = DateTime::Lite::LeapSecond::day_length( $new_day - 1 );
         $_[2] += $day_length;
         $_[1]--;

lang/perl/DateTime-Lite/trunk/t/04epoch.t

@@ -5 +5 @@
 use Test::More tests => 28;
 
-use DateTime::Lite;
+use DateTime::Lite qw(Arithmetic);
 
 {

lang/perl/DateTime-Lite/trunk/t/10subtract.t

@@ -3 +3 @@
 use strict;
 
-use Test::More skip_all => "arithmetic not implemented"; # tests => 105;
-
-use DateTime::Lite;
+use Test::More tests => 105;
+
+use DateTime::Lite qw(Arithmetic);
 
 {