From 950dcafb63b0ded068ed8b4a6596ff2f1a62419c Mon Sep 17 00:00:00 2001
From: Michael G. Schwern <schwern@pobox.com>
Date: Thu, 11 Mar 2010 10:43:47 -0800
Subject: [PATCH] Comprehensive fix for DT v non-DT string overloading.
Make eq, ne and cmp work for non-DateTime objects and plain strings.
Change the docs to reflect this fact.
Document that DateTime objects do not numify.
Document the recommended way to sort mixed DT and nonDT objects.
---
lib/DateTime.pm | 39 ++++++++++++++++++++++++++++-----------
t/29overload.t | 47 +++++++++++++++++++++++++++++++++++++++++++++--
2 files changed, 73 insertions(+), 13 deletions(-)
diff --git a/lib/DateTime.pm b/lib/DateTime.pm
index 48c267b..d4cc5c8 100644
--- a/lib/DateTime.pm
+++ b/lib/DateTime.pm
@@ -56,7 +56,7 @@ use Params::Validate qw( validate validate_pos SCALAR BOOLEAN HASHREF OBJECT );
#
use overload ( 'fallback' => 1,
'<=>' => '_compare_overload',
- 'cmp' => '_compare_overload',
+ 'cmp' => '_string_compare_overload',
'""' => '_stringify',
'-' => '_subtract_overload',
'+' => '_add_overload',
@@ -1728,6 +1728,19 @@ sub _compare_overload
return $_[2] ? - $_[0]->compare( $_[1] ) : $_[0]->compare( $_[1] );
}
+sub _string_compare_overload {
+ my($dt1, $dt2, $flip) = @_;
+ my $sign = $flip ? -1 : 1;
+
+ # One is a DateTime object, one isn't. Just stringify and compare.
+ if( !DateTime::Helpers::can( $dt2, 'utc_rd_values' ) ) {
+ return $sign * ("$dt1" cmp "$dt2");
+ }
+ else {
+ goto $dt1->can('_compare_overload');
+ }
+}
+
sub compare
{
shift->_compare( @_, 0 );
@@ -1793,10 +1806,10 @@ sub _string_equals_overload
{
my ( $class, $dt1, $dt2 ) = ref $_[0] ? ( undef, @_ ) : @_;
- return unless
- ( DateTime::Helpers::can( $dt1, 'utc_rd_values' )
- && DateTime::Helpers::can( $dt2, 'utc_rd_values' )
- );
+ # One is a DateTime object, one isn't. Just stringify and compare.
+ if( !DateTime::Helpers::can( $dt2, 'utc_rd_values' ) ) {
+ return "$dt1" eq "$dt2";
+ }
$class ||= ref $dt1;
return ! $class->compare( $dt1, $dt2 );
@@ -3401,13 +3414,17 @@ Additionally, the fallback parameter is set to true, so other
derivable operators (+=, -=, etc.) will work properly. Do not expect
increment (++) or decrement (--) to do anything useful.
-If you attempt to sort DateTime objects with non-DateTime.pm objects
-or scalars (strings, number, whatever) then an exception will be
-thrown. Using the string comparison operators, C<eq> or C<ne>, to
-compare a DateTime.pm always returns false.
+The string comparison operators, C<eq> or C<ne>, will use the string
+value to compare with non-DateTime objects.
-The module also overloads stringification to use the C<iso8601()>
-method.
+DateTime objects do not have a numeric value, using C<==> or C<< <=>
+>> to compare a DateTime object with a non-DateTime object will result
+in an exception. To safely sort mixed DateTime and non-DateTime
+objects, use C<sort { $a cmp $b } @dates>.
+
+The module also overloads stringification using the object's
+formatter, defaulting to C<iso8601()> method. See L<Formatters And
+Stringification> for details.
=head2 Formatters And Stringification
diff --git a/t/29overload.t b/t/29overload.t
index 71be162..df04885 100644
--- a/t/29overload.t
+++ b/t/29overload.t
@@ -2,7 +2,7 @@
use strict;
-use Test::More tests => 12;
+use Test::More tests => 29;
use DateTime;
@@ -16,7 +16,50 @@ use DateTime;
my $dt = DateTime->new( year => 2050, month => 1, day => 15,
hour => 20, minute => 10, second => 10 );
- is( "$dt", '2050-01-15T20:10:10', 'stringification overloading' );
+ my $before_string = '2050-01-15T20:10:09';
+ my $dt_string = '2050-01-15T20:10:10';
+ my $after_string = '2050-01-15T20:10:11';
+
+ is( "$dt", $dt_string, 'stringification overloading' );
+ ok( $dt eq $dt_string, 'eq overloading true' );
+ ok( !($dt eq $after_string), 'eq overloading false' );
+ ok( $dt ne $after_string, 'ne overloading true' );
+ ok( !($dt ne $dt_string), 'ne overloading false' );
+
+ is( $dt cmp $dt_string, 0, 'cmp overloading' );
+ is( $dt cmp $after_string, -1, ' less than' );
+ ok( $dt lt $after_string, 'lt overloading' );
+ ok( !($dt lt $dt_string), ' not' );
+
+ {
+ package Other::Date;
+ use overload
+ q[""] => sub { return ${$_[0]}; },
+ fallback => 1;
+ sub new {
+ my($class, $date) = @_;
+ return bless \$date, $class
+ }
+ }
+
+ my $same = Other::Date->new($dt_string);
+ my $after = Other::Date->new($after_string);
+ my $before = Other::Date->new($before_string);
+ ok $dt eq $same, "DateTime eq non-DateTime overloaded object true";
+ ok !($dt eq $after), " eq false";
+ ok $dt ne $after, " ne true";
+ ok !($dt ne $same), " ne false";
+
+ is( $dt cmp $same, 0, 'cmp overloading' );
+ is( $dt cmp $after, -1, ' lt overloading' );
+ ok( $dt lt $after, 'lt overloading' );
+ ok( !($dt lt $same), ' not' );
+
+ is_deeply(
+ [sort { $a cmp $b } $same, $after, $before, $dt, $dt_string, $after_string, $before_string],
+ [$before, $before_string, $dt, $same, $dt_string, $after, $after_string],
+ "eq sort"
+ );
eval { my $x = $dt + 1 };
like( $@, qr/Cannot add 1 to a DateTime object/,
--
1.7.0
