diff options
Diffstat (limited to 'generic/tclClock.c')
| -rw-r--r-- | generic/tclClock.c | 3359 |
1 files changed, 2975 insertions, 384 deletions
diff --git a/generic/tclClock.c b/generic/tclClock.c index 4951f04..c16ae74 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -5,16 +5,18 @@ * the time and date facilities of TclX, by Mark Diekhans and Karl * Lehenbauer. * - * Copyright © 1991-1995 Karl Lehenbauer & Mark Diekhans. - * Copyright © 1995 Sun Microsystems, Inc. - * Copyright © 2004 Kevin B. Kenny. All rights reserved. + * Copyright (c) 1991-1995 Karl Lehenbauer & Mark Diekhans. + * Copyright (c) 1995 Sun Microsystems, Inc. + * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. + * Copyright (c) 2015 by Sergey G. Brester aka sebres. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" -#include "tclTomMath.h" +#include "tclStrIdxTree.h" +#include "tclDate.h" /* * Windows has mktime. The configurators do not check. @@ -25,21 +27,6 @@ #endif /* - * Constants - */ - -#define JULIAN_DAY_POSIX_EPOCH 2440588 -#define SECONDS_PER_DAY 86400 -#define JULIAN_SEC_POSIX_EPOCH (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \ - * SECONDS_PER_DAY) -#define FOUR_CENTURIES 146097 /* days */ -#define JDAY_1_JAN_1_CE_JULIAN 1721424 -#define JDAY_1_JAN_1_CE_GREGORIAN 1721426 -#define ONE_CENTURY_GREGORIAN 36524 /* days */ -#define FOUR_YEARS 1461 /* days */ -#define ONE_YEAR 365 /* days */ - -/* * Table of the days in each month, leap and common years */ @@ -56,70 +43,13 @@ static const int daysInPriorMonths[2][13] = { * Enumeration of the string literals used in [clock] */ -typedef enum ClockLiteral { - LIT__NIL, - LIT__DEFAULT_FORMAT, - LIT_BCE, LIT_C, - LIT_CANNOT_USE_GMT_AND_TIMEZONE, - LIT_CE, - LIT_DAYOFMONTH, LIT_DAYOFWEEK, LIT_DAYOFYEAR, - LIT_ERA, LIT_GMT, LIT_GREGORIAN, - LIT_INTEGER_VALUE_TOO_LARGE, - LIT_ISO8601WEEK, LIT_ISO8601YEAR, - LIT_JULIANDAY, LIT_LOCALSECONDS, - LIT_MONTH, - LIT_SECONDS, LIT_TZNAME, LIT_TZOFFSET, - LIT_YEAR, - LIT__END -} ClockLiteral; -static const char *const literals[] = { - "", - "%a %b %d %H:%M:%S %Z %Y", - "BCE", "C", - "cannot use -gmt and -timezone in same call", - "CE", - "dayOfMonth", "dayOfWeek", "dayOfYear", - "era", ":GMT", "gregorian", - "integer value too large to represent", - "iso8601Week", "iso8601Year", - "julianDay", "localSeconds", - "month", - "seconds", "tzName", "tzOffset", - "year" -}; - -/* - * Structure containing the client data for [clock] - */ +CLOCK_LITERAL_ARRAY(Literals); -typedef struct { - size_t refCount; /* Number of live references. */ - Tcl_Obj **literals; /* Pool of object literals. */ -} ClockClientData; +/* Msgcat literals for exact match (mcKey) */ +CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLiterals, ""); +/* Msgcat index literals prefixed with _IDX_, used for quick dictionary search */ +CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLitIdxs, "_IDX_"); -/* - * Structure containing the fields used in [clock format] and [clock scan] - */ - -typedef struct { - Tcl_WideInt seconds; /* Time expressed in seconds from the Posix - * epoch */ - Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds - * from the Posix epoch */ - int tzOffset; /* Time zone offset in seconds east of - * Greenwich */ - Tcl_Obj *tzName; /* Time zone name */ - int julianDay; /* Julian Day Number in local time zone */ - int isBce; /* 1 if BCE */ - int gregorian; /* Flag == 1 if the date is Gregorian */ - int year; /* Year of the era */ - int dayOfYear; /* Day of the year (1 January == 1) */ - int month; /* Month number */ - int dayOfMonth; /* Day of the month */ - int iso8601Year; /* ISO8601 week-based year */ - int iso8601Week; /* ISO8601 week number */ - int dayOfWeek; /* Day of the week */ -} TclDateFields; static const char *const eras[] = { "CE", "BCE", NULL }; /* @@ -140,41 +70,82 @@ TCL_DECLARE_MUTEX(clockMutex) * Function prototypes for local procedures in this file: */ -static int ConvertUTCToLocal(Tcl_Interp *, - TclDateFields *, Tcl_Obj *, int); static int ConvertUTCToLocalUsingTable(Tcl_Interp *, - TclDateFields *, Tcl_Size, Tcl_Obj *const[]); + TclDateFields *, int, Tcl_Obj *const[], + Tcl_WideInt *rangesVal); static int ConvertUTCToLocalUsingC(Tcl_Interp *, TclDateFields *, int); -static int ConvertLocalToUTC(Tcl_Interp *, - TclDateFields *, Tcl_Obj *, int); +static int ConvertLocalToUTC(ClientData clientData, Tcl_Interp *, + TclDateFields *, Tcl_Obj *timezoneObj, int); static int ConvertLocalToUTCUsingTable(Tcl_Interp *, - TclDateFields *, Tcl_Size, Tcl_Obj *const[]); + TclDateFields *, int, Tcl_Obj *const[], + Tcl_WideInt *rangesVal); static int ConvertLocalToUTCUsingC(Tcl_Interp *, TclDateFields *, int); -static Tcl_Obj * LookupLastTransition(Tcl_Interp *, Tcl_WideInt, - Tcl_Size, Tcl_Obj *const *); +static int ClockConfigureObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void GetYearWeekDay(TclDateFields *, int); static void GetGregorianEraYearDay(TclDateFields *, int); static void GetMonthDay(TclDateFields *); -static void GetJulianDayFromEraYearWeekDay(TclDateFields *, int); -static void GetJulianDayFromEraYearMonthDay(TclDateFields *, int); -static int IsGregorianLeapYear(TclDateFields *); -static int WeekdayOnOrBefore(int, int); -static Tcl_ObjCmdProc ClockClicksObjCmd; -static Tcl_ObjCmdProc ClockConvertlocaltoutcObjCmd; -static Tcl_ObjCmdProc ClockGetdatefieldsObjCmd; -static Tcl_ObjCmdProc ClockGetjuliandayfromerayearmonthdayObjCmd; -static Tcl_ObjCmdProc ClockGetjuliandayfromerayearweekdayObjCmd; -static Tcl_ObjCmdProc ClockGetenvObjCmd; -static Tcl_ObjCmdProc ClockMicrosecondsObjCmd; -static Tcl_ObjCmdProc ClockMillisecondsObjCmd; -static Tcl_ObjCmdProc ClockParseformatargsObjCmd; -static Tcl_ObjCmdProc ClockSecondsObjCmd; +static Tcl_WideInt WeekdayOnOrBefore(int, Tcl_WideInt); +static int ClockClicksObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int ClockConvertlocaltoutcObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); + +static int ClockGetDateFields(ClientData clientData, + Tcl_Interp *interp, TclDateFields *fields, + Tcl_Obj *timezoneObj, int changeover); +static int ClockGetdatefieldsObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int ClockGetjuliandayfromerayearmonthdayObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int ClockGetjuliandayfromerayearweekdayObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int ClockGetenvObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int ClockMicrosecondsObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int ClockMillisecondsObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int ClockSecondsObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int ClockFormatObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int ClockScanObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int ClockScanCommit( + DateInfo *info, + ClockFmtScnCmdArgs *opts); +static int ClockFreeScan( + DateInfo *info, + Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts); +static int ClockCalcRelTime( + DateInfo *info); +static int ClockAddObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int ClockValidDate( + DateInfo *, + ClockFmtScnCmdArgs *, int stage); static struct tm * ThreadSafeLocalTime(const time_t *); -static void TzsetIfNecessary(void); -static void ClockDeleteCmdProc(void *); +static size_t TzsetIfNecessary(void); +static void ClockDeleteCmdProc(ClientData); +static int ClockSafeCatchCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); /* * Structure containing description of "native" clock commands to create. */ @@ -183,22 +154,32 @@ struct ClockCommand { const char *name; /* The tail of the command name. The full name * is "::tcl::clock::<name>". When NULL marks * the end of the table. */ - Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This + Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This * will always have the ClockClientData sent * to it, but may well ignore this data. */ + CompileProc *compileProc; /* The compiler for the command. */ + ClientData clientData; /* Any clientData to give the command (if NULL + * a reference to ClockClientData will be sent) */ }; static const struct ClockCommand clockCommands[] = { - { "getenv", ClockGetenvObjCmd }, - { "Oldscan", TclClockOldscanObjCmd }, - { "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd }, - { "GetDateFields", ClockGetdatefieldsObjCmd }, - { "GetJulianDayFromEraYearMonthDay", - ClockGetjuliandayfromerayearmonthdayObjCmd }, - { "GetJulianDayFromEraYearWeekDay", - ClockGetjuliandayfromerayearweekdayObjCmd }, - { "ParseFormatArgs", ClockParseformatargsObjCmd }, - { NULL, NULL } + {"add", ClockAddObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL}, + {"format", ClockFormatObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"getenv", ClockGetenvObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"microseconds", ClockMicrosecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(1)}, + {"milliseconds", ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(2)}, + {"scan", ClockScanObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, INT2PTR(3)}, + {"configure", ClockConfigureObjCmd, NULL, NULL}, + {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd, NULL, NULL}, + {"GetDateFields", ClockGetdatefieldsObjCmd, NULL, NULL}, + {"GetJulianDayFromEraYearMonthDay", + ClockGetjuliandayfromerayearmonthdayObjCmd, NULL, NULL}, + {"GetJulianDayFromEraYearWeekDay", + ClockGetjuliandayfromerayearweekdayObjCmd, NULL, NULL}, + {"catch", ClockSafeCatchCmd, TclCompileBasicMin1ArgCmd, NULL}, + {NULL, NULL, NULL, NULL} }; /* @@ -227,22 +208,10 @@ TclClockInit( char cmdName[50]; /* Buffer large enough to hold the string *::tcl::clock::GetJulianDayFromEraYearMonthDay * plus a terminating NUL. */ + Command *cmdPtr; ClockClientData *data; int i; - /* Structure of the 'clock' ensemble */ - - static const EnsembleImplMap clockImplMap[] = { - {"add", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, - {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL, NULL, 0}, - {"format", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, - {"microseconds", ClockMicrosecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(1), 0}, - {"milliseconds", ClockMillisecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(2), 0}, - {"scan", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL , 0}, - {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(3), 0}, - {NULL, NULL, NULL, NULL, NULL, 0} - }; - /* * Safe interps get [::clock] as alias to a parent, so do not need their * own copies of the support routines. @@ -260,27 +229,1166 @@ TclClockInit( data->refCount = 0; data->literals = (Tcl_Obj **)Tcl_Alloc(LIT__END * sizeof(Tcl_Obj*)); for (i = 0; i < LIT__END; ++i) { - data->literals[i] = Tcl_NewStringObj(literals[i], -1); - Tcl_IncrRefCount(data->literals[i]); + Tcl_InitObjRef(data->literals[i], Tcl_NewStringObj(Literals[i], -1)); } + data->mcLiterals = NULL; + data->mcLitIdxs = NULL; + data->mcDicts = NULL; + data->lastTZEpoch = 0; + data->currentYearCentury = ClockDefaultYearCentury; + data->yearOfCenturySwitch = ClockDefaultCenturySwitch; + data->validMinYear = INT_MIN; + data->validMaxYear = INT_MAX; + /* corresponds max of JDN in sqlite - 9999-12-31 23:59:59 per default */ + data->maxJDN = 5373484.499999994; + + data->systemTimeZone = NULL; + data->systemSetupTZData = NULL; + data->gmtSetupTimeZoneUnnorm = NULL; + data->gmtSetupTimeZone = NULL; + data->gmtSetupTZData = NULL; + data->gmtTZName = NULL; + data->lastSetupTimeZoneUnnorm = NULL; + data->lastSetupTimeZone = NULL; + data->lastSetupTZData = NULL; + data->prevSetupTimeZoneUnnorm = NULL; + data->prevSetupTimeZone = NULL; + data->prevSetupTZData = NULL; + + data->defaultLocale = NULL; + data->defaultLocaleDict = NULL; + data->currentLocale = NULL; + data->currentLocaleDict = NULL; + data->lastUsedLocaleUnnorm = NULL; + data->lastUsedLocale = NULL; + data->lastUsedLocaleDict = NULL; + data->prevUsedLocaleUnnorm = NULL; + data->prevUsedLocale = NULL; + data->prevUsedLocaleDict = NULL; + + data->lastBase.timezoneObj = NULL; + + memset(&data->lastTZOffsCache, 0, sizeof(data->lastTZOffsCache)); + + data->defFlags = 0; /* * Install the commands. - * TODO - Let Tcl_MakeEnsemble do this? */ #define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */ memcpy(cmdName, "::tcl::clock::", TCL_CLOCK_PREFIX_LEN); for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) { + ClientData clientData; + strcpy(cmdName + TCL_CLOCK_PREFIX_LEN, clockCmdPtr->name); - data->refCount++; - Tcl_CreateObjCommand(interp, cmdName, clockCmdPtr->objCmdProc, data, - ClockDeleteCmdProc); + if (!(clientData = clockCmdPtr->clientData)) { + clientData = data; + data->refCount++; + } + cmdPtr = (Command *)Tcl_CreateObjCommand(interp, cmdName, + clockCmdPtr->objCmdProc, clientData, + clockCmdPtr->clientData ? NULL : ClockDeleteCmdProc); + cmdPtr->compileProc = clockCmdPtr->compileProc ? + clockCmdPtr->compileProc : TclCompileBasicMin0ArgCmd; + } +} + +/* + *---------------------------------------------------------------------- + * + * ClockConfigureClear -- + * + * Clean up cached resp. run-time storages used in clock commands. + * + * Shared usage for clean-up (ClockDeleteCmdProc) and "configure -clear". + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +ClockConfigureClear( + ClockClientData *data) +{ + ClockFrmScnClearCaches(); + + data->lastTZEpoch = 0; + Tcl_UnsetObjRef(data->systemTimeZone); + Tcl_UnsetObjRef(data->systemSetupTZData); + Tcl_UnsetObjRef(data->gmtSetupTimeZoneUnnorm); + Tcl_UnsetObjRef(data->gmtSetupTimeZone); + Tcl_UnsetObjRef(data->gmtSetupTZData); + Tcl_UnsetObjRef(data->gmtTZName); + Tcl_UnsetObjRef(data->lastSetupTimeZoneUnnorm); + Tcl_UnsetObjRef(data->lastSetupTimeZone); + Tcl_UnsetObjRef(data->lastSetupTZData); + Tcl_UnsetObjRef(data->prevSetupTimeZoneUnnorm); + Tcl_UnsetObjRef(data->prevSetupTimeZone); + Tcl_UnsetObjRef(data->prevSetupTZData); + + Tcl_UnsetObjRef(data->defaultLocale); + data->defaultLocaleDict = NULL; + Tcl_UnsetObjRef(data->currentLocale); + data->currentLocaleDict = NULL; + Tcl_UnsetObjRef(data->lastUsedLocaleUnnorm); + Tcl_UnsetObjRef(data->lastUsedLocale); + data->lastUsedLocaleDict = NULL; + Tcl_UnsetObjRef(data->prevUsedLocaleUnnorm); + Tcl_UnsetObjRef(data->prevUsedLocale); + data->prevUsedLocaleDict = NULL; + + Tcl_UnsetObjRef(data->lastBase.timezoneObj); + + Tcl_UnsetObjRef(data->lastTZOffsCache[0].timezoneObj); + Tcl_UnsetObjRef(data->lastTZOffsCache[0].tzName); + Tcl_UnsetObjRef(data->lastTZOffsCache[1].timezoneObj); + Tcl_UnsetObjRef(data->lastTZOffsCache[1].tzName); + + Tcl_UnsetObjRef(data->mcDicts); +} + +/* + *---------------------------------------------------------------------- + * + * ClockDeleteCmdProc -- + * + * Remove a reference to the clock client data, and clean up memory + * when it's all gone. + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ +static void +ClockDeleteCmdProc( + ClientData clientData) /* Opaque pointer to the client data */ +{ + ClockClientData *data = (ClockClientData *)clientData; + int i; + + if (data->refCount-- <= 1) { + for (i = 0; i < LIT__END; ++i) { + Tcl_DecrRefCount(data->literals[i]); + } + if (data->mcLiterals != NULL) { + for (i = 0; i < MCLIT__END; ++i) { + Tcl_DecrRefCount(data->mcLiterals[i]); + } + data->mcLiterals = NULL; + } + if (data->mcLitIdxs != NULL) { + for (i = 0; i < MCLIT__END; ++i) { + Tcl_DecrRefCount(data->mcLitIdxs[i]); + } + data->mcLitIdxs = NULL; + } + + ClockConfigureClear(data); + + Tcl_Free(data->literals); + Tcl_Free(data); + } +} + +/* + *---------------------------------------------------------------------- + * + * SavePrevTimezoneObj -- + * + * Used to store previously used/cached time zone (makes it reusable). + * + * This enables faster switch between time zones (e. g. to convert from one to another). + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static inline void +SavePrevTimezoneObj( + ClockClientData *dataPtr) /* Client data containing literal pool */ +{ + Tcl_Obj *timezoneObj = dataPtr->lastSetupTimeZone; + if (timezoneObj && timezoneObj != dataPtr->prevSetupTimeZone) { + Tcl_SetObjRef(dataPtr->prevSetupTimeZoneUnnorm, dataPtr->lastSetupTimeZoneUnnorm); + Tcl_SetObjRef(dataPtr->prevSetupTimeZone, timezoneObj); + Tcl_SetObjRef(dataPtr->prevSetupTZData, dataPtr->lastSetupTZData); } +} + +/* + *---------------------------------------------------------------------- + * + * NormTimezoneObj -- + * + * Normalizes the timezone object (used for caching puposes). + * + * If already cached time zone could be found, returns this + * object (last setup or last used, system (current) or gmt). + * + * Results: + * Normalized tcl object pointer. + * + *---------------------------------------------------------------------- + */ - /* Make the clock ensemble */ +static Tcl_Obj * +NormTimezoneObj( + ClockClientData *dataPtr, /* Client data containing literal pool */ + Tcl_Obj *timezoneObj, /* Name of zone to find */ + int *loaded) /* Used to recognized TZ was loaded */ +{ + const char *tz; - TclMakeEnsemble(interp, "clock", clockImplMap); + *loaded = 1; + if ( timezoneObj == dataPtr->lastSetupTimeZoneUnnorm + && dataPtr->lastSetupTimeZone != NULL + ) { + return dataPtr->lastSetupTimeZone; + } + if ( timezoneObj == dataPtr->prevSetupTimeZoneUnnorm + && dataPtr->prevSetupTimeZone != NULL + ) { + return dataPtr->prevSetupTimeZone; + } + if (timezoneObj == dataPtr->gmtSetupTimeZoneUnnorm + && dataPtr->gmtSetupTimeZone != NULL + ) { + return dataPtr->literals[LIT_GMT]; + } + if ( timezoneObj == dataPtr->lastSetupTimeZone + || timezoneObj == dataPtr->prevSetupTimeZone + || timezoneObj == dataPtr->gmtSetupTimeZone + || timezoneObj == dataPtr->systemTimeZone + ) { + return timezoneObj; + } + + tz = TclGetString(timezoneObj); + if (dataPtr->lastSetupTimeZone != NULL && + strcmp(tz, TclGetString(dataPtr->lastSetupTimeZone)) == 0 + ) { + Tcl_SetObjRef(dataPtr->lastSetupTimeZoneUnnorm, timezoneObj); + return dataPtr->lastSetupTimeZone; + } + if (dataPtr->prevSetupTimeZone != NULL && + strcmp(tz, TclGetString(dataPtr->prevSetupTimeZone)) == 0 + ) { + Tcl_SetObjRef(dataPtr->prevSetupTimeZoneUnnorm, timezoneObj); + return dataPtr->prevSetupTimeZone; + } + if (dataPtr->systemTimeZone != NULL && + strcmp(tz, TclGetString(dataPtr->systemTimeZone)) == 0 + ) { + return dataPtr->systemTimeZone; + } + if (strcmp(tz, Literals[LIT_GMT]) == 0) { + Tcl_SetObjRef(dataPtr->gmtSetupTimeZoneUnnorm, timezoneObj); + if (dataPtr->gmtSetupTimeZone == NULL) { + *loaded = 0; + } + return dataPtr->literals[LIT_GMT]; + } + /* unknown/unloaded tz - recache/revalidate later as last-setup if needed */ + *loaded = 0; + return timezoneObj; +} + +/* + *---------------------------------------------------------------------- + * + * ClockGetSystemLocale -- + * + * Returns system locale. + * + * Executes ::tcl::clock::GetSystemLocale in given interpreter. + * + * Results: + * Returns system locale tcl object. + * + *---------------------------------------------------------------------- + */ + +static inline Tcl_Obj * +ClockGetSystemLocale( + ClockClientData *dataPtr, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp) /* Tcl interpreter */ +{ + if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETSYSTEMLOCALE], 0) != TCL_OK) { + return NULL; + } + + return Tcl_GetObjResult(interp); +} +/* + *---------------------------------------------------------------------- + * + * ClockGetCurrentLocale -- + * + * Returns current locale. + * + * Executes ::tcl::clock::mclocale in given interpreter. + * + * Results: + * Returns current locale tcl object. + * + *---------------------------------------------------------------------- + */ + +static inline Tcl_Obj * +ClockGetCurrentLocale( + ClockClientData *dataPtr, /* Client data containing literal pool */ + Tcl_Interp *interp) /* Tcl interpreter */ +{ + if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETCURRENTLOCALE], 0) != TCL_OK) { + return NULL; + } + + Tcl_SetObjRef(dataPtr->currentLocale, Tcl_GetObjResult(interp)); + dataPtr->currentLocaleDict = NULL; + Tcl_ResetResult(interp); + + return dataPtr->currentLocale; +} + +/* + *---------------------------------------------------------------------- + * + * SavePrevLocaleObj -- + * + * Used to store previously used/cached locale (makes it reusable). + * + * This enables faster switch between locales (e. g. to convert from one to another). + * + * Results: + * None. + * + *---------------------------------------------------------------------- + */ + +static inline void +SavePrevLocaleObj( + ClockClientData *dataPtr) /* Client data containing literal pool */ +{ + Tcl_Obj *localeObj = dataPtr->lastUsedLocale; + if (localeObj && localeObj != dataPtr->prevUsedLocale) { + Tcl_SetObjRef(dataPtr->prevUsedLocaleUnnorm, dataPtr->lastUsedLocaleUnnorm); + Tcl_SetObjRef(dataPtr->prevUsedLocale, localeObj); + /* mcDicts owns reference to dict */ + dataPtr->prevUsedLocaleDict = dataPtr->lastUsedLocaleDict; + } +} + +/* + *---------------------------------------------------------------------- + * + * NormLocaleObj -- + * + * Normalizes the locale object (used for caching puposes). + * + * If already cached locale could be found, returns this + * object (current, system (OS) or last used locales). + * + * Results: + * Normalized tcl object pointer. + * + *---------------------------------------------------------------------- + */ + +static Tcl_Obj * +NormLocaleObj( + ClockClientData *dataPtr, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *localeObj, + Tcl_Obj **mcDictObj) +{ + const char *loc, *loc2; + if ( localeObj == NULL + || localeObj == dataPtr->literals[LIT_C] + || localeObj == dataPtr->defaultLocale + ) { + *mcDictObj = dataPtr->defaultLocaleDict; + return dataPtr->defaultLocale ? + dataPtr->defaultLocale : dataPtr->literals[LIT_C]; + } + if ( localeObj == dataPtr->currentLocale + || localeObj == dataPtr->literals[LIT_CURRENT] + ) { + if (dataPtr->currentLocale == NULL) { + ClockGetCurrentLocale(dataPtr, interp); + } + *mcDictObj = dataPtr->currentLocaleDict; + return dataPtr->currentLocale; + } + if ( localeObj == dataPtr->lastUsedLocale + || localeObj == dataPtr->lastUsedLocaleUnnorm + ) { + *mcDictObj = dataPtr->lastUsedLocaleDict; + return dataPtr->lastUsedLocale; + } + if ( localeObj == dataPtr->prevUsedLocale + || localeObj == dataPtr->prevUsedLocaleUnnorm + ) { + *mcDictObj = dataPtr->prevUsedLocaleDict; + return dataPtr->prevUsedLocale; + } + + loc = TclGetString(localeObj); + if ( dataPtr->currentLocale != NULL + && ( localeObj == dataPtr->currentLocale + || (localeObj->length == dataPtr->currentLocale->length + && strcasecmp(loc, TclGetString(dataPtr->currentLocale)) == 0 + ) + ) + ) { + *mcDictObj = dataPtr->currentLocaleDict; + return dataPtr->currentLocale; + } + if ( dataPtr->lastUsedLocale != NULL + && ( localeObj == dataPtr->lastUsedLocale + || (localeObj->length == dataPtr->lastUsedLocale->length + && strcasecmp(loc, TclGetString(dataPtr->lastUsedLocale)) == 0 + ) + ) + ) { + *mcDictObj = dataPtr->lastUsedLocaleDict; + Tcl_SetObjRef(dataPtr->lastUsedLocaleUnnorm, localeObj); + return dataPtr->lastUsedLocale; + } + if ( dataPtr->prevUsedLocale != NULL + && ( localeObj == dataPtr->prevUsedLocale + || (localeObj->length == dataPtr->prevUsedLocale->length + && strcasecmp(loc, TclGetString(dataPtr->prevUsedLocale)) == 0 + ) + ) + ) { + *mcDictObj = dataPtr->prevUsedLocaleDict; + Tcl_SetObjRef(dataPtr->prevUsedLocaleUnnorm, localeObj); + return dataPtr->prevUsedLocale; + } + if ( + (localeObj->length == 1 /* C */ + && strcasecmp(loc, Literals[LIT_C]) == 0) + || (dataPtr->defaultLocale && (loc2 = TclGetString(dataPtr->defaultLocale)) + && localeObj->length == dataPtr->defaultLocale->length + && strcasecmp(loc, loc2) == 0) + ) { + *mcDictObj = dataPtr->defaultLocaleDict; + return dataPtr->defaultLocale ? + dataPtr->defaultLocale : dataPtr->literals[LIT_C]; + } + if ( localeObj->length == 7 /* current */ + && strcasecmp(loc, Literals[LIT_CURRENT]) == 0 + ) { + if (dataPtr->currentLocale == NULL) { + ClockGetCurrentLocale(dataPtr, interp); + } + *mcDictObj = dataPtr->currentLocaleDict; + return dataPtr->currentLocale; + } + if ( + (localeObj->length == 6 /* system */ + && strcasecmp(loc, Literals[LIT_SYSTEM]) == 0) + ) { + SavePrevLocaleObj(dataPtr); + Tcl_SetObjRef(dataPtr->lastUsedLocaleUnnorm, localeObj); + localeObj = ClockGetSystemLocale(dataPtr, interp); + Tcl_SetObjRef(dataPtr->lastUsedLocale, localeObj); + *mcDictObj = NULL; + return localeObj; + } + *mcDictObj = NULL; + return localeObj; +} + +/* + *---------------------------------------------------------------------- + * + * ClockMCDict -- + * + * Retrieves a localized storage dictionary object for the given + * locale object. + * + * This corresponds with call `::tcl::clock::mcget locale`. + * Cached representation stored in options (for further access). + * + * Results: + * Tcl-object contains smart reference to msgcat dictionary. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +ClockMCDict(ClockFmtScnCmdArgs *opts) +{ + ClockClientData *dataPtr = (ClockClientData *)opts->clientData; + + /* if dict not yet retrieved */ + if (opts->mcDictObj == NULL) { + + /* if locale was not yet used */ + if ( !(opts->flags & CLF_LOCALE_USED) ) { + + opts->localeObj = NormLocaleObj((ClockClientData *)opts->clientData, opts->interp, + opts->localeObj, &opts->mcDictObj); + + if (opts->localeObj == NULL) { + Tcl_SetObjResult(opts->interp, + Tcl_NewStringObj("locale not specified and no default locale set", -1)); + Tcl_SetErrorCode(opts->interp, "CLOCK", "badOption", NULL); + return NULL; + } + opts->flags |= CLF_LOCALE_USED; + + /* check locale literals already available (on demand creation) */ + if (dataPtr->mcLiterals == NULL) { + int i; + dataPtr->mcLiterals = (Tcl_Obj **)Tcl_Alloc(MCLIT__END * sizeof(Tcl_Obj*)); + for (i = 0; i < MCLIT__END; ++i) { + Tcl_InitObjRef(dataPtr->mcLiterals[i], + Tcl_NewStringObj(MsgCtLiterals[i], -1)); + } + } + } + + /* check or obtain mcDictObj (be sure it's modifiable) */ + if (opts->mcDictObj == NULL || opts->mcDictObj->refCount > 1) { + int ref = 1; + + /* first try to find locale catalog dict */ + if (dataPtr->mcDicts == NULL) { + Tcl_SetObjRef(dataPtr->mcDicts, Tcl_NewDictObj()); + } + Tcl_DictObjGet(NULL, dataPtr->mcDicts, + opts->localeObj, &opts->mcDictObj); + + if (opts->mcDictObj == NULL) { + /* get msgcat dictionary - ::tcl::clock::mcget locale */ + Tcl_Obj *callargs[2]; + + callargs[0] = dataPtr->literals[LIT_MCGET]; + callargs[1] = opts->localeObj; + + if (Tcl_EvalObjv(opts->interp, 2, callargs, 0) != TCL_OK) { + return NULL; + } + + opts->mcDictObj = Tcl_GetObjResult(opts->interp); + Tcl_ResetResult(opts->interp); + ref = 0; /* new object is not yet referenced */ + } + + /* be sure that object reference doesn't increase (dict changeable) */ + if (opts->mcDictObj->refCount > ref) { + /* smart reference (shared dict as object with no ref-counter) */ + opts->mcDictObj = TclDictObjSmartRef(opts->interp, + opts->mcDictObj); + } + + /* create exactly one reference to catalog / make it searchable for future */ + Tcl_DictObjPut(NULL, dataPtr->mcDicts, opts->localeObj, + opts->mcDictObj); + + if ( opts->localeObj == dataPtr->literals[LIT_C] + || opts->localeObj == dataPtr->defaultLocale + ) { + dataPtr->defaultLocaleDict = opts->mcDictObj; + } + if ( opts->localeObj == dataPtr->currentLocale ) { + dataPtr->currentLocaleDict = opts->mcDictObj; + } else if ( opts->localeObj == dataPtr->lastUsedLocale ) { + dataPtr->lastUsedLocaleDict = opts->mcDictObj; + } else { + SavePrevLocaleObj(dataPtr); + Tcl_SetObjRef(dataPtr->lastUsedLocale, opts->localeObj); + Tcl_UnsetObjRef(dataPtr->lastUsedLocaleUnnorm); + dataPtr->lastUsedLocaleDict = opts->mcDictObj; + } + } + } + + return opts->mcDictObj; +} + +/* + *---------------------------------------------------------------------- + * + * ClockMCGet -- + * + * Retrieves a msgcat value for the given literal integer mcKey + * from localized storage (corresponding given locale object) + * by mcLiterals[mcKey] (e. g. MONTHS_FULL). + * + * Results: + * Tcl-object contains localized value. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +ClockMCGet( + ClockFmtScnCmdArgs *opts, + int mcKey) +{ + ClockClientData *dataPtr = (ClockClientData *)opts->clientData; + + Tcl_Obj *valObj = NULL; + + if (opts->mcDictObj == NULL) { + ClockMCDict(opts); + if (opts->mcDictObj == NULL) + return NULL; + } + + Tcl_DictObjGet(opts->interp, opts->mcDictObj, + dataPtr->mcLiterals[mcKey], &valObj); + + return valObj; /* or NULL in obscure case if Tcl_DictObjGet failed */ +} + +/* + *---------------------------------------------------------------------- + * + * ClockMCGetIdx -- + * + * Retrieves an indexed msgcat value for the given literal integer mcKey + * from localized storage (corresponding given locale object) + * by mcLitIdxs[mcKey] (e. g. _IDX_MONTHS_FULL). + * + * Results: + * Tcl-object contains localized indexed value. + * + *---------------------------------------------------------------------- + */ + +MODULE_SCOPE Tcl_Obj * +ClockMCGetIdx( + ClockFmtScnCmdArgs *opts, + int mcKey) +{ + ClockClientData *dataPtr = (ClockClientData *)opts->clientData; + + Tcl_Obj *valObj = NULL; + + if (opts->mcDictObj == NULL) { + ClockMCDict(opts); + if (opts->mcDictObj == NULL) + return NULL; + } + + /* try to get indices object */ + if (dataPtr->mcLitIdxs == NULL) { + return NULL; + } + + if (Tcl_DictObjGet(NULL, opts->mcDictObj, + dataPtr->mcLitIdxs[mcKey], &valObj) != TCL_OK + ) { + return NULL; + } + + return valObj; +} + +/* + *---------------------------------------------------------------------- + * + * ClockMCSetIdx -- + * + * Sets an indexed msgcat value for the given literal integer mcKey + * in localized storage (corresponding given locale object) + * by mcLitIdxs[mcKey] (e. g. _IDX_MONTHS_FULL). + * + * Results: + * Returns a standard Tcl result. + * + *---------------------------------------------------------------------- + */ + +int +ClockMCSetIdx( + ClockFmtScnCmdArgs *opts, + int mcKey, Tcl_Obj *valObj) +{ + ClockClientData *dataPtr = (ClockClientData *)opts->clientData; + + if (opts->mcDictObj == NULL) { + ClockMCDict(opts); + if (opts->mcDictObj == NULL) + return TCL_ERROR; + } + + /* if literal storage for indices not yet created */ + if (dataPtr->mcLitIdxs == NULL) { + int i; + dataPtr->mcLitIdxs = (Tcl_Obj **)Tcl_Alloc(MCLIT__END * sizeof(Tcl_Obj*)); + for (i = 0; i < MCLIT__END; ++i) { + Tcl_InitObjRef(dataPtr->mcLitIdxs[i], + Tcl_NewStringObj(MsgCtLitIdxs[i], -1)); + } + } + + return Tcl_DictObjPut(opts->interp, opts->mcDictObj, + dataPtr->mcLitIdxs[mcKey], valObj); +} + +static void +TimezoneLoaded( + ClockClientData *dataPtr, + Tcl_Obj *timezoneObj, /* Name of zone was loaded */ + Tcl_Obj *tzUnnormObj) /* Name of zone was loaded */ +{ + /* last setup zone loaded */ + if (dataPtr->lastSetupTimeZone != timezoneObj) { + SavePrevTimezoneObj(dataPtr); + Tcl_SetObjRef(dataPtr->lastSetupTimeZone, timezoneObj); + Tcl_UnsetObjRef(dataPtr->lastSetupTZData); + } + Tcl_SetObjRef(dataPtr->lastSetupTimeZoneUnnorm, tzUnnormObj); + + /* mark GMT zone loaded */ + if ( dataPtr->gmtSetupTimeZone == NULL + && timezoneObj == dataPtr->literals[LIT_GMT] + ) { + Tcl_SetObjRef(dataPtr->gmtSetupTimeZone, + dataPtr->literals[LIT_GMT]); + } +} +/* + *---------------------------------------------------------------------- + * + * ClockConfigureObjCmd -- + * + * This function is invoked to process the Tcl "clock configure" command. + * + * Usage: + * ::tcl::clock::configure ?-option ?value?? + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ClockConfigureObjCmd( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const objv[]) /* Parameter vector */ +{ + ClockClientData *dataPtr = (ClockClientData *)clientData; + + static const char *const options[] = { + "-system-tz", "-setup-tz", "-default-locale", "-current-locale", + "-clear", + "-year-century", "-century-switch", + "-min-year", "-max-year", "-max-jdn", "-validate", + NULL + }; + enum optionInd { + CLOCK_SYSTEM_TZ, CLOCK_SETUP_TZ, CLOCK_DEFAULT_LOCALE, CLOCK_CURRENT_LOCALE, + CLOCK_CLEAR_CACHE, + CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH, + CLOCK_MIN_YEAR, CLOCK_MAX_YEAR, CLOCK_MAX_JDN, CLOCK_VALIDATE + }; + int optionIndex; /* Index of an option. */ + int i; + + for (i = 1; i < objc; i++) { + if (Tcl_GetIndexFromObj(interp, objv[i++], options, + "option", 0, &optionIndex) != TCL_OK) { + Tcl_SetErrorCode(interp, "CLOCK", "badOption", + Tcl_GetString(objv[i-1]), NULL); + return TCL_ERROR; + } + switch (optionIndex) { + case CLOCK_SYSTEM_TZ: + if (1) { + /* validate current tz-epoch */ + size_t lastTZEpoch = TzsetIfNecessary(); + if (i < objc) { + if (dataPtr->systemTimeZone != objv[i]) { + Tcl_SetObjRef(dataPtr->systemTimeZone, objv[i]); + Tcl_UnsetObjRef(dataPtr->systemSetupTZData); + } + dataPtr->lastTZEpoch = lastTZEpoch; + } + if (i+1 >= objc && dataPtr->systemTimeZone != NULL + && dataPtr->lastTZEpoch == lastTZEpoch) { + Tcl_SetObjResult(interp, dataPtr->systemTimeZone); + } + } + break; + case CLOCK_SETUP_TZ: + if (i < objc) { + int loaded; + Tcl_Obj *timezoneObj = NormTimezoneObj(dataPtr, objv[i], &loaded); + if (!loaded) { + TimezoneLoaded(dataPtr, timezoneObj, objv[i]); + } + Tcl_SetObjResult(interp, timezoneObj); + } + else + if (i+1 >= objc && dataPtr->lastSetupTimeZone != NULL) { + Tcl_SetObjResult(interp, dataPtr->lastSetupTimeZone); + } + break; + case CLOCK_DEFAULT_LOCALE: + if (i < objc) { + if (dataPtr->defaultLocale != objv[i]) { + Tcl_SetObjRef(dataPtr->defaultLocale, objv[i]); + dataPtr->defaultLocaleDict = NULL; + } + } + if (i+1 >= objc) { + Tcl_SetObjResult(interp, dataPtr->defaultLocale ? + dataPtr->defaultLocale : dataPtr->literals[LIT_C]); + } + break; + case CLOCK_CURRENT_LOCALE: + if (i < objc) { + if (dataPtr->currentLocale != objv[i]) { + Tcl_SetObjRef(dataPtr->currentLocale, objv[i]); + dataPtr->currentLocaleDict = NULL; + } + } + if (i+1 >= objc && dataPtr->currentLocale != NULL) { + Tcl_SetObjResult(interp, dataPtr->currentLocale); + } + break; + case CLOCK_YEAR_CENTURY: + if (i < objc) { + int year; + if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) { + return TCL_ERROR; + } + dataPtr->currentYearCentury = year; + if (i+1 >= objc) { + Tcl_SetObjResult(interp, objv[i]); + } + continue; + } + if (i+1 >= objc) { + Tcl_SetObjResult(interp, + Tcl_NewIntObj(dataPtr->currentYearCentury)); + } + break; + case CLOCK_CENTURY_SWITCH: + if (i < objc) { + int year; + if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) { + return TCL_ERROR; + } + dataPtr->yearOfCenturySwitch = year; + Tcl_SetObjResult(interp, objv[i]); + continue; + } + if (i+1 >= objc) { + Tcl_SetObjResult(interp, + Tcl_NewIntObj(dataPtr->yearOfCenturySwitch)); + } + break; + case CLOCK_MIN_YEAR: + if (i < objc) { + int year; + if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) { + return TCL_ERROR; + } + dataPtr->validMinYear = year; + Tcl_SetObjResult(interp, objv[i]); + continue; + } + if (i+1 >= objc) { + Tcl_SetObjResult(interp, + Tcl_NewIntObj(dataPtr->validMinYear)); + } + break; + case CLOCK_MAX_YEAR: + if (i < objc) { + int year; + if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) { + return TCL_ERROR; + } + dataPtr->validMaxYear = year; + Tcl_SetObjResult(interp, objv[i]); + continue; + } + if (i+1 >= objc) { + Tcl_SetObjResult(interp, + Tcl_NewIntObj(dataPtr->validMaxYear)); + } + break; + case CLOCK_MAX_JDN: + if (i < objc) { + double jd; + if (Tcl_GetDoubleFromObj(interp, objv[i], &jd) != TCL_OK) { + return TCL_ERROR; + } + dataPtr->maxJDN = jd; + Tcl_SetObjResult(interp, objv[i]); + continue; + } + if (i+1 >= objc) { + Tcl_SetObjResult(interp, + Tcl_NewDoubleObj(dataPtr->maxJDN)); + } + break; + case CLOCK_VALIDATE: + if (i < objc) { + int val; + if (Tcl_GetBooleanFromObj(interp, objv[i], &val) != TCL_OK) { + return TCL_ERROR; + } + if (val) { + dataPtr->defFlags |= CLF_VALIDATE; + } else { + dataPtr->defFlags &= ~CLF_VALIDATE; + } + } + if (i+1 >= objc) { + Tcl_SetObjResult(interp, + Tcl_NewIntObj(dataPtr->defFlags & CLF_VALIDATE ? 1 : 0)); + } + break; + case CLOCK_CLEAR_CACHE: + ClockConfigureClear(dataPtr); + break; + } + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ClockGetTZData -- + * + * Retrieves tzdata table for given normalized timezone. + * + * Results: + * Returns a tcl object with tzdata. + * + * Side effects: + * The tzdata can be cached in ClockClientData structure. + * + *---------------------------------------------------------------------- + */ + +static inline Tcl_Obj * +ClockGetTZData( + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *timezoneObj) /* Name of the timezone */ +{ + ClockClientData *dataPtr = (ClockClientData *)clientData; + Tcl_Obj *ret, **out = NULL; + + /* if cached (if already setup this one) */ + if ( timezoneObj == dataPtr->lastSetupTimeZone + || timezoneObj == dataPtr->lastSetupTimeZoneUnnorm + ) { + if (dataPtr->lastSetupTZData != NULL) { + return dataPtr->lastSetupTZData; + } + out = &dataPtr->lastSetupTZData; + } + /* differentiate GMT and system zones, because used often */ + /* simple caching, because almost used the tz-data of last timezone + */ + if (timezoneObj == dataPtr->systemTimeZone) { + if (dataPtr->systemSetupTZData != NULL) { + return dataPtr->systemSetupTZData; + } + out = &dataPtr->systemSetupTZData; + } + else + if ( timezoneObj == dataPtr->literals[LIT_GMT] + || timezoneObj == dataPtr->gmtSetupTimeZoneUnnorm + ) { + if (dataPtr->gmtSetupTZData != NULL) { + return dataPtr->gmtSetupTZData; + } + out = &dataPtr->gmtSetupTZData; + } + else + if ( timezoneObj == dataPtr->prevSetupTimeZone + || timezoneObj == dataPtr->prevSetupTimeZoneUnnorm + ) { + if (dataPtr->prevSetupTZData != NULL) { + return dataPtr->prevSetupTZData; + } + out = &dataPtr->prevSetupTZData; + } + + ret = Tcl_ObjGetVar2(interp, dataPtr->literals[LIT_TZDATA], + timezoneObj, TCL_LEAVE_ERR_MSG); + + /* cache using corresponding slot and as last used */ + if (out != NULL) { + Tcl_SetObjRef(*out, ret); + } + else + if (dataPtr->lastSetupTimeZone != timezoneObj) { + SavePrevTimezoneObj(dataPtr); + Tcl_SetObjRef(dataPtr->lastSetupTimeZone, timezoneObj); + Tcl_UnsetObjRef(dataPtr->lastSetupTimeZoneUnnorm); + Tcl_SetObjRef(dataPtr->lastSetupTZData, ret); + } + return ret; +} + +/* + *---------------------------------------------------------------------- + * + * ClockGetSystemTimeZone -- + * + * Returns system (current) timezone. + * + * If system zone not yet cached, it executes ::tcl::clock::GetSystemTimeZone + * in given interpreter and caches its result. + * + * Results: + * Returns normalized timezone object. + * + *---------------------------------------------------------------------- + */ + +static Tcl_Obj * +ClockGetSystemTimeZone( + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp) /* Tcl interpreter */ +{ + ClockClientData *dataPtr = (ClockClientData *)clientData; + + /* if known (cached and same epoch) - return now */ + if (dataPtr->systemTimeZone != NULL + && dataPtr->lastTZEpoch == TzsetIfNecessary()) { + return dataPtr->systemTimeZone; + } + + Tcl_UnsetObjRef(dataPtr->systemTimeZone); + Tcl_UnsetObjRef(dataPtr->systemSetupTZData); + + if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETSYSTEMTIMEZONE], 0) != TCL_OK) { + return NULL; + } + if (dataPtr->systemTimeZone == NULL) { + Tcl_SetObjRef(dataPtr->systemTimeZone, Tcl_GetObjResult(interp)); + } + Tcl_ResetResult(interp); + return dataPtr->systemTimeZone; +} + +/* + *---------------------------------------------------------------------- + * + * ClockSetupTimeZone -- + * + * Sets up the timezone. Loads tzdata, etc. + * + * Results: + * Returns normalized timezone object. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +ClockSetupTimeZone( + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *timezoneObj) +{ + ClockClientData *dataPtr = (ClockClientData *)clientData; + int loaded; + Tcl_Obj *callargs[2]; + + /* if cached (if already setup this one) */ + if ( timezoneObj == dataPtr->literals[LIT_GMT] + && dataPtr->gmtSetupTZData != NULL + ) { + return timezoneObj; + } + if ( ( timezoneObj == dataPtr->lastSetupTimeZone + || timezoneObj == dataPtr->lastSetupTimeZoneUnnorm + ) && dataPtr->lastSetupTimeZone != NULL + ) { + return dataPtr->lastSetupTimeZone; + } + if ( ( timezoneObj == dataPtr->prevSetupTimeZone + || timezoneObj == dataPtr->prevSetupTimeZoneUnnorm + ) && dataPtr->prevSetupTimeZone != NULL + ) { + return dataPtr->prevSetupTimeZone; + } + + /* differentiate normalized (last, GMT and system) zones, because used often and already set */ + callargs[1] = NormTimezoneObj(dataPtr, timezoneObj, &loaded); + /* if loaded (setup already called for this TZ) */ + if (loaded) { + return callargs[1]; + } + + /* before setup just take a look in TZData variable */ + if (Tcl_ObjGetVar2(interp, dataPtr->literals[LIT_TZDATA], timezoneObj, 0)) { + /* put it to last slot and return normalized */ + TimezoneLoaded(dataPtr, callargs[1], timezoneObj); + return callargs[1]; + } + /* setup now */ + callargs[0] = dataPtr->literals[LIT_SETUPTIMEZONE]; + if (Tcl_EvalObjv(interp, 2, callargs, 0) == TCL_OK) { + /* save unnormalized last used */ + Tcl_SetObjRef(dataPtr->lastSetupTimeZoneUnnorm, timezoneObj); + return callargs[1]; + } + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * ClockFormatNumericTimeZone -- + * + * Formats a time zone as +hhmmss + * + * Parameters: + * z - Time zone in seconds east of Greenwich + * + * Results: + * Returns the time zone object (formatted in a numeric form) + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +ClockFormatNumericTimeZone(int z) { + char sign = '+'; + int h, m; + if ( z < 0 ) { + z = -z; + sign = '-'; + } + h = z / 3600; + z %= 3600; + m = z / 60; + z %= 60; + if (z != 0) { + return Tcl_ObjPrintf("%c%02d%02d%02d", sign, h, m, z); + } + return Tcl_ObjPrintf("%c%02d%02d", sign, h, m); } /* @@ -292,11 +1400,11 @@ TclClockInit( * is available. * * Usage: - * ::tcl::clock::ConvertUTCToLocal dictionary tzdata changeover + * ::tcl::clock::ConvertUTCToLocal dictionary timezone changeover * * Parameters: * dict - Dictionary containing a 'localSeconds' entry. - * tzdata - Time zone data + * timezone - Time zone * changeover - Julian Day of the adoption of the Gregorian calendar. * * Results: @@ -312,13 +1420,12 @@ TclClockInit( static int ClockConvertlocaltoutcObjCmd( - void *clientData, /* Client data */ + ClientData clientData, /* Client data */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ { ClockClientData *data = (ClockClientData *)clientData; - Tcl_Obj *const *lit = data->literals; Tcl_Obj *secondsObj; Tcl_Obj *dict; int changeover; @@ -326,16 +1433,17 @@ ClockConvertlocaltoutcObjCmd( int created = 0; int status; + fields.tzName = NULL; /* * Check params and convert time. */ if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, "dict tzdata changeover"); + Tcl_WrongNumArgs(interp, 1, objv, "dict timezone changeover"); return TCL_ERROR; } dict = objv[1]; - if (Tcl_DictObjGet(interp, dict, lit[LIT_LOCALSECONDS], + if (Tcl_DictObjGet(interp, dict, data->literals[LIT_LOCALSECONDS], &secondsObj)!= TCL_OK) { return TCL_ERROR; } @@ -347,7 +1455,7 @@ ClockConvertlocaltoutcObjCmd( if ((TclGetWideIntFromObj(interp, secondsObj, &fields.localSeconds) != TCL_OK) || (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) - || ConvertLocalToUTC(interp, &fields, objv[2], changeover)) { + || ConvertLocalToUTC(clientData, interp, &fields, objv[2], changeover)) { return TCL_ERROR; } @@ -361,7 +1469,7 @@ ClockConvertlocaltoutcObjCmd( created = 1; Tcl_IncrRefCount(dict); } - status = Tcl_DictObjPut(interp, dict, lit[LIT_SECONDS], + status = Tcl_DictObjPut(interp, dict, data->literals[LIT_SECONDS], Tcl_NewWideIntObj(fields.seconds)); if (status == TCL_OK) { Tcl_SetObjResult(interp, dict); @@ -381,12 +1489,11 @@ ClockConvertlocaltoutcObjCmd( * formatting a date, and populates a dictionary with them. * * Usage: - * ::tcl::clock::GetDateFields seconds tzdata changeover + * ::tcl::clock::GetDateFields seconds timezone changeover * * Parameters: * seconds - Time expressed in seconds from the Posix epoch. - * tzdata - Time zone data of the time zone in which time is to be - * expressed. + * timezone - Time zone in which time is to be expressed. * changeover - Julian Day Number at which the current locale adopted * the Gregorian calendar * @@ -404,7 +1511,7 @@ ClockConvertlocaltoutcObjCmd( int ClockGetdatefieldsObjCmd( - void *clientData, /* Opaque pointer to literal pool, etc. */ + ClientData clientData, /* Opaque pointer to literal pool, etc. */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ @@ -415,12 +1522,14 @@ ClockGetdatefieldsObjCmd( Tcl_Obj *const *lit = data->literals; int changeover; + fields.tzName = NULL; + /* * Check params. */ if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata changeover"); + Tcl_WrongNumArgs(interp, 1, objv, "seconds timezone changeover"); return TCL_ERROR; } if (TclGetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK @@ -438,30 +1547,14 @@ ClockGetdatefieldsObjCmd( return TCL_ERROR; } - /* - * Convert UTC time to local. - */ + /* Extract fields */ - if (ConvertUTCToLocal(interp, &fields, objv[2], changeover) != TCL_OK) { + if (ClockGetDateFields(clientData, interp, &fields, objv[2], + changeover) != TCL_OK) { return TCL_ERROR; } - /* - * Extract Julian day. Always round the quotient down by subtracting 1 - * when the remainder is negative (i.e. if the quotient was rounded up). - */ - - fields.julianDay = (int) ((fields.localSeconds / SECONDS_PER_DAY) - - ((fields.localSeconds % SECONDS_PER_DAY) < 0) + - JULIAN_DAY_POSIX_EPOCH); - - /* - * Convert to Julian or Gregorian calendar. - */ - - GetGregorianEraYearDay(&fields, changeover); - GetMonthDay(&fields); - GetYearWeekDay(&fields, changeover); + /* Make dict of fields */ dict = Tcl_NewDictObj(); Tcl_DictObjPut(NULL, dict, lit[LIT_LOCALSECONDS], @@ -471,27 +1564,27 @@ ClockGetdatefieldsObjCmd( Tcl_DictObjPut(NULL, dict, lit[LIT_TZNAME], fields.tzName); Tcl_DecrRefCount(fields.tzName); Tcl_DictObjPut(NULL, dict, lit[LIT_TZOFFSET], - Tcl_NewWideIntObj(fields.tzOffset)); + Tcl_NewIntObj(fields.tzOffset)); Tcl_DictObjPut(NULL, dict, lit[LIT_JULIANDAY], - Tcl_NewWideIntObj(fields.julianDay)); + Tcl_NewIntObj(fields.julianDay)); Tcl_DictObjPut(NULL, dict, lit[LIT_GREGORIAN], - Tcl_NewWideIntObj(fields.gregorian)); + Tcl_NewIntObj(fields.gregorian)); Tcl_DictObjPut(NULL, dict, lit[LIT_ERA], - lit[fields.isBce ? LIT_BCE : LIT_CE]); + lit[fields.era ? LIT_BCE : LIT_CE]); Tcl_DictObjPut(NULL, dict, lit[LIT_YEAR], - Tcl_NewWideIntObj(fields.year)); + Tcl_NewIntObj(fields.year)); Tcl_DictObjPut(NULL, dict, lit[LIT_DAYOFYEAR], - Tcl_NewWideIntObj(fields.dayOfYear)); + Tcl_NewIntObj(fields.dayOfYear)); Tcl_DictObjPut(NULL, dict, lit[LIT_MONTH], - Tcl_NewWideIntObj(fields.month)); + Tcl_NewIntObj(fields.month)); Tcl_DictObjPut(NULL, dict, lit[LIT_DAYOFMONTH], - Tcl_NewWideIntObj(fields.dayOfMonth)); + Tcl_NewIntObj(fields.dayOfMonth)); Tcl_DictObjPut(NULL, dict, lit[LIT_ISO8601YEAR], - Tcl_NewWideIntObj(fields.iso8601Year)); + Tcl_NewIntObj(fields.iso8601Year)); Tcl_DictObjPut(NULL, dict, lit[LIT_ISO8601WEEK], - Tcl_NewWideIntObj(fields.iso8601Week)); + Tcl_NewIntObj(fields.iso8601Week)); Tcl_DictObjPut(NULL, dict, lit[LIT_DAYOFWEEK], - Tcl_NewWideIntObj(fields.dayOfWeek)); + Tcl_NewIntObj(fields.dayOfWeek)); Tcl_SetObjResult(interp, dict); return TCL_OK; @@ -500,6 +1593,58 @@ ClockGetdatefieldsObjCmd( /* *---------------------------------------------------------------------- * + * ClockGetDateFields -- + * + * Converts given UTC time (seconds in a TclDateFields structure) + * to local time and determines the values that clock routines will + * use in scanning or formatting a date. + * + * Results: + * Date-time values are stored in structure "fields". + * Returns a standard Tcl result. + * + *---------------------------------------------------------------------- + */ + +int +ClockGetDateFields( + ClientData clientData, /* Client data of the interpreter */ + Tcl_Interp *interp, /* Tcl interpreter */ + TclDateFields *fields, /* Pointer to result fields, where + * fields->seconds contains date to extract */ + Tcl_Obj *timezoneObj, /* Time zone object or NULL for gmt */ + int changeover) /* Julian Day Number */ +{ + /* + * Convert UTC time to local. + */ + + if (ConvertUTCToLocal(clientData, interp, fields, timezoneObj, + changeover) != TCL_OK) { + return TCL_ERROR; + } + + /* + * Extract Julian day and seconds of the day. + */ + + ClockExtractJDAndSODFromSeconds(fields->julianDay, fields->secondOfDay, + fields->localSeconds); + + /* + * Convert to Julian or Gregorian calendar. + */ + + GetGregorianEraYearDay(fields, changeover); + GetMonthDay(fields); + GetYearWeekDay(fields, changeover); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * ClockGetjuliandayfromerayearmonthdayObjCmd -- * * Tcl command that converts a time from era-year-month-day to a Julian @@ -523,9 +1668,10 @@ FetchEraField( Tcl_Interp *interp, Tcl_Obj *dict, Tcl_Obj *key, - int *storePtr) + ERA_ENUM *storePtr) { Tcl_Obj *value = NULL; + int result, era; if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) { return TCL_ERROR; @@ -535,7 +1681,11 @@ FetchEraField( "expected key(s) not found in dictionary", -1)); return TCL_ERROR; } - return Tcl_GetIndexFromObj(interp, value, eras, "era", TCL_EXACT, storePtr); + result = Tcl_GetIndexFromObj(interp, value, eras, "era", TCL_EXACT, &era); + if (result == TCL_OK && storePtr) { + *storePtr = (ERA_ENUM)era; + } + return result; } static int @@ -560,7 +1710,7 @@ FetchIntField( static int ClockGetjuliandayfromerayearmonthdayObjCmd( - void *clientData, /* Opaque pointer to literal pool, etc. */ + ClientData clientData, /* Opaque pointer to literal pool, etc. */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ @@ -572,7 +1722,9 @@ ClockGetjuliandayfromerayearmonthdayObjCmd( int changeover; int copied = 0; int status; - int isBce = 0; + ERA_ENUM era = CE; + + fields.tzName = NULL; /* * Check params. @@ -583,7 +1735,7 @@ ClockGetjuliandayfromerayearmonthdayObjCmd( return TCL_ERROR; } dict = objv[1]; - if (FetchEraField(interp, dict, lit[LIT_ERA], &isBce) != TCL_OK + if (FetchEraField(interp, dict, lit[LIT_ERA], &era) != TCL_OK || FetchIntField(interp, dict, lit[LIT_YEAR], &fields.year) != TCL_OK || FetchIntField(interp, dict, lit[LIT_MONTH], &fields.month) @@ -593,7 +1745,7 @@ ClockGetjuliandayfromerayearmonthdayObjCmd( || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) { return TCL_ERROR; } - fields.isBce = isBce; + fields.era = era; /* * Get Julian day. @@ -611,7 +1763,7 @@ ClockGetjuliandayfromerayearmonthdayObjCmd( copied = 1; } status = Tcl_DictObjPut(interp, dict, lit[LIT_JULIANDAY], - Tcl_NewWideIntObj(fields.julianDay)); + Tcl_NewIntObj(fields.julianDay)); if (status == TCL_OK) { Tcl_SetObjResult(interp, dict); } @@ -644,7 +1796,7 @@ ClockGetjuliandayfromerayearmonthdayObjCmd( static int ClockGetjuliandayfromerayearweekdayObjCmd( - void *clientData, /* Opaque pointer to literal pool, etc. */ + ClientData clientData, /* Opaque pointer to literal pool, etc. */ Tcl_Interp *interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const *objv) /* Parameter vector */ @@ -656,7 +1808,9 @@ ClockGetjuliandayfromerayearweekdayObjCmd( int changeover; int copied = 0; int status; - int isBce = 0; + ERA_ENUM era = CE; + + fields.tzName = NULL; /* * Check params. @@ -667,7 +1821,7 @@ ClockGetjuliandayfromerayearweekdayObjCmd( return TCL_ERROR; } dict = objv[1]; - if (FetchEraField(interp, dict, lit[LIT_ERA], &isBce) != TCL_OK + if (FetchEraField(interp, dict, lit[LIT_ERA], &era) != TCL_OK || FetchIntField(interp, dict, lit[LIT_ISO8601YEAR], &fields.iso8601Year) != TCL_OK || FetchIntField(interp, dict, lit[LIT_ISO8601WEEK], @@ -677,7 +1831,7 @@ ClockGetjuliandayfromerayearweekdayObjCmd( || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) { return TCL_ERROR; } - fields.isBce = isBce; + fields.era = era; /* * Get Julian day. @@ -695,7 +1849,7 @@ ClockGetjuliandayfromerayearweekdayObjCmd( copied = 1; } status = Tcl_DictObjPut(interp, dict, lit[LIT_JULIANDAY], - Tcl_NewWideIntObj(fields.julianDay)); + Tcl_NewIntObj(fields.julianDay)); if (status == TCL_OK) { Tcl_SetObjResult(interp, dict); } @@ -725,18 +1879,63 @@ ClockGetjuliandayfromerayearweekdayObjCmd( static int ConvertLocalToUTC( + ClientData clientData, /* Client data of the interpreter */ Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ - Tcl_Obj *tzdata, /* Time zone data */ + Tcl_Obj *timezoneObj, /* Time zone */ int changeover) /* Julian Day of the Gregorian transition */ { + ClockClientData *dataPtr = (ClockClientData *)clientData; + Tcl_Obj *tzdata; /* Time zone data */ Tcl_Size rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ + Tcl_WideInt seconds; + ClockLastTZOffs * ltzoc = NULL; + + /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */ + if (timezoneObj == dataPtr->literals[LIT_GMT]) { + fields->seconds = fields->localSeconds; + fields->tzOffset = 0; + return TCL_OK; + } + + /* + * Check cacheable conversion could be used + * (last-period UTC2Local cache within the same TZ and seconds) + */ + for (rowc = 0; rowc < 2; rowc++) { + ltzoc = &dataPtr->lastTZOffsCache[rowc]; + if (timezoneObj != ltzoc->timezoneObj || changeover != ltzoc->changeover) { + ltzoc = NULL; + continue; + } + seconds = fields->localSeconds - ltzoc->tzOffset; + if ( seconds >= ltzoc->rangesVal[0] + && seconds < ltzoc->rangesVal[1] + ) { + /* the same time zone and offset (UTC time inside the last minute) */ + fields->tzOffset = ltzoc->tzOffset; + fields->seconds = seconds; + return TCL_OK; + } + /* in the DST-hole (because of the check above) - correct localSeconds */ + if (fields->localSeconds == ltzoc->localSeconds) { + /* the same time zone and offset (but we'll shift local-time) */ + fields->tzOffset = ltzoc->tzOffset; + fields->seconds = seconds; + goto dstHole; + } + } /* * Unpack the tz data. */ + tzdata = ClockGetTZData(clientData, interp, timezoneObj); + if (tzdata == NULL) { + return TCL_ERROR; + } + if (TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK) { return TCL_ERROR; } @@ -747,10 +1946,59 @@ ConvertLocalToUTC( */ if (rowc == 0) { - return ConvertLocalToUTCUsingC(interp, fields, changeover); + + if (ConvertLocalToUTCUsingC(interp, fields, changeover) != TCL_OK) { + return TCL_ERROR; + }; + + /* we cannot cache (ranges unknown yet) - todo: check later the DST-hole here */ + return TCL_OK; + } else { - return ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv); + Tcl_WideInt rangesVal[2]; + + if (ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv, + rangesVal) != TCL_OK) { + return TCL_ERROR; + }; + + seconds = fields->seconds; + + /* Cache the last conversion */ + if (ltzoc != NULL) { /* slot was found above */ + /* timezoneObj and changeover are the same */ + Tcl_SetObjRef(ltzoc->tzName, fields->tzName); /* may be NULL */ + } else { + /* no TZ in cache - just move second slot down and use the first one */ + ltzoc = &dataPtr->lastTZOffsCache[0]; + Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].timezoneObj); + Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].tzName); + memcpy(&dataPtr->lastTZOffsCache[1], ltzoc, sizeof(*ltzoc)); + Tcl_InitObjRef(ltzoc->timezoneObj, timezoneObj); + ltzoc->changeover = changeover; + Tcl_InitObjRef(ltzoc->tzName, fields->tzName); /* may be NULL */ + } + ltzoc->localSeconds = fields->localSeconds; + ltzoc->rangesVal[0] = rangesVal[0]; + ltzoc->rangesVal[1] = rangesVal[1]; + ltzoc->tzOffset = fields->tzOffset; } + + + /* check DST-hole: if retrieved seconds is out of range */ + if ( ltzoc->rangesVal[0] > seconds || seconds >= ltzoc->rangesVal[1] ) { + dstHole: + #if 0 + printf("given local-time is outside the time-zone (in DST-hole): " + "%d - offs %d => %d <= %d < %d\n", + (int)fields->localSeconds, fields->tzOffset, + (int)ltzoc->rangesVal[0], (int)seconds, (int)ltzoc->rangesVal[1]); + #endif + /* because we don't know real TZ (we're outsize), just invalidate local + * time (which could be verified in ClockValidDate later) */ + fields->localSeconds = TCL_INV_SECONDS; /* not valid seconds */ + } + return TCL_OK; } /* @@ -775,16 +2023,19 @@ static int ConvertLocalToUTCUsingTable( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Time to convert, with 'seconds' filled in */ - Tcl_Size rowc, /* Number of points at which time changes */ - Tcl_Obj *const rowv[]) /* Points at which time changes */ + int rowc, /* Number of points at which time changes */ + Tcl_Obj *const rowv[], /* Points at which time changes */ + Tcl_WideInt *rangesVal) /* Return bounds for time period */ { Tcl_Obj *row; Tcl_Size cellc; Tcl_Obj **cellv; - int have[8]; + struct { + Tcl_Obj *tzName; + int tzOffset; + } have[8]; int nHave = 0; - int i; - int found; + Tcl_Size i; /* * Perform an initial lookup assuming that local == UTC, and locate the @@ -796,11 +2047,11 @@ ConvertLocalToUTCUsingTable( * Saving Time transition. */ - found = 0; fields->tzOffset = 0; fields->seconds = fields->localSeconds; - while (!found) { - row = LookupLastTransition(interp, fields->seconds, rowc, rowv); + while (1) { + row = LookupLastTransition(interp, fields->seconds, rowc, rowv, + rangesVal); if ((row == NULL) || TclListObjGetElementsM(interp, row, &cellc, &cellv) != TCL_OK @@ -808,23 +2059,24 @@ ConvertLocalToUTCUsingTable( &fields->tzOffset) != TCL_OK) { return TCL_ERROR; } - found = 0; - for (i = 0; !found && i < nHave; ++i) { - if (have[i] == fields->tzOffset) { - found = 1; - break; + for (i = 0; i < nHave; ++i) { + if (have[i].tzOffset == fields->tzOffset) { + goto found; } } - if (!found) { - if (nHave == 8) { - Tcl_Panic("loop in ConvertLocalToUTCUsingTable"); - } - have[nHave++] = fields->tzOffset; + if (nHave == 8) { + Tcl_Panic("loop in ConvertLocalToUTCUsingTable"); } + have[nHave].tzName = cellv[3]; + have[nHave++].tzOffset = fields->tzOffset; fields->seconds = fields->localSeconds - fields->tzOffset; } - fields->tzOffset = have[i]; + + found: + fields->tzOffset = have[i].tzOffset; fields->seconds = fields->localSeconds - fields->tzOffset; + Tcl_SetObjRef(fields->tzName, have[i].tzName); + return TCL_OK; } @@ -855,19 +2107,14 @@ ConvertLocalToUTCUsingC( struct tm timeVal; int localErrno; int secondOfDay; - Tcl_WideInt jsec; /* * Convert the given time to a date. */ - jsec = fields->localSeconds + JULIAN_SEC_POSIX_EPOCH; - fields->julianDay = (int) (jsec / SECONDS_PER_DAY); - secondOfDay = (int)(jsec % SECONDS_PER_DAY); - if (secondOfDay < 0) { - secondOfDay += SECONDS_PER_DAY; - fields->julianDay--; - } + ClockExtractJDAndSODFromSeconds(fields->julianDay, secondOfDay, + fields->localSeconds); + GetGregorianEraYearDay(fields, changeover); GetMonthDay(fields); @@ -894,7 +2141,7 @@ ConvertLocalToUTCUsingC( Tcl_MutexLock(&clockMutex); errno = 0; fields->seconds = (Tcl_WideInt) mktime(&timeVal); - localErrno = (fields->seconds == -1) ? errno : 0; + localErrno = errno; Tcl_MutexUnlock(&clockMutex); /* @@ -926,20 +2173,67 @@ ConvertLocalToUTCUsingC( *---------------------------------------------------------------------- */ -static int +int ConvertUTCToLocal( + ClientData clientData, /* Client data of the interpreter */ Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ - Tcl_Obj *tzdata, /* Time zone data */ + Tcl_Obj *timezoneObj, /* Time zone */ int changeover) /* Julian Day of the Gregorian transition */ { + ClockClientData *dataPtr = (ClockClientData *)clientData; + Tcl_Obj *tzdata; /* Time zone data */ Tcl_Size rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ + ClockLastTZOffs * ltzoc = NULL; + + /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */ + if (timezoneObj == dataPtr->literals[LIT_GMT]) { + fields->localSeconds = fields->seconds; + fields->tzOffset = 0; + if (dataPtr->gmtTZName == NULL) { + Tcl_Obj *tzName; + tzdata = ClockGetTZData(clientData, interp, timezoneObj); + if ( TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK + || Tcl_ListObjIndex(interp, rowv[0], 3, &tzName) != TCL_OK) { + return TCL_ERROR; + } + Tcl_SetObjRef(dataPtr->gmtTZName, tzName); + } + Tcl_SetObjRef(fields->tzName, dataPtr->gmtTZName); + return TCL_OK; + } + + /* + * Check cacheable conversion could be used + * (last-period UTC2Local cache within the same TZ and seconds) + */ + for (rowc = 0; rowc < 2; rowc++) { + ltzoc = &dataPtr->lastTZOffsCache[rowc]; + if (timezoneObj != ltzoc->timezoneObj || changeover != ltzoc->changeover) { + ltzoc = NULL; + continue; + } + if ( fields->seconds >= ltzoc->rangesVal[0] + && fields->seconds < ltzoc->rangesVal[1] + ) { + /* the same time zone and offset (UTC time inside the last minute) */ + fields->tzOffset = ltzoc->tzOffset; + fields->localSeconds = fields->seconds + fields->tzOffset; + Tcl_SetObjRef(fields->tzName, ltzoc->tzName); + return TCL_OK; + } + } /* * Unpack the tz data. */ + tzdata = ClockGetTZData(clientData, interp, timezoneObj); + if (tzdata == NULL) { + return TCL_ERROR; + } + if (TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK) { return TCL_ERROR; } @@ -950,10 +2244,41 @@ ConvertUTCToLocal( */ if (rowc == 0) { - return ConvertUTCToLocalUsingC(interp, fields, changeover); + + if (ConvertUTCToLocalUsingC(interp, fields, changeover) != TCL_OK) { + return TCL_ERROR; + } + + /* we cannot cache (ranges unknown yet) */ } else { - return ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv); + Tcl_WideInt rangesVal[2]; + + if (ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv, + rangesVal) != TCL_OK) { + return TCL_ERROR; + } + + /* Cache the last conversion */ + if (ltzoc != NULL) { /* slot was found above */ + /* timezoneObj and changeover are the same */ + Tcl_SetObjRef(ltzoc->tzName, fields->tzName); + } else { + /* no TZ in cache - just move second slot down and use the first one */ + ltzoc = &dataPtr->lastTZOffsCache[0]; + Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].timezoneObj); + Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].tzName); + memcpy(&dataPtr->lastTZOffsCache[1], ltzoc, sizeof(*ltzoc)); + Tcl_InitObjRef(ltzoc->timezoneObj, timezoneObj); + ltzoc->changeover = changeover; + Tcl_InitObjRef(ltzoc->tzName, fields->tzName); + } + ltzoc->localSeconds = fields->localSeconds; + ltzoc->rangesVal[0] = rangesVal[0]; + ltzoc->rangesVal[1] = rangesVal[1]; + ltzoc->tzOffset = fields->tzOffset; } + + return TCL_OK; } /* @@ -978,9 +2303,10 @@ static int ConvertUTCToLocalUsingTable( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the date */ - Tcl_Size rowc, /* Number of rows in the conversion table + int rowc, /* Number of rows in the conversion table * (>= 1) */ - Tcl_Obj *const rowv[]) /* Rows of the conversion table */ + Tcl_Obj *const rowv[], /* Rows of the conversion table */ + Tcl_WideInt *rangesVal) /* Return bounds for time period */ { Tcl_Obj *row; /* Row containing the current information */ Tcl_Size cellc; /* Count of cells in the row (must be 4) */ @@ -990,7 +2316,7 @@ ConvertUTCToLocalUsingTable( * Look up the nearest transition time. */ - row = LookupLastTransition(interp, fields->seconds, rowc, rowv); + row = LookupLastTransition(interp, fields->seconds, rowc, rowv, rangesVal); if (row == NULL || TclListObjGetElementsM(interp, row, &cellc, &cellv) != TCL_OK || TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) { @@ -1001,8 +2327,7 @@ ConvertUTCToLocalUsingTable( * Convert the time. */ - fields->tzName = cellv[3]; - Tcl_IncrRefCount(fields->tzName); + Tcl_SetObjRef(fields->tzName, cellv[3]); fields->localSeconds = fields->seconds + fields->tzOffset; return TCL_OK; } @@ -1045,7 +2370,7 @@ ConvertUTCToLocalUsingC( if ((Tcl_WideInt) tock != fields->seconds) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "number too large to represent as a Posix time", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", (void *)NULL); + Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL); return TCL_ERROR; } TzsetIfNecessary(); @@ -1054,7 +2379,7 @@ ConvertUTCToLocalUsingC( Tcl_SetObjResult(interp, Tcl_NewStringObj( "localtime failed (clock value may be too " "large/small to represent)", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", (void *)NULL); + Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL); return TCL_ERROR; } @@ -1062,7 +2387,7 @@ ConvertUTCToLocalUsingC( * Fill in the date in 'fields' and use it to derive Julian Day. */ - fields->isBce = 0; + fields->era = CE; fields->year = timeVal->tm_year + 1900; fields->month = timeVal->tm_mon + 1; fields->dayOfMonth = timeVal->tm_mday; @@ -1088,15 +2413,14 @@ ConvertUTCToLocalUsingC( } else { *buffer = '+'; } - snprintf(buffer+1, sizeof(buffer) - 1, "%02d", diff / 3600); + sprintf(buffer+1, "%02d", diff / 3600); diff %= 3600; - snprintf(buffer+3, sizeof(buffer) - 3, "%02d", diff / 60); + sprintf(buffer+3, "%02d", diff / 60); diff %= 60; if (diff > 0) { - snprintf(buffer+5, sizeof(buffer) - 5, "%02d", diff); + sprintf(buffer+5, "%02d", diff); } - fields->tzName = Tcl_NewStringObj(buffer, -1); - Tcl_IncrRefCount(fields->tzName); + Tcl_SetObjRef(fields->tzName, Tcl_NewStringObj(buffer, -1)); return TCL_OK; } @@ -1114,17 +2438,18 @@ ConvertUTCToLocalUsingC( *---------------------------------------------------------------------- */ -static Tcl_Obj * +Tcl_Obj * LookupLastTransition( Tcl_Interp *interp, /* Interpreter for error messages */ Tcl_WideInt tick, /* Time from the epoch */ - Tcl_Size rowc, /* Number of rows of tzdata */ - Tcl_Obj *const *rowv) /* Rows in tzdata */ + int rowc, /* Number of rows of tzdata */ + Tcl_Obj *const *rowv, /* Rows in tzdata */ + Tcl_WideInt *rangesVal) /* Return bounds for time period */ { - Tcl_Size l; - Tcl_Size u; + int l = 0; + int u; Tcl_Obj *compObj; - Tcl_WideInt compVal; + Tcl_WideInt compVal, fromVal = LLONG_MIN, toVal = LLONG_MAX; /* * Examine the first row to make sure we're in bounds. @@ -1140,7 +2465,11 @@ LookupLastTransition( * anyway. */ - if (tick < compVal) { + if (tick < (fromVal = compVal)) { + if (rangesVal) { + rangesVal[0] = fromVal; + rangesVal[1] = toVal; + } return rowv[0]; } @@ -1148,7 +2477,6 @@ LookupLastTransition( * Binary-search to find the transition. */ - l = 0; u = rowc-1; while (l < u) { int m = (l + u + 1) / 2; @@ -1159,10 +2487,17 @@ LookupLastTransition( } if (tick >= compVal) { l = m; + fromVal = compVal; } else { u = m-1; + toVal = compVal; } } + + if (rangesVal) { + rangesVal[0] = fromVal; + rangesVal[1] = toVal; + } return rowv[l]; } @@ -1193,6 +2528,8 @@ GetYearWeekDay( TclDateFields temp; int dayOfFiscalYear; + temp.tzName = NULL; + /* * Find the given date, minus three days, plus one year. That date's * iso8601 year is an upper bound on the ISO8601 year of the given date. @@ -1200,7 +2537,7 @@ GetYearWeekDay( temp.julianDay = fields->julianDay - 3; GetGregorianEraYearDay(&temp, changeover); - if (temp.isBce) { + if (temp.era == BCE) { temp.iso8601Year = temp.year - 1; } else { temp.iso8601Year = temp.year + 1; @@ -1216,7 +2553,7 @@ GetYearWeekDay( */ if (fields->julianDay < temp.julianDay) { - if (temp.isBce) { + if (temp.era == BCE) { temp.iso8601Year += 1; } else { temp.iso8601Year -= 1; @@ -1256,10 +2593,10 @@ GetGregorianEraYearDay( TclDateFields *fields, /* Date fields containing 'julianDay' */ int changeover) /* Gregorian transition date */ { - int jday = fields->julianDay; - int day; - int year; - int n; + Tcl_WideInt jday = fields->julianDay; + Tcl_WideInt day; + Tcl_WideInt year; + Tcl_WideInt n; if (jday >= changeover) { /* @@ -1342,10 +2679,10 @@ GetGregorianEraYearDay( */ if (year <= 0) { - fields->isBce = 1; + fields->era = BCE; fields->year = 1 - year; } else { - fields->isBce = 0; + fields->era = CE; fields->year = year; } fields->dayOfYear = day + 1; @@ -1373,11 +2710,27 @@ GetMonthDay( { int day = fields->dayOfYear; int month; - const int *h = hath[IsGregorianLeapYear(fields)]; + const int *dipm = daysInPriorMonths[IsGregorianLeapYear(fields)]; - for (month = 0; month < 12 && day > h[month]; ++month) { - day -= h[month]; + /* + * Estimate month by calculating `dayOfYear / (365/12)` + */ + month = (day*12) / dipm[12]; + /* then do forwards backwards correction */ + while (1) { + if (day > dipm[month]) { + if (month >= 11 || day <= dipm[month+1]) { + break; + } + month++; + } else { + if (month == 0) { + break; + } + month--; + } } + day -= dipm[month]; fields->month = month+1; fields->dayOfMonth = day; } @@ -1399,21 +2752,23 @@ GetMonthDay( *---------------------------------------------------------------------- */ -static void +void GetJulianDayFromEraYearWeekDay( TclDateFields *fields, /* Date to convert */ int changeover) /* Julian Day Number of the Gregorian * transition */ { - int firstMonday; /* Julian day number of week 1, day 1 in the + Tcl_WideInt firstMonday; /* Julian day number of week 1, day 1 in the * given year */ TclDateFields firstWeek; + firstWeek.tzName = NULL; + /* * Find January 4 in the ISO8601 year, which will always be in week 1. */ - firstWeek.isBce = fields->isBce; + firstWeek.era = fields->era; firstWeek.year = fields->iso8601Year; firstWeek.month = 1; firstWeek.dayOfMonth = 4; @@ -1450,14 +2805,15 @@ GetJulianDayFromEraYearWeekDay( *---------------------------------------------------------------------- */ -static void +void GetJulianDayFromEraYearMonthDay( TclDateFields *fields, /* Date to convert */ int changeover) /* Gregorian transition date as a Julian Day */ { - int year, ym1, month, mm1, q, r, ym1o4, ym1o100, ym1o400; + Tcl_WideInt year, ym1, ym1o4, ym1o100, ym1o400; + int month, mm1, q, r; - if (fields->isBce) { + if (fields->era == BCE) { year = 1 - fields->year; } else { year = fields->year; @@ -1485,10 +2841,10 @@ GetJulianDayFromEraYearMonthDay( fields->gregorian = 1; if (year < 1) { - fields->isBce = 1; + fields->era = BCE; fields->year = 1-year; } else { - fields->isBce = 0; + fields->era = CE; fields->year = year; } @@ -1503,9 +2859,9 @@ GetJulianDayFromEraYearMonthDay( * Have to make sure quotient is truncated towards 0 when negative. * See above bug for details. The casts are necessary. */ - if (ym1 >= 0) { + if (ym1 >= 0) ym1o4 = ym1 / 4; - } else { + else { ym1o4 = - (int) (((unsigned int) -ym1) / 4); } #endif @@ -1546,6 +2902,61 @@ GetJulianDayFromEraYearMonthDay( /* *---------------------------------------------------------------------- * + * GetJulianDayFromEraYearDay -- + * + * Given era, year, and dayOfYear (in TclDateFields), and the + * Gregorian transition date, computes the Julian Day Number. + * + * Results: + * None. + * + * Side effects: + * Stores day number in 'julianDay' + * + *---------------------------------------------------------------------- + */ + + +void +GetJulianDayFromEraYearDay( + TclDateFields *fields, /* Date to convert */ + int changeover) /* Gregorian transition date as a Julian Day */ +{ + Tcl_WideInt year, ym1; + + /* Get absolute year number from the civil year */ + if (fields->era == BCE) { + year = 1 - fields->year; + } else { + year = fields->year; + } + + ym1 = year - 1; + + /* Try the Gregorian calendar first. */ + fields->gregorian = 1; + fields->julianDay = + 1721425 + + fields->dayOfYear + + ( 365 * ym1 ) + + ( ym1 / 4 ) + - ( ym1 / 100 ) + + ( ym1 / 400 ); + + /* If the date is before the Gregorian change, use the Julian calendar. */ + + if ( fields->julianDay < changeover ) { + fields->gregorian = 0; + fields->julianDay = + 1721423 + + fields->dayOfYear + + ( 365 * ym1 ) + + ( ym1 / 4 ); + } +} +/* + *---------------------------------------------------------------------- + * * IsGregorianLeapYear -- * * Tests whether a given year is a leap year, in either Julian or @@ -1557,13 +2968,13 @@ GetJulianDayFromEraYearMonthDay( *---------------------------------------------------------------------- */ -static int +int IsGregorianLeapYear( TclDateFields *fields) /* Date to test */ { - int year = fields->year; + Tcl_WideInt year = fields->year; - if (fields->isBce) { + if (fields->era == BCE) { year = 1 - year; } if (year%4 != 0) { @@ -1593,10 +3004,10 @@ IsGregorianLeapYear( *---------------------------------------------------------------------- */ -static int +static Tcl_WideInt WeekdayOnOrBefore( int dayOfWeek, /* Day of week; Sunday == 0 or 7 */ - int julianDay) /* Reference date */ + Tcl_WideInt julianDay) /* Reference date */ { int k = (dayOfWeek + 6) % 7; if (k < 0) { @@ -1695,7 +3106,7 @@ ThreadSafeLocalTime( struct tm *tmPtr = (struct tm *)Tcl_GetThreadData(&tmKey, sizeof(struct tm)); #ifdef HAVE_LOCALTIME_R - tmPtr = localtime_r(timePtr, tmPtr); + localtime_r(timePtr, tmPtr); #else struct tm *sysTmPtr; @@ -1705,7 +3116,7 @@ ThreadSafeLocalTime( Tcl_MutexUnlock(&clockMutex); return NULL; } - memcpy(tmPtr, sysTmPtr, sizeof(struct tm)); + memcpy(tmPtr, localtime(timePtr), sizeof(struct tm)); Tcl_MutexUnlock(&clockMutex); #endif return tmPtr; @@ -1763,13 +3174,13 @@ ClockClicksObjCmd( switch (index) { case CLICKS_MILLIS: Tcl_GetTime(&now); - clicks = (Tcl_WideInt)(unsigned long long)now.sec * 1000 + now.usec / 1000; + clicks = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000; break; case CLICKS_NATIVE: #ifdef TCL_WIDE_CLICKS clicks = TclpGetWideClicks(); #else - clicks = (Tcl_WideInt)TclpGetClicks(); + clicks = (Tcl_WideInt) TclpGetClicks(); #endif break; case CLICKS_MICROS: @@ -1807,16 +3218,14 @@ ClockMillisecondsObjCmd( Tcl_Obj *const *objv) /* Parameter values */ { Tcl_Time now; - Tcl_Obj *timeObj; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_GetTime(&now); - TclNewUIntObj(timeObj, (Tcl_WideUInt) - now.sec * 1000 + now.usec / 1000); - Tcl_SetObjResult(interp, timeObj); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) + now.sec * 1000 + now.usec / 1000)); return TCL_OK; } @@ -1853,122 +3262,1258 @@ ClockMicrosecondsObjCmd( return TCL_OK; } +static inline void +ClockInitFmtScnArgs( + ClientData clientData, + Tcl_Interp *interp, + ClockFmtScnCmdArgs *opts) +{ + memset(opts, 0, sizeof(*opts)); + opts->clientData = clientData; + opts->interp = interp; +} + /* *----------------------------------------------------------------------------- * - * ClockParseformatargsObjCmd -- + * ClockParseFmtScnArgs -- * - * Parses the arguments for [clock format]. + * Parses the arguments for sub-commands "scan", "format" and "add". * - * Results: - * Returns a standard Tcl result, whose value is a four-element list - * comprising the time format, the locale, and the timezone. + * Note: common options table used here, because for the options often used + * the same literals (objects), so it avoids permanent "recompiling" of + * option object representation to indexType with another table. * - * This function exists because the loop that parses the [clock format] - * options is a known performance "hot spot", and is implemented in an effort - * to speed that particular code up. + * Results: + * Returns a standard Tcl result, and stores parsed options + * (format, the locale, timezone and base) in structure "opts". * *----------------------------------------------------------------------------- */ +#define CLC_FMT_ARGS (0) +#define CLC_SCN_ARGS (1 << 0) +#define CLC_ADD_ARGS (1 << 1) + static int -ClockParseformatargsObjCmd( - void *clientData, /* Client data containing literal pool */ - Tcl_Interp *interp, /* Tcl interpreter */ +ClockParseFmtScnArgs( + ClockFmtScnCmdArgs *opts, /* Result vector: format, locale, timezone... */ + TclDateFields *date, /* Extracted date-time corresponding base + * (by scan or add) resp. clockval (by format) */ int objc, /* Parameter count */ - Tcl_Obj *const objv[]) /* Parameter vector */ -{ - ClockClientData *dataPtr = (ClockClientData *)clientData; - Tcl_Obj **litPtr = dataPtr->literals; - Tcl_Obj *results[3]; /* Format, locale and timezone */ -#define formatObj results[0] -#define localeObj results[1] -#define timezoneObj results[2] + Tcl_Obj *const objv[], /* Parameter vector */ + int flags, /* Flags, differentiates between format, scan, add */ + const char *syntax /* Syntax of the current command */ +) { + Tcl_Interp *interp = opts->interp; + ClockClientData *dataPtr = (ClockClientData *)opts->clientData; int gmtFlag = 0; - static const char *const options[] = { /* Command line options expected */ - "-format", "-gmt", "-locale", - "-timezone", NULL }; + static const char *const options[] = { + "-base", "-format", "-gmt", "-locale", "-timezone", "-validate", NULL + }; enum optionInd { - CLOCK_FORMAT_FORMAT, CLOCK_FORMAT_GMT, CLOCK_FORMAT_LOCALE, - CLOCK_FORMAT_TIMEZONE + CLC_ARGS_BASE, CLC_ARGS_FORMAT, CLC_ARGS_GMT, CLC_ARGS_LOCALE, + CLC_ARGS_TIMEZONE, CLC_ARGS_VALIDATE }; int optionIndex; /* Index of an option. */ int saw = 0; /* Flag == 1 if option was seen already. */ - Tcl_WideInt clockVal; /* Clock value - just used to parse. */ int i; + Tcl_WideInt baseVal; /* Base time, expressed in seconds from the Epoch */ - /* - * Args consist of a time followed by keyword-value pairs. - */ - - if (objc < 2 || (objc % 2) != 0) { - Tcl_WrongNumArgs(interp, 0, objv, - "clock format clockval ?-format string? " - "?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"); - Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", (void *)NULL); - return TCL_ERROR; + if ( flags & (CLC_SCN_ARGS) ) { + /* default flags (from configure) */ + opts->flags |= dataPtr->defFlags & (CLF_VALIDATE); + } else { + /* clock value (as current base) */ + opts->baseObj = objv[1]; + saw |= (1 << CLC_ARGS_BASE); } /* * Extract values for the keywords. */ - formatObj = litPtr[LIT__DEFAULT_FORMAT]; - localeObj = litPtr[LIT_C]; - timezoneObj = litPtr[LIT__NIL]; for (i = 2; i < objc; i+=2) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, - &optionIndex) != TCL_OK) { - Tcl_SetErrorCode(interp, "CLOCK", "badOption", - TclGetString(objv[i]), (void *)NULL); - return TCL_ERROR; + /* bypass integers (offsets) by "clock add" */ + if (flags & CLC_ADD_ARGS) { + Tcl_WideInt num; + if (TclGetWideIntFromObj(NULL, objv[i], &num) == TCL_OK) { + continue; + } + } + /* get option */ + if (Tcl_GetIndexFromObj(interp, objv[i], options, + "option", 0, &optionIndex) != TCL_OK) { + goto badOptionMsg; + } + /* if already specified */ + if (saw & (1 << optionIndex)) { + if ( !(flags & CLC_SCN_ARGS) + && optionIndex == CLC_ARGS_BASE) { + goto badOptionMsg; + } + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": doubly present", + TclGetString(objv[i])) + ); + goto badOption; } switch (optionIndex) { - case CLOCK_FORMAT_FORMAT: - formatObj = objv[i+1]; + case CLC_ARGS_FORMAT: + if (flags & CLC_ADD_ARGS) { + goto badOptionMsg; + } + opts->formatObj = objv[i+1]; break; - case CLOCK_FORMAT_GMT: + case CLC_ARGS_GMT: if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){ return TCL_ERROR; } break; - case CLOCK_FORMAT_LOCALE: - localeObj = objv[i+1]; + case CLC_ARGS_LOCALE: + opts->localeObj = objv[i+1]; break; - case CLOCK_FORMAT_TIMEZONE: - timezoneObj = objv[i+1]; + case CLC_ARGS_TIMEZONE: + opts->timezoneObj = objv[i+1]; + break; + case CLC_ARGS_BASE: + opts->baseObj = objv[i+1]; + break; + case CLC_ARGS_VALIDATE: + if ( !(flags & CLC_SCN_ARGS) ) { + goto badOptionMsg; + } else { + int val; + if (Tcl_GetBooleanFromObj(interp, objv[i+1], &val) != TCL_OK) { + return TCL_ERROR; + } + if (val) { + opts->flags |= CLF_VALIDATE; + } else { + opts->flags &= ~CLF_VALIDATE; + } + } break; } - saw |= 1 << optionIndex; + saw |= (1 << optionIndex); } /* * Check options. */ - if (TclGetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) { + if ((saw & (1 << CLC_ARGS_GMT)) + && (saw & (1 << CLC_ARGS_TIMEZONE))) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot use -gmt and -timezone in same call", -1)); + Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL); return TCL_ERROR; } - if ((saw & (1 << CLOCK_FORMAT_GMT)) - && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) { - Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]); - Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", (void *)NULL); + if (gmtFlag) { + opts->timezoneObj = dataPtr->literals[LIT_GMT]; + } + else + /* If time zone not specified use system time zone */ + if ( opts->timezoneObj == NULL + || TclGetString(opts->timezoneObj) == NULL + || opts->timezoneObj->length == 0 + ) { + opts->timezoneObj = ClockGetSystemTimeZone(opts->clientData, interp); + if (opts->timezoneObj == NULL) { + return TCL_ERROR; + } + } + + /* Setup timezone (normalize object if needed and load TZ on demand) */ + + opts->timezoneObj = ClockSetupTimeZone(opts->clientData, interp, opts->timezoneObj); + if (opts->timezoneObj == NULL) { return TCL_ERROR; } - if (gmtFlag) { - timezoneObj = litPtr[LIT_GMT]; + + /* Base (by scan or add) or clock value (by format) */ + + if (opts->baseObj != NULL) { + Tcl_Obj *baseObj = opts->baseObj; + /* bypass integer recognition if looks like option "-now" */ + if ( + (baseObj->length == 4 && baseObj->bytes && *(baseObj->bytes+1) == 'n') || + TclGetWideIntFromObj(NULL, baseObj, &baseVal) != TCL_OK + ) { + + /* we accept "-now" as current date-time */ + static const char *const nowOpts[] = { + "-now", NULL + }; + int idx; + if (Tcl_GetIndexFromObj(NULL, baseObj, nowOpts, "seconds or -now", + TCL_EXACT, &idx) == TCL_OK + ) { + goto baseNow; + } + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + Tcl_GetString(baseObj))); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); + i = 1; + goto badOption; + } + /* + * Seconds could be an unsigned number that overflowed. Make sure + * that it isn't. Additionally it may be too complex to calculate + * julianday etc (forwards/backwards) by too large/small values, thus + * just let accept a bit shorter values to avoid overflow. + * Note the year is currently an integer, thus avoid to overflow it also. + */ + + if ( baseObj->typePtr == &tclBignumType + || baseVal < TCL_MIN_SECONDS || baseVal > TCL_MAX_SECONDS + ) { + Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); + return TCL_ERROR; + } + + } else { + +baseNow: + { + Tcl_Time now; + Tcl_GetTime(&now); + baseVal = (Tcl_WideInt) now.sec; + } + } + + /* + * Extract year, month and day from the base time for the parser to use as + * defaults + */ + + /* check base fields already cached (by TZ, last-second cache) */ + if ( dataPtr->lastBase.timezoneObj == opts->timezoneObj + && dataPtr->lastBase.date.seconds == baseVal) { + memcpy(date, &dataPtr->lastBase.date, ClockCacheableDateFieldsSize); + } else { + /* extact fields from base */ + date->seconds = baseVal; + if (ClockGetDateFields(opts->clientData, interp, date, opts->timezoneObj, + GREGORIAN_CHANGE_DATE) != TCL_OK) { /* TODO - GREGORIAN_CHANGE_DATE should be locale-dependent */ + return TCL_ERROR; + } + /* cache last base */ + memcpy(&dataPtr->lastBase.date, date, ClockCacheableDateFieldsSize); + Tcl_SetObjRef(dataPtr->lastBase.timezoneObj, opts->timezoneObj); + } + + return TCL_OK; + +badOptionMsg: + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": must be %s", + TclGetString(objv[i]), syntax) + ); + +badOption: + + Tcl_SetErrorCode(interp, "CLOCK", "badOption", + i < objc ? Tcl_GetString(objv[i]) : NULL, NULL); + + return TCL_ERROR; +} + +/*---------------------------------------------------------------------- + * + * ClockFormatObjCmd -- , clock format -- + * + * This function is invoked to process the Tcl "clock format" command. + * + * Formats a count of seconds since the Posix Epoch as a time of day. + * + * The 'clock format' command formats times of day for output. Refer + * to the user documentation to see what it does. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +ClockFormatObjCmd( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const objv[]) /* Parameter values */ +{ + ClockClientData *dataPtr = (ClockClientData *)clientData; + + static const char *syntax = "clockval|-now " + "?-format string? " + "?-gmt boolean? " + "?-locale LOCALE? ?-timezone ZONE?"; + int ret; + ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ + DateFormat dateFmt; /* Common structure used for formatting */ + + /* even number of arguments */ + if ((objc & 1) == 1) { + Tcl_WrongNumArgs(interp, 1, objv, syntax); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + return TCL_ERROR; + } + + memset(&dateFmt, 0, sizeof(dateFmt)); + + /* + * Extract values for the keywords. + */ + + ClockInitFmtScnArgs(clientData, interp, &opts); + ret = ClockParseFmtScnArgs(&opts, &dateFmt.date, objc, objv, + CLC_FMT_ARGS, "-format, -gmt, -locale, or -timezone"); + if (ret != TCL_OK) { + goto done; + } + + /* Default format */ + if (opts.formatObj == NULL) { + opts.formatObj = dataPtr->literals[LIT__DEFAULT_FORMAT]; + } + + /* Use compiled version of Format - */ + + ret = ClockFormat(&dateFmt, &opts); + +done: + + Tcl_UnsetObjRef(dateFmt.date.tzName); + + if (ret != TCL_OK) { + return ret; + } + + return TCL_OK; +} + +/*---------------------------------------------------------------------- + * + * ClockScanObjCmd -- , clock scan -- + * + * This function is invoked to process the Tcl "clock scan" command. + * + * Inputs a count of seconds since the Posix Epoch as a time of day. + * + * The 'clock scan' command scans times of day on input. Refer to the + * user documentation to see what it does. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +ClockScanObjCmd( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const objv[]) /* Parameter values */ +{ + static const char *syntax = "string " + "?-base seconds? " + "?-format string? " + "?-gmt boolean? " + "?-locale LOCALE? ?-timezone ZONE? ?-validate boolean?"; + int ret; + ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ + DateInfo yy; /* Common structure used for parsing */ + DateInfo *info = &yy; + + /* even number of arguments */ + if ((objc & 1) == 1) { + Tcl_WrongNumArgs(interp, 1, objv, syntax); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + return TCL_ERROR; + } + + ClockInitDateInfo(&yy); + + /* + * Extract values for the keywords. + */ + + ClockInitFmtScnArgs(clientData, interp, &opts); + ret = ClockParseFmtScnArgs(&opts, &yy.date, objc, objv, + CLC_SCN_ARGS, "-base, -format, -gmt, -locale, -timezone or -validate"); + if (ret != TCL_OK) { + goto done; + } + + /* seconds are in localSeconds (relative base date), so reset time here */ + yyHour = yyMinutes = yySeconds = yySecondOfDay = 0; yyMeridian = MER24; + + /* If free scan */ + if (opts.formatObj == NULL) { + /* Use compiled version of FreeScan - */ + + /* [SB] TODO: Perhaps someday we'll localize the legacy code. Right now, it's not localized. */ + if (opts.localeObj != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("legacy [clock scan] does not support -locale", -1)); + Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL); + ret = TCL_ERROR; + goto done; + } + ret = ClockFreeScan(&yy, objv[1], &opts); + } + else { + /* Use compiled version of Scan - */ + + ret = ClockScan(&yy, objv[1], &opts); + } + + if (ret != TCL_OK) { + goto done; + } + + /* Convert date info structure into UTC seconds */ + + ret = ClockScanCommit(&yy, &opts); + if (ret != TCL_OK) { + goto done; + } + + /* Apply validation rules, if expected */ + if ( (opts.flags & CLF_VALIDATE) ) { + ret = ClockValidDate(&yy, &opts, opts.formatObj == NULL ? 2 : 3); + if (ret != TCL_OK) { + goto done; + } + } + +done: + + Tcl_UnsetObjRef(yy.date.tzName); + + if (ret != TCL_OK) { + return ret; + } + + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(yy.date.seconds)); + return TCL_OK; +} + +/*---------------------------------------------------------------------- + * + * ClockScanCommit -- + * + * Converts date info structure into UTC seconds. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ClockScanCommit( + DateInfo *info, /* Clock scan info structure */ + ClockFmtScnCmdArgs *opts) /* Format, locale, timezone and base */ +{ + /* If needed assemble julianDay using year, month, etc. */ + if (info->flags & CLF_ASSEMBLE_JULIANDAY) { + if ((info->flags & CLF_ISO8601WEAK)) { + GetJulianDayFromEraYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE); + } + else + if ( !(info->flags & CLF_DAYOFYEAR) /* no day of year */ + || (info->flags & (CLF_DAYOFMONTH|CLF_MONTH)) /* yymmdd over yyddd */ + == (CLF_DAYOFMONTH|CLF_MONTH) + ) { + GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); + } else { + GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); + } + info->flags |= CLF_ASSEMBLE_SECONDS; + info->flags &= ~CLF_ASSEMBLE_JULIANDAY; + } + + /* some overflow checks */ + if (info->flags & CLF_JULIANDAY) { + ClockClientData *dataPtr = (ClockClientData *)opts->clientData; + double curJDN = (double)yydate.julianDay + + ((double)yySecondOfDay - SECONDS_PER_DAY/2) / SECONDS_PER_DAY; + if (curJDN > dataPtr->maxJDN) { + Tcl_SetObjResult(opts->interp, Tcl_NewStringObj( + "requested date too large to represent", -1)); + Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL); + return TCL_ERROR; + } + } + + /* Local seconds to UTC (stored in yydate.seconds) */ + + if (info->flags & (CLF_ASSEMBLE_SECONDS)) { + yydate.localSeconds = + -210866803200L + + ( SECONDS_PER_DAY * (Tcl_WideInt)yydate.julianDay ) + + ( yySecondOfDay % SECONDS_PER_DAY ); + } + + if (info->flags & (CLF_ASSEMBLE_SECONDS|CLF_LOCALSEC)) { + if (ConvertLocalToUTC(opts->clientData, opts->interp, &yydate, + opts->timezoneObj, GREGORIAN_CHANGE_DATE) != TCL_OK) { + return TCL_ERROR; + } + } + + /* Increment UTC seconds with relative time */ + + yydate.seconds += yyRelSeconds; + + return TCL_OK; +} + +/*---------------------------------------------------------------------- + * + * ClockValidDate -- + * + * Validate date info structure for wrong data (e. g. out of ranges). + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ClockValidDate( + DateInfo *info, /* Clock scan info structure */ + ClockFmtScnCmdArgs *opts, /* Scan options */ + int stage) /* Stage to validate (1, 2 or 3 for both) */ +{ + const char *errMsg = "", *errCode = ""; + TclDateFields temp; + int tempCpyFlg = 0; + ClockClientData *dataPtr = (ClockClientData *)opts->clientData; + + #if 0 + printf("yyMonth %d, yyDay %d, yyDayOfYear %d, yyHour %d, yyMinutes %d, yySeconds %d, " + "yySecondOfDay %d, sec %d, daySec %d, tzOffset %d\n", + yyMonth, yyDay, yydate.dayOfYear, yyHour, yyMinutes, yySeconds, + yySecondOfDay, (int)yydate.localSeconds, (int)(yydate.localSeconds % SECONDS_PER_DAY), + yydate.tzOffset); + #endif + + if (!(stage & 1)) { + goto stage_2; + } + + /* first year (used later in hath / daysInPriorMonths) */ + if ((info->flags & (CLF_YEAR|CLF_ISO8601YEAR))) { + if ((info->flags & CLF_ISO8601YEAR)) { + if ( yydate.iso8601Year < dataPtr->validMinYear + || yydate.iso8601Year > dataPtr->validMaxYear ) { + errMsg = "invalid iso year"; errCode = "iso year"; goto error; + } + } + if (info->flags & CLF_YEAR) { + if ( yyYear < dataPtr->validMinYear + || yyYear > dataPtr->validMaxYear ) { + errMsg = "invalid year"; errCode = "year"; goto error; + } + } else if ((info->flags & CLF_ISO8601YEAR)) { + yyYear = yydate.iso8601Year; /* used to recognize leap */ + } + if ((info->flags & (CLF_ISO8601YEAR|CLF_YEAR)) + == (CLF_ISO8601YEAR|CLF_YEAR)) { + if (yyYear != yydate.iso8601Year) { + errMsg = "ambiguous year"; errCode = "year"; goto error; + } + } + } + /* and month (used later in hath) */ + if (info->flags & CLF_MONTH) { + if ( yyMonth < 1 || yyMonth > 12 ) { + errMsg = "invalid month"; errCode = "month"; goto error; + } + } + /* day of month */ + if (info->flags & (CLF_DAYOFMONTH|CLF_DAYOFWEEK)) { + if ( yyDay < 1 || yyDay > 31 ) { + errMsg = "invalid day"; errCode = "day"; goto error; + } + else + if ( (info->flags & CLF_MONTH) ) { + const int *h = hath[IsGregorianLeapYear(&yydate)]; + if ( yyDay > h[yyMonth-1] ) { + errMsg = "invalid day"; goto error; + } + } + } + if (info->flags & CLF_DAYOFYEAR) { + if ( yydate.dayOfYear < 1 + || yydate.dayOfYear > daysInPriorMonths[IsGregorianLeapYear(&yydate)][12] ) { + errMsg = "invalid day of year"; errCode = "day of year"; goto error; + } + } + + /* mmdd !~ ddd */ + if ((info->flags & (CLF_DAYOFYEAR|CLF_DAYOFMONTH|CLF_MONTH)) + == (CLF_DAYOFYEAR|CLF_DAYOFMONTH|CLF_MONTH)) { + if (!tempCpyFlg) { + memcpy(&temp, &yydate, sizeof(temp)); + tempCpyFlg = 1; + } + GetJulianDayFromEraYearDay(&temp, GREGORIAN_CHANGE_DATE); + if (temp.julianDay != yydate.julianDay) { + errMsg = "ambiguous day"; errCode = "day"; goto error; + } + } + + if (info->flags & CLF_TIME) { + /* hour */ + if ( yyHour < 0 || yyHour > ((yyMeridian == MER24) ? 23 : 12) ) { + errMsg = "invalid time (hour)"; errCode = "hour"; goto error; + } + /* minutes */ + if ( yyMinutes < 0 || yyMinutes > 59 ) { + errMsg = "invalid time (minutes)"; errCode = "minutes"; goto error; + } + /* oldscan could return secondOfDay (parsedTime) -1 by invalid time (ex.: 25:00:00) */ + if ( yySeconds < 0 || yySeconds > 59 || yySecondOfDay <= -1 ) { + errMsg = "invalid time"; errCode = "seconds"; goto error; + } + } + + if (!(stage & 2)) { + return TCL_OK; + } + + /* + * Further tests expected ready calculated julianDay (inclusive relative), + * and time-zone conversion (local to UTC time). + */ + stage_2: + + /* time, regarding the modifications by the time-zone (looks for given time + * in between DST-time hole, so does not exist in this time-zone) */ + if (info->flags & CLF_TIME) { + /* + * we don't need to do the backwards time-conversion (UTC to local) and + * compare results, because the after conversion (local to UTC) we + * should have valid localSeconds (was not invalidated to TCL_INV_SECONDS), + * so if it was invalidated - invalid time, outside the time-zone (in DST-hole) + */ + if ( yydate.localSeconds == TCL_INV_SECONDS ) { + errMsg = "invalid time (does not exist in this time-zone)"; + errCode = "out-of-time"; goto error; + } + } + + /* day of week */ + if (info->flags & CLF_DAYOFWEEK) { + if (!tempCpyFlg) { + memcpy(&temp, &yydate, sizeof(temp)); + tempCpyFlg = 1; + } + GetYearWeekDay(&temp, GREGORIAN_CHANGE_DATE); + if (temp.dayOfWeek != yyDayOfWeek) { + errMsg = "invalid day of week"; errCode = "day of week"; goto error; + } + } + + return TCL_OK; + + error: + Tcl_SetObjResult(opts->interp, + Tcl_ObjPrintf("unable to convert input string: %s", errMsg)); + Tcl_SetErrorCode(opts->interp, "CLOCK", "invInpStr", errCode, NULL); + return TCL_ERROR; +} + +/*---------------------------------------------------------------------- + * + * ClockFreeScan -- + * + * Used by ClockScanObjCmd for free scanning without format. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +ClockFreeScan( + DateInfo *info, /* Date fields used for parsing & converting + * simultaneously a yy-parse structure of the + * TclClockFreeScan */ + Tcl_Obj *strObj, /* String containing the time to scan */ + ClockFmtScnCmdArgs *opts) /* Command options */ +{ + Tcl_Interp *interp = opts->interp; + ClockClientData *dataPtr = (ClockClientData *)opts->clientData; + + int ret = TCL_ERROR; + + /* + * Parse the date. The parser will fill a structure "info" with date, + * time, time zone, relative month/day/seconds, relative weekday, ordinal + * month. + * Notice that many yy-defines point to values in the "info" or "date" + * structure, e. g. yySecondOfDay -> info->date.secondOfDay or + * yyMonth -> info->date.month (same as yydate.month) + */ + yyInput = Tcl_GetString(strObj); + + if (TclClockFreeScan(interp, info) != TCL_OK) { + Tcl_Obj *msg = Tcl_NewObj(); + Tcl_AppendPrintfToObj(msg, "unable to convert date-time string \"%s\": %s", + Tcl_GetString(strObj), TclGetString(Tcl_GetObjResult(interp))); + Tcl_SetObjResult(interp, msg); + goto done; } /* - * Return options as a list. + * If the caller supplied a date in the string, update the date with + * the value. If the caller didn't specify a time with the date, default to + * midnight. */ - Tcl_SetObjResult(interp, Tcl_NewListObj(3, results)); + if (info->flags & CLF_YEAR) { + if (yyYear < 100) { + if (yyYear >= dataPtr->yearOfCenturySwitch) { + yyYear -= 100; + } + yyYear += dataPtr->currentYearCentury; + } + yydate.era = CE; + info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS; + } + + /* + * If the caller supplied a time zone in the string, make it into a time + * zone indicator of +-hhmm and setup this time zone. + */ + + if (info->flags & CLF_ZONE) { + Tcl_Obj *tzObjStor = NULL; + int minEast = -yyTimezone; + int dstFlag = 1 - yyDSTmode; + tzObjStor = ClockFormatNumericTimeZone( + 60 * minEast + 3600 * dstFlag); + Tcl_IncrRefCount(tzObjStor); + + opts->timezoneObj = ClockSetupTimeZone(dataPtr, interp, tzObjStor); + + Tcl_DecrRefCount(tzObjStor); + if (opts->timezoneObj == NULL) { + goto done; + } + + // Tcl_SetObjRef(yydate.tzName, opts->timezoneObj); + + info->flags |= CLF_ASSEMBLE_SECONDS; + } + + /* + * For freescan apply validation rules (stage 1) before mixed with + * relative time (otherwise always valid recalculated date & time). + */ + if ( (opts->flags & CLF_VALIDATE) ) { + if (ClockValidDate(info, opts, 1) != TCL_OK) { + goto done; + } + } + + /* + * Assemble date, time, zone into seconds-from-epoch + */ + + if ((info->flags & (CLF_TIME|CLF_HAVEDATE)) == CLF_HAVEDATE) { + yySecondOfDay = 0; + info->flags |= CLF_ASSEMBLE_SECONDS; + } + else + if (info->flags & CLF_TIME) { + yySecondOfDay = ToSeconds(yyHour, yyMinutes, + yySeconds, yyMeridian); + info->flags |= CLF_ASSEMBLE_SECONDS; + } + else + if ( (info->flags & (CLF_DAYOFWEEK|CLF_HAVEDATE)) == CLF_DAYOFWEEK + || (info->flags & CLF_ORDINALMONTH) + || ( (info->flags & CLF_RELCONV) + && ( yyRelMonth != 0 + || yyRelDay != 0 ) ) + ) { + yySecondOfDay = 0; + info->flags |= CLF_ASSEMBLE_SECONDS; + } + else { + yySecondOfDay = yydate.localSeconds % SECONDS_PER_DAY; + } + + /* + * Do relative times + */ + + ret = ClockCalcRelTime(info); + + /* Free scanning completed - date ready */ + +done: + + return ret; +} + +/*---------------------------------------------------------------------- + * + * ClockCalcRelTime -- + * + * Used for calculating of relative times. + * + * Results: + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +int +ClockCalcRelTime( + DateInfo *info) /* Date fields used for converting */ +{ + + int prevDayOfWeek = yyDayOfWeek; /* preserve unchanged day of week */ + + /* + * Because some calculations require in-between conversion of the + * julian day, we can repeat this processing multiple times + */ +repeat_rel: + + if (info->flags & CLF_RELCONV) { + + /* + * Relative conversion normally possible in UTC time only, because + * of possible wrong local time increment if ignores in-between DST-hole. + * (see test-cases clock-34.53, clock-34.54). + * So increment date in julianDay, but time inside day in UTC (seconds). + */ + + /* add months (or years in months) */ + + if (yyRelMonth != 0) { + int m, h; + + /* if needed extract year, month, etc. again */ + if (info->flags & CLF_ASSEMBLE_DATE) { + GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); + GetMonthDay(&yydate); + GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE); + info->flags &= ~CLF_ASSEMBLE_DATE; + } + + /* add the requisite number of months */ + yyMonth += yyRelMonth - 1; + yyYear += yyMonth / 12; + m = yyMonth % 12; + /* compiler fix for negative offs - wrap y, m = (0, -1) -> (-1, 11) */ + if (m < 0) { + yyYear--; + m = 12 + m; + } + yyMonth = m + 1; + + /* if the day doesn't exist in the current month, repair it */ + h = hath[IsGregorianLeapYear(&yydate)][m]; + if (yyDay > h) { + yyDay = h; + } + + /* on demand (lazy) assemble julianDay using new year, month, etc. */ + info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS; + + yyRelMonth = 0; + } + + /* add days (or other parts aligned to days) */ + if (yyRelDay) { + + /* assemble julianDay using new year, month, etc. */ + if (info->flags & CLF_ASSEMBLE_JULIANDAY) { + GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); + info->flags &= ~CLF_ASSEMBLE_JULIANDAY; + } + yydate.julianDay += yyRelDay; + + /* julianDay was changed, on demand (lazy) extract year, month, etc. again */ + info->flags |= CLF_ASSEMBLE_DATE|CLF_ASSEMBLE_SECONDS; + + yyRelDay = 0; + } + + /* relative time (seconds), if exceeds current date, do the day conversion and + * leave rest of the increment in yyRelSeconds to add it hereafter in UTC seconds */ + if (yyRelSeconds) { + int newSecs = yySecondOfDay + yyRelSeconds; + + /* if seconds increment outside of current date, increment day */ + if (newSecs / SECONDS_PER_DAY != yySecondOfDay / SECONDS_PER_DAY) { + + yyRelDay += newSecs / SECONDS_PER_DAY; + yySecondOfDay = 0; + yyRelSeconds = newSecs % SECONDS_PER_DAY; + + goto repeat_rel; + } + } + + info->flags &= ~CLF_RELCONV; + } + + /* + * Do relative (ordinal) month + */ + + if (info->flags & CLF_ORDINALMONTH) { + int monthDiff; + + /* if needed extract year, month, etc. again */ + if (info->flags & CLF_ASSEMBLE_DATE) { + GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); + GetMonthDay(&yydate); + GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE); + info->flags &= ~CLF_ASSEMBLE_DATE; + } + + if (yyMonthOrdinalIncr > 0) { + monthDiff = yyMonthOrdinal - yyMonth; + if (monthDiff <= 0) { + monthDiff += 12; + } + yyMonthOrdinalIncr--; + } else { + monthDiff = yyMonth - yyMonthOrdinal; + if (monthDiff >= 0) { + monthDiff -= 12; + } + yyMonthOrdinalIncr++; + } + + /* process it further via relative times */ + yyYear += yyMonthOrdinalIncr; + yyRelMonth += monthDiff; + info->flags &= ~CLF_ORDINALMONTH; + info->flags |= CLF_RELCONV|CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS; + + goto repeat_rel; + } + + /* + * Do relative weekday + */ + + if ((info->flags & (CLF_DAYOFWEEK|CLF_HAVEDATE)) == CLF_DAYOFWEEK) { + + /* restore scanned day of week */ + yyDayOfWeek = prevDayOfWeek; + + /* if needed assemble julianDay now */ + if (info->flags & CLF_ASSEMBLE_JULIANDAY) { + GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); + info->flags &= ~CLF_ASSEMBLE_JULIANDAY; + } + + yydate.era = CE; + yydate.julianDay = WeekdayOnOrBefore(yyDayOfWeek, yydate.julianDay + 6) + + 7 * yyDayOrdinal; + if (yyDayOrdinal > 0) { + yydate.julianDay -= 7; + } + info->flags |= CLF_ASSEMBLE_DATE|CLF_ASSEMBLE_SECONDS; + } + return TCL_OK; +} + + +/*---------------------------------------------------------------------- + * + * ClockWeekdaysOffs -- + * + * Get offset in days for the number of week days corresponding the + * given day of week (skipping Saturdays and Sundays). + * + * + * Results: + * Returns a day increment adjusted the given weekdays + * + *---------------------------------------------------------------------- + */ + +static inline int +ClockWeekdaysOffs( + int dayOfWeek, + int offs) +{ + int weeks, resDayOfWeek; + + /* offset in days */ + weeks = offs / 5; + offs = offs % 5; + /* compiler fix for negative offs - wrap (0, -1) -> (-1, 4) */ + if (offs < 0) { + weeks--; + offs = 5 + offs; + } + offs += 7 * weeks; -#undef timezoneObj -#undef localeObj -#undef formatObj + /* resulting day of week */ + { + int day = (offs % 7); + /* compiler fix for negative offs - wrap (0, -1) -> (-1, 6) */ + if (day < 0) { + day = 7 + day; + } + resDayOfWeek = dayOfWeek + day; + } + + /* adjust if we start from a weekend */ + if (dayOfWeek > 5) { + int adj = 5 - dayOfWeek; + offs += adj; + resDayOfWeek += adj; + } + + /* adjust if we end up on a weekend */ + if (resDayOfWeek > 5) { + offs += 2; + } + + return offs; +} + + + +/*---------------------------------------------------------------------- + * + * ClockAddObjCmd -- , clock add -- + * + * Adds an offset to a given time. + * + * Refer to the user documentation to see what it exactly does. + * + * Syntax: + * clock add clockval ?count unit?... ?-option value? + * + * Parameters: + * clockval -- Starting time value + * count -- Amount of a unit of time to add + * unit -- Unit of time to add, must be one of: + * years year months month weeks week + * days day hours hour minutes minute + * seconds second + * + * Options: + * -gmt BOOLEAN + * Flag synonymous with '-timezone :GMT' + * -timezone ZONE + * Name of the time zone in which calculations are to be done. + * -locale NAME + * Name of the locale in which calculations are to be done. + * Used to determine the Gregorian change date. + * + * Results: + * Returns a standard Tcl result with the given time adjusted + * by the given offset(s) in order. + * + * Notes: + * It is possible that adding a number of months or years will adjust the + * day of the month as well. For instance, the time at one month after + * 31 January is either 28 or 29 February, because February has fewer + * than 31 days. + * + *---------------------------------------------------------------------- + */ + +int +ClockAddObjCmd( + ClientData clientData, /* Client data containing literal pool */ + Tcl_Interp *interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const objv[]) /* Parameter values */ +{ + static const char *syntax = "clockval|-now ?number units?..." + "?-gmt boolean? " + "?-locale LOCALE? ?-timezone ZONE?"; + ClockClientData *dataPtr = (ClockClientData *)clientData; + int ret; + ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */ + DateInfo yy; /* Common structure used for parsing */ + DateInfo *info = &yy; + + /* add "week" to units also (because otherwise ambiguous) */ + static const char *const units[] = { + "years", "months", "week", "weeks", + "days", "weekdays", + "hours", "minutes", "seconds", + NULL + }; + enum unitInd { + CLC_ADD_YEARS, CLC_ADD_MONTHS, CLC_ADD_WEEK, CLC_ADD_WEEKS, + CLC_ADD_DAYS, CLC_ADD_WEEKDAYS, + CLC_ADD_HOURS, CLC_ADD_MINUTES, CLC_ADD_SECONDS + }; + int unitIndex; /* Index of an option. */ + int i; + Tcl_WideInt offs; + + /* even number of arguments */ + if ((objc & 1) == 1) { + Tcl_WrongNumArgs(interp, 1, objv, syntax); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + return TCL_ERROR; + } + + ClockInitDateInfo(&yy); + + /* + * Extract values for the keywords. + */ + + ClockInitFmtScnArgs(clientData, interp, &opts); + ret = ClockParseFmtScnArgs(&opts, &yy.date, objc, objv, + CLC_ADD_ARGS, syntax); + if (ret != TCL_OK) { + goto done; + } + + /* time together as seconds of the day */ + yySecondOfDay = yySeconds = yydate.localSeconds % SECONDS_PER_DAY; + /* seconds are in localSeconds (relative base date), so reset time here */ + yyHour = 0; yyMinutes = 0; yyMeridian = MER24; + + ret = TCL_ERROR; + + /* + * Find each offset and process date increment + */ + + for (i = 2; i < objc; i+=2) { + /* bypass not integers (options, allready processed above) */ + if (TclGetWideIntFromObj(NULL, objv[i], &offs) != TCL_OK) { + continue; + } + if (objv[i]->typePtr == &tclBignumType) { + Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); + goto done; + } + /* get unit */ + if (Tcl_GetIndexFromObj(interp, objv[i+1], units, "unit", 0, + &unitIndex) != TCL_OK) { + goto done; + } + + /* nothing to do if zero quantity */ + if (!offs) { + continue; + } + + /* if in-between conversion needed (already have relative date/time), + * correct date info, because the date may be changed, + * so refresh it now */ + + if ( (info->flags & CLF_RELCONV) + && ( unitIndex == CLC_ADD_WEEKDAYS + /* some months can be shorter as another */ + || yyRelMonth || yyRelDay + /* day changed */ + || yySeconds + yyRelSeconds > SECONDS_PER_DAY + || yySeconds + yyRelSeconds < 0 + ) + ) { + if (ClockCalcRelTime(info) != TCL_OK) { + goto done; + } + } + + /* process increment by offset + unit */ + info->flags |= CLF_RELCONV; + switch (unitIndex) { + case CLC_ADD_YEARS: + yyRelMonth += offs * 12; + break; + case CLC_ADD_MONTHS: + yyRelMonth += offs; + break; + case CLC_ADD_WEEK: + case CLC_ADD_WEEKS: + yyRelDay += offs * 7; + break; + case CLC_ADD_DAYS: + yyRelDay += offs; + break; + case CLC_ADD_WEEKDAYS: + /* add number of week days (skipping Saturdays and Sundays) + * to a relative days value. */ + offs = ClockWeekdaysOffs(yy.date.dayOfWeek, offs); + yyRelDay += offs; + break; + case CLC_ADD_HOURS: + yyRelSeconds += offs * 60 * 60; + break; + case CLC_ADD_MINUTES: + yyRelSeconds += offs * 60; + break; + case CLC_ADD_SECONDS: + yyRelSeconds += offs; + break; + } + } + + /* + * Do relative times (if not yet already processed interim): + */ + + if (info->flags & CLF_RELCONV) { + if (ClockCalcRelTime(info) != TCL_OK) { + goto done; + } + } + + /* Convert date info structure into UTC seconds */ + + ret = ClockScanCommit(&yy, &opts); + +done: + + Tcl_UnsetObjRef(yy.date.tzName); + + if (ret != TCL_OK) { + return ret; + } + + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(yy.date.seconds)); + return TCL_OK; } /*---------------------------------------------------------------------- @@ -1997,22 +4542,89 @@ ClockSecondsObjCmd( Tcl_Obj *const *objv) /* Parameter values */ { Tcl_Time now; - Tcl_Obj *timeObj; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_GetTime(&now); - TclNewUIntObj(timeObj, (Tcl_WideUInt)now.sec); - - Tcl_SetObjResult(interp, timeObj); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec)); return TCL_OK; } /* *---------------------------------------------------------------------- * + * ClockSafeCatchCmd -- + * + * Same as "::catch" command but avoids overwriting of interp state. + * + * See [554117edde] for more info (and proper solution). + * + *---------------------------------------------------------------------- + */ +int +ClockSafeCatchCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + typedef struct { + int status; /* return code status */ + int flags; /* Each remaining field saves the */ + int returnLevel; /* corresponding field of the Interp */ + int returnCode; /* struct. These fields taken together are */ + Tcl_Obj *errorInfo; /* the "state" of the interp. */ + Tcl_Obj *errorCode; + Tcl_Obj *returnOpts; + Tcl_Obj *objResult; + Tcl_Obj *errorStack; + int resetErrorStack; + } InterpState; + + Interp *iPtr = (Interp *)interp; + int ret, flags = 0; + InterpState *statePtr; + + if (objc == 1) { + /* wrong # args : */ + return Tcl_CatchObjCmd(NULL, interp, objc, objv); + } + + statePtr = (InterpState *)Tcl_SaveInterpState(interp, 0); + if (!statePtr->errorInfo) { + /* todo: avoid traced get of errorInfo here */ + Tcl_InitObjRef(statePtr->errorInfo, + Tcl_ObjGetVar2(interp, iPtr->eiVar, NULL, 0)); + flags |= ERR_LEGACY_COPY; + } + if (!statePtr->errorCode) { + /* todo: avoid traced get of errorCode here */ + Tcl_InitObjRef(statePtr->errorCode, + Tcl_ObjGetVar2(interp, iPtr->ecVar, NULL, 0)); + flags |= ERR_LEGACY_COPY; + } + + /* original catch */ + ret = Tcl_CatchObjCmd(NULL, interp, objc, objv); + + if (ret == TCL_ERROR) { + Tcl_DiscardInterpState((Tcl_InterpState)statePtr); + return TCL_ERROR; + } + /* overwrite result in state with catch result */ + Tcl_SetObjRef(statePtr->objResult, Tcl_GetObjResult(interp)); + /* set result (together with restore state) to interpreter */ + (void) Tcl_RestoreInterpState(interp, (Tcl_InterpState)statePtr); + /* todo: unless ERR_LEGACY_COPY not set in restore (branch [bug-554117edde] not merged yet) */ + iPtr->flags |= (flags & ERR_LEGACY_COPY); + return ret; +} + +/* + *---------------------------------------------------------------------- + * * TzsetIfNecessary -- * * Calls the tzset() library function if the contents of the TZ @@ -2036,12 +4648,13 @@ ClockSecondsObjCmd( #define wcscpy strcpy #endif -static void +static size_t TzsetIfNecessary(void) { static WCHAR* tzWas = (WCHAR *)INT2PTR(-1); /* Previous value of TZ, protected by * clockMutex. */ - static long long tzLastRefresh = 0; /* Used for latency before next refresh */ + static long tzLastRefresh = 0; /* Used for latency before next refresh */ + static size_t tzWasEpoch = 0; /* Epoch, signals that TZ changed */ static size_t tzEnvEpoch = 0; /* Last env epoch, for faster signaling, that TZ changed via TCL */ const WCHAR *tzIsNow; /* Current value of TZ */ @@ -2049,19 +4662,23 @@ TzsetIfNecessary(void) /* * Prevent performance regression on some platforms by resolving of system time zone: * small latency for check whether environment was changed (once per second) - * no latency if environment was changed with tcl-env (compare both epoch values) + * no latency if environment was chaned with tcl-env (compare both epoch values) */ Tcl_Time now; Tcl_GetTime(&now); if (now.sec == tzLastRefresh && tzEnvEpoch == TclEnvEpoch) { - return; + return tzWasEpoch; } tzEnvEpoch = TclEnvEpoch; tzLastRefresh = now.sec; + /* check in lock */ Tcl_MutexLock(&clockMutex); - tzIsNow = getenv("TZ"); + tzIsNow = getenv("TCL_TZ"); + if (tzIsNow == NULL) { + tzIsNow = getenv("TZ"); + } if (tzIsNow != NULL && (tzWas == NULL || tzWas == (WCHAR *)INT2PTR(-1) || wcscmp(tzIsNow, tzWas) != 0)) { tzset(); @@ -2070,42 +4687,16 @@ TzsetIfNecessary(void) } tzWas = (WCHAR *)Tcl_Alloc(sizeof(WCHAR) * (wcslen(tzIsNow) + 1)); wcscpy(tzWas, tzIsNow); + tzWasEpoch++; } else if (tzIsNow == NULL && tzWas != NULL) { tzset(); if (tzWas != (WCHAR *)INT2PTR(-1)) Tcl_Free(tzWas); tzWas = NULL; + tzWasEpoch++; } Tcl_MutexUnlock(&clockMutex); -} - -/* - *---------------------------------------------------------------------- - * - * ClockDeleteCmdProc -- - * - * Remove a reference to the clock client data, and clean up memory - * when it's all gone. - * - * Results: - * None. - * - *---------------------------------------------------------------------- - */ - -static void -ClockDeleteCmdProc( - void *clientData) /* Opaque pointer to the client data */ -{ - ClockClientData *data = (ClockClientData *)clientData; - int i; - if (data->refCount-- <= 1) { - for (i = 0; i < LIT__END; ++i) { - Tcl_DecrRefCount(data->literals[i]); - } - Tcl_Free(data->literals); - Tcl_Free(data); - } + return tzWasEpoch; } /* |