From 91ad94b9333781cc2c25be8df24f091bf06dfab1 Mon Sep 17 00:00:00 2001 From: Jan Wielemaker Date: Sun, 29 Sep 2024 11:43:12 +0200 Subject: [PATCH] MODIFIED: parse_time/2,3: interpret missing timezone as local time. This patch fixes parsing ``YYYY-MM``, which used to be a day too early. --- library/date.pl | 148 ++++++++++++++++++--------------- src/Tests/library/test_date.pl | 2 +- 2 files changed, 83 insertions(+), 67 deletions(-) diff --git a/library/date.pl b/library/date.pl index 14f221ce74..accaa2c64a 100644 --- a/library/date.pl +++ b/library/date.pl @@ -3,7 +3,8 @@ Author: Jan Wielemaker and Willem Robert van Hage E-mail: wielemak@science.uva.nl WWW: http://www.swi-prolog.org - Copyright (c) 2006-2014, University of Amsterdam + Copyright (c) 2006-2024, University of Amsterdam + SWI-Prolog Solutions b.v. All rights reserved. Redistribution and use in source and binary forms, with or without @@ -82,12 +83,25 @@ % % Fri, 08 Dec 2006 15:29:44 GMT % +% All components except for the time zone are obligatory. +% If the time zone is omitted, the time is interpreted as +% _local time_. +% % * iso_8601 % Commonly used in XML documents. Actually the XML RFC3339 % is a _profile_ of ISO8601. For example % % 2006-12-08T15:29:44Z % +% The ISO8601 format allows removing components from the +% right, returning the lowest time stamp in the specified +% internal. If a time is specified but no time zone, the +% time stamp is computed for the _local time_. If only +% the date components are specified, the stamp uses UTC. +% To compute the start of a day in local time, use +% e.g. ``2006-12-08T00``. +% +% @arg Text is an atom, string or list of character _codes_. % @see xsd_time_string/3 from library(sgml) implements RFC3339 % strictly. @@ -95,101 +109,103 @@ parse_time(Text, _Format, Stamp). parse_time(Text, Format, Stamp) :- - atom_codes(Text, Codes), + to_codes(Text, Codes), phrase(date(Format, Y,Mon,D,H,Min,S,UTCOffset), Codes), !, - date_time_stamp(date(Y,Mon,D,H,Min,S,UTCOffset,-,-), Stamp). - -date(iso_8601, Yr, Mon, D, H, Min, S, 0) --> % BC - "-", date(iso_8601, Y, Mon, D, H, Min, S, 0), + tz_dst(time(H,Min,S), UTCOffset, TZ, DST), + date_time_stamp(date(Y,Mon,D,H,Min,S,UTCOffset,TZ,DST), Stamp). + +to_codes(In, Codes) :- + ( is_list(In) + -> Codes = In + ; atom_codes(In, Codes) + ). + +tz_dst(_Time, UTCOffset, TZ, DST), nonvar(UTCOffset) => + TZ = (-), DST = (-). +tz_dst(time(H,M,S), UTCOffset, TZ, DST), var(H), var(M), var(S) => + UTCOffset = 0, TZ = (-), DST = (-). +tz_dst(_, _, _, _) => + true. + +date(iso_8601, Yr, Mon, D, H, Min, S, UTCOffset) --> % BC + "-", date(iso_8601, Y, Mon, D, H, Min, S, UTCOffset), { Yr is -1 * Y }. -date(iso_8601, Y, Mon, D, H, Min, S, 0) --> +date(iso_8601, Y, Mon, D, H, Min, S, UTCOffset) --> year(Y), - iso_8601_rest(Y, Mon, D, H, Min, S). -date(rfc_1123, Y, Mon, D, Hr, Min, Sec, 0) --> % RFC 1123: "Fri, 08 Dec 2006 15:29:44 GMT" - day_name(_), ", ", ws, + iso_8601_rest(Y, Mon, D, H, Min, S, UTCOffset). +date(rfc_1123, Y, Mon, D, H, M, S, UTCOffset) --> + day_name(_), ", ", ws, % RFC 1123: "Fri, 08 Dec 2006 15:29:44 GMT" day_of_the_month(D), ws, month_name(Mon), ws, year(Y), ws, hour(H), ":", minute(M), ":", second(S), ws, - timezone(DH, DM, DS), - { Hr is H + DH, Min is M + DM, Sec is S + DS }. - + timezone(UTCOffset). -%! iso_8601_rest(+Year:int, -Mon, -Day, -H, -M, -S) +%! iso_8601_rest(+Year:int, -Mon, -Day, -H, -M, -S, -UTCOffset) % % Process ISO 8601 time-values after parsing the 4-digit year. -iso_8601_rest(_, Mon, D, H, Min, S) --> +iso_8601_rest(_, Mon, D, H, Min, S, UTCOffset) --> "-", month(Mon), "-", day(D), - opt_time(H, Min, S). -iso_8601_rest(_, Mon, 0, 0, 0, 0) --> + opt_time(H, Min, S, UTCOffset). +iso_8601_rest(_, Mon, _, _, _, _, _) --> "-", month(Mon). -iso_8601_rest(_, Mon, D, H, Min, S) --> +iso_8601_rest(_, Mon, D, H, Min, S, UTCOffset) --> month(Mon), day(D), - opt_time(H, Min, S). -iso_8601_rest(_, 1, D, H, Min, S) --> + opt_time(H, Min, S, UTCOffset). +iso_8601_rest(_, 1, D, H, Min, S, UTCOffset) --> "-", ordinal(D), - opt_time(H, Min, S). -iso_8601_rest(Yr, 1, D, H, Min, S) --> + opt_time(H, Min, S, UTCOffset). +iso_8601_rest(Yr, 1, D, H, Min, S, UTCOffset) --> "-W", week(W), "-", day_of_the_week(DW), - opt_time(H, Min, S), + opt_time(H, Min, S, UTCOffset), { week_ordinal(Yr, W, DW, D) }. -iso_8601_rest(Yr, 1, D, H, Min, S) --> +iso_8601_rest(Yr, 1, D, H, Min, S, UTCOffset) --> "W", week(W), day_of_the_week(DW), - opt_time(H, Min, S), + opt_time(H, Min, S, UTCOffset), { week_ordinal(Yr, W, DW, D) }. -iso_8601_rest(Yr, 1, D, 0, 0, 0) --> +iso_8601_rest(Yr, 1, D, _, _, _, _) --> "W", week(W), { week_ordinal(Yr, W, 1, D) }. -opt_time(Hr, Min, Sec) --> - ("T";" "), !, iso_time(Hr, Min, Sec). -opt_time(0, 0, 0) --> "". +opt_time(Hr, Min, Sec, UTCOffset) --> + ("T";" "), !, iso_time(Hr, Min, Sec), timezone(UTCOffset). +opt_time(_H, _M, _S, _UTCOffset) --> "". % TIMEX2 ISO: "2006-12-08T15:29:44 UTC" or "20061208T" -iso_time(Hr, Min, Sec) --> - hour(H), ":", minute(M), ":", second(S), - timezone(DH, DM, DS), - { Hr is H + DH, Min is M + DM, Sec is S + DS }. -iso_time(Hr, Min, Sec) --> - hour(H), ":", minute(M), - timezone(DH, DM, DS), - { Hr is H + DH, Min is M + DM, Sec is DS }. -iso_time(Hr, Min, Sec) --> - hour(H), minute(M), second(S), - timezone(DH, DM, DS), - { Hr is H + DH, Min is M + DM, Sec is S + DS }. -iso_time(Hr, Min, Sec) --> - hour(H), minute(M), - timezone(DH, DM, DS), - { Hr is H + DH, Min is M + DM, Sec is DS }. -iso_time(Hr, Min, Sec) --> - hour(H), - timezone(DH, DM, DS), - { Hr is H + DH, Min is DM, Sec is DS }. +iso_time(H, M, S) --> + hour(H), ":", minute(M), ":", second(S). +iso_time(H, M, _) --> + hour(H), ":", minute(M). +iso_time(H, M, S) --> + hour(H), minute(M), second(S). +iso_time(H, M, _) --> + hour(H), minute(M). +iso_time(H, _, _) --> + hour(H). % FIXME: deal with leap seconds -timezone(Hr, Min, 0) --> - "+", hour(H), ":", minute(M), { Hr is -1 * H, Min is -1 * M }. -timezone(Hr, Min, 0) --> - "+", hour(H), minute(M), { Hr is -1 * H, Min is -1 * M }. -timezone(Hr, 0, 0) --> - "+", hour(H), { Hr is -1 * H }. -timezone(Hr, Min, 0) --> - "-", hour(H), ":", minute(M), { Hr is H, Min is M }. -timezone(Hr, Min, 0) --> - "-", hour(H), minute(M), { Hr is H, Min is M }. -timezone(Hr, 0, 0) --> - "-", hour(H), { Hr is H }. -timezone(0, 0, 0) --> +timezone(UTCOffset) --> + "+", hour(H), ":", minute(M), { UTCOffset is -(H*3600+M*60) }. +timezone(UTCOffset) --> + "+", hour(H), minute(M), { UTCOffset is -(H*3600+M*60) }. +timezone(UTCOffset) --> + "+", hour(H), { UTCOffset is -(H*3600) }. +timezone(UTCOffset) --> + "-", hour(H), ":", minute(M), { UTCOffset is H*3600+M*60 }. +timezone(UTCOffset) --> + "-", hour(H), minute(M), { UTCOffset is H*3600+M*60 }. +timezone(UTCOffset) --> + "-", hour(H), { UTCOffset is H*3600 }. +timezone(0) --> "Z". -timezone(0, 0, 0) --> +timezone(0) --> ws, "UTC". -timezone(0, 0, 0) --> - ws, "GMT". % remove this? -timezone(0, 0, 0) --> +timezone(0) --> + ws, "GMT". +timezone(_) --> % unknown []. day_name(0) --> "Sun". diff --git a/src/Tests/library/test_date.pl b/src/Tests/library/test_date.pl index 1770f99f19..9f15784155 100644 --- a/src/Tests/library/test_date.pl +++ b/src/Tests/library/test_date.pl @@ -219,7 +219,7 @@ parse_time('2006-12-08', iso_8601, T). test(iso_8601, T =:= 1165536000) :- parse_time('20061208', iso_8601, T). -test(iso_8601, T =:= 1164844800) :- +test(iso_8601, T =:= 1164931200) :- parse_time('2006-12', iso_8601, T). test(iso_8601, T =:= 1165536000) :- parse_time('2006-W49-5', iso_8601, T).