Date and Time Conversions

 Автор: Dr. Brian Marks, Formcroft Ltd.

Источник: The Rexx Language Association

Built-in functions which convert between different formats of dates and times were on the Rexx programmers' "wish-list" for a long time. The reasons for this are clear. In addition to improved presentation of dates, conversion means that simple programming can answer questions like "How many days are between these dates?" and "What is the date of the first Wednesday in May next year?".

When the committee developing the ANSI standard discussed the matter in 1993 there was already a proposal from Mike Cowlishaw on the syntax to be used: second and third arguments allowed on the TIME and DATE built-ins that would specify a value to be converted and the format that value was in. Only the first letter of the format specifier is significant, so we talk of format options as letters. The committee work was in deciding which formats could be converted to which formats, and deciding the actual conversion algorithms.

For dates, the letters B,D,E,N,M,O,S,U, and W are familiar to programmers for specifying the format of the current date. M and W are not suitable formats for a date value that is to be converted because Month or Weekday alone is not enough to specify a date. Some of the allowed conversions have to "guess" the century. These conversions might have been prohibited, but that would be harsh since a "guessing rule" can be chosen which is almost certain to be right for some applications, for example for your personal diary. However, particular applications may need to use better rules than the one chosen for Rexx, for example in converting birth dates, since those dates are known to be in the past.

For times, the letters for conversion formats are C,H,L,M,N and S; elapsed times are not involved.

The details of the formats that are acceptable for conversion are the same as the details of the output when the current date or time is requested. So, for example, 2:54pm is acceptable as a time to be converted but 02:54pm is not.

Rexx has always considered TIME and DATE as associated within a clause, so if you SAY DATE() TIME() around midnight there is no risk that you will get the date from one day and the time within another day. That, however, is not enough to make DATE&TIME a true timestamp, where the same value never occurs twice from the same source of times. The committee added a rule that the time in microseconds will increase between calls and provided TIME('O') to determine the effect of local daylight saving etc. With these additions a true timestamp can be constructed.

Here is the status of the IBM support for these parts of the standard from Christian Michel, Object Rexx Development, GSDL Boeblingen Germany:

"The two problems of the DATE function in Object Rexx described by Brian Marks have been identified and   corrected. Converting to the 'S' format will now preserve leading zeros as required by the ANSI standard. We have also added the conversion from the 'D' format. This functionality apparently was left out of the Object Rexx implementation at the time the ANSI standard was finalized. The updated DATE function will be available with bug fix releases of Object Rexx. These will either be distributed via the OS/2 service channels for Object Rexx included in OS/2 Warp V4, or through our Object Rexx for Windows 95/NT service pages on the Internet."

In September 1997 the REXX standardizing committee proposed extra  arguments on DATE coversions to allow the character used as the separator  between fields to be specified. You can have this feature, and all other time and date conversions, by adding the following code to your program, even if the product you are using does not provide date conversions.

 

/*---------------------------------------------------------------------------*/
/* Time Bif Specifications                                                   */
/*     Acknowledgements: Klaus Hansjakob provided the basic algorithm for    */
/*      time conversion.  Brian Marks provided the coding specific to the    */
/*      Rexx builtin functions.  Ian Collier and Kurt Maerker have provided  */
/*      corrections to errors.                                               */
/*                                                                           */
/*    Note: This version has the extensions which the Rexx standardizing     */
/*      committee proposes for conversion of delimiters.  That is not part   */
/*      of the current Rexx standard.                                        */
/*---------------------------------------------------------------------------*/

