Skip Menu |
 

This queue is for tickets about the TimeDate CPAN distribution.

Report information
The Basics
Id: 53413
Status: open
Priority: 0/
Queue: TimeDate

People
Owner: Nobody in particular
Requestors: stephen [...] enterity.com
Cc: FULLERMD [...] cpan.org
AdminCc:

Bug Information
Severity: Important
Broken in: 1.20
Fixed in: (no value)



Subject: Date:Parse mangling 4-digit year dates
strptime subtracts 1900 from 4 digit dates.  My problem arose from trying to set a date with a year of 1924 kept coming out as 2024.  When I removed this line the problem goes away.  I think it's because 2-digit years are treated on a rolling basis under timelocal.

This is in version 2.27 of Date::Parse, but appears to remain present in 2.30
Subject: Re: [rt.cpan.org #53413] Date:Parse mangling 4-digit year dates
Date: Tue, 5 Jan 2010 18:55:08 -0600
To: bug-TimeDate [...] rt.cpan.org
From: Graham Barr <gbarr [...] pobox.com>
Download (untitled) / with headers
text/plain 282b
strptime returns year as an offset from 1900, just as localtime does perl -Ilib -MDate::Parse -le '$,=" "; my $t = localtime(time); print $t; print localtime(time); print strptime($t);' Tue Jan 5 18:53:26 2010 26 53 18 5 0 110 2 4 0 26 53 18 5 0 110 this is not a bug Graham.
Download (untitled) / with headers
text/plain 145b
Looks like this ticket could be closed, right? Just so as not to have people like me getting shocked at seeing 6yo "Important" bugs still open :)
Download (untitled) / with headers
text/plain 199b
Show quoted text
> this is not a bug
I'm pretty sure it is, since str2time() internally uses strptime(), which means it currently fails badly on dates 1966 and before. This is also the meat of bug 84075, bug 105031
Download (untitled) / with headers
text/plain 678b
On Tue Jan 05 19:55:34 2010, gbarr@pobox.com wrote: Show quoted text
> strptime returns year as an offset from 1900, just as localtime does
... Show quoted text
> this is not a bug
Hi Graham, The bug is not in strptime(), but in str2time(), where it calls Time::Local::timegm (or timelocal), passing the year returned by strptime without compensating for Time::Local's non-standard fiddling of 2-digit years. Time::Local::timegm will change a 2-digit year to simulate human behavior, which is wrong in this case. You need to ALWAYS pass a 4-digit year to Time::Local::timegm (or timelocal) to prevent mis-behavior. In your case, I think that means adding 1900 to the year returned by strptime(). Cheers.
Attached is a patch which fixes this bug. Graham, would you please review it? Thanks very much.
Subject: dateparse_patch.txt
Download dateparse_patch.txt
text/plain 12.7k

Message body is not shown because it is too large.

