Dates

This module provides minimal date time records and procedures for working with dates in YYYY-MM-DD and MM/DD/YYYY format and times in H:MM, HH:MM and HH:MM:SS formats.

Set
Set a DateTime record providing year, month, day, hour, minute and second as integers and the DateTime record to be populated.
SetDate
Set the date portion of a DateTime record, leaves the hour, minute and second attributes unmodified.
SetTime
Set the time portion of a DateTime record, leaves the year, month, date attributes unmodified.
Copy
Copy the attributes of one DateTime record into another DateTime record
ToChars
Given a DateTime record and a format constant, render the DateTime record to an array of CHAR.
LeapYear
Given a DateTime record check to see if it is a leap year.
NumOfDays
Given a year and monoth return the number of days in the month.
IsValid
Check to see if the all attributes in a DateTime record are valid.
OberonToDateTime
Convert oberon date and time integer values into a DateTime record
DateTimeToOberon
Convert a DateTime record into Oberon date and time integer values.
Now
Set a DateTime record’s attributes to the current time, depends of on the implementation of Clock.Mod.
WeekDate
Given a DateTime record calculates the year, week and weekday as integers values.
Equal
Checks to DateTime records to see if they have equivalent attribute values.
Compare
Compare two DateTime records, if t1 < t2 then return -1, if t1 = t2 return 0 else if t1 > t2 return 1.
CompareDate
Compare the year, month, day attributes of two DateTime records following the approach used in Compare.
CompareTime
Compare the hour, minute, second attributes of two DateTime records following the approach used in Compare.
TimeDifference
Take the differ of two DateTime records setting the difference in integer values for days, hours, minutes and seconds.
AddYears
Add years to a DateTime record. Years is a positive or negative integer.
AddMonths
Add months to a DateTime record. Months is either a positive or negative integer. Months will propogate to year in the DataTime record.
AddDays
Add days to a DateTime record. Days can be either a positive or negative integer. Days will propogate to month and year attributes of the DateTime record.
AddHours
Add hours to a DateTime record. Hours can be either a positive or negative integer. Hours will propogate to day, month and year attributes of the DateTime record.
AddMinutes
Add minutes to a DateTime record. Minutes can be either a positive or negative integer. Minutes will propogate to hour, day, month and year attributes of the DateTime record.
AddSeconds
Add seconds to a DateTime record. Seconds can be either a positive or negatice integer. Seconds will propogate to minute, hour, day, month, year attributes of the DateTime record.
IsValidDate
IsValidDate checks the day, month, year attributes of a DateTime record and validates the values. Returns TRUE if everthing is ok, FALSE otherwise.
IsValidTime
IsValidTime checks the hour, minute, second attributes of a DateTime record and validates the values. Returns TRUE if everthing is ok, FALSE otherwise.
IsDateString
Checks to see if an ARRAY OF CHAR is a parsiable date string (e.g. in 2020-11-26 or 11/26/2020). Returns TRUE if the string is parsable, FALSE otherwise. NOTE: It does NOT check to see if the day, month or year values are valid. It only checks the format of the string.
IsTimeString
Checks to see if an ARRAY OF CHAR is a parsible time string (e.g. 3:32, 14:55, 09:19:22). NOTE: It only checks the format and does not check the hour, minute and second values.
ParseDate
Parse an ARRAY OF CHAR setting the values if year, month and day. Return TRUE on successful parse and FALSE otherwise.
ParseTime
Parse an ARRAY OF CHAR setting the values of hour, minute and second. Return TRUE on succesful parse and FALSE otherwise.
Parse
Parse an ARRAY OF CHAR setting the attributes of a DateTime record. Return TURE on success, FALSE otherwise.

Limitations

Dates are presumed to be in the YYYY-DD-MM or MM/DD/YYYY formats. Does not handle dates with spelled out months or weekdays.

Time portion of the date object doesn’t include time zone. This will need to be rectified at some point.

