Dates and Clock

By R. S. Doiel, 2020-11-27

The Oakwood guidelines specified a common set of modules for Oberon-2 for writing programs outside of an Oberon System. A missing module from the Oakwood guidelines is modules for working with dates and the system clock. Fortunately the A2 Oberon System1 provides a template for that functionality. In this article I am exploring implementing the Dates and Clock modules for Oberon-07. I also plan to go beyond the A2 implementations and provide additional functionality such as parsing procedures and the ability to work with either the date or time related attributes separately in the Dates.DateTime record.

Divergences

One of the noticeable differences between Oberon-07 and Active Oberon is the types that functional procedures can return. We cannot return an Object in Oberon-07. This is not much of a handicap as we have variable procedure parameters. Likewise Active Oberon provides a large variety of integer number types. In Oberon-07 we have only INTEGER. Where I’ve create new procedures I’ve used the Oberon idiom of read only input parameters followed by variable parameters with side effects and finally parameters for the target record or values to be updated.

Similarities

In spite of the divergence I have split the module into two. The Dates module is the one you would include in your program, it provides a DateTime record type which holds the integer values for year, month, day, hour, minute and second. It provides the means of parsing a date or time string, comparison, difference and addition of dates. The second module Clock provides a mechanism to retrieve the real time clock value from the host system and map the C based time object into our own DateTime record. Clock is specific to OBNC method of interfacing to the C standard libraries of the host system. If you were to use a different Oberon compiled such as the Oxford Oberon Compiler you would need to re-implement Clock. Dates itself should be system independent and work with Oberon-07 compilers generally.

Clock

The Clock module is built from a skeleton in Oberon-07 describing the signatures of the procedure and an implementation in C that is built using the technique for discussed in my post Combining Oberon-07 and C with OBNC. In that article I outline Karl’s three step process to create a module that will be an interface to C code. In Step one I create the Oberon module. Normally I’d leave all procedures empty and develop them in C. In this specific case I went ahead and wrote the procedure called Get in Oberon and left the procedure GetRtcTime blank. This allowed OBNC to generate the C code for Get saving me some time and create the skeleton for GetRtcTime which does the work interfacing with the system clock via C library calls.

The interface Oberon module looked like this:

  2. MODULE Clock;
  4. PROCEDURE GetRtcTime*(VAR second, minute, hour, day, month, year : INTEGER);
  5. BEGIN
  6. END GetRtcTime;
  8. PROCEDURE Get*(VAR time, date : INTEGER);
  9. VAR
  10.     second, minute, hour, day, month, year : INTEGER;
  11. BEGIN
  12.     GetRtcTime(second, minute, hour, day, month, year);
  13.     time = ((hour * 4096) + (minute * 64)) + second;
  14.     date = ((year * 512) + (month * 32)) + day;
  15. END Get;
  17. END Clock.

I wrote the Get procedure code in Oberon-07 is the OBNC compiler will render the Oberon as C during the compilation process. I save myself writing some C code in by leveraging OBNC.

Step two was to write ClockTest.Mod in Oberon-07.

  2. MODULE ClockTest;
  4. IMPORT Tests, Chars, Clock; (* , Out; *)
  6. CONST
  7.     MAXSTR = Chars.MAXSTR;
  9. VAR
  10.     title : ARRAY MAXSTR OF CHAR;
  11.     success, errors : INTEGER;
  13. PROCEDURE TestGetRtcTime() : BOOLEAN;
  14. VAR second, minute, hour, day, month, year : INTEGER; 
  15.     test, expected, result: BOOLEAN;
  16. BEGIN
  17.     test := TRUE;
  18.     second := 0; minute := 0; hour := 0;
  19.     day := 0; month := 0; year := 0;
  20.     expected := TRUE;
  21.     Clock.GetRtcTime(second, minute, hour, day, month, year);
  24.     result := (year > 1900);
  25.     Tests.ExpectedBool(expected, result, 
  26.           "year should be greater than 1900", test);
  27.     result := (month >= 0) & (month <= 11);
  28.     Tests.ExpectedBool(expected, result,
  29.           "month should be [0, 11]", test);
  30.     result := (day >= 1) & (day <= 31);
  31.     Tests.ExpectedBool(expected, result,
  32.           "day should be non-zero", test);
  34.     result := (hour >= 0) & (hour <= 23);
  35.     Tests.ExpectedBool(expected, result,
  36.           "hour should be [0, 23]", test);
  37.     result := (minute >= 0) & (minute <= 59);
  38.     Tests.ExpectedBool(expected, result, 
  39.           "minute should be [0, 59]", test);
  40.     result := (second >= 0) & (second <= 60);
  41.     Tests.ExpectedBool(expected, result,
  42.           "second year should be [0,60]", test);
  43.     RETURN test
  44. END TestGetRtcTime;
  46. PROCEDURE TestGet() : BOOLEAN;
  47. VAR time, date : INTEGER; 
  48.     test, expected, result : BOOLEAN;
  49. BEGIN
  50.     test := TRUE;
  51.     time := 0;
  52.     date := 0;
  53.     Clock.Get(time, date);
  54.     expected := TRUE;
  55.     result := (time > 0);
  56.     Tests.ExpectedBool(expected, result,
  57.         "time should not be zero", test);
  58.     result := (date > 0);
  59.     Tests.ExpectedBool(expected, result,
  60.         "date should not be zero", test);
  62.     RETURN test
  63. END TestGet;
  65. BEGIN
  66.     Chars.Set("Clock module test", title);
  67.     success := 0; errors := 0;
  68.     Tests.Test(TestGetRtcTime, success, errors);
  69.     Tests.Test(TestGet, success, errors);
  70.     Tests.Summarize(title, success, errors);
  71. END ClockTest.