Time: procedure
/* This routine is essentially the code from the standard, put in
stand-alone form.  The only 'tricky bit' is that there is no Rexx way
for it to fail with the same error codes as a "real" implementation
would.  It can however give a SYNTAX error, albeit not the desirable
one.  This causing of an error is done by returning with no value.
Since the routine will have been called as a function, this produces
an error. */

  /* Backslash is avoided as some systems don't handle that negation sign. */
  if arg()>3 then
    return
  numeric digits 18
  if arg(1,'E') then
    if pos(translate(left(arg(1),1)),"CEHLMNRS")=0 then
      return
  /* (The standard would also allow 'O' but what this code is running
  on would not.) */
  if arg(3,'E') then    if pos(translate(left(arg(3),1)),"CHLMNS")=0 then
      return
  /* If the third argument is given then the second is mandatory. */
  if arg(3,'E') & arg(2,'E')=0 then
    return
  /* Default the first argument. */
  if arg(1,'E') then
    Option = translate(left(arg(1),1))
  else
    Option = 'N'
  /* If there is no second argument, the current time is returned. */
  if arg(2,'E') = 0 then
    if arg(1,'E') then
      return 'TIME'(arg(1))
    else
      return 'TIME'()
  /* One cannot convert to elapsed times. */
  if pos(Option, 'ERO') > 0 then
    return
  InValue = arg(2)
  if arg(3,'E') then
    InOption = arg(3)
  else
    InOption = 'N'
  HH = 0
  MM = 0
  SS = 0
  HourAdjust = 0
  select
    when InOption == 'C' then do
      parse var InValue HH ':' . +1 MM +2 XX
      if HH = 12 then
        HH = 0
      if XX == 'pm' then
        HourAdjust = 12
    end
    when InOption == 'H' then
      HH = InValue
    when InOption == 'L' | InOption == 'N' then
      parse var InValue HH ':' MM ':' SS
    when InOption == 'M' then
      MM = InValue
    otherwise
      SS = InValue
  end
  if datatype(HH,'W')=0 | datatype(MM,'W')=0 | datatype(SS,'N')=0 then
    return
  HH = HH + HourAdjust
  /* Convert to microseconds */
  Micro = trunc((((HH * 60) + MM) * 60 + SS) * 1000000)
  /* There is no special message for time-out-of-range; the bad-format
  message is used. */
  if Micro 24*3600*1000000 then
    return
  /* Reconvert to further check the original. */
  if TimeFormat(Micro,InOption) == InValue then
    return TimeFormat(Micro, Option)
  return

TimeFormat: procedure
  /* Convert from microseconds to given format. */
  /* The day will be irrelevant; actually it will be the first day possible. */
  x = Time2Date2(arg(1))
  parse value x with Year Month Day Hour Minute Second Microsecond Base Days
  select
    when arg(2) == 'C' then
      select
        when Hour>12 then
          return Hour-12':'right(Minute,2,'0')'pm'
        when Hour=12 then
          return '12:'right(Minute,2,'0')'pm'        when Hour>0 then
          return Hour':'right(Minute,2,'0')'am'
        when Hour=0 then
          return '12:'right(Minute,2,'0')'am'
      end
    when arg(2) == 'H' then return Hour
    when arg(2) == 'L' then
       return right(Hour,2,'0')':'right(Minute,2,'0')':'right(Second,2,'0'),
         || '.'right(Microsecond,6,'0')
    when arg(2) == 'M' then
      return 60*Hour+Minute
    when arg(2) == 'N' then
      return right(Hour,2,'0')':'right(Minute,2,'0')':'right(Second,2,'0')
    otherwise /* arg(2) == 'S' */
      return 3600*Hour+60*Minute+Second
  end

Time2Date:
  /* These are checks on the range of the date. */
  if arg(1) = 315537897600000000 then
    return 'Bad'
  return Time2Date2(arg(1))

Time2Date2: Procedure
  /*  Convert a timestamp to a date.
  Argument is a timestamp (the number of microseconds relative to
  0001 01 01 00:00:00.000000)
  Returns a date in the form:
    year month day hour minute second microsecond base days     */

  /* Argument is relative to the virtual date 0001 01 01 00:00:00.000000 */
  Time = arg(1)

  Second = Time   % 1000000    ; Microsecond = Time   // 1000000
  Minute = Second %      60    ; Second      = Second //      60
  Hour   = Minute %      60    ; Minute      = Minute //      60
  Day    = Hour   %      24    ; Hour        = Hour   //      24

  /* At this point, the days are the days since the 0001 base date. */
  BaseDays = Day
  Day = Day + 1

  /* Compute either the fitting year, or some year not too far earlier.
  Compute the number of days left on the first of January of this year. */
  Year   = Day % 366
  Day    = Day - (Year*365 + Year%4 - Year%100 + Year%400)
  Year   = Year + 1

  /* Now if the number of days left is larger than the number of days
  in the year we computed, increment the year, and decrement the
  number of days accordingly. */
  do while Day > (365 + Leap(Year))
    Day = Day - (365 + Leap(Year))
    Year = Year + 1
  end

  /* At this point, the days left pertain to this year. */
  YearDays = Day

  /* Now step through the months, increment the number of the month,
  and decrement the number of days accordingly (taking into
  consideration that in a leap year February has 29 days), until
  further reducing the number of days and incrementing the month
  would lead to a negative number of days */
  Days = '31 28 31 30 31 30 31 31 30 31 30 31'
  do Month = 1 to words(Days)
    ThisMonth = Word(Days, Month) + (Month = 2) * Leap(Year)
    if Day <= ThisMonth then leave
    Day = Day - ThisMonth
  end

  return Year Month Day Hour Minute Second Microsecond BaseDays YearDays