Source code for Dates.Mod

  1. (* Dates -- this module was inspired by the A2's Dates module, adapted
  2.    for Oberon-07 and a POSIX system. It provides an assortment of procedures
  3.    for working with a simple datetime record.
  5. Copyright (C) 2020 R. S. Doiel
  7. This program is free software: you can redistribute it and/or modify
  8. it under the terms of the GNU Affero General Public License as
  9. published by the Free Software Foundation, either version 3 of the
  10. License, or (at your option) any later version.
  12. This program is distributed in the hope that it will be useful,
  13. but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. GNU Affero General Public License for more details.
  17. You should have received a copy of the GNU Affero General Public License
  18. along with this program.  If not, see <https://www.gnu.org/licenses/>.
  21. @Author R. S. Doiel, <rsdoiel@gmail.com>
  22. copyright (c) 2020, all rights reserved.
  23. This software is released under the GNU AGPL
  24. See http://www.gnu.org/licenses/agpl-3.0.html
  25. *)
  26. MODULE Dates;
  27. IMPORT Chars, Strings, Clock, Convert := extConvert; (*, Out; **)
  29. CONST
  30.     MAXSTR = Chars.MAXSTR;
  31.     SHORTSTR = Chars.SHORTSTR;
  33.     YYYYMMDD* = 1; (* YYYY-MM-DD format *)
  34.     MMDDYYYY* = 2; (* MM/DD/YYYY format *)
  35.     YYYYMMDDHHMMSS* = 3; (* YYYY-MM-DD HH:MM:SS format *)
  37. TYPE
  38.     DateTime* = RECORD
  39.         year*, month*, day*, hour*, minute*, second* : INTEGER
  40.     END;
  42. VAR
  43.     (* Month names, January = 0, December = 11 *)
  44.     Months*: ARRAY 23 OF ARRAY 10 OF CHAR; 
  45.     (* Days of week, Monday = 0, Sunday = 6 *)
  46.     Days*: ARRAY 7 OF ARRAY 10 OF CHAR;
  47.     DaysInMonth: ARRAY 12 OF INTEGER;
  50. (* Set -- initialize a date record year, month and day values *)
  51. PROCEDURE Set*(year, month, day, hour, minute, second : INTEGER; VAR dt: DateTime);
  52. BEGIN
  53.     dt.year := year;
  54.     dt.month := month;
  55.     dt.day := day;
  56.     dt.hour := hour;
  57.     dt.minute := minute;
  58.     dt.second := second;
  59. END Set;
  61. (* SetDate -- set a Date record's year, month and day attributes *)
  62. PROCEDURE SetDate*(year, month, day : INTEGER; VAR dt: DateTime);
  63. BEGIN
  64.     dt.year := year;
  65.     dt.month := month;
  66.     dt.day := day;
  67. END SetDate;
  69. (* SetTime -- set a Date record's hour, minute, second attributes *)
  70. PROCEDURE SetTime*(hour, minute, second : INTEGER; VAR dt: DateTime);
  71. BEGIN
  72.     dt.hour := hour;
  73.     dt.minute := minute;
  74.     dt.second := second;
  75. END SetTime;
  77. (* Copy -- copy the values from one date record to another *)
  78. PROCEDURE Copy*(src : DateTime; VAR dest : DateTime);
  79. BEGIN
  80.     dest.year := src.year;
  81.     dest.month := src.month;
  82.     dest.day := src.day;
  83.     dest.hour := src.hour;
  84.     dest.minute := src.minute;
  85.     dest.second := src.second;
  86. END Copy;
  88. (* ToChars -- converts a date record into an array of chars using
  89. the format constant. Formats supported are YYYY-MM-DD HH:MM:SS
  90. or MM/DD/YYYY HH:MM:SS. *)
  91. PROCEDURE ToChars*(dt: DateTime; fmt : INTEGER; VAR src : ARRAY OF CHAR);
  92. VAR ok : BOOLEAN;
  93. BEGIN
  94.     Chars.Clear(src);
  95.     IF fmt = YYYYMMDD THEN
  96.         Chars.AppendInt(dt.year, 4, "0", src);
  97.         ok := Chars.AppendChar("-", src);
  98.         Chars.AppendInt(dt.month, 2, "0", src);
  99.         ok := Chars.AppendChar("-", src);
  100.         Chars.AppendInt(dt.day, 2, "0", src);
  101.     ELSIF fmt = MMDDYYYY THEN
  102.         Chars.AppendInt(dt.month, 2, "0", src);
  103.         ok := Chars.AppendChar("/", src);
  104.         Chars.AppendInt(dt.day, 2, "0", src);
  105.         ok := Chars.AppendChar("/", src);
  106.         Chars.AppendInt(dt.year, 4, "0", src);
  107.     ELSIF fmt = YYYYMMDDHHMMSS THEN
  108.         Chars.AppendInt(dt.year, 4, "0", src);
  109.         ok := Chars.AppendChar("-", src);
  110.         Chars.AppendInt(dt.month, 2, "0", src);
  111.         ok := Chars.AppendChar("-", src);
  112.         Chars.AppendInt(dt.day, 2, "0", src);
  113.         ok := Chars.AppendChar(" ", src);
  114.         Chars.AppendInt(dt.hour, 2, "0", src);
  115.         ok := Chars.AppendChar(":", src);
  116.         Chars.AppendInt(dt.minute, 2, "0", src);
  117.         ok := Chars.AppendChar(":", src);
  118.         Chars.AppendInt(dt.second, 2, "0", src);
  119.     END;
  120. END ToChars;
  122. (* 
  123.  * Date and Time functions very much inspired by A2 but
  124.  * adapted for use in Oberon-07 and OBNC compiler.
  125.  *)
  127. (* LeapYear -- returns TRUE if 'year' is a leap year *)
  128. PROCEDURE LeapYear*(year: INTEGER): BOOLEAN;
  129. BEGIN
  130.     RETURN (year > 0) & (year MOD 4 = 0) & (~(year MOD 100 = 0) OR (year MOD 400 = 0))
  131. END LeapYear;
  133. (* NumOfDays -- number of days, returns the number of days in that month *)
  134. PROCEDURE NumOfDays*(year, month: INTEGER): INTEGER;
  135. VAR result : INTEGER;
  136. BEGIN
  137.     result := 0;
  138.     DEC(month);
  139.     IF ((month >= 0) & (month < 12)) THEN
  140.         IF (month = 1) & LeapYear(year) THEN 
  141.             result := DaysInMonth[1]+1;
  142.         ELSE 
  143.             result := DaysInMonth[month];
  144.         END;
  145.     END;
  146.     RETURN result
  147. END NumOfDays;
  149. (* IsValid -- checks if the attributes set in a DateTime record are valid *)
  150. PROCEDURE IsValid*(dt: DateTime): BOOLEAN;
  151. BEGIN
  152.     RETURN ((dt.year > 0) & (dt.month > 0) & (dt.month <= 12) & (dt.day > 0) & (dt.day <= NumOfDays(dt.year, dt.month)) & (dt.hour >= 0) & (dt.hour < 24) & (dt.minute >= 0) & (dt.minute < 60) & (dt.second >= 0) & (dt.second < 60))
  153. END IsValid;
  155. (* IsValidDate -- checks to see if a datetime record has valid day, month and year
  156. attributes *)
  157. PROCEDURE IsValidDate*(dt: DateTime) : BOOLEAN;
  158. BEGIN
  159.     RETURN (dt.year > 0) & (dt.month > 0) & (dt.month <= 12) & (dt.day > 0) & (dt.day <= NumOfDays(dt.year, dt.month))
  160. END IsValidDate;
  162. (* IsValidTime -- checks if the hour, minute, second attributes set in a DateTime record are valid *)
  163. PROCEDURE IsValidTime*(dt: DateTime): BOOLEAN;
  164. BEGIN
  165.     RETURN (dt.hour >= 0) & (dt.hour < 24) & (dt.minute >= 0) & (dt.minute < 60) & (dt.second >= 0) & (dt.second < 60)
  166. END IsValidTime;
  169. (* OberonToDateTime -- convert an Oberon date/time to a DateTime 
  170. structure *)
  171. PROCEDURE OberonToDateTime*(Date, Time: INTEGER; VAR dt : DateTime);
  172. BEGIN
  173.     dt.second := Time MOD 64; Time := Time DIV 64;
  174.     dt.minute := Time MOD 64; Time := Time DIV 64;
  175.     dt.hour := Time MOD 24;
  176.     dt.day := Date MOD 32; Date := Date DIV 32;
  177.     dt.month := (Date MOD 16) + 1; Date := Date DIV 16;
  178.     dt.year := Date;
  179. END OberonToDateTime;
  181. (* DateTimeToOberon -- convert a DateTime structure to an Oberon 
  182. date/time *)
  183. PROCEDURE DateTimeToOberon*(dt: DateTime; VAR date, time: INTEGER);
  184. BEGIN
  185.     IF IsValid(dt) THEN
  186.     date := (dt.year)*512 + dt.month*32 + dt.day;
  187.     time := dt.hour*4096 + dt.minute*64 + dt.second
  188.     ELSE
  189.         date := 0;
  190.         time := 0;
  191.     END;
  192. END DateTimeToOberon;
  194. (* Now -- returns the current date and time as a DateTime record. *)
  195. PROCEDURE Now*(VAR dt: DateTime);
  196. VAR d, t: INTEGER;
  197. BEGIN
  198.     Clock.Get(t, d);
  199.     OberonToDateTime(d, t, dt);
  200. END Now;
  203. (* WeekDate -- returns the ISO 8601 year number, week number &
  204. week day (Monday=1, ....Sunday=7) 
  205. Algorithm is by Rick McCarty, http://personal.ecu.edu/mccartyr/ISOwdALG.txt
  206. *)
  207. PROCEDURE WeekDate*(dt: DateTime; VAR year, week, weekday: INTEGER);
  208. VAR doy, i, yy, c, g, jan1: INTEGER; leap: BOOLEAN;
  209. BEGIN
  210.     IF IsValid(dt) THEN
  211.         leap := LeapYear(dt.year);
  212.         doy := dt.day; i := 0;
  213.         WHILE (i < (dt.month - 1)) DO 
  214.             doy := doy + DaysInMonth[i];
  215.             INC(i);
  216.         END;
  217.         IF leap & (dt.month > 2) THEN 
  218.             INC(doy);
  219.         END;
  220.         yy := (dt.year - 1) MOD 100; 
  221.         c := (dt.year - 1) - yy; 
  222.         g := (yy + yy) DIV 4;
  223.         jan1 := 1 + (((((c DIV 100) MOD 4) * 5) + g) MOD 7);
  225.         weekday := 1 + (((doy + (jan1 - 1)) - 1) MOD 7);
  227.         IF (doy <= (8 - jan1)) & (jan1 > 4) THEN (* falls in year-1 ? *)
  228.             year := dt.year - 1;
  229.             IF (jan1 = 5) OR ((jan1 = 6) & LeapYear(year)) THEN 
  230.                 week := 53;
  231.             ELSE 
  232.                 week := 52;
  233.             END;
  234.         ELSE
  235.             IF leap THEN 
  236.                 i := 366;
  237.             ELSE 
  238.                 i := 365;
  239.             END;
  240.             IF ((i - doy) < (4 - weekday)) THEN
  241.                 year := dt.year + 1;
  242.                 week := 1;
  243.             ELSE
  244.                 year := dt.year;
  245.                 i := doy + (7-weekday) + (jan1-1);
  246.                 week := i DIV 7;
  247.                 IF (jan1 > 4) THEN 
  248.                     DEC(week);
  249.                 END;
  250.             END;
  251.         END;
  252.     ELSE
  253.         year := -1; week := -1; weekday := -1;
  254.     END;
  255. END WeekDate;
  257. (* Equal -- compare to date records to see if they are equal values *)
  258. PROCEDURE Equal*(t1, t2: DateTime) : BOOLEAN;
  259. BEGIN
  260.     RETURN ((t1.second = t2.second) & (t1.minute = t2.minute) & (t1.hour = t2.hour) & (t1.day = t2.day) & (t1.month = t2.month) & (t1.year = t2.year))
  261. END Equal;
  263. (* compare -- used in Compare only for comparing specific values,
  264.     returning an appropriate -1, 0, 1 *)
  265. PROCEDURE compare(t1, t2 : INTEGER) : INTEGER;
  266. VAR result : INTEGER;
  267. BEGIN
  268.     IF (t1 < t2) THEN 
  269.         result := -1;
  270.     ELSIF (t1 > t2) THEN 
  271.         result := 1;
  272.     ELSE 
  273.         result := 0;
  274.     END;
  275.     RETURN result
  276. END compare;
  278. (* Compare -- returns -1 if (t1 < t2), 0 if (t1 = t2) or 1 if (t1 >  t2) *)
  279. PROCEDURE Compare*(t1, t2: DateTime) : INTEGER;
  280. VAR result : INTEGER;
  281. BEGIN
  282.     result := compare(t1.year, t2.year);
  283.     IF (result = 0) THEN
  284.         result := compare(t1.month, t2.month);
  285.         IF (result = 0) THEN
  286.             result := compare(t1.day, t2.day);
  287.             IF (result = 0) THEN
  288.                 result := compare(t1.hour, t2.hour);
  289.                 IF (result = 0) THEN
  290.                     result := compare(t1.minute, t2.minute);
  291.                     IF (result = 0) THEN
  292.                         result := compare(t1.second, t2.second);
  293.                     END;
  294.                 END;
  295.             END;
  296.         END;
  297.     END;
  298.     RETURN result
  299. END Compare;
  301. (* CompareDate -- compare day, month and year values only *)
  302. PROCEDURE CompareDate*(t1, t2: DateTime) : INTEGER;
  303. VAR result : INTEGER;
  304. BEGIN
  305.     result := compare(t1.year, t2.year);
  306.     IF (result = 0) THEN
  307.         result := compare(t1.month, t2.month);
  308.         IF (result = 0) THEN
  309.             result := compare(t1.day, t2.day);
  310.         END;
  311.     END;
  312.     RETURN result
  313. END CompareDate;
  315. (* CompareTime -- compare second, minute and hour values only *)
  316. PROCEDURE CompareTime*(t1, t2: DateTime) : INTEGER;
  317. VAR result : INTEGER;
  318. BEGIN
  319.     result := compare(t1.hour, t2.hour);
  320.     IF (result = 0) THEN
  321.         result := compare(t1.minute, t2.minute);
  322.         IF (result = 0) THEN
  323.             result := compare(t1.second, t2.second);
  324.         END;
  325.     END;
  326.     RETURN result
  327. END CompareTime;
  331. (* TimeDifferences -- returns the absolute time difference between 
  332. t1 and t2.
  334. Note that leap seconds are not counted, 
  335. see http://www.eecis.udel.edu/~mills/leap.html *)
  336. PROCEDURE TimeDifference*(t1, t2: DateTime; VAR days, hours, minutes, seconds : INTEGER);
  337. CONST SecondsPerMinute = 60; SecondsPerHour = 3600; SecondsPerDay = 86400;
  338. VAR start, end: DateTime; year, month, second : INTEGER;
  339. BEGIN
  340.     IF (Compare(t1, t2) = -1) THEN 
  341.         start := t1; 
  342.         end := t2; 
  343.     ELSE 
  344.         start := t2; 
  345.         end := t1; 
  346.     END;
  347.     IF (start.year = end.year) & (start.month = end.month) & (start.day = end.day) THEN
  348.         second := end.second - start.second + ((end.minute - start.minute) * SecondsPerMinute) + ((end.hour - start.hour) * SecondsPerHour);
  349.         days := 0;
  350.         hours := 0;
  351.         minutes := 0;
  352.     ELSE
  353.         (* use start date/time as reference point *)
  354.         (* seconds until end of the start.day *)
  355.         second := (SecondsPerDay - start.second) - (start.minute * SecondsPerMinute) - (start.hour * SecondsPerHour);
  356.         IF (start.year = end.year) & (start.month = end.month) THEN
  357.             (* days between start.day and end.day *)
  358.             days := (end.day - start.day) - 1;
  359.         ELSE
  360.             (* days until start.month ends excluding start.day *)
  361.             days := NumOfDays(start.year, start.month) - start.day;
  362.             IF (start.year = end.year) THEN
  363.                 (* months between start.month and end.month *)
  364.                 FOR month := start.month + 1 TO end.month - 1 DO
  365.                     days := days + NumOfDays(start.year, month);
  366.                 END;
  367.             ELSE
  368.                 (* days until start.year ends (excluding start.month) *)
  369.                 FOR month := start.month + 1 TO 12 DO
  370.                     days := days + NumOfDays(start.year, month);
  371.                 END;
  372.                 FOR year := start.year + 1 TO end.year - 1 DO (* days between start.years and end.year *)
  373.                     IF LeapYear(year) THEN days := days + 366; ELSE days := days + 365; END;
  374.                 END;
  375.                 FOR month := 1 TO end.month - 1 DO (* days until we reach end.month in end.year *)
  376.                     days := days + NumOfDays(end.year, month);
  377.                 END;
  378.             END;
  379.             (* days in end.month until reaching end.day excluding end.day *)
  380.             days := (days + end.day) - 1;
  381.         END;
  382.         (* seconds in end.day *)
  383.         second := second + end.second + (end.minute * SecondsPerMinute) + (end.hour * SecondsPerHour);
  384.     END;
  385.     days := days + (second DIV SecondsPerDay); second := (second MOD SecondsPerDay);
  386.     hours := (second DIV SecondsPerHour); second := (second MOD SecondsPerHour);
  387.     minutes := (second DIV SecondsPerMinute); second := (second MOD SecondsPerMinute);
  388.     seconds := second;
  389. END TimeDifference;
  391. (* AddYear -- Add/Subtract a number of years to/from date *)
  392. PROCEDURE AddYears*(VAR dt: DateTime; years : INTEGER);
  393. BEGIN
  394.     ASSERT(IsValid(dt));
  395.     dt.year := dt.year + years;
  396.     ASSERT(IsValid(dt));
  397. END AddYears;
  399. (* AddMonths -- Add/Subtract a number of months to/from date.
  400. This will adjust date.year if necessary *)
  401. PROCEDURE AddMonths*(VAR dt: DateTime; months : INTEGER);
  402. VAR years : INTEGER;
  403. BEGIN
  404.     ASSERT(IsValid(dt));
  405.     years := months DIV 12;
  406.     dt.month := dt.month + (months MOD 12);
  407.     IF (dt.month > 12) THEN
  408.         dt.month := dt.month - 12;
  409.         INC(years);
  410.     ELSIF (dt.month < 1) THEN
  411.         dt.month := dt.month + 12;
  412.         DEC(years);
  413.     END;
  414.     IF (years # 0) THEN AddYears(dt, years); END;
  415.     ASSERT(IsValid(dt));
  416. END AddMonths;
  418. (* AddDays --  Add/Subtract a number of days to/from date.
  419. This will adjust date.month and date.year if necessary *)
  420. PROCEDURE AddDays*(VAR dt: DateTime; days : INTEGER);
  421. VAR nofDaysLeft : INTEGER;
  422. BEGIN
  423.     ASSERT(IsValid(dt));
  424.     IF (days > 0) THEN
  425.         WHILE (days > 0) DO
  426.             nofDaysLeft := NumOfDays(dt.year, dt.month) - dt.day;
  427.             IF (days > nofDaysLeft) THEN
  428.                 dt.day := 1;
  429.                 AddMonths(dt, 1);
  430.                 days := days - nofDaysLeft - 1; (* -1 because we consume the first day of the next month *)
  431.             ELSE
  432.                 dt.day := dt.day + days;
  433.                 days := 0;
  434.             END;
  435.         END;
  436.     ELSIF (days < 0) THEN
  437.         days := -days;
  438.         WHILE (days > 0) DO
  439.             nofDaysLeft := dt.day - 1;
  440.             IF (days > nofDaysLeft) THEN
  441.                 dt.day := 1; (* otherwise, dt could become an invalid date if the previous month has less days than dt.day *)
  442.                 AddMonths(dt, -1);
  443.                 dt.day := NumOfDays(dt.year, dt.month);
  444.                 days := days - nofDaysLeft - 1; (* -1 because we consume the last day of the previous month *)
  445.             ELSE
  446.                 dt.day := dt.day - days;
  447.                 days := 0;
  448.             END;
  449.         END;
  450.     END;
  451.     ASSERT(IsValid(dt));
  452. END AddDays;
  454. (* AddHours -- Add/Subtract a number of hours to/from date.
  455. This will adjust date.day, date.month and date.year if necessary *)
  456. PROCEDURE AddHours*(VAR dt: DateTime; hours : INTEGER);
  457. VAR days : INTEGER;
  458. BEGIN
  459.     ASSERT(IsValid(dt));
  460.     dt.hour := dt.hour + hours;
  461.     days := dt.hour DIV 24;
  462.     dt.hour := dt.hour MOD 24;
  463.     IF (dt.hour < 0) THEN
  464.         dt.hour := dt.hour + 24;
  465.         DEC(days);
  466.     END;
  467.     IF (days # 0) THEN AddDays(dt, days); END;
  468.     ASSERT(IsValid(dt));
  469. END AddHours;
  471. (* AddMinutes -- Add/Subtract a number of minutes to/from date.
  472. This will adjust date.hour, date.day, date.month and date.year 
  473. if necessary *)
  474. PROCEDURE AddMinutes*(VAR dt: DateTime; minutes : INTEGER);
  475. VAR hours : INTEGER;
  476. BEGIN
  477.     ASSERT(IsValid(dt));
  478.     dt.minute := dt.minute + minutes;
  479.     hours := dt.minute DIV 60;
  480.     dt.minute := dt.minute MOD 60;
  481.     IF (dt.minute < 0) THEN
  482.         dt.minute := dt.minute + 60;
  483.         DEC(hours);
  484.     END;
  485.     IF (hours # 0) THEN AddHours(dt, hours); END;
  486.     ASSERT(IsValid(dt));
  487. END AddMinutes;
  489. (* AddSeconds -- Add/Subtract a number of seconds to/from date.
  490. This will adjust date.minute, date.hour, date.day, date.month and
  491. date.year if necessary *)
  492. PROCEDURE AddSeconds*(VAR dt: DateTime; seconds : INTEGER);
  493. VAR minutes : INTEGER;
  494. BEGIN
  495.     ASSERT(IsValid(dt));
  496.     dt.second := dt.second + seconds;
  497.     minutes := dt.second DIV 60;
  498.     dt.second := dt.second MOD 60;
  499.     IF (dt.second < 0) THEN
  500.         dt.second := dt.second + 60;
  501.         DEC(minutes);
  502.     END;
  503.     IF (minutes # 0) THEN AddMinutes(dt, minutes); END;
  504.     ASSERT(IsValid(dt));
  505. END AddSeconds;
  508. (* IsDateString -- return TRUE if the ARRAY OF CHAR is 10 characters
  509. long and is either in the form of YYYY-MM-DD or MM/DD/YYYY where
  510. Y, M and D are digits. 
  511. NOTE: is DOES NOT check the ranges of the digits. *)
  512. PROCEDURE IsDateString*(inline : ARRAY OF CHAR) : BOOLEAN;
  513. VAR 
  514.     test : BOOLEAN; i, pos : INTEGER;
  515.     src : ARRAY MAXSTR OF CHAR;
  516. BEGIN
  517.     Chars.Set(inline, src);
  518.     Chars.TrimSpace(src);
  519.     test := FALSE;
  520.     IF Strings.Length(src) = 10 THEN
  521.         pos := Strings.Pos("-", src, 0);
  522.         IF pos > 0 THEN
  523.             IF (src[4] = "-") & (src[7] = "-") THEN
  524.                 test := TRUE;
  525.                 FOR i := 0 TO 9 DO
  526.                     IF (i # 4) & (i # 7) THEN
  527.                        IF Chars.IsDigit(src[i]) = FALSE THEN
  528.                            test := FALSE;
  529.                        END;
  530.                     END;
  531.                 END;
  532.             ELSE
  533.                 test := FALSE;
  534.             END;
  535.         END;
  536.         pos := Strings.Pos("/", src, 0);
  537.         IF pos > 0 THEN
  538.             IF (src[2] = "/") & (src[5] = "/") THEN
  539.                 test := TRUE;
  540.                 FOR i := 0 TO 9 DO
  541.                     IF (i # 2) & (i # 5) THEN
  542.                         IF Chars.IsDigit(src[i]) = FALSE THEN
  543.                             test := FALSE;
  544.                         END;
  545.                     END;
  546.                 END;
  547.             ELSE
  548.                 test := FALSE;
  549.             END;
  550.         END;
  551.     END;
  552.     RETURN test
  553. END IsDateString;
  555. (* IsTimeString -- return TRUE if the ARRAY OF CHAR has 4 to 8 
  556. characters in the form of H:MM, HH:MM, HH:MM:SS where H, M and S
  557. are digits. *)
  558. PROCEDURE IsTimeString*(inline : ARRAY OF CHAR) : BOOLEAN;
  559. VAR 
  560.     test : BOOLEAN; 
  561.     l : INTEGER;
  562.     src : ARRAY MAXSTR OF CHAR;
  563. BEGIN
  564.     Chars.Set(inline, src);
  565.     Chars.TrimSpace(src);
  566.     (* remove any trailing am/pm suffixes *)
  567.     IF Chars.EndsWith("m", src) THEN
  568.         IF Chars.EndsWith("am", src) THEN
  569.             Chars.TrimSuffix("am", src);
  570.         ELSE
  571.             Chars.TrimSuffix("pm", src);
  572.         END;
  573.         Chars.TrimSpace(src);
  574.     ELSIF Chars.EndsWith("M", src) THEN
  575.         Chars.TrimSuffix("AM", src);
  576.         Chars.TrimSuffix("PM", src);
  577.         Chars.TrimSpace(src);
  578.     ELSIF Chars.EndsWith("p", src) THEN
  579.         Chars.TrimSuffix("p", src);
  580.         Chars.TrimSpace(src);
  581.     ELSIF Chars.EndsWith("P", src) THEN
  582.         Chars.TrimSuffix("P", src);
  583.         Chars.TrimSpace(src);
  584.     ELSIF Chars.EndsWith("a", src) THEN
  585.         Chars.TrimSuffix("a", src);
  586.         Chars.TrimSpace(src);
  587.     ELSIF Chars.EndsWith("A", src) THEN
  588.         Chars.TrimSuffix("A", src);
  589.         Chars.TrimSpace(src);
  590.     END;
  591.     Strings.Extract(src, 0, 8, src);
  592.     test := FALSE;
  593.     l := Strings.Length(src);
  594.     IF (l = 4) THEN
  595.         IF Chars.IsDigit(src[0]) & (src[1] = ":") & 
  596.             Chars.IsDigit(src[2]) & Chars.IsDigit(src[3]) THEN
  597.             test := TRUE;
  598.         ELSE
  599.             test := FALSE;
  600.         END;
  601.     ELSIF (l = 5) THEN
  602.         IF Chars.IsDigit(src[0]) & Chars.IsDigit(src[1]) &
  603.             (src[2] = ":") & 
  604.             Chars.IsDigit(src[3]) & Chars.IsDigit(src[4]) THEN
  605.             test := TRUE;
  606.         ELSE
  607.             test := FALSE;
  608.         END;
  609.     ELSIF (l = 8) THEN
  610.         IF Chars.IsDigit(src[0]) & Chars.IsDigit(src[1]) &
  611.             (src[2] = ":") & 
  612.             Chars.IsDigit(src[3]) & Chars.IsDigit(src[4]) & 
  613.             (src[5] = ":") & 
  614.             Chars.IsDigit(src[6]) & Chars.IsDigit(src[7]) THEN
  615.             test := TRUE;
  616.         ELSE
  617.             test := FALSE;
  618.         END;
  619.     ELSE
  620.         test := FALSE;
  621.     END;
  622.     RETURN test
  623. END IsTimeString;
  625. (* ParseDate -- parses a date string in YYYY-MM-DD or
  626. MM/DD/YYYY format. *)
  627. PROCEDURE ParseDate*(inline : ARRAY OF CHAR; VAR year, month, day : INTEGER) : BOOLEAN;
  628. VAR src, tmp : ARRAY MAXSTR OF CHAR; ok, b : BOOLEAN;
  629. BEGIN
  630.     Chars.Set(inline, src);
  631.     Chars.Clear(tmp);
  632.     ok := FALSE;
  633.     IF IsDateString(src) THEN
  634.         (* FIXME: Need to allow for more than 4 digit years! *)
  635.         IF (src[2] = "/") & (src[5] = "/") THEN
  636.             ok := TRUE;
  637.             Strings.Extract(src, 0, 2, tmp);
  638.             Convert.StringToInt(tmp, month, b);
  639.             ok := ok & b;
  640.             Strings.Extract(src, 4, 2, tmp);
  641.             Convert.StringToInt(tmp, day, b);
  642.             ok := ok & b;
  643.             Strings.Extract(src, 6, 4, tmp);
  644.             Convert.StringToInt(tmp, year, b);
  645.             ok := ok & b;
  646.         ELSIF (src[4] = "-") & (src[7] = "-") THEN
  647.             ok := TRUE;
  648.             Strings.Extract(src, 0, 4, tmp);
  649.             Convert.StringToInt(tmp, year, b);
  650.             ok := ok & b;
  651.             Strings.Extract(src, 5, 2, tmp);
  652.             Convert.StringToInt(tmp, month, b);
  653.             ok := ok & b;
  654.             Strings.Extract(src, 8, 2, tmp);
  655.             Convert.StringToInt(tmp, day, b);
  656.             ok := ok & b;
  657.         ELSE
  658.             ok := FALSE;
  659.         END;
  660.     END;
  661.     RETURN ok
  662. END ParseDate;
  664. (* ParseTime -- procedure for parsing time strings into hour,
  665. minute, second. Returns TRUE on successful parse, FALSE otherwise *)
  666. PROCEDURE ParseTime*(inline : ARRAY OF CHAR; VAR hour, minute, second : INTEGER) : BOOLEAN;
  667. VAR src, tmp : ARRAY MAXSTR OF CHAR; ok : BOOLEAN; cur, pos, l : INTEGER;
  668. BEGIN
  669.     Chars.Set(inline, src);
  670.     Chars.Clear(tmp);
  671.     IF IsTimeString(src) THEN
  672.         ok := TRUE;
  673.         cur := 0; pos := 0;
  674.         pos := Strings.Pos(":", src, cur);
  675.         IF pos > 0 THEN
  676.         (* Get Hour *)
  677.             Strings.Extract(src, cur, pos - cur, tmp);
  678.             Convert.StringToInt(tmp, hour, ok);
  679.             IF ok THEN
  680.                 (* Get Minute *)
  681.                 cur := pos + 1;
  682.                 Strings.Extract(src, cur, 2, tmp);
  683.                 Convert.StringToInt(tmp, minute, ok);
  684.                 IF ok THEN
  685.                     (* Get second, optional, default to zero *)
  686.                     pos := Strings.Pos(":", src, cur);
  687.                     IF pos > 0 THEN
  688.                         cur := pos + 1;
  689.                         Strings.Extract(src, cur, 2, tmp);
  690.                         Convert.StringToInt(tmp, second, ok);
  691.                         cur := cur + 2;
  692.                     ELSE
  693.                         second := 0;
  694.                     END;
  695.                     (* Get AM/PM, optional, adjust hour if PM *)
  696.                     l := Strings.Length(src);
  697.                     WHILE (cur < l) & Chars.IsSpace(src[cur]) DO
  698.                         cur := cur + 1;
  699.                     END;
  700.                     Strings.Extract(src, cur, 2, tmp);
  701.                     Chars.TrimSpace(tmp);
  702.                     IF Chars.Equal(tmp, "PM") OR Chars.Equal(tmp, "pm") THEN
  703.                         hour := hour + 12;
  704.                     END;
  705.                 ELSE
  706.                     ok := FALSE;
  707.                 END;
  708.             END;
  709.         ELSE
  710.             ok := FALSE;
  711.         END;
  712.     ELSE
  713.         ok := FALSE;
  714.     END;
  715.     IF ok THEN
  716.         ok := ((hour >= 0) & (hour <= 23)) &
  717.             ((minute >= 0) & (minute <= 59)) &
  718.                 ((second >= 0) & (second <= 59));
  719.     END;
  720.     RETURN ok
  721. END ParseTime;
  724. (* Parse accepts a date array of chars in either dates, times
  725. or dates and times separate by spaces. Date formats supported
  726. include YYYY-MM-DD, MM/DD/YYYY. Time formats include
  727. H:MM, HH:MM, H:MM:SS, HH:MM:SS with 'a', 'am', 'p', 'pm' 
  728. suffixes.  Dates and times can also be accepted as JSON 
  729. expressions with the individual time compontents are specified 
  730. as attributes, e.g. `{"year": 1998, "month": 12, "day": 10,
  731. "hour": 11, "minute": 4, "second": 3}.
  732. Parse returns TRUE on successful parse, FALSE otherwise.
  734. BUG: Assumes a 4 digit year.
  735. *) 
  736. PROCEDURE Parse*(inline : ARRAY OF CHAR; VAR dt: DateTime) : BOOLEAN;
  737. VAR src, ds, ts, tmp : ARRAY SHORTSTR OF CHAR; ok, okDate, okTime : BOOLEAN; 
  738.     pos, year, month, day, hour, minute, second : INTEGER;
  739. BEGIN
  740.     dt.year := 0;
  741.     dt.month := 0;
  742.     dt.day := 0;
  743.     dt.hour := 0;
  744.     dt.minute := 0;
  745.     dt.second := 0;
  746.     Chars.Clear(tmp);
  747.     Chars.Set(inline, src);
  748.     Chars.TrimSpace(src);
  749.     (* Split into Date and Time components *)
  750.     pos := Strings.Pos(" ", src, 0);
  751.     IF pos >= 0 THEN
  752.         Strings.Extract(src, 0, pos, ds);
  753.         pos := pos + 1;
  754.         Strings.Extract(src, pos, Strings.Length(src) - pos, ts);
  755.     ELSE
  756.         Chars.Set(src, ds);
  757.         Chars.Set(src, ts);
  758.     END;
  759.     ok := FALSE;
  760.     IF IsDateString(ds) THEN
  761.         ok := TRUE;
  762.         okDate := ParseDate(ds, year, month, day);
  763.         SetDate(year, month, day, dt);
  764.         ok := ok & okDate;
  765.     END;
  766.     IF IsTimeString(ts) THEN
  767.         ok := ok OR okDate;
  768.         okTime := ParseTime(ts, hour, minute, second);
  769.         SetTime(hour, minute, second, dt);
  770.         ok := ok & okTime;
  771.     END;
  772.     RETURN ok
  773. END Parse;
  775. BEGIN
  776.     Chars.Set("January", Months[0]);
  777.     Chars.Set("February", Months[1]);
  778.     Chars.Set("March", Months[2]);
  779.     Chars.Set("April", Months[3]);
  780.     Chars.Set("May", Months[4]);
  781.     Chars.Set("June", Months[5]);
  782.     Chars.Set("July", Months[6]);
  783.     Chars.Set("August", Months[7]);
  784.     Chars.Set("September", Months[8]);
  785.     Chars.Set("October", Months[9]);
  786.     Chars.Set("November", Months[10]);
  787.     Chars.Set("December", Months[11]);
  789.     Chars.Set("Sunday", Days[0]);
  790.     Chars.Set("Monday", Days[1]);
  791.     Chars.Set("Tuesday", Days[2]);
  792.     Chars.Set("Wednesday", Days[3]);
  793.     Chars.Set("Thursday", Days[4]);
  794.     Chars.Set("Friday", Days[5]);
  795.     Chars.Set("Saturday", Days[6]);
  797.     DaysInMonth[0] := 31; (* January *)
  798.     DaysInMonth[1] := 28; (* February *)
  799.     DaysInMonth[2] := 31; (* March *)
  800.     DaysInMonth[3] := 30; (* April *)
  801.     DaysInMonth[4] := 31; (* May *)
  802.     DaysInMonth[5] := 30; (* June *)
  803.     DaysInMonth[6] := 31; (* July *)
  804.     DaysInMonth[7] := 31; (* August *)
  805.     DaysInMonth[8] := 30; (* September *)
  806.     DaysInMonth[9] := 31; (* October *)
  807.     DaysInMonth[10] := 30; (* November *)
  808.     DaysInMonth[11] := 31; (* December *)
  810. END Dates.