Index: lib/DateTime/Format/Pg.pm =================================================================== RCS file: /cvsroot/perl-date-time/modules/DateTime-Format-Pg/lib/DateTime/Format/Pg.pm,v retrieving revision 1.14 diff -u -r1.14 Pg.pm --- lib/DateTime/Format/Pg.pm 2 Sep 2005 21:38:59 -0000 1.14 +++ lib/DateTime/Format/Pg.pm 6 Jan 2006 23:19:08 -0000 @@ -550,23 +550,32 @@ =cut sub parse_duration { - my ($self,$string,%param) = @_; - - # USE_ISO_DATES - # - if($string =~ m/^(?:(-?\d+) years?)? *(?:([-\+]?\d+) mons?)? *(?:([-\+]?\d+) days?)? *(?:([-\+])?(\d{2,}):(\d{2,})(?::(\d{2,})(\.\d+)?)?)?$/) { - my ($year,$mon,$day,$sgn,$hour,$min,$sec,$frc) = ($1,$2,$3,$4,$5,$6,$7,$8); + my ($self, $string) = @_; + my ($year, $mon, $day, $sgn, $hour, $min, $sec, $frc, $ago) = $string =~ m{ + \A # Start of string. + (?:\@\s*)? # Optional leading @. + (?:([-+]?\d+)\s+years?\s*)? # years + (?:([-+]?\d+)\s+mons?\s*)? # months + (?:([-+]?\d+)\s+days?\s*)? # days + (?: # Start h/m/s + # hours + (?:([-+])?([012345]\d(?=:)|\d+(?=\s+hour))(?:\s+hours?)?\s*)? + # minutes + (?::?((?<=:)[012345]\d|\d+(?=\s+mins?))(?:\s+mins?)?\s*)? + # seconds + (?::?((?<=:)[012345]\d|\d+(?=\.|\s+secs?))(\.\d+)?(?:\s+secs?)?\s*)? + ?) # End hh:mm:ss + (ago)? # Optional inversion + \z # End of string + }xms or croak 'Invalid interval string'; # NB: We can't just pass our values to new() because it treats all # arguments as negative if we have a single negative component. # PostgreSQL might return mixed signs, e.g. '1 mon -1day'. - my $du = DateTime::Duration->new(); + my $du = DateTime::Duration->new; - $sec ||= 0; - $frc ||= 0; - $min ||= 0; - $day ||= 0; - $mon ||= 0; + # Define for calculations + $_ ||= 0 for $sec, $frc, $min, $day, $mon; # DT::Duration only stores years, days, months, seconds (and # nanoseconds) @@ -574,86 +583,22 @@ $min += 60 * $hour if $hour; # HH:MM:SS.FFFF share a single sign - # - $sgn ||= '+'; - $sgn = $sgn eq '-' ? -1 : 1; - $min *= $sgn; - $sec *= $sgn; - $frc *= $sgn; - - # If the most significant value is negative, set the sign - # - if($mon<0 || ($mon==0 && ($day<0 || ($day==0 && ($sgn<0 && ($min != 0 || $sec != 0 || $frc != 0)))))) { - $du = $du->inverse(); - } - - # Fractional seconds. Pg can have a maximum precision of 10 decimal - # digits, so it's safe to just use floating point arithmetic - # (provided we have at least double precision). - # - $frc *= DateTime::Duration::MAX_NANOSECONDS; - - # One add per sign (PostgreSQL stores, months, days and time with - # one sign each) - $du -> add( 'months' => $mon ) if $mon; - $du -> add( 'days' => $day ) if $day; - $du -> add( - ($min ? ( 'minutes'=> $min) : () ), - ($sec ? ( 'seconds'=> $sec) : () ), - ($frc ? ( 'nanoseconds'=> $frc ) : ()) ) if $min || $sec || $frc; - - return $du; - } - - # USE_POSTGRES_DATES (and 'default') - # - elsif($string =~ m/^@ (?:(-?\d+) years?)? *(?:([-\+]?\d+) mons?)? *(?:([-\+]?\d+) days?)? *(?:([-\+]?\d+) hours?)? *(?:([-\+]?\d+) mins?)? *(?:(([-\+])?\d+)(\.\d+)? secs?)? *(ago)?$/) { - my ($year,$mon,$day,$hour,$min,$sec,$sgn,$frc,$ago) = ($1,$2,$3,$4,$5,$6,$7,$8,$9); - - # NB: We can't just pass our values to new() because it treats all - # arguments as negative if we have a single negative component. - # PostgreSQL might return mixed signs, e.g. '1 mon -1day'. - my $du = DateTime::Duration->new(); - - # DT::Duration only stores years, days, months, seconds (and - # nanoseconds) - $mon += 12 * $year if $year; - $min += 60 * $hour if $hour; - - # Fractional seconds. Pg can have a maximum precision of 10 decimal - # digits, so it's safe to just use floating point arithmetic - # (provided we have at least double precision). - # - if ($frc) { - $frc = $sgn.$frc if $sgn; - $frc *= DateTime::Duration::MAX_NANOSECONDS; - } - $frc ||= 0; - - # One add per sign (PostgreSQL stores, months, days and time with - # one sign each) - $du -> add( 'months' => $mon ) if $mon; - $du -> add( 'days' => $day ) if $day; - $du -> add( - ($min ? ( 'minutes'=> $min) : () ), - ($sec ? ( 'seconds'=> $sec) : () ), - ($frc ? ( 'nanoseconds'=> $frc ) : ()) ) if $min || $sec || $frc; - - if($ago) { - return $du->inverse(); + if ($sgn && $sgn eq '-') { + $sgn = -1; + $_ *= $sgn for $min, $sec, $frc; } else { - return $du; + $sgn = 1; } - } - # zero interval - # - elsif($string =~ m/^\@? *0+ *(ago)?$/) { - return DateTime::Duration->new( 'seconds' => 0 ); - } - - croak 'Invalid input format'; -}; + $du->add( + months => $mon, + days => $day, + minutes => $min, + seconds => $sec, + nanoseconds => $frc * DateTime::Duration::MAX_NANOSECONDS, + ); + return $ago ? $du->inverse : $du; +} *parse_interval = \&parse_duration; Index: t/parse_interval.t =================================================================== RCS file: /cvsroot/perl-date-time/modules/DateTime-Format-Pg/t/parse_interval.t,v retrieving revision 1.2 diff -u -r1.2 parse_interval.t --- t/parse_interval.t 30 May 2003 14:04:49 -0000 1.2 +++ t/parse_interval.t 6 Jan 2006 23:19:08 -0000 @@ -1,39 +1,91 @@ # $Id: parse_interval.t,v 1.2 2003/05/30 14:04:49 cfaerber Exp $ -use Test::More tests => 8; -use DateTime::Format::Pg 0.02; +use strict; +use Test::More tests => 30; +use DateTime; +use DateTime::Duration; +use Data::Dumper; -my @results = ( - { 'days' => -1 }, - { 'minutes' => -(23*60+59) }, - { 'days' => -1, 'minutes' => -1 }, - { 'months' => 1, 'days' => -1 }, -); - -my %tests = ( - '-1 days' => $results[0], - '-23:59' => $results[1], - '-1 days -00:01' => $results[2], - '1 mon -1 days' => $results[3], - - '@ 1 day ago' => $results[0], - '@ 23 hours 59 mins ago' => $results[1], - '@ 1 day 1 min ago' => $results[2], - '@ 1 mon -1 days' => $results[3], -); - -foreach my $test (keys %tests) { - my $du = DateTime::Format::Pg->parse_interval($test); - is( duration_hash_to_string($du->deltas()), - duration_hash_to_string(%{$tests{$test}}) ); -} +BEGIN {use_ok 'DateTime::Format::Pg' or die }; + +for my $compare ( + [ '01:00:00' => DateTime::Duration->new( hours => 1 ) ], + [ '-08:00:00' => DateTime::Duration->new( hours => -8 ) ], + [ '-1 days' => DateTime::Duration->new(days => -1) ], + [ '-23:59' => DateTime::Duration->new(hours => -23, minutes => -59) ], + [ '-1 days -00:01' => DateTime::Duration->new( days => -1, minutes => -1) ], + [ '1 mon -1 days' => DateTime::Duration->new(months => 1)->add(days => -1) ], + [ '@ 1 mon -1 days' => DateTime::Duration->new(months => 1)->add(days => -1) ], + [ '-1 days +02:03:00' => DateTime::Duration->new(days => -1) + ->add( + hours => 2, + minutes => 3, + ) + ], + ['9 years 1 mon -12 days +13:14:00' => DateTime::Duration->new( + years => 9, + months => 1, + hours => 13, + minutes => 14, + )->add(days => -12)], + [ '@ 1 day ago' => DateTime::Duration->new( days => -1 )], + [ '@ 1 day 10 mins' => DateTime::Duration->new( days => 1, minutes => 10 )], + [ '@ 23 hours 59 mins ago' => DateTime::Duration->new( + hours => -23, + minutes => -59 + )], + [ '@ 1 day 1 min ago' => DateTime::Duration->new( days => -1, minutes => -1 )], + [ '10 days' => DateTime::Duration->new(days => 10 ) ], + [ '34 years' => DateTime::Duration->new(years => 34 )], + [ '3 mons' => DateTime::Duration->new(months => 3 )], + [ '-00:00:14' => DateTime::Duration->new(seconds => -14 )], + [ '1 day 02:03:04' => DateTime::Duration->new( + days => 1, + hours => 2, + minutes => 3, + seconds => 4, + )], + + [ '5 mons 12:00:00' => DateTime::Duration->new( months => 5, hours => 12) ], + [ '@ 1 min' => DateTime::Duration->new(minutes => 1 )], + [ '@ 5 hours' => DateTime::Duration->new( hours => 5 )], + [ '@ 34 years' => DateTime::Duration->new(years => 34 )], + [ '@ 3 mons' => DateTime::Duration->new(months => 3 )], + [ '@ 14 secs ago' => DateTime::Duration->new( seconds => -14 )], + [ '@ 1 day 2 hours 3 mins 4 secs' => DateTime::Duration->new( + days => 1, + hours => 2, + minutes => 3, + seconds => 4, + )], + + [ '@ 5 mons 12 hours' => DateTime::Duration->new( hours => 12, months => 5) ], + [ '@ 4541 years 4 mons 4 days 17 mins 31 secs' => DateTime::Duration->new( + years => 4541, + months => 4, + days => 4, + minutes => 17, + seconds => 31, + )], -# for better Test::More::is output -# -sub duration_hash_to_string { - my %hash = @_; - my @vals = (); - foreach(qw (months days minutes seconds nanoseconds)) { - push @vals, sprintf('%s=%d',$_,$hash{$_}) if $hash{$_}; - } - return join(', ',@vals); + [ '@ 6 mons 5 days 4 hours 3 mins 2 secs' => DateTime::Duration->new( + months => 6, + days => 5, + hours => 4, + minutes => 3, + seconds => 2, + )], + + [ '1 days 02:03:00 ago' => DateTime::Duration->new( + days => -1, + hours => -2, + minutes => -3, + )], + +) { + ok !DateTime::Duration->compare( + DateTime::Format::Pg->parse_duration($compare->[0]), + $compare->[1] + ), "'$compare->[0]'" + or diag Dumper {DateTime::Format::Pg->parse_duration($compare->[0])->deltas}; } +