Leap: procedure
  /* Return 1 if the year given as argument is a leap year, or 0
  otherwise. */
  return (arg(1)//4 = 0) & ((arg(1)//100 <> 0) | (arg(1)//400 = 0))


/*---------------------------------------------------------------------------*/
/* Date Bif Specifications                                                   */
/*---------------------------------------------------------------------------*/

date: procedure
/* This routine is essentially the code from the standard, put in
stand-alone form.  The only 'tricky bit' is that there is no Rexx way
for it to fail with the same error codes as a "real" implementation
would.  It can however give a SYNTAX error, albeit not the desirable
one.  This causing of an error is done by returning with no value.
Since the routine will have been called as a function, this produces
an error. */

  if arg() > 5 then return
  numeric digits 18
  if arg(1,'E') then
    if pos(translate(left(arg(1),1)),"BDEMNOSUW")=0 then
      return

  if arg(3,'E') then
    if pos(translate(left(arg(3),1)),"BDENOSU")=0 then
      return

  /* If the third argument is given then the second is mandatory. */
  if arg(3,'E') & arg(2,'E')=0 then
    return

  /* Default the first argument. */
  if arg(1,'E') then                             /* OutOption                */
    Option = translate(left(arg(1),1))
  else
    Option = 'N'

  /* If there is no second argument, the current time is returned. */
    if arg() <= 1 then
    if arg(1,'E') then
      return 'DATE'(arg(1))
    else
      return 'DATE'()

  if arg(3,'E') then                             /* InOption                 */
    InOption = arg(3)
  else
    InOption = 'N'

  /*>> In September 97 the standardizing committee decided how DATE should <<
    >> be extended to generalize the separators used.                      <

  if Option == 'S' then
    OutSeparator = ''
  else
    OutSeparator = translate(Option,"xx/x //x","BDEMNOUW")

  if arg(4,'E') then do                          /* OutSeparator             */
    /*-----------------------------------------------------------------------*/
    /* The text for the following error 40.46 is:                            */
    /* '<bif> argument <argnumber>, "<value>", is a format incompatible with */
    /* separator specified in argument <argnumber>'                          */
    /*-----------------------------------------------------------------------*/
    if OutSeparator == 'x' then
      return
    OutSeparator = arg(4)

    /*-----------------------------------------------------------------------*/
    /* The text for the following error 40.45 is;                            */
    /* '<bif> argument <argnumber> must be a single non-alphanumeric         */
    /* character or the null string; found <value>"'                         */
    /*-----------------------------------------------------------------------*/
    if length(OutSeparator) > 1 | datatype(OutSeparator,'A') then
      return
  end

  if InOption == 'S' then
    InSeparator = ''
  else
    InSeparator = translate(InOption,"xx/ //","BDENOU")

  if arg(5,'E') then do                          /* InSeparator              */
    if InSeparator == 'x' then
      return
    InSeparator = arg(5)
    if length(InSeparator) > 1 | datatype(InSeparator,'A') then
      return
  end

  /* English spellings are used, even if messages not in English are used.   */
  Months = 'January February March April May June July',
           'August September October November December'

  WeekDays = 'Monday Tuesday Wednesday Thursday Friday Saturday Sunday'

  Value = arg(2)

  /* First try for Year Month Day */
  Logic = 'NS'
  select
    when InOption == 'N' then do
      if InSeparator == '' then do
        if length(Value)<9 then return
        Year = right(Value,4)
        MonthIs = substr(right(Value,7),1,3)
        Day = left(Value,length(Value)-7)
      end
      else
        parse var Value Day (InSeparator) MonthIs (InSeparator) Year
      do Month = 1 to 12
        if left(word(Months, Month), 3) == MonthIs then leave
      end Month
    end
    when InOption == 'S' then
      if InSeparator == '' then
        parse var Value Year +4 Month +2 Day
      else
        parse var Value Year (InSeparator) Month (InSeparator) Day
    otherwise
      Logic = 'EOU' /* or BD */
  end

  /* Next try for year without century */
  if logic = 'EOU' then
    Select
      when InOption == 'E' then
        if InSeparator == '' then
          parse var Value Day +2 Month +2 YY
        else
          parse var Value Day (InSeparator) Month (InSeparator) YY
      when InOption == 'O' then
        if InSeparator == '' then
          parse var Value YY +2 Month +2 Day
        else
          parse var Value YY (InSeparator) Month (InSeparator) Day
      when InOption == 'U' then
        if InSeparator == '' then
          parse var Value Month +2 Day +2 YY
        else
          parse var Value Month (InSeparator) Day (InSeparator) YY
      otherwise
        Logic = 'BD'
    end

  if Logic = 'EOU' then do
    /* The century is assumed, on the basis of the current year. */
    if datatype(YY,'W')=0 then
      return
    YearNow = left('DATE'('S'),4)
    Year = YY
    do while Year < YearNow-50
      Year = Year + 100
    end
  end /* Century assumption */

  if Logic <> 'BD' then do
    /* Convert Month & Day to Days of year. */
    if datatype(Month,'W')=0 | datatype(Day,'W')=0 | datatype(Year,'W')=0 then
      return
    Days = word('0 31 59 90 120 151 181 212 243 273 304 334',Month),
                                      + (Month>2)*Leap(Year) + Day-1
  end
  else
    if datatype(Value,'W')=0 then
      return
  if InOption == 'D' then do
    Year = left('DATE'('S'),4)
    Days = Value - 1 /* 'D' includes current day */
  end

  /* Convert to BaseDays */
  if InOption <> 'B' then
    BaseDays = (Year-1)*365 + (Year-1)%4 - (Year-1)%100 + (Year-1)%400 + Days
  else
    Basedays = Value

  /* Convert to microseconds from 0001 */
  Micro = BaseDays * 86400 * 1000000

  /* Reconvert to check the original. (eg for Month = 99) */
  if DateFormat(Micro,InOption,InSeparator) == Value then
    return DateFormat(Micro,Option,OutSeparator)
  return

DateFormat:

  /* Convert from microseconds to given format and separator. */
  x = Time2Date(arg(1))
  if x = 'Bad' then
    return 'Bad'
  parse value x with Year Month Day Hour Minute Second Microsecond Base Days
  select
    when arg(2) == 'B' then
      return Base
    when arg(2) == 'D' then
      return Days
    when arg(2) == 'E' then
      return right(Day,2,'0')(arg(3))right(Month,2,'0')(arg(3))right(Year,2,'0')
    when arg(2) == 'M' then
      return word(Months,Month)
    when arg(2) == 'N' then
      return (Day)(arg(3))left(word(Months,Month),3)(arg(3))right(Year,4,'0')
    when arg(2) == 'O' then
      return right(Year,2,'0')(arg(3))right(Month,2,'0')(arg(3))right(Day,2,'0')
    when arg(2) == 'S' then
      return right(Year,4,'0')(arg(3))right(Month,2,'0')(arg(3))right(Day,2,'0')
    when arg(2) == 'U' then
      return right(Month,2,'0')(arg(3))right(Day,2,'0')(arg(3))right(Year,2,'0')
    otherwise /* arg(2) == 'W' */
      return word(Weekdays,1+Base//7)
  end


/* It must be a variant of Murphy's law that if you write some code that
others might use it turns out that the code depends on something that
different interpreters treat differently.  In this particular case,
interpreters differ on whether the error of a function failing to
return a result is an error that the level calling the function sees,or an error that the function itself sees. */

GoodDate: procedure
  signal on syntax name Better_Be_Unique1
  /* Next two clauses are deliberately on the same line. */
  GoodDateSigl = RecordSigl(); GoodDateResult = date(arg(2),arg(1),arg(2))
  if GoodDateResult='*' then
    return 0
  return 1

Better_Be_Unique1:
  if sigl==GoodDateSigl then
    /* This code being run by interpreter that raises error in the caller */
    return 0
  /* This code being run by interpreter that raises error in the callee */
  return '*'

RecordSigl:
  return sigl

GoodTime: procedure
  signal on syntax name Better_Be_Unique2
  /* Next two clauses are deliberately on the same line. */
  GoodTimeSigl = RecordSigl(); GoodTimeResult = time(arg(2),arg(1),arg(2))
  if GoodTimeResult='*' then
    return 0
  return 1

Better_Be_Unique2:
  if sigl==GoodTimeSigl then
    /* This code being run by interpreter that raises error in the caller */
    return 0
  /* This code being run by interpreter that raises error in the callee */
  return '*'