ClockTest is a simple test module for Clock.Mod. It also serves the role when compiled with OBNC to create the template C code for Clock.c. Here’s the steps we take to generate Clock.c with OBNC:

  2. obnc ClockTest.Mod
  3. mv .obnc/Clock.c ./
  4. vi Clock.c

After compiling .obnc/Clock.c I then moved .obnc/Clock.c to my working directory. Filled in the C version of GetRtcTime function and modified my Clock.Mod to contain my empty procedure.

The finally version of Clock.c looks like (note how we need to include “Clock.h” in the head of the our C source file).

  2. /*GENERATED BY OBNC 0.16.1*/
  4. #include ".obnc/Clock.h"
  5. #include <obnc/OBNC.h>
  6. #include <time.h>
  8. #define OBERON_SOURCE_FILENAME "Clock.Mod"
  10. void Clock__GetRtcTime_(OBNC_INTEGER *second_, OBNC_INTEGER *minute_,
  11.      OBNC_INTEGER *hour_, OBNC_INTEGER *day_,
  12.      OBNC_INTEGER *month_, OBNC_INTEGER *year_)
  13. {
  14.     time_t now;
  15.     struct tm *time_info;
  16.     now = time(NULL);
  17.     time_info = localtime(&now);
  18.     *second_ = time_info->tm_sec;
  19.     *minute_ = time_info->tm_min;
  20.     *hour_ = time_info->tm_hour;
  21.     *day_ = time_info->tm_mday;
  22.     *month_ = time_info->tm_mon;
  23.     *year_ = (time_info->tm_year) + 1900;
  24. }
  27. void Clock__Get_(OBNC_INTEGER *time_, OBNC_INTEGER *date_)
  28. {
  29.     OBNC_INTEGER second_, minute_, hour_, day_, month_, year_;
  31.     Clock__GetRtcTime_(&second_, &minute_, 
  32.                        &hour_, &day_, &month_, &year_);
  33.     (*time_) = ((hour_ * 4096) + (minute_ * 64)) + second_;
  34.     (*date_) = ((year_ * 512) + (month_ * 32)) + day_;
  35. }
  38. void Clock__Init(void)
  39. {
  40. }

The final version of Clock.Mod looks like

  2. MODULE Clock;
  4. PROCEDURE GetRtcTime*(VAR second, minute, 
  5.                       hour, day, month, year : INTEGER);
  6. BEGIN
  7. END GetRtcTime;
  9. PROCEDURE Get*(VAR time, date : INTEGER);
  10. BEGIN
  11. END Get;
  13. END Clock.

Step three was to re-compile ClockTest.Mod and run the tests.

  2.     obnc ClockTest.Mod
  3.     ./ClockTest

Dates

The dates module provides a rich variety of procedures for working with dates. This includes parsing date strings into DateTime records, testing strings for supported date formats, setting dates or time in a DateTime record as well as comparison, difference and addition (both addition and subtraction) of dates. Tests for the Dates module is implemented in DatesTest.Mod.

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

Postscript: In this article I included a reference to the module Chars. This is a non-standard module I wrote for Oberon-07. Here is a link to Chars. RSD, 2021-05-06

Next, Previous

  1. A2 information can be found in the Oberon wikibook↩︎