Source file time.icn
#
# $Id: time.icn,v 1.6 2006-07-10 13:44:28 rparlett Exp $
#
# This file is in the public domain.
#
# Author: Robert Parlett (parlett@dial.pipex.com)
#

$include "posix.icn"

package util

import lang

$define DEFAULT_FORMAT "yyyy/MM/dd HH:mm:ss zzz"

#
# Constant data for time functions
#
global Time_data_months, Time_data_base_year, Time_data_week_days,
   Time_data_tzchars, Time_data_unix_base_offset

#
# This class is used to represent a date/time.  The representation may be
# retrieved from the class either as the constituent parts of a date, or
# as the number of seconds since a base date, which is 1/1/1600.
#
# The "seconds" viewpoint is always in UTC, whilst the "broken down" viewpoint
# is always in the local timezone.
#
# The timezone is specified as a timezone object.
#
# If not specified as a parameter the timezone defaults to a value extracted
# from the system, if possible.
#
# @example
# @ t := Time()           # t is uninitialized
# @ t.set_current_time(Timezone(-18000))  # t now represents the current time;
#                                         # time zone GMT-5hrs
# @ t.parse("1990/12/2 11:22:03 -0500")  # the given date
# @ t.set_fields(1990, 12, 2, 11, 22, 03, Timezone(-18000))  # the same date
# @ t.set_seconds(n, z)      # n seconds past the base date in GMT, +/-z mins
#
class Time : Error : Object(seconds, year, month, mday, hour, min, sec,
			    zone, psub, ppos)
   #
   # Convert to a string
   #
   method to_string()
      return format("MMMM d, yyyy H:mm.ss z")
   end

   #
   # Format the given int using the given width
   # @p
   method format_int(n, w)
      local s
      s := ::string(n)
      if *s < w then
	 return ::right(s, w, "0")
      else
	 return s
   end

   #
   # Format a weekday (Mon, Tue etc) given a width.
   # @p
   method format_weekday(w)
      local s
      s := Time_data_week_days[self.week_day() + 1]
      if w < 4 then
	 return s[1:4]
      else
	 return s
   end

   #
   # Format a month (Jan, Feb etc) given a width
   # @p
   method format_month(w)
      local s

      if w < 3 then
	 return format_int(self.month, w)

      s := Time_data_months[self.month]
      if w = 3 then
	 return s[1:4]
      else
	 return s
   end

   #
   # Format a year given the width
   # @p
   method format_year(w)
      local s

      if w == 2 then
	 return format_int(self.year % 100, w)
      else
	 return format_int(self.year, w)
   end

   #
   # Format the instance using the given pattern string.  The pattern
   # consists of pattern chars and other chars.
   #
   # The "width" of a field is the number of successive equal pattern
   # chars.  For example in the pattern
   #
   # yyyy/MMM/dd
   #
   # the widths are 4, 3 and 2 respectively.
   #
   # The possible pattern chars are :-
   #
   # E - The weekday.  A width < 4 gives the first three chars (eg Mon),
   # otherwise the full day is given (eg Monday)
   #
   # y - The year.  If the width is 2, the year will be the least
   # significant 2 digits (eg "99"), otherwise it is the full year
   # padded to the width.
   #
   # d - The day of the month padded to the width.
   #
   # H - The hour in the day using the 24 hour clock padded to the width.
   #
   # h - The hour in the day using the 12 hour clock padded to the width.
   #
   # M - The month of the year.  If the width is less than 3 then the
   # numeric value is used, padded to the width.  If the width is 3, then
   # the abbreviated month is used (eg "Jul"); otherwise the full month is
   # used (eg "July").
   #
   # m - The minute in the hour padded to the width.
   #
   # s - The second in the minute padded to the width.
   #
   # a - am or pm.  The width is ignored.
   #
   # A - AM or PM  The width is ignored.
   #
   # z - the timezone id (eg UTC or +0400).   The width is ignored.
   #
   # Literal strings (which can include the above chars) can be
   # included using single quotes.  Two single quotes maps to
   # an actual single quote.
   #
   # @example
   # @
   # @ yyyy MM dd HH mm ss -> 1999 12 17 23 30 01
   # @ yyyy MM dd HH 'o''clock' mm ss -> 1999 12 17 23 o'clock 30 01
   # @ yyyy/M/d HH:mm:ss zzz -> 1999/2/7 23:30:01 PST
   # @ E MMM dd HH:mm:ss zzz yyyy -> Mon Feb 07 23:30:01 PST 1999
   # @ yy MM dd HH mm ss -> 99 12 17 23 30 01
   #
   method format(p)
      local res, ch, w

      /p := DEFAULT_FORMAT

      res := ""
      p ? {
	 while not ::pos(0) do {
	    if ::any('EydHMhmsaAz') then {
	       ch := p[&pos]
	       w := *::tab(::many(ch))
	       res ||:= case ch of {
		  "E": format_weekday(w)
		  "y": format_year(w)
		  "M": format_month(w)
		  "d": format_int(self.mday, w)
		  "h": {
		     if self.hour < 13 then
		        format_int(self.hour, w)
		     else
		        format_int(self.hour - 12, w)
		     }
		  "H": format_int(self.hour, w)
		  "m": format_int(self.min, w)
		  "s": format_int(self.sec, w)
		  "z": zone.get_id()
		  "Z": zone.get_offset()
		  "a": {
		     if self.hour < 12 then
		        "am"
		     else
		        "pm"
		     }
		  "A": {
		     if self.hour < 12 then
		        "AM"
		     else
		        "PM"
 		     }
		  }
	    } else if ::any('\'') then
	       res ||:= match_literal()
	    else
	       res ||:= ::move(1)
	 }
      }
      return res
   end

   #
   # Get the next parsed int
   # @p
   method parse_int(w)
      local j, n
      j := ::many(&digits, psub, ppos) | return error("Digit expected")
      #
      # If there is a numeric field immediately following, limit the length
      # of this field.  This allows for example yyyyMMdd to parse 20001201.
      #
      if ::any('ydHMhms') then
	 j >:= ppos + w

      n := ::integer(psub[ppos:j])
      ppos := j
      return n
   end

   #
   # Get the next parsed timezone
   # @p
   method parse_timezone()
      local j, z
      j := ::many(Time_data_tzchars, psub, ppos)|return error("Timezone expected")
      z := get_known_timezone(psub[ppos:j]) | return error("Invalid timezone")
      ppos := j
      return z
   end

   #
   # Get the next parsed am/pm
   # @p
   method parse_ampm()
      local s
      s := ::map(psub[ppos+:2]) | return error("am/pm expected")
      s == ("am" | "pm") | return error("am/pm expected")
      ppos +:= 2
      return s
   end

   #
   # Get the next parsed month
   # @p
   method parse_month(w)
      local j, m
      if w < 3 then
         return parse_int(w)
      j := ::many(&ucase ++ &lcase, psub, ppos) | return error("Month expected")
      m := month_to_num(psub[ppos:j]) | return error("Invalid month")
      ppos := j
      return m
   end

   #
   # Get the next parsed weekday
   # @p
   method parse_weekday()
      local j
      j := ::many(&letters, psub, ppos) | return error("Weekday expected")
      ppos := j
      return
   end

   #
   # Match a literal, which begins with a ', and ends with the next ', except
   # that two ' together means a single ' in the result.
   # @p
   method match_literal()
      local s
      ="\'"
      s := ""
      repeat {
	 s ||:= ::tab(::find("\'") | 0)
	 if ::pos(0) then
	    break
	 ::move(1)
	 # Two ''s in a row mean a single ' and press on - else break.
	 s ||:= ="'" | break
	 }
      return s
   end

   #
   # Get the next parsed month
   # @p
   method parse_year(w)
      local n
      n := parse_int(w) | fail
      if n < 70 then
	 return 2000 + n
      else if n < 100 then
	 return 1900 + n
      else
	 return n
   end

   #
   # Parse the instance using the given pattern string.  The pattern
   # consists of pattern chars and other chars.
   #
   # The "width" of a field is the number of successive equal pattern
   # chars.  For example in the pattern
   #
   # yyyy/MMM/dd
   #
   # the widths are 4, 3 and 2 respectively.
   #
   # Except for the month (see below), the only use of the width is to
   # separate adjacent fields, eg yyyyMMdd with input "19991201".
   #
   # The possible pattern chars are :-
   #
   # E - The weekday (eg Mon) - this is just a sequence of upper and lower
   # case chars and is otherwise ignored.
   #
   # y - The year.  If the year is less than 70 it is taken to be 20xx; if
   # it is less than 100 it is taken to be 19xx, otherwise it is as given.
   #
   # d - The day of the month
   #
   # H/h - The hour in the day
   #
   # M - The month of the year.  If the width is less than 3 then the
   # numeric value is expected, otherwise the textual value is expected.
   #
   # m - The minute in the hour
   #
   # s - The second in the minute
   #
   # a/A - am or pm.  Case is ignored.  If pm, then the hour is
   # adjusted accordingly in the result.
   #
   # z - The timezone (eg UTC or +0400).
   #
   method parse(s, p)
      local y, d, m, hh, mm, ss, z, ampm, lit, ch, w

      /p := DEFAULT_FORMAT
      psub := s
      ppos := 1
      p ? {
         while not ::pos(0) do {
            if ::any('EydHMhmsaAz') then {
               ch := p[&pos]
               w := *::tab(::many(ch))
               case ch of {
		  "E": parse_weekday() | fail
		  "y": y := parse_year(w) | fail
		  "M": m := parse_month(w) | fail
		  "d": d := parse_int(w) | fail
		  "h"|"H": hh := parse_int(w) | fail
		  "m": mm := parse_int(w) | fail
		  "s": ss := parse_int(w) | fail
		  "z": z := parse_timezone() | fail
		  "A"|"a": {
		     ampm := parse_ampm() | fail
		     if ampm == "pm" & (0 < \hh < 12) then
		        hh +:= 12
		     }
		  }
	       }
	    else if ::any('\'') then {
	       lit := match_literal()
	       ppos := ::match(lit, psub, ppos) |
		  return error("Expected literal:" || lit)
	       }
	    else {
	       ch := ::move(1)
	       while psub[ppos] == ch do
	          ppos +:= 1
	       }
	    }
	 }
      set_fields(y, m, d, hh, mm, ss, z)
      return
   end

   #
   # Convert to string in accordance with RFC 822.
   #
   method to_rfc822()
      return format("E, d MMM yyyy HH:mm:ss z")
   end

   #
   # Convert to string in a format suitable for use in a letter
   #
   method to_letter_string()
      return format("d MMMM, yyyy")
   end

   #
   # Convert to string in format d-MMM-yy
   #
   method to_short_string()
      return format("d-MMM-yy")
   end

   ##
   # Convert to icon &date format
   #
   # @p
   method to_date()
      return format("yyyy/MM/dd")
   end

   #
   # Convert to icon &clock format
   #
   method to_clock()
      return format("HH:mm:ss")
   end

   #
   # Convert to a string in icon &date format followed by Icon &clock format
   # followed by the timezone.
   #
   method to_date_clock()
      return format(DEFAULT_FORMAT)
   end

   #
   # Convert to a string in icon &dateline format
   #
   method to_dateline()
      return format("EEEE, MMMM d, yyyy  h:mm a")
   end

   #
   # Succeed if date is after d
   #
   method after(d)
      return self.seconds > d.seconds
   end

   #
   # Succeed if date is before d
   #
   method before(d)
      return self.seconds < d.seconds
   end

   #
   # Succeed if date is equal to d.  Overrides {Object.equals()}
   #
   method equals(d)
      return self.seconds = d.seconds
   end

   #
   # Compute day of week.  0 = Sunday etc.  Add 6 because
   # 1/1/Time_data_base_year is always a Saturday
   #
   method week_day()
      return (6 + (self.seconds + self.zone.get_offset()) / 86400) % 7
   end

   #
   # Compute year day. January 1st = 1 etc
   #
   method year_day()
      return get_cum_days(self.year, self.month) + self.mday
   end

   #
   # Compute seconds past base date based on broken down fields.
   #
   method compute_seconds()
      local days, year, mon, mday, year_diff, l, n

      #
      # Normalize seconds
      #
      self.min +:= self.sec / 60
      self.sec %:= 60
      if self.sec < 0 then {
	 self.sec +:= 60
	 self.min -:= 1
	 }

      #
      # Normalize minutes
      #
      self.hour +:= self.min / 60
      self.min %:= 60
      if self.min < 0 then {
	 self.min +:= 60
	 self.hour -:= 1
	 }

      #
      # Normalize hours
      #
      self.mday +:= self.hour / 24
      self.hour %:= 24
      if self.hour < 0 then {
	 self.hour +:= 24
	 self.mday -:= 1
	 }

      #
      # Normalize month, year
      #
      self.year +:= (self.month - 1) / 12
      self.month := 1 + (self.month - 1) % 12
      if self.month < 1 then {
         self.year -:= 1
         self.month +:= 12
	 }

      #
      # Normalize mday downwards, adjusting month, year as we go along
      #
      while self.mday > (n := get_days(self.year, self.month)) do {
         self.mday -:= n
         self.month +:= 1
         if self.month = 13 then {
	    self.month := 1
	    self.year +:= 1
	    }
	 }

      #
      # Normalize mday upwards, adjusting month, year as we go along
      #
      while self.mday < 1 do {
         self.month -:= 1
         if self.month = 0 then {
	    self.month := 12
	    self.year -:= 1
	    }
	 self.mday +:= get_days(self.year, self.month)
	 }

      year_diff := self.year - Time_data_base_year

      days := 365 * year_diff + (year_diff + 3) / 4 - (year_diff + 99) / 100 +
	 (year_diff + 399) / 400 + get_cum_days(year, month) + mday - 1

      return seconds :=  86400 * days + 3600 * hour + 60 * min + sec -
	 zone.get_offset()
   end

   #
   # Compute broken down fields based on seconds past base date
   #
   method compute_broken_down_fields()
      local n, year, flag, l, i
      n := self.seconds + self.zone.get_offset()
      self.sec := n % 60
      n /:= 60
      self.min := n % 60
      n /:= 60
      self.hour := n % 24
      n := n / 24

      # Reduce down to 400 year period - 400 years = 400 * 365.25 - 3
      year := Time_data_base_year + 400 * (n / 146097)
      n %:= 146097

      # Case analysis within the 400 years to reduce to 4 years of 1460 or 1461
      # days.  - flag indicates whether block is 1460 or 1461 days
      if n < 36525 then {       # 1/1/1600 - 31/12/1699 - 25 blocks of 1461 days
	 year +:= 4 * (n / 1461)
	 n %:= 1461
	 flag := 1
	 }
      else if n < 37985 then {    # 1/1/1700 - 31/12/1703 - 1 block of 1460 days
         year +:= 100
         n -:= 36525
	 }
      else if n < 73049 then {  # 1/1/1704 - 31/12/1799 - 24 blocks of 1461 days
	 n -:= 37985
	 year +:= 104 + 4 * (n / 1461)
	 n %:= 1461
	 flag := 1
	 }
      else if n < 74509 then {    # 1/1/1800 - 31/12/1803 - 1 block of 1460 days
	 year +:= 200
	 n -:= 73049
	 }
      else if n < 109573 then { # 1/1/1804 - 31/12/1899 - 24 blocks of 1461 days
	 n -:= 74509
	 year +:= 204 + 4 * (n / 1461)
	 n %:= 1461
	 flag := 1
	 }
      else if n < 111033 then {   # 1/1/1900 - 31/12/1903 - 1 block of 1460 days
	 year +:= 300
	 n -:= 109573
	 }
      else { # n < 146097         1/1/1904 - 31/12/1999 - 24 blocks of 1461 days
	 n -:= 111033
	 year +:= 304 + 4 * (n / 1461)
	 n %:= 1461
	 flag := 1
	 }

      if /flag then {       # 4 years of 365 days each
	 year +:= n / 365
	 n %:= 365
	 }
      else {              # 4 years of 366, 365, 365, 365 days
	 if n > 365 then {
	    year +:= 1 + (n - 366) / 365
	    n := (n - 366) % 365
	    }
	 }

      self.year := year
      get_cum_days(self.year, i := 1 to 13) > n
      self.month := i - 1
      self.mday := n - get_cum_days(self.year, self.month) + 1
   end

   #
   # Set seconds and zone field; re-compute broken down fields
   #
   # @param n the seconds past the base point
   # @param z the zone, as a {Timezone} object, or &null, in which chase
   # @        the system timezone is used.
   #
   method set_seconds(n, zone)
      self.seconds := n
      self.zone := \zone | get_system_timezone()
      self.compute_broken_down_fields()
   end

   #
   # Set year; recompute seconds past the base date.
   #
   method set_year(n)
      self.year := n
      self.compute_seconds()
   end

   #
   # Set month; recompute seconds past the base date.
   #
   method set_month(n)
      self.month := n
      self.compute_seconds()
   end

   #
   # As above,  but if mday is out of bounds for new month,
   # truncate to end of month
   #
   method set_month_truncate(n)
      local t, d
      t := self.mday
      self.mday := 1
      self.month := n
      self.compute_seconds()

      d := get_days(self.year, self.month)
      if t > d then
         t := d
      self.mday := t
      self.compute_seconds()
   end

   #
   # Set mday; recompute seconds past the base date.
   #
   method set_mday(n)
      self.mday := n
      self.compute_seconds()
   end

   #
   # Set hour; recompute seconds past the base date.
   #
   method set_hour(n)
      self.hour := n
      self.compute_seconds()
   end

   #
   # Set min; recompute seconds past the base date.
   #
   method set_min(n)
      self.min := n
      self.compute_seconds()
   end

   #
   # Set seconds past the hour; recompute seconds past the base date.
   #
   method set_sec(n)
      self.sec := n
      self.compute_seconds()
   end

   #
   # Set the time zone offset.  The zone is a Timezone object.
   #
   method set_zone(z)
      self.zone := z
      self.compute_seconds()
   end

   #
   # Get the time zone
   #
   method get_zone()
      return self.zone
   end

   #
   # Get the seconds past the base date
   #
   method get_seconds()
      return self.seconds
   end

   #
   # Get the year.
   #
   method get_year()
      return self.year
   end

   #
   # Get the month.
   #
   method get_month()
      return self.month
   end

   #
   # Get the mday.
   #
   method get_mday()
      return self.mday
   end

   #
   # Get the hour.
   #
   method get_hour()
      return self.hour
   end

   #
   # Get the min.
   #
   method get_min()
      return self.min
   end

   #
   # Get the seconds past the hour.
   #
   method get_sec()
      return self.sec
   end

   #
   # Utility procedure - return cumulative days upto month m in year y
   #
   # @p
   method get_cum_days(y, m)
      return if (y % 4 = 0) & (y % 100 ~= 0 | y % 400 = 0) then	# leap year
         [0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366][m]
      else							# non-leap year
         [0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365][m]
   end

   #
   # Utility procedure - return in month m for year y
   #
   # @p
   method get_days(y, m)
      return if (y % 4 = 0) & (y % 100 ~= 0 | y % 400 = 0) then	# leap year
         [31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31][m]
      else							# non-leap year
         [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31][m]
   end

   #
   # Utility to get next integer
   #
   # Remove and allow the procedure get_int() from str_util.icn to be used
   # instead as the code is identical to the procedure get_int()
   #
   # @p
   #method get_int()
   #   suspend ::tab(::upto(&digits)) & ::integer(::tab(::many(&digits)))
   #end

   #
   # An alternative more liberal form of parsing.  The numeric fields are taken
   # as successive ints in the input: all else is ignored.  The year, month and
   # day are mandatory, but hours, mins, secs are optional. Finally, an optional
   # timezone is allowed.
   #
   method simple_parse(s)
      local y, d, m, hh, mm, ss, z
      s ? {
         (y := get_int() &
          m := get_int() &
          d := get_int()) | return error("y m d missing")
         hh := get_int() | 0
         mm := get_int() | 0
         ss := get_int() | 0
         if ::tab(::upto(Time_data_tzchars)) then
            z := get_known_timezone(::tab(::many(Time_data_tzchars))) |
	    return error("No timezone")
         else
            z := get_system_timezone()
      }
      set_fields(y, m, d, hh, mm, ss, z)
      return
   end

   #
   # Set to the current time
   # @param z an optional {Timezone}.  If omitted, the system timezone is used.
   #
   method set_current_time(z)
      set_seconds(Time_data_unix_base_offset + gettimeofday()[1], z)
   end

   #
   # Return the difference in seconds between the current system time and the
   # time represented by this object.
   #
   method get_age()
      return Time_data_unix_base_offset + gettimeofday()[1] - self.seconds
   end

   #
   # Set the fields
   #
   method set_fields(year, month, mday, hour, min, sec, zone)
      self.year := \year | Time_data_base_year
      self.month := \month | 1
      self.mday := \mday | 1
      self.hour := \hour | 0
      self.min := \min | 0
      self.sec := \sec | 0
      self.zone := \zone | get_system_timezone()
      compute_seconds()
   end

   initially(a[])
      initial {
         init_time()
      }
      if *a = 1 then
         simple_parse(a[1]) | fail
      else if *a >= 3 then
         set_fields ! a
end

#
# Get the current time as a {Time} object
# @param z an optional {Timezone}.  If omitted, the system timezone is used.
#
procedure get_current_time(z)
   local t
   t := Time()
   t.set_current_time(z)
   return t
end

#
# Initialize global data
#
procedure init_time()
   local f, s, t1, t2, offset

   Time_data_months := ["January", "February", "March", "April", "May",
                        "June", "July", "August", "September", "October",
                        "November", "December"]
   Time_data_week_days := ["Sunday", "Monday", "Tuesday", "Wednesday",
			   "Thursday", "Friday", "Saturday", "Sunday"]
   Time_data_tzchars := '+-' ++ &digits ++ &ucase
   Time_data_base_year := 1600     # must be a multiple of 400
   Time_data_unix_base_offset := 11676096000
end

#
# Convert a month string to an month number, eg "feb"->2
#
procedure month_to_num(s)
   local i
   initial {
      init_time()
   }

   s := ::map(s)
   every i := 1 to *Time_data_months do {
      if ::match(s, ::map(Time_data_months[i])) then
         return i
   }
end

#
# Sleep for n milliseconds.  This is for backward compatibility;
# use the built-in function delay() instead.
#
procedure sleep(n)
   return ::delay(\n)
end

#
# Return the current time of day from the system clock, in milliseconds.
#
procedure milliseconds()
   local t := gettimeofday()
   return t.sec*1000 + t.usec/1000
end

procedure microseconds()
   local t := gettimeofday()
   return t.sec*1000000 + t.usec
end

This page produced by UniDoc on 2021/04/15 @ 23:59:43.