|
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 '*'
|