Download (untitled) / with headers
text/plain 122b
Ignore that, something horrible filled the patch file with binary junk... I'll attach a good patch momentarily (sorry!)
Download (untitled) / with headers
text/plain 185b
Ok, here is a good patch (attached). The previous one was messed up because a vim temporary file was present in the new hierarchy. I'll also attach a demo script which shows the bug.
Subject: tester.pl
Download tester.pl
text/x-perl 627b
#!/usr/bin/perl use strict; use warnings; # Tester for Date::Parse bug causing certain years to be off by 100 use lib '/tmp/new'; # Load the new version use Carp; use POSIX qw(strftime); use Time::Local qw(timegm timegm); use Date::Parse qw(str2time); my $bugs=0; my %seen; for my $yyyy (1967..1975, 2066..2075) { my $str = "Jan 1, $yyyy"; my $t = str2time($str); my ($ss,$mm,$hh,$day,$mday,$year) = gmtime($t); print "str2time('$str') = $t ; gmtime returns ($ss,$mm,$hh,$day,$mday,$year)\n"; if ($seen{$t}++) { print " ** DUPLICATE **\n"; $bugs++; } } print("Bugs found\n"),exit(1) if $bugs; exit 0;
Subject: patchtry2.txt
Download patchtry2.txt
text/plain 842b
diff -Naur /usr/share/perl5/Date/Parse.pm /tmp/new/Date/Parse.pm --- /usr/share/perl5/Date/Parse.pm 2014-04-26 01:05:35.000000000 -0700 +++ /tmp/new/Date/Parse.pm 2018-12-29 14:27:26.030661550 -0800 @@ -261,7 +261,8 @@ if (defined $zone) { $result = eval { local $SIG{__DIE__} = sub {}; # Ick! - timegm($ss,$mm,$hh,$day,$month,$year); + # Prevent Time::Local::timegm fiddling with certain 2-digit years + timegm($ss,$mm,$hh,$day,$month,1900+$year); }; return undef if !defined $result @@ -273,7 +274,8 @@ else { $result = eval { local $SIG{__DIE__} = sub {}; # Ick! - timelocal($ss,$mm,$hh,$day,$month,$year); + # Prevent Time::Local::timelocal fiddling with certain 2-digit years + timelocal($ss,$mm,$hh,$day,$month,1900+$year); }; return undef if !defined $result
Download (untitled) / with headers
text/plain 426b
Ok, that patch did not handle years down to 1901. Attached is a new patch, and a proper test script. Currently strptime() does not actually return year-1900 for dates prior to January 1, 1901. I'm guessing this is because some code somewhere can not handle zero or negative "year" values (i.e. -1 for the year 1899). The new patch has to take that into account, and the corresponding test cases are "skipped". Best, -Jim
Subject: patch3.txt
Download patch3.txt
text/plain 1.2k
diff -Naur /usr/share/perl5/Date/Parse.pm /tmp/new/Date/Parse.pm --- /usr/share/perl5/Date/Parse.pm 2014-04-26 01:05:35.000000000 -0700 +++ /tmp/new/Date/Parse.pm 2018-12-29 17:52:24.402900266 -0800 @@ -252,6 +252,14 @@ $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5] unless(defined $year); + # Must use 4-digit year with Time::Local::timegm to prevent fiddling. + # + # However, currently strptime() actually returns the full year, not + # year-1900, for years before 1901. In other words, it never returns zero or + # a negative value. If strptime() is someday changed to return zero/neg + # values then this should be changed to $yyyy = $year+1900 always. + my $yyyy = $year < 1900 ? $year+1900 : $year; + return undef unless($month <= 11 && $day >= 1 && $day <= 31 && $hh <= 23 && $mm <= 59 && $ss <= 59); @@ -261,7 +269,7 @@ if (defined $zone) { $result = eval { local $SIG{__DIE__} = sub {}; # Ick! - timegm($ss,$mm,$hh,$day,$month,$year); + timegm($ss,$mm,$hh,$day,$month,$yyyy); }; return undef if !defined $result @@ -273,7 +281,7 @@ else { $result = eval { local $SIG{__DIE__} = sub {}; # Ick! - timelocal($ss,$mm,$hh,$day,$month,$year); + timelocal($ss,$mm,$hh,$day,$month,$yyyy); }; return undef if !defined $result
Subject: ym1900bug.t
Download ym1900bug.t
text/x-perl 2.4k
#!/usr/bin/perl use strict; use warnings; use feature qw(state say); use Test::More tests => 3; # Tester for Date::Parse bug which caused certain years to be off by 100 ## FIXME use lib '/tmp/new'; # point to the patched version use Date::Parse qw(str2time); use POSIX qw(strftime); use Time::Local qw(timegm timegm); my $maxerrs = 10; my $fmt = "%Y-%m-%dT%H:%M:%SZ"; # ISO-8801 sub test($$$$$$$;$) { my ($seenhash, $isec, $imin, $ihr, $imday, $imon, $iyear, $verbose) = @_; my $bugs = 0; my $str = POSIX::strftime($fmt, $isec,$imin,$ihr,$imday,$imon,$iyear-1900); my $t = str2time($str,0); return(0) unless defined $t; # if it knows it can't handle it, that's ok if ($seenhash->{$t}) { diag("str2time produced the same result ($t) for\n", " $seenhash->{$t} and\n", " $str\n"); $bugs++; } $seenhash->{$t} = $str; my ($sec,$min,$hr,$mday,$mon,$yminus1900) = gmtime($t); my $str2 = POSIX::strftime($fmt, $sec,$min,$hr,$mday,$mon,$yminus1900); if ($str ne $str2) { diag("str2time('$str',0)=$t and gmtime(...)=($sec,$min,$hr,$mday,$mon,$yminus1900);\n", " but strftime(...) = '$str2'\n"); $bugs++; } print "## strftime($isec, $imin, $ihr, $imday, $imon, $iyear-1900=",$iyear-1900,")=$str\n", "## str2time(...,0) = $t ; gmtime(t)=($sec,$min,$hr,$mday,$mon,$yminus1900)\n" if $verbose; $bugs } sub flatten($) { ref($_[0]) ? @{$_[0]} : ($_[0]) } sub test_combos($$$$$$;$) { my ($asec, $amin, $ahr, $amday, $amon, $ayear, $verbose) = @_; my %seen; my $count = 0; my $bugs = 0; foreach my $isec (flatten $asec) { foreach my $imin (flatten $amin) { foreach my $ihr (flatten $ahr) { foreach my $imday (flatten $amday) { foreach my $imon (flatten $amon) { foreach my $iyear (flatten $ayear) { $count++; $bugs += test(\%seen,$isec,$imin,$ihr,$imday,$imon,$iyear,$verbose); die "too many errors" if $bugs > $maxerrs; } } } } } } ok($bugs==0, "Test $count combinations"); } #test_combos(0,0,0,01,0, [1901],1); #test_combos(0,0,0,01,0, [1900],1); #test_combos(0,0,0,01,0, [2900],1); # Some of these cases failed before the patch test_combos(13,12,11,01,0, [1967..1975, 2066..2075]); # Now a more exhaustive sequence test_combos(13,12,11,31,11, [1901..3799]); SKIP: { skip "because strptime() does not currently handle years < 1901 (it can not return negative year)",1; test_combos(13,12,11,31,11, [1..1900]); }


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.