#
# $Id: time.icn,v 1.3 2004/12/10 19:04:03 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(&ucase ++ &lcase, 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(upto('\'') | 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 / 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

      #
      # 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(self.year, self.month) + self.mday - 1

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

   #
   # Compute broken down fields based on seconds past base date
   #
   method compute_broken_down_fields()
      local n, year, flag, l
      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
         [0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366][m]   # leap year
      else
         [0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365][m]   # non-leap year
   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
         [31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31][m]               # leap year
      else
         [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31][m]               # non-leap year
   end

   #
   # Utility to get next integer
   #
   # @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
      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

   #
   # 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

#
# 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)
   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 curr_time_millis()
   local t
   t := gettimeofday()
   return t[1] * 1000 + t[2] / 1000
end