use strict;
use warnings;
use Test::More;
use Date::Parse qw(str2time strptime);
use Date::Language;
# --- Undef / empty / garbage inputs ---
ok(!defined str2time(undef), "str2time(undef) returns undef");
ok(!defined str2time(""), "str2time('') returns undef");
ok(!defined str2time("garbage"), "str2time('garbage') returns undef");
ok(!defined str2time("not a date at all"), "str2time('not a date at all') returns undef");
# --- ISO 8601 variants ---
{
my $t1 = str2time("2002-07-22T10:00:00Z");
ok(defined $t1, "ISO 8601 with T separator and Z");
is($t1, 1027332000, "ISO 8601 basic format parses correctly");
my $t2 = str2time("2002-07-22 10:00:00Z");
is($t2, 1027332000, "ISO 8601 with space separator and Z");
my $t3 = str2time("20020722T100000Z");
is($t3, 1027332000, "ISO 8601 compact format");
my $t4 = str2time("2001-02-26T13:44:12-0700");
is($t4, 983220252, "ISO 8601 with negative offset");
my $t5 = str2time("2002-11-07T23:31:49-05:00");
is($t5, 1036729909, "RFC 3339 with colon in offset");
}
# --- AM/PM parsing ---
{
my $base = str2time("Jul 13 1999 13:23:00 GMT");
is(str2time("Jul 13 1999 1:23P GMT"), $base, "1:23P parses as PM");
is(str2time("Jul 13 1999 1:23P.M GMT"), $base, "1:23P.M parses as PM");
is(str2time("Jul 13 1999 1:23P.M. GMT"), $base, "1:23P.M. parses as PM");
my $am = str2time("92/01/02 12:01 AM");
my $pm = str2time("92/01/02 12:01 PM");
ok(defined $am && defined $pm, "AM/PM dates parse");
cmp_ok($pm - $am, '==', 12 * 3600, "PM is 12 hours after AM");
}
# --- Fractional seconds ---
{
my $t = str2time("2003-02-17T08:14:07.198189+0000");
ok(defined $t, "fractional seconds parse");
cmp_ok(abs($t - 1045469647.198189), '<', 0.001, "fractional seconds preserved");
my $t2 = str2time("1995-01-24T09:08:17.1823213");
ok(defined $t2, "high-precision fractional seconds parse");
}
# --- Apache-style dates ---
{
my $t = str2time("07/Nov/2000:16:45:56 +0100");
is($t, 973611956, "Apache log date format");
}
# --- RFC 2822 / email dates ---
{
my $t = str2time("Wed, 9 Nov 1994 09:50:32 -0500 (EST)");
is($t, 784392632, "RFC 2822 date with comment");
my $t2 = str2time("Sat, 19 Nov 1994 16:59:14 +0100");
is($t2, 785260754, "RFC 2822 date with positive offset");
}
# --- Date::Language error handling ---
{
eval { Date::Language->new('NonexistentLanguage') };
ok($@, "Date::Language->new with invalid language dies");
my $fr = Date::Language->new('French');
ok(defined $fr, "Date::Language->new('French') succeeds");
my $ts = $fr->str2time('15 janvier 2010');
ok(defined $ts, "French 'janvier' parses");
}
# --- French month parsing ---
{
my $fr = Date::Language->new('French');
my @months = (
['janvier', 1],
['mars', 3],
['juin', 6],
['octobre', 10],
['novembre', 11],
);
for my $pair (@months) {
my ($month_name, $month_num) = @$pair;
my $ts = $fr->str2time("15 $month_name 2010");
if (defined $ts) {
my @lt = localtime($ts);
is($lt[4] + 1, $month_num, "French '$month_name' -> month $month_num");
}
else {
fail("French '$month_name' failed to parse");
}
}
}
# --- Two-digit year handling ---
# Two-digit years: 69-99 -> 1969-1999, 0-68 -> 2000-2068 (POSIX convention)
{
my $t = str2time("16 Oct 09");
ok(defined $t, "two-digit year '09' parses");
cmp_ok($t, '>=', 0, "two-digit year '09' gives non-negative time");
my @gm = gmtime($t);
is($gm[5] + 1900, 2009, "two-digit year '09' maps to 2009");
}
# --- Two-digit years for 1970s/1980s dates (GH issue #47) ---
{
my $t74 = str2time("01 Jan 74 00:00:00 GMT");
ok(defined $t74, "two-digit year '74' parses");
is($t74, 126230400, "two-digit year '74' gives 1974-01-01 not 2074");
my $t73 = str2time("15 Jun 73 12:00:00 GMT");
ok(defined $t73, "two-digit year '73' parses");
my @gm73 = gmtime($t73);
is($gm73[5] + 1900, 1973, "two-digit year '73' maps to 1973");
my $t72 = str2time("01 Jan 72 00:00:00 GMT");
ok(defined $t72, "two-digit year '72' parses");
my @gm72 = gmtime($t72);
is($gm72[5] + 1900, 1972, "two-digit year '72' maps to 1972");
# Boundary: 69 -> 1969, 68 -> 2068
my $t69 = str2time("01 Jan 69 00:00:00 GMT");
ok(defined $t69, "two-digit year '69' parses");
my @gm69 = gmtime($t69);
is($gm69[5] + 1900, 1969, "two-digit year '69' maps to 1969 (boundary)");
}
# --- Time-only formats ---
{
my $t = str2time("10:00:00Z");
ok(defined $t, "time-only with Z parses");
my $t2 = str2time("10:00:00");
ok(defined $t2, "time-only without zone parses");
my $t3 = str2time("10:00");
ok(defined $t3, "time-only HH:MM parses");
}
# --- Various date separator styles ---
{
my $t1 = str2time("21 dec 17:05");
my $t2 = str2time("21-dec 17:05");
my $t3 = str2time("21/dec 17:05");
ok(defined $t1, "space-separated day month");
is($t1, $t2, "dash separator matches space separator");
is($t1, $t3, "slash separator matches space separator");
}
# --- Boost C++ timestamp format ---
{
my $t = str2time("2024-May-15 14:30:00.123456");
ok(defined $t, "boost format YYYY-Mon-DD HH:MM:SS.f parses");
}
# --- Leap day (Feb 29) handling ---
# When only a year is given, str2time fills in the current month/day.
# On Feb 29 the year must be a leap year or str2time returns undef.
# See: https://github.com/atoomic/perl-TimeDate/issues/28
{
# Explicit Feb 29 on a leap year must succeed
my $t1 = str2time("29 Feb 2000 10:02:18 GMT");
ok(defined $t1, "Feb 29 of leap year 2000 parses");
is($t1, 951818538, "Feb 29 2000 10:02:18 GMT matches expected epoch");
# Explicit Feb 29 on a non-leap year must fail
my $t2 = str2time("29 Feb 1999 10:02:18 GMT");
ok(!defined $t2, "Feb 29 of non-leap year 1999 returns undef");
}
# --- Comma as decimal separator in fractional seconds (ISO 8601) ---
{
my $dot = str2time("2016-01-28 23:27:13.995 UTC");
my $comma = str2time("2016-01-28 23:27:13,995 UTC");
ok(defined $dot, "dot decimal fractional seconds parse");
ok(defined $comma, "comma decimal fractional seconds parse");
cmp_ok(abs($dot - $comma), '<', 0.01,
"comma decimal gives same result as dot decimal");
my $t1 = str2time("2016-01-28 23:27:13,995 UTC");
my $t2 = str2time("2016-01-28 23:27:13,996 UTC");
cmp_ok($t2, '>', $t1,
"comma decimal: ,996 is later than ,995");
cmp_ok(abs($t2 - $t1 - 0.001), '<', 0.0001,
"comma decimal: difference is ~1ms");
# RFC 2822 commas still work
my $rfc = str2time("Wed, 16 Jun 94 07:29:35 CST");
is($rfc, 771773375, "RFC 2822 comma after day name still works");
}
# --- Year inference for dates without an explicit year (GH #46) ---
# When no year is given, str2time should assume the most recent occurrence:
# a date in the future (month > now, OR same month but day > today) gets
# previous year; a date in the past (or today) gets current year.
{
my @lt = localtime();
my ($cur_day, $cur_month, $cur_year) = @lt[3, 4, 5];
$cur_year += 1900;
my @mon_names = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
# A future month (strictly > current month): should infer previous year.
if ($cur_month < 11) {
my $future_mon = $mon_names[$cur_month + 1];
my $t = str2time("$future_mon 4 01:04:16");
ok(defined $t, "future month '$future_mon 4': parses");
my @res = localtime($t);
is($res[5] + 1900, $cur_year - 1,
"future month ($future_mon) → previous year (GH#46)");
}
# A past month (strictly < current month): should infer current year.
if ($cur_month > 0) {
my $past_mon = $mon_names[$cur_month - 1];
my $t = str2time("$past_mon 4 01:04:16");
ok(defined $t, "past month '$past_mon 4': parses");
my @res = localtime($t);
is($res[5] + 1900, $cur_year,
"past month ($past_mon) → current year (GH#46)");
}
# Same month, day strictly in the future → previous year.
if ($cur_day <= 27) {
my $future_day = $cur_day + 1;
my $mon = $mon_names[$cur_month];
my $t = str2time(sprintf("%s %d 01:04:16", $mon, $future_day));
ok(defined $t, "future day same month '$mon $future_day': parses");
my @res = localtime($t);
is($res[5] + 1900, $cur_year - 1,
"same month, future day ($mon $future_day) → previous year (GH#46)");
}
# Same month, day strictly in the past → current year.
if ($cur_day >= 2) {
my $past_day = $cur_day - 1;
my $mon = $mon_names[$cur_month];
my $t = str2time(sprintf("%s %d 01:04:16", $mon, $past_day));
ok(defined $t, "past day same month '$mon $past_day': parses");
my @res = localtime($t);
is($res[5] + 1900, $cur_year,
"same month, past day ($mon $past_day) → current year (GH#46)");
}
}
done_testing;