/*
 * tclClock.c --
 *
 *	Contains the time and date related commands. This code is derived from
 *	the time and date facilities of TclX, by Mark Diekhans and Karl
 *	Lehenbauer.
 *
 * Copyright 1991-1995 Karl Lehenbauer and 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 "tclStrIdxTree.h"
#include "tclDate.h"
#include "tclCompile.h"

/*
 * Windows has mktime. The configurators do not check.
 */

#ifdef _WIN32
#define HAVE_MKTIME 1
#endif

/*
 * Table of the days in each month, leap and common years
 */

static const int hath[2][12] = {
    {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31},
    {31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}
};
static const int daysInPriorMonths[2][13] = {
    {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365},
    {0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366}
};

/*
 * Enumeration of the string literals used in [clock]
 */

CLOCK_LITERAL_ARRAY(Literals);

/* 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_");

static const char *const eras[] = { "CE", "BCE", NULL };

/*
 * Thread specific data block holding a 'struct tm' for the 'gmtime' and
 * 'localtime' library calls.
 */

static Tcl_ThreadDataKey tmKey;

/*
 * Mutex protecting 'gmtime', 'localtime' and 'mktime' calls and the statics
 * in the date parsing code.
 */

TCL_DECLARE_MUTEX(clockMutex)

/*
 * Function prototypes for local procedures in this file:
 */

static int		ConvertUTCToLocalUsingTable(Tcl_Interp *,
			    TclDateFields *, int, Tcl_Obj *const[],
			    Tcl_WideInt rangesVal[2]);
static int		ConvertUTCToLocalUsingC(Tcl_Interp *,
			    TclDateFields *, int);
static int		ConvertLocalToUTC(ClientData clientData, Tcl_Interp *,
			    TclDateFields *, Tcl_Obj *timezoneObj, int);
static int		ConvertLocalToUTCUsingTable(Tcl_Interp *,
			    TclDateFields *, int, Tcl_Obj *const[],
			    Tcl_WideInt rangesVal[2]);
static int		ConvertLocalToUTCUsingC(Tcl_Interp *,
			    TclDateFields *, int);
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 int		WeekdayOnOrBefore(int, int);
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(
			    ClientData clientData, register DateInfo *info,
			    register ClockFmtScnCmdArgs *opts);
static int		ClockFreeScan(
			    register DateInfo *info, 
			    Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts);
static int		ClockCalcRelTime(
			    register DateInfo *info, ClockFmtScnCmdArgs *opts);
static int		ClockAddObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static struct tm *	ThreadSafeLocalTime(const time_t *);
static unsigned long	TzsetGetEpoch(void);
static void		TzsetIfNecessary(void);
static void		ClockDeleteCmdProc(ClientData);

/*
 * Structure containing description of "native" clock commands to create.
 */

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
				 * 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[] = {
    {"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},
    {"Oldscan",		  TclClockOldscanObjCmd,		NULL, NULL},
    {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd,		NULL, NULL},
    {"GetDateFields",	  ClockGetdatefieldsObjCmd,		NULL, NULL},
    {"GetJulianDayFromEraYearMonthDay",
		ClockGetjuliandayfromerayearmonthdayObjCmd,	NULL, NULL},
    {"GetJulianDayFromEraYearWeekDay",
		ClockGetjuliandayfromerayearweekdayObjCmd,	NULL, NULL},
    {NULL, NULL, NULL, NULL}
};

/*
 *----------------------------------------------------------------------
 *
 * TclClockInit --
 *
 *	Registers the 'clock' subcommands with the Tcl interpreter and
 *	initializes its client data (which consists mostly of constant
 *	Tcl_Obj's that it is too much trouble to keep recreating).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Installs the commands and creates the client data
 *
 *----------------------------------------------------------------------
 */

void
TclClockInit(
    Tcl_Interp *interp)		/* Tcl interpreter */
{
    const struct ClockCommand *clockCmdPtr;
    char cmdName[50];		/* Buffer large enough to hold the string
				 *::tcl::clock::GetJulianDayFromEraYearMonthDay
				 * plus a terminating NUL. */
    Command         *cmdPtr;
    ClockClientData *data;
    int i;

    /*
     * Safe interps get [::clock] as alias to a master, so do not need their
     * own copies of the support routines.
     */

    if (Tcl_IsSafe(interp)) {
	return;
    }

    /*
     * Create the client data, which is a refcounted literal pool.
     */

    data = ckalloc(sizeof(ClockClientData));
    data->refCount = 0;
    data->literals = ckalloc(LIT__END * sizeof(Tcl_Obj*));
    for (i = 0; i < LIT__END; ++i) {
	Tcl_InitObjRef(data->literals[i], Tcl_NewStringObj(Literals[i], -1));
    }
    data->mcLiterals = NULL;
    data->mcLitIdxs = NULL;
    data->LastTZEpoch = 0;
    data->currentYearCentury = ClockDefaultYearCentury;
    data->yearOfCenturySwitch = ClockDefaultCenturySwitch;
    data->SystemTimeZone = NULL;
    data->SystemSetupTZData = NULL;
    data->GMTSetupTimeZone = NULL;
    data->GMTSetupTZData = NULL;
    data->AnySetupTimeZone = NULL;
    data->AnySetupTZData = NULL;
    data->LastUnnormSetupTimeZone = NULL;
    data->LastSetupTimeZone = NULL;
    data->LastSetupTZData = NULL;

    data->CurrentLocale = NULL;
    data->CurrentLocaleDict = NULL;
    data->LastUnnormUsedLocale = NULL;
    data->LastUsedLocale = NULL;
    data->LastUsedLocaleDict = NULL;

    data->lastBase.timezoneObj = NULL;
    data->UTC2Local.timezoneObj = NULL;
    data->UTC2Local.tzName = NULL;
    data->Local2UTC.timezoneObj = NULL;

    /*
     * Install the commands.
     */

#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);
	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->GMTSetupTimeZone);
    Tcl_UnsetObjRef(data->GMTSetupTZData);
    Tcl_UnsetObjRef(data->AnySetupTimeZone);
    Tcl_UnsetObjRef(data->AnySetupTZData);
    Tcl_UnsetObjRef(data->LastUnnormSetupTimeZone);
    Tcl_UnsetObjRef(data->LastSetupTimeZone);
    Tcl_UnsetObjRef(data->LastSetupTZData);

    Tcl_UnsetObjRef(data->CurrentLocale);
    Tcl_UnsetObjRef(data->CurrentLocaleDict);
    Tcl_UnsetObjRef(data->LastUnnormUsedLocale);
    Tcl_UnsetObjRef(data->LastUsedLocale);
    Tcl_UnsetObjRef(data->LastUsedLocaleDict);

    Tcl_UnsetObjRef(data->lastBase.timezoneObj);
    Tcl_UnsetObjRef(data->UTC2Local.timezoneObj);
    Tcl_UnsetObjRef(data->UTC2Local.tzName);
    Tcl_UnsetObjRef(data->Local2UTC.timezoneObj);
}

/*
 *----------------------------------------------------------------------
 *
 * 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 = 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);

	ckfree(data->literals);
	ckfree(data);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

static inline Tcl_Obj *
NormTimezoneObj(
    ClockClientData *dataPtr,  /* Client data containing literal pool */
    Tcl_Obj *timezoneObj)
{
    const char *tz;
    if ( timezoneObj == dataPtr->LastUnnormSetupTimeZone
      && dataPtr->LastSetupTimeZone != NULL 
    ) {
	return dataPtr->LastSetupTimeZone;
    }
    if ( timezoneObj == dataPtr->LastSetupTimeZone
      || timezoneObj == dataPtr->literals[LIT_GMT]
      || timezoneObj == dataPtr->SystemTimeZone
      || timezoneObj == dataPtr->AnySetupTimeZone
    ) {
	return timezoneObj;
    }

    tz = TclGetString(timezoneObj);
    if (dataPtr->AnySetupTimeZone != NULL &&
	(timezoneObj == dataPtr->AnySetupTimeZone
	   || strcmp(tz, TclGetString(dataPtr->AnySetupTimeZone)) == 0
	)
    ) {
	timezoneObj = dataPtr->AnySetupTimeZone;
    }
    else
    if (dataPtr->SystemTimeZone != NULL &&
	(timezoneObj == dataPtr->SystemTimeZone
	   || strcmp(tz, TclGetString(dataPtr->SystemTimeZone)) == 0
	)
    ) {
	timezoneObj = dataPtr->SystemTimeZone;
    }
    else
    if (
	strcmp(tz, Literals[LIT_GMT]) == 0
    ) {
	timezoneObj = dataPtr->literals[LIT_GMT];
    }
    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));
    Tcl_UnsetObjRef(dataPtr->CurrentLocaleDict);

    return dataPtr->CurrentLocale;
}

/*
 *----------------------------------------------------------------------
 *
 * 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;
    if ( localeObj == NULL || localeObj == dataPtr->CurrentLocale
      || localeObj == dataPtr->literals[LIT_C] 
      || localeObj == dataPtr->literals[LIT_CURRENT]
    ) {
	if (dataPtr->CurrentLocale == NULL) {
	    ClockGetCurrentLocale(dataPtr, interp);
	}
	*mcDictObj = dataPtr->CurrentLocaleDict;
	return dataPtr->CurrentLocale;
    }
    if ( localeObj == dataPtr->LastUsedLocale
      || localeObj == dataPtr->LastUnnormUsedLocale
    ) {
	*mcDictObj = dataPtr->LastUsedLocaleDict;
	return dataPtr->LastUsedLocale;
    }

    loc = TclGetString(localeObj);
    if ( dataPtr->CurrentLocale != NULL
      && ( localeObj == dataPtr->CurrentLocale
       || (localeObj->length == dataPtr->CurrentLocale->length
	  && strcmp(loc, TclGetString(dataPtr->CurrentLocale)) == 0
	)
      )
    ) {
	*mcDictObj = dataPtr->CurrentLocaleDict;
	localeObj = dataPtr->CurrentLocale;
    }
    else
    if ( dataPtr->LastUsedLocale != NULL
      && ( localeObj == dataPtr->LastUsedLocale
       || (localeObj->length == dataPtr->LastUsedLocale->length
	  && strcmp(loc, TclGetString(dataPtr->LastUsedLocale)) == 0
	)
      )
    ) {
	*mcDictObj = dataPtr->LastUsedLocaleDict;
	Tcl_SetObjRef(dataPtr->LastUnnormUsedLocale, localeObj);
	localeObj = dataPtr->LastUsedLocale;
    }
    else
    if (
	 (localeObj->length == 1 /* C */
	   && strncasecmp(loc, Literals[LIT_C], localeObj->length) == 0)
      || (localeObj->length == 7 /* current */
	   && strncasecmp(loc, Literals[LIT_CURRENT], localeObj->length) == 0)
    ) {
	if (dataPtr->CurrentLocale == NULL) {
	    ClockGetCurrentLocale(dataPtr, interp);
	}
	*mcDictObj = dataPtr->CurrentLocaleDict;
	localeObj = dataPtr->CurrentLocale;
    } 
    else 
    if (
	 (localeObj->length == 6 /* system */
	   && strncasecmp(loc, Literals[LIT_SYSTEM], localeObj->length) == 0)
    ) {
	Tcl_SetObjRef(dataPtr->LastUnnormUsedLocale, localeObj);
	localeObj = ClockGetSystemLocale(dataPtr, interp);
	Tcl_SetObjRef(dataPtr->LastUsedLocale, localeObj);
	*mcDictObj = NULL;
    } 
    else 
    {
	*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.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE Tcl_Obj *
ClockMCDict(ClockFmtScnCmdArgs *opts)
{
    ClockClientData *dataPtr = 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(opts->clientData, opts->interp,
		opts->localeObj, &opts->mcDictObj);
	    
	    if (opts->localeObj == NULL) {
		Tcl_SetResult(opts->interp,
		    "locale not specified and no default locale set", TCL_STATIC);
		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 = ckalloc(MCLIT__END * sizeof(Tcl_Obj*));
		for (i = 0; i < MCLIT__END; ++i) {
		    Tcl_InitObjRef(dataPtr->mcLiterals[i], 
			Tcl_NewStringObj(MsgCtLiterals[i], -1));
		}
	    }
	}

	if (opts->mcDictObj == NULL) {
	    Tcl_Obj *callargs[2];
	    /* get msgcat dictionary - ::tcl::clock::mcget locale */
	    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);
	    /* be sure that object reference not increases (dict changeable) */
	    if (opts->mcDictObj->refCount > 0) {
		/* smart reference (shared dict as object with no ref-counter) */
		opts->mcDictObj = Tcl_DictObjSmartRef(opts->interp, opts->mcDictObj);
	    }
	    if ( opts->localeObj == dataPtr->CurrentLocale ) {
		Tcl_SetObjRef(dataPtr->CurrentLocaleDict, opts->mcDictObj);
	    } else if ( opts->localeObj == dataPtr->LastUsedLocale ) {
		Tcl_SetObjRef(dataPtr->LastUsedLocaleDict, opts->mcDictObj);
	    } else {
		Tcl_SetObjRef(dataPtr->LastUsedLocale, opts->localeObj);
		Tcl_UnsetObjRef(dataPtr->LastUnnormUsedLocale);
		Tcl_SetObjRef(dataPtr->LastUsedLocaleDict, opts->mcDictObj);
	    }
	    Tcl_ResetResult(opts->interp);
	}
    }

    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.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE Tcl_Obj *
ClockMCGet(
    ClockFmtScnCmdArgs *opts, 
    int mcKey)
{
    ClockClientData *dataPtr = 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 = 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.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE int
ClockMCSetIdx(
    ClockFmtScnCmdArgs *opts, 
    int mcKey, Tcl_Obj *valObj)
{
    ClockClientData *dataPtr = 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 = ckalloc(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);
}

/*
 *----------------------------------------------------------------------
 *
 * 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 = clientData;
    
    static const char *const options[] = {
	"-system-tz",	  "-setup-tz",	  "-default-locale",
	"-clear",
	"-year-century",  "-century-switch",
	NULL
    };
    enum optionInd {
	CLOCK_SYSTEM_TZ,  CLOCK_SETUP_TZ, CLOCK_CURRENT_LOCALE,
	CLOCK_CLEAR_CACHE,
	CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH,
	CLOCK_SETUP_GMT, CLOCK_SETUP_NOP
    };
    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 */
	    unsigned long lastTZEpoch = TzsetGetEpoch();
	    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) {
		/* differentiate GMT and system zones, because used often */
		Tcl_Obj *timezoneObj = NormTimezoneObj(dataPtr, objv[i]);
		Tcl_SetObjRef(dataPtr->LastUnnormSetupTimeZone, objv[i]);
		if (dataPtr->LastSetupTimeZone != timezoneObj) {
		    Tcl_SetObjRef(dataPtr->LastSetupTimeZone, timezoneObj);
		    Tcl_UnsetObjRef(dataPtr->LastSetupTZData);
		}
		if (timezoneObj == dataPtr->literals[LIT_GMT]) {
		    optionIndex = CLOCK_SETUP_GMT;
		} else if (timezoneObj == dataPtr->SystemTimeZone) {
		    optionIndex = CLOCK_SETUP_NOP;
		}
		switch (optionIndex) {
		case CLOCK_SETUP_GMT:
		    if (i < objc) {
			if (dataPtr->GMTSetupTimeZone != timezoneObj) {
			    Tcl_SetObjRef(dataPtr->GMTSetupTimeZone, timezoneObj);
			    Tcl_UnsetObjRef(dataPtr->GMTSetupTZData);
			}
		    }
		break;
		case CLOCK_SETUP_TZ:
		    if (i < objc) {
			if (dataPtr->AnySetupTimeZone != timezoneObj) {
			    Tcl_SetObjRef(dataPtr->AnySetupTimeZone, timezoneObj);
			    Tcl_UnsetObjRef(dataPtr->AnySetupTZData);
			}
		    } 
		break;
		}
	    }
	    if (i+1 >= objc && dataPtr->LastSetupTimeZone != NULL) {
		Tcl_SetObjResult(interp, dataPtr->LastSetupTimeZone);
	    }
	break;
	case CLOCK_CURRENT_LOCALE:
	    if (i < objc) {
		if (dataPtr->CurrentLocale != objv[i]) {
		    Tcl_SetObjRef(dataPtr->CurrentLocale, objv[i]);
		    Tcl_UnsetObjRef(dataPtr->CurrentLocaleDict);
		}
	    }
	    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_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 = clientData;
    Tcl_Obj **literals = dataPtr->literals;
    Tcl_Obj *ret, **out = NULL;

    /* if cached (if already setup this one) */
    if ( dataPtr->LastSetupTZData != NULL
      && ( timezoneObj == dataPtr->LastSetupTimeZone
	|| timezoneObj == dataPtr->LastUnnormSetupTimeZone
      )
    ) {
	return 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->GMTSetupTimeZone) {
	if (dataPtr->GMTSetupTZData != NULL) {
	    return dataPtr->GMTSetupTZData;
	}
	out = &dataPtr->GMTSetupTZData;
    }
    else
    if (timezoneObj == dataPtr->AnySetupTimeZone) {
	if (dataPtr->AnySetupTZData != NULL) {
	    return dataPtr->AnySetupTZData;
	}
	out = &dataPtr->AnySetupTZData;
    }

    ret = Tcl_ObjGetVar2(interp, literals[LIT_TZDATA],
	timezoneObj, TCL_LEAVE_ERR_MSG);

    /* cache using corresponding slot and as last used */
    if (out != NULL) {
	Tcl_SetObjRef(*out, ret);
    }
    Tcl_SetObjRef(dataPtr->LastSetupTZData, ret);
    if (dataPtr->LastSetupTimeZone != timezoneObj) {
	Tcl_SetObjRef(dataPtr->LastSetupTimeZone, timezoneObj);
	Tcl_UnsetObjRef(dataPtr->LastUnnormSetupTimeZone);
    }
    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 = clientData;
    Tcl_Obj **literals;

    /* if known (cached and same epoch) - return now */
    if (dataPtr->SystemTimeZone != NULL 
	  && dataPtr->LastTZEpoch == TzsetGetEpoch()) {
	return dataPtr->SystemTimeZone;
    }

    Tcl_UnsetObjRef(dataPtr->SystemTimeZone);
    Tcl_UnsetObjRef(dataPtr->SystemSetupTZData);

    literals = dataPtr->literals;

    if (Tcl_EvalObjv(interp, 1, &literals[LIT_GETSYSTEMTIMEZONE], 0) != TCL_OK) {
	return NULL;
    }
    if (dataPtr->SystemTimeZone == NULL) {
	Tcl_SetObjRef(dataPtr->SystemTimeZone, Tcl_GetObjResult(interp));
    }
    return dataPtr->SystemTimeZone;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockSetupTimeZone --
 *
 *	Sets up the timezone. Loads tzdata, etc.
 *
 * Results:
 *	Returns normalized timezone object.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE Tcl_Obj *
ClockSetupTimeZone(
    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *timezoneObj)
{
    ClockClientData *dataPtr = clientData;
    Tcl_Obj **literals = dataPtr->literals;
    Tcl_Obj *callargs[2];

    /* if cached (if already setup this one) */
    if ( dataPtr->LastSetupTimeZone != NULL
      && ( timezoneObj == dataPtr->LastSetupTimeZone
	|| timezoneObj == dataPtr->LastUnnormSetupTimeZone
      )
    ) {
	return dataPtr->LastSetupTimeZone;
    }

    /* differentiate GMT and system zones, because used often and already set */
    timezoneObj = NormTimezoneObj(dataPtr, timezoneObj);
    if (   timezoneObj == dataPtr->GMTSetupTimeZone
	|| timezoneObj == dataPtr->SystemTimeZone
	|| timezoneObj == dataPtr->AnySetupTimeZone
    ) {
	return timezoneObj;
    }

    callargs[0] = literals[LIT_SETUPTIMEZONE];
    callargs[1] = timezoneObj;

    if (Tcl_EvalObjv(interp, 2, callargs, 0) == TCL_OK) {
	return dataPtr->LastSetupTimeZone;
    }
    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);
}

/*
 *----------------------------------------------------------------------
 *
 * ClockConvertlocaltoutcObjCmd --
 *
 *	Tcl command that converts a UTC time to a local time by whatever means
 *	is available.
 *
 * Usage:
 *	::tcl::clock::ConvertUTCToLocal dictionary timezone changeover
 *
 * Parameters:
 *	dict - Dictionary containing a 'localSeconds' entry.
 *	timezone - Time zone
 *	changeover - Julian Day of the adoption of the Gregorian calendar.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	On success, sets the interpreter result to the given dictionary
 *	augmented with a 'seconds' field giving the UTC time. On failure,
 *	leaves an error message in the interpreter result.
 *
 *----------------------------------------------------------------------
 */

static int
ClockConvertlocaltoutcObjCmd(
    ClientData clientData,	/* Client data */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    ClockClientData *data = clientData;
    Tcl_Obj *const *literals = data->literals;
    Tcl_Obj *secondsObj;
    Tcl_Obj *dict;
    int changeover;
    TclDateFields fields;
    int created = 0;
    int status;

    fields.tzName = NULL;
    /*
     * Check params and convert time.
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict timezone changeover");
	return TCL_ERROR;
    }
    dict = objv[1];
    if (Tcl_DictObjGet(interp, dict, literals[LIT_LOCALSECONDS],
	    &secondsObj)!= TCL_OK) {
	return TCL_ERROR;
    }
    if (secondsObj == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("key \"localseconds\" not "
		"found in dictionary", -1));
	return TCL_ERROR;
    }
    if ((TclGetWideIntFromObj(interp, secondsObj,
	    &fields.localSeconds) != TCL_OK)
	|| (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK)
	|| ConvertLocalToUTC(clientData, interp, &fields, objv[2], changeover)) {
	return TCL_ERROR;
    }

    /*
     * Copy-on-write; set the 'seconds' field in the dictionary and place the
     * modified dictionary in the interpreter result.
     */

    if (Tcl_IsShared(dict)) {
	dict = Tcl_DuplicateObj(dict);
	created = 1;
	Tcl_IncrRefCount(dict);
    }
    status = Tcl_DictObjPut(interp, dict, literals[LIT_SECONDS],
	    Tcl_NewWideIntObj(fields.seconds));
    if (status == TCL_OK) {
	Tcl_SetObjResult(interp, dict);
    }
    if (created) {
	Tcl_DecrRefCount(dict);
    }
    return status;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockGetdatefieldsObjCmd --
 *
 *	Tcl command that determines the values that [clock format] will use in
 *	formatting a date, and populates a dictionary with them.
 *
 * Usage:
 *	::tcl::clock::GetDateFields seconds timezone changeover
 *
 * Parameters:
 *	seconds - Time expressed in seconds from the Posix epoch.
 *	timezone - Time zone in which time is to be expressed.
 *	changeover - Julian Day Number at which the current locale adopted
 *		     the Gregorian calendar
 *
 * Results:
 *	Returns a dictonary populated with the fields:
 *		seconds - Seconds from the Posix epoch
 *		localSeconds - Nominal seconds from the Posix epoch in the
 *			       local time zone.
 *		tzOffset - Time zone offset in seconds east of Greenwich
 *		tzName - Time zone name
 *		julianDay - Julian Day Number in the local time zone
 *
 *----------------------------------------------------------------------
 */

int
ClockGetdatefieldsObjCmd(
    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = clientData;
    Tcl_Obj *const *literals = data->literals;
    int changeover;

    fields.tzName = NULL;

    /*
     * Check params.
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "seconds timezone changeover");
	return TCL_ERROR;
    }
    if (TclGetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK
	    || TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * fields.seconds could be an unsigned number that overflowed. Make sure
     * that it isn't.
     */

    if (objv[1]->typePtr == &tclBignumType) {
	Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]);
	return TCL_ERROR;
    }

    /* Extract fields */

    if (ClockGetDateFields(clientData, interp, &fields, objv[2], 
	  changeover) != TCL_OK) {
	return TCL_ERROR;
    }

    /* Make dict of fields */

    dict = Tcl_NewDictObj();
    Tcl_DictObjPut(NULL, dict, literals[LIT_LOCALSECONDS],
	    Tcl_NewWideIntObj(fields.localSeconds));
    Tcl_DictObjPut(NULL, dict, literals[LIT_SECONDS],
	    Tcl_NewWideIntObj(fields.seconds));
    Tcl_DictObjPut(NULL, dict, literals[LIT_TZNAME], fields.tzName);
    Tcl_DecrRefCount(fields.tzName);
    Tcl_DictObjPut(NULL, dict, literals[LIT_TZOFFSET],
	    Tcl_NewIntObj(fields.tzOffset));
    Tcl_DictObjPut(NULL, dict, literals[LIT_JULIANDAY],
	    Tcl_NewIntObj(fields.julianDay));
    Tcl_DictObjPut(NULL, dict, literals[LIT_GREGORIAN],
	    Tcl_NewIntObj(fields.gregorian));
    Tcl_DictObjPut(NULL, dict, literals[LIT_ERA],
	    literals[fields.era ? LIT_BCE : LIT_CE]);
    Tcl_DictObjPut(NULL, dict, literals[LIT_YEAR],
	    Tcl_NewIntObj(fields.year));
    Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFYEAR],
	    Tcl_NewIntObj(fields.dayOfYear));
    Tcl_DictObjPut(NULL, dict, literals[LIT_MONTH],
	    Tcl_NewIntObj(fields.month));
    Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFMONTH],
	    Tcl_NewIntObj(fields.dayOfMonth));
    Tcl_DictObjPut(NULL, dict, literals[LIT_ISO8601YEAR],
	    Tcl_NewIntObj(fields.iso8601Year));
    Tcl_DictObjPut(NULL, dict, literals[LIT_ISO8601WEEK],
	    Tcl_NewIntObj(fields.iso8601Week));
    Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFWEEK],
	    Tcl_NewIntObj(fields.dayOfWeek));
    Tcl_SetObjResult(interp, dict);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * 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.
     */

    fields->julianDay = (int) ((fields->localSeconds + JULIAN_SEC_POSIX_EPOCH)
	    / SECONDS_PER_DAY);

    /*
     * 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
 *	Day Number.
 *
 * Parameters:
 *	dict - Dictionary that contains 'era', 'year', 'month' and
 *	       'dayOfMonth' keys.
 *	changeover - Julian Day of changeover to the Gregorian calendar
 *
 * Results:
 *	Result is either TCL_OK, with the interpreter result being the
 *	dictionary augmented with a 'julianDay' key, or TCL_ERROR,
 *	with the result being an error message.
 *
 *----------------------------------------------------------------------
 */

static int
FetchEraField(
    Tcl_Interp *interp,
    Tcl_Obj *dict,
    Tcl_Obj *key,
    int *storePtr)
{
    Tcl_Obj *value = NULL;

    if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) {
	return TCL_ERROR;
    }
    if (value == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"expected key(s) not found in dictionary", -1));
	return TCL_ERROR;
    }
    return Tcl_GetIndexFromObj(interp, value, eras, "era", TCL_EXACT, storePtr);
}

static int
FetchIntField(
    Tcl_Interp *interp,
    Tcl_Obj *dict,
    Tcl_Obj *key,
    int *storePtr)
{
    Tcl_Obj *value = NULL;

    if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) {
	return TCL_ERROR;
    }
    if (value == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"expected key(s) not found in dictionary", -1));
	return TCL_ERROR;
    }
    return TclGetIntFromObj(interp, value, storePtr);
}

static int
ClockGetjuliandayfromerayearmonthdayObjCmd(
    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = clientData;
    Tcl_Obj *const *literals = data->literals;
    int changeover;
    int copied = 0;
    int status;
    int era = 0;

    fields.tzName = NULL;

    /*
     * Check params.
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
	return TCL_ERROR;
    }
    dict = objv[1];
    if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_YEAR], &fields.year)
		!= TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_MONTH], &fields.month)
		!= TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_DAYOFMONTH],
		&fields.dayOfMonth) != TCL_OK
	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
	return TCL_ERROR;
    }
    fields.era = era;

    /*
     * Get Julian day.
     */

    GetJulianDayFromEraYearMonthDay(&fields, changeover);

    /*
     * Store Julian day in the dictionary - copy on write.
     */

    if (Tcl_IsShared(dict)) {
	dict = Tcl_DuplicateObj(dict);
	Tcl_IncrRefCount(dict);
	copied = 1;
    }
    status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY],
	    Tcl_NewIntObj(fields.julianDay));
    if (status == TCL_OK) {
	Tcl_SetObjResult(interp, dict);
    }
    if (copied) {
	Tcl_DecrRefCount(dict);
    }
    return status;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockGetjuliandayfromerayearweekdayObjCmd --
 *
 *	Tcl command that converts a time from the ISO calendar to a Julian Day
 *	Number.
 *
 * Parameters:
 *	dict - Dictionary that contains 'era', 'iso8601Year', 'iso8601Week'
 *	       and 'dayOfWeek' keys.
 *	changeover - Julian Day of changeover to the Gregorian calendar
 *
 * Results:
 *	Result is either TCL_OK, with the interpreter result being the
 *	dictionary augmented with a 'julianDay' key, or TCL_ERROR, with the
 *	result being an error message.
 *
 *----------------------------------------------------------------------
 */

static int
ClockGetjuliandayfromerayearweekdayObjCmd(
    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = clientData;
    Tcl_Obj *const *literals = data->literals;
    int changeover;
    int copied = 0;
    int status;
    int era = 0;

    fields.tzName = NULL;

    /*
     * Check params.
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
	return TCL_ERROR;
    }
    dict = objv[1];
    if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_ISO8601YEAR],
		&fields.iso8601Year) != TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_ISO8601WEEK],
		&fields.iso8601Week) != TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_DAYOFWEEK],
		&fields.dayOfWeek) != TCL_OK
	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
	return TCL_ERROR;
    }
    fields.era = era;

    /*
     * Get Julian day.
     */

    GetJulianDayFromEraYearWeekDay(&fields, changeover);

    /*
     * Store Julian day in the dictionary - copy on write.
     */

    if (Tcl_IsShared(dict)) {
	dict = Tcl_DuplicateObj(dict);
	Tcl_IncrRefCount(dict);
	copied = 1;
    }
    status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY],
	    Tcl_NewIntObj(fields.julianDay));
    if (status == TCL_OK) {
	Tcl_SetObjResult(interp, dict);
    }
    if (copied) {
	Tcl_DecrRefCount(dict);
    }
    return status;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertLocalToUTC --
 *
 *	Converts a time (in a TclDateFields structure) from the local wall
 *	clock to UTC.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Populates the 'seconds' field if successful; stores an error message
 *	in the interpreter result on failure.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertLocalToUTC(
    ClientData clientData,	/* Client data of the interpreter */
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the time */
    Tcl_Obj *timezoneObj,	/* Time zone */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    ClockClientData *dataPtr = clientData;
    Tcl_Obj *tzdata;		/* Time zone data */
    int rowc;			/* Number of rows in tzdata */
    Tcl_Obj **rowv;		/* Pointers to the rows */
    Tcl_WideInt seconds;

    /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */
    if (timezoneObj == dataPtr->GMTSetupTimeZone && dataPtr->GMTSetupTimeZone != NULL) {
	fields->seconds = fields->localSeconds;
	fields->tzOffset = 0;
	return TCL_OK;
    }

    /*
     * Check cacheable conversion could be used
     * (last-period Local2UTC cache within the same TZ)
     */
    seconds = fields->localSeconds - dataPtr->Local2UTC.tzOffset;
    if ( timezoneObj == dataPtr->Local2UTC.timezoneObj
      && ( fields->localSeconds == dataPtr->Local2UTC.localSeconds
	|| ( seconds >= dataPtr->Local2UTC.rangesVal[0]
	  && seconds <	dataPtr->Local2UTC.rangesVal[1])
      )
      && changeover == dataPtr->Local2UTC.changeover
    ) {
	/* the same time zone and offset (UTC time inside the last minute) */
	fields->tzOffset = dataPtr->Local2UTC.tzOffset;
	fields->seconds = seconds;
	return TCL_OK;
    }

    /*
     * Check cacheable back-conversion could be used
     * (last-period UTC2Local cache within the same TZ)
     */
    seconds = fields->localSeconds - dataPtr->UTC2Local.tzOffset;
    if ( timezoneObj == dataPtr->UTC2Local.timezoneObj
      && ( seconds == dataPtr->UTC2Local.seconds
	|| ( seconds >= dataPtr->UTC2Local.rangesVal[0]
	  && seconds <	dataPtr->UTC2Local.rangesVal[1])
      )
      && changeover == dataPtr->UTC2Local.changeover
    ) {
	/* the same time zone and offset (UTC time inside the last minute) */
	fields->tzOffset = dataPtr->UTC2Local.tzOffset;
	fields->seconds = seconds;
	return TCL_OK;
    }

    /*
     * Unpack the tz data.
     */

    tzdata = ClockGetTZData(clientData, interp, timezoneObj);
    if (tzdata == NULL) {
	return TCL_ERROR;
    }

    if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Special case: If the time zone is :localtime, the tzdata will be empty.
     * Use 'mktime' to convert the time to local
     */

    if (rowc == 0) {
	dataPtr->Local2UTC.rangesVal[0] = 0;
	dataPtr->Local2UTC.rangesVal[1] = 0;

	if (ConvertLocalToUTCUsingC(interp, fields, changeover) != TCL_OK) {
	    return TCL_ERROR;
	};
    } else {
	if (ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv, 
		dataPtr->Local2UTC.rangesVal) != TCL_OK) {
	    return TCL_ERROR;
	};
    }

    /* Cache the last conversion */
    Tcl_SetObjRef(dataPtr->Local2UTC.timezoneObj, timezoneObj);
    dataPtr->Local2UTC.localSeconds = fields->localSeconds;
    dataPtr->Local2UTC.changeover = changeover;
    dataPtr->Local2UTC.tzOffset = fields->tzOffset;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertLocalToUTCUsingTable --
 *
 *	Converts a time (in a TclDateFields structure) from local time in a
 *	given time zone to UTC.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Stores an error message in the interpreter if an error occurs; if
 *	successful, stores the 'seconds' field in 'fields.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertLocalToUTCUsingTable(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Time to convert, with 'seconds' filled in */
    int rowc,			/* Number of points at which time changes */
    Tcl_Obj *const rowv[],	/* Points at which time changes */
    Tcl_WideInt rangesVal[2])	/* Return bounds for time period */
{
    Tcl_Obj *row;
    int cellc;
    Tcl_Obj **cellv;
    int have[8];
    int nHave = 0;
    int i;
    int found;

    /*
     * Perform an initial lookup assuming that local == UTC, and locate the
     * last time conversion prior to that time. Get the offset from that row,
     * and look up again. Continue until we find an offset that we found
     * before. This definition, rather than "the same offset" ensures that we
     * don't enter an endless loop, as would otherwise happen when trying to
     * convert a non-existent time such as 02:30 during the US Spring Daylight
     * Saving Time transition.
     */

    found = 0;
    fields->tzOffset = 0;
    fields->seconds = fields->localSeconds;
    while (!found) {
	row = LookupLastTransition(interp, fields->seconds, rowc, rowv,
		    rangesVal);
	if ((row == NULL)
		|| TclListObjGetElements(interp, row, &cellc,
		    &cellv) != TCL_OK
		|| TclGetIntFromObj(interp, cellv[1],
		    &fields->tzOffset) != TCL_OK) {
	    return TCL_ERROR;
	}
	found = 0;
	for (i = 0; !found && i < nHave; ++i) {
	    if (have[i] == fields->tzOffset) {
		found = 1;
		break;
	    }
	}
	if (!found) {
	    if (nHave == 8) {
		Tcl_Panic("loop in ConvertLocalToUTCUsingTable");
	    }
	    have[nHave++] = fields->tzOffset;
	}
	fields->seconds = fields->localSeconds - fields->tzOffset;
    }
    fields->tzOffset = have[i];
    fields->seconds = fields->localSeconds - fields->tzOffset;

#if 0
    /* currently unused, test purposes only */
    /*
     * Convert back from UTC, if local times are different - wrong local time
     * (local time seems to be in between DST-hole).
     */
    if (fields->tzOffset) {

	int corrOffset;
	Tcl_WideInt backCompVal;
	/* check DST-hole interval contains UTC time */
	TclGetWideIntFromObj(NULL, cellv[0], &backCompVal);
	if ( fields->seconds >= backCompVal - fields->tzOffset 
	  && fields->seconds <= backCompVal + fields->tzOffset
	) {
	    row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
	    if (row == NULL ||
		    TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK ||
		    TclGetIntFromObj(interp, cellv[1], &corrOffset) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (fields->localSeconds != fields->seconds + corrOffset) {
		Tcl_Panic("wrong local time %ld by LocalToUTC conversion,"
		    " local time seems to be in between DST-hole", 
		    fields->localSeconds);
		/* correcting offset * /
		fields->tzOffset -= corrOffset;
		fields->seconds += fields->tzOffset;
		*/
	    }
	}
    }
#endif

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertLocalToUTCUsingC --
 *
 *	Converts a time from local wall clock to UTC when the local time zone
 *	cannot be determined. Uses 'mktime' to do the job.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Stores an error message in the interpreter if an error occurs; if
 *	successful, stores the 'seconds' field in 'fields.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertLocalToUTCUsingC(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Time to convert, with 'seconds' filled in */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    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--;
    }
    GetGregorianEraYearDay(fields, changeover);
    GetMonthDay(fields);

    /*
     * Convert the date/time to a 'struct tm'.
     */

    timeVal.tm_year = fields->year - 1900;
    timeVal.tm_mon = fields->month - 1;
    timeVal.tm_mday = fields->dayOfMonth;
    timeVal.tm_hour = (secondOfDay / 3600) % 24;
    timeVal.tm_min = (secondOfDay / 60) % 60;
    timeVal.tm_sec = secondOfDay % 60;
    timeVal.tm_isdst = -1;
    timeVal.tm_wday = -1;
    timeVal.tm_yday = -1;

    /*
     * Get local time. It is rumored that mktime is not thread safe on some
     * platforms, so seize a mutex before attempting this.
     */

    TzsetIfNecessary();
    Tcl_MutexLock(&clockMutex);
    errno = 0;
    fields->seconds = (Tcl_WideInt) mktime(&timeVal);
    localErrno = errno;
    Tcl_MutexUnlock(&clockMutex);

    /*
     * If conversion fails, report an error.
     */

    if (localErrno != 0
	    || (fields->seconds == -1 && timeVal.tm_yday == -1)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"time value too large/small to represent", -1));
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertUTCToLocal --
 *
 *	Converts a time (in a TclDateFields structure) from UTC to local time.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Populates the 'tzName' and 'tzOffset' fields.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE int
ConvertUTCToLocal(
    ClientData clientData,	/* Client data of the interpreter */
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the time */
    Tcl_Obj *timezoneObj,	/* Time zone */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    ClockClientData *dataPtr = clientData;
    Tcl_Obj *tzdata;		/* Time zone data */
    int rowc;			/* Number of rows in tzdata */
    Tcl_Obj **rowv;		/* Pointers to the rows */

    /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */
    if (timezoneObj == dataPtr->GMTSetupTimeZone 
	&& dataPtr->GMTSetupTimeZone != NULL 
	&& dataPtr->GMTSetupTZData != NULL
    ) {
	fields->localSeconds = fields->seconds;
	fields->tzOffset = 0;
	if ( TclListObjGetElements(interp, dataPtr->GMTSetupTZData, &rowc, &rowv) != TCL_OK
	  || Tcl_ListObjIndex(interp, rowv[0], 3, &fields->tzName) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_IncrRefCount(fields->tzName);
	return TCL_OK;
    }

    /*
     * Check cacheable conversion could be used
     * (last-period UTC2Local cache within the same TZ)
     */
    if ( timezoneObj == dataPtr->UTC2Local.timezoneObj
      && ( fields->seconds == dataPtr->UTC2Local.seconds
	|| ( fields->seconds >= dataPtr->UTC2Local.rangesVal[0]
	  && fields->seconds <	dataPtr->UTC2Local.rangesVal[1])
      )
      && changeover == dataPtr->UTC2Local.changeover
    ) {
	/* the same time zone and offset (UTC time inside the last minute) */
	Tcl_SetObjRef(fields->tzName, dataPtr->UTC2Local.tzName);
	fields->tzOffset = dataPtr->UTC2Local.tzOffset;
	fields->localSeconds = fields->seconds + fields->tzOffset;
	return TCL_OK;
    }

    /*
     * Unpack the tz data.
     */

    tzdata = ClockGetTZData(clientData, interp, timezoneObj);
    if (tzdata == NULL) {
	return TCL_ERROR;
    }

    if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Special case: If the time zone is :localtime, the tzdata will be empty.
     * Use 'localtime' to convert the time to local
     */

    if (rowc == 0) {
	dataPtr->UTC2Local.rangesVal[0] = 0;
	dataPtr->UTC2Local.rangesVal[1] = 0;

	if (ConvertUTCToLocalUsingC(interp, fields, changeover) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	if (ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv, 
		dataPtr->UTC2Local.rangesVal) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    /* Cache the last conversion */
    Tcl_SetObjRef(dataPtr->UTC2Local.timezoneObj, timezoneObj);
    dataPtr->UTC2Local.seconds = fields->seconds;
    dataPtr->UTC2Local.changeover = changeover;
    dataPtr->UTC2Local.tzOffset = fields->tzOffset;
    Tcl_SetObjRef(dataPtr->UTC2Local.tzName, fields->tzName);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertUTCToLocalUsingTable --
 *
 *	Converts UTC to local time, given a table of transition points
 *
 * Results:
 *	Returns a standard Tcl result
 *
 * Side effects:
 *	On success, fills fields->tzName, fields->tzOffset and
 *	fields->localSeconds. On failure, places an error message in the
 *	interpreter result.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertUTCToLocalUsingTable(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the date */
    int rowc,			/* Number of rows in the conversion table
				 * (>= 1) */
    Tcl_Obj *const rowv[],	/* Rows of the conversion table */
    Tcl_WideInt rangesVal[2])	/* Return bounds for time period */
{
    Tcl_Obj *row;		/* Row containing the current information */
    int cellc;			/* Count of cells in the row (must be 4) */
    Tcl_Obj **cellv;		/* Pointers to the cells */

    /*
     * Look up the nearest transition time.
     */

    row = LookupLastTransition(interp, fields->seconds, rowc, rowv, rangesVal);
    if (row == NULL ||
	    TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK ||
	    TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Convert the time.
     */

    Tcl_SetObjRef(fields->tzName, cellv[3]);
    fields->localSeconds = fields->seconds + fields->tzOffset;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertUTCToLocalUsingC --
 *
 *	Converts UTC to localtime in cases where the local time zone is not
 *	determinable, using the C 'localtime' function to do it.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	On success, fills fields->tzName, fields->tzOffset and
 *	fields->localSeconds. On failure, places an error message in the
 *	interpreter result.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertUTCToLocalUsingC(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Time to convert, with 'seconds' filled in */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    time_t tock;
    struct tm *timeVal;		/* Time after conversion */
    int diff;			/* Time zone diff local-Greenwich */
    char buffer[8];		/* Buffer for time zone name */

    /*
     * Use 'localtime' to determine local year, month, day, time of day.
     */

    tock = (time_t) fields->seconds;
    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", NULL);
	return TCL_ERROR;
    }
    TzsetIfNecessary();
    timeVal = ThreadSafeLocalTime(&tock);
    if (timeVal == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"localtime failed (clock value may be too "
		"large/small to represent)", -1));
	Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL);
	return TCL_ERROR;
    }

    /*
     * Fill in the date in 'fields' and use it to derive Julian Day.
     */

    fields->era = CE;
    fields->year = timeVal->tm_year + 1900;
    fields->month = timeVal->tm_mon + 1;
    fields->dayOfMonth = timeVal->tm_mday;
    GetJulianDayFromEraYearMonthDay(fields, changeover);

    /*
     * Convert that value to seconds.
     */

    fields->localSeconds = (((fields->julianDay * (Tcl_WideInt) 24
	    + timeVal->tm_hour) * 60 + timeVal->tm_min) * 60
	    + timeVal->tm_sec) - JULIAN_SEC_POSIX_EPOCH;

    /*
     * Determine a time zone offset and name; just use +hhmm for the name.
     */

    diff = (int) (fields->localSeconds - fields->seconds);
    fields->tzOffset = diff;
    if (diff < 0) {
	*buffer = '-';
	diff = -diff;
    } else {
	*buffer = '+';
    }
    sprintf(buffer+1, "%02d", diff / 3600);
    diff %= 3600;
    sprintf(buffer+3, "%02d", diff / 60);
    diff %= 60;
    if (diff > 0) {
	sprintf(buffer+5, "%02d", diff);
    }
    Tcl_SetObjRef(fields->tzName, Tcl_NewStringObj(buffer, -1));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * LookupLastTransition --
 *
 *	Given a UTC time and a tzdata array, looks up the last transition on
 *	or before the given time.
 *
 * Results:
 *	Returns a pointer to the row, or NULL if an error occurs.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE Tcl_Obj *
LookupLastTransition(
    Tcl_Interp *interp,		/* Interpreter for error messages */
    Tcl_WideInt tick,		/* Time from the epoch */
    int rowc,			/* Number of rows of tzdata */
    Tcl_Obj *const *rowv,	/* Rows in tzdata */
    Tcl_WideInt rangesVal[2])	/* Return bounds for time period */
{
    int l = 0;
    int u;
    Tcl_Obj *compObj;
    Tcl_WideInt compVal, fromVal = tick, toVal = tick;

    /*
     * Examine the first row to make sure we're in bounds.
     */

    if (Tcl_ListObjIndex(interp, rowv[0], 0, &compObj) != TCL_OK
	    || TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
	return NULL;
    }

    /*
     * Bizarre case - first row doesn't begin at MIN_WIDE_INT. Return it
     * anyway.
     */

    if (tick < compVal) {
	goto done;
    }

    /*
     * Binary-search to find the transition.
     */

    u = rowc-1;
    while (l < u) {
	int m = (l + u + 1) / 2;

	if (Tcl_ListObjIndex(interp, rowv[m], 0, &compObj) != TCL_OK ||
		TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
	    return NULL;
	}
	if (tick >= compVal) {
	    l = m;
	    fromVal = compVal;
	} else {
	    u = m-1;
	    toVal = compVal;
	}
    }

done:

    if (rangesVal) {
	rangesVal[0] = fromVal;
	rangesVal[1] = toVal;
    }
    return rowv[l];
}

/*
 *----------------------------------------------------------------------
 *
 * GetYearWeekDay --
 *
 *	Given a date with Julian Calendar Day, compute the year, week, and day
 *	in the ISO8601 calendar.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores 'iso8601Year', 'iso8601Week' and 'dayOfWeek' in the date
 *	fields.
 *
 *----------------------------------------------------------------------
 */

static void
GetYearWeekDay(
    TclDateFields *fields,	/* Date to convert, must have 'julianDay' */
    int changeover)		/* Julian Day Number of the Gregorian
				 * transition */
{
    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.
     */

    temp.julianDay = fields->julianDay - 3;
    GetGregorianEraYearDay(&temp, changeover);
    if (temp.era == BCE) {
	temp.iso8601Year = temp.year - 1;
    } else {
	temp.iso8601Year = temp.year + 1;
    }
    temp.iso8601Week = 1;
    temp.dayOfWeek = 1;
    GetJulianDayFromEraYearWeekDay(&temp, changeover);

    /*
     * temp.julianDay is now the start of an ISO8601 year, either the one
     * corresponding to the given date, or the one after. If we guessed high,
     * move one year earlier
     */

    if (fields->julianDay < temp.julianDay) {
	if (temp.era == BCE) {
	    temp.iso8601Year += 1;
	} else {
	    temp.iso8601Year -= 1;
	}
	GetJulianDayFromEraYearWeekDay(&temp, changeover);
    }

    fields->iso8601Year = temp.iso8601Year;
    dayOfFiscalYear = fields->julianDay - temp.julianDay;
    fields->iso8601Week = (dayOfFiscalYear / 7) + 1;
    fields->dayOfWeek = (dayOfFiscalYear + 1) % 7;
    if (fields->dayOfWeek < 1) {
	fields->dayOfWeek += 7;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * GetGregorianEraYearDay --
 *
 *	Given a Julian Day Number, extracts the year and day of the year and
 *	puts them into TclDateFields, along with the era (BCE or CE) and a
 *	flag indicating whether the date is Gregorian or Julian.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores 'era', 'gregorian', 'year', and 'dayOfYear'.
 *
 *----------------------------------------------------------------------
 */

static void
GetGregorianEraYearDay(
    TclDateFields *fields,	/* Date fields containing 'julianDay' */
    int changeover)		/* Gregorian transition date */
{
    int jday = fields->julianDay;
    int day;
    int year;
    int n;

    if (jday >= changeover) {
	/*
	 * Gregorian calendar.
	 */

	fields->gregorian = 1;
	year = 1;

	/*
	 * n = Number of 400-year cycles since 1 January, 1 CE in the
	 * proleptic Gregorian calendar. day = remaining days.
	 */

	day = jday - JDAY_1_JAN_1_CE_GREGORIAN;
	n = day / FOUR_CENTURIES;
	day %= FOUR_CENTURIES;
	if (day < 0) {
	    day += FOUR_CENTURIES;
	    n--;
	}
	year += 400 * n;

	/*
	 * n = number of centuries since the start of (year);
	 * day = remaining days
	 */

	n = day / ONE_CENTURY_GREGORIAN;
	day %= ONE_CENTURY_GREGORIAN;
	if (n > 3) {
	    /*
	     * 31 December in the last year of a 400-year cycle.
	     */

	    n = 3;
	    day += ONE_CENTURY_GREGORIAN;
	}
	year += 100 * n;
    } else {
	/*
	 * Julian calendar.
	 */

	fields->gregorian = 0;
	year = 1;
	day = jday - JDAY_1_JAN_1_CE_JULIAN;
    }

    /*
     * n = number of 4-year cycles; days = remaining days.
     */

    n = day / FOUR_YEARS;
    day %= FOUR_YEARS;
    if (day < 0) {
	day += FOUR_YEARS;
	n--;
    }
    year += 4 * n;

    /*
     * n = number of years; days = remaining days.
     */

    n = day / ONE_YEAR;
    day %= ONE_YEAR;
    if (n > 3) {
	/*
	 * 31 December of a leap year.
	 */

	n = 3;
	day += 365;
    }
    year += n;

    /*
     * store era/year/day back into fields.
     */

    if (year <= 0) {
	fields->era = BCE;
	fields->year = 1 - year;
    } else {
	fields->era = CE;
	fields->year = year;
    }
    fields->dayOfYear = day + 1;
}

/*
 *----------------------------------------------------------------------
 *
 * GetMonthDay --
 *
 *	Given a date as year and day-of-year, find month and day.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores 'month' and 'dayOfMonth' in the 'fields' structure.
 *
 *----------------------------------------------------------------------
 */

static void
GetMonthDay(
    TclDateFields *fields)	/* Date to convert */
{
    int day = fields->dayOfYear;
    int month;
    const int *h = hath[IsGregorianLeapYear(fields)];

    for (month = 0; month < 12 && day > h[month]; ++month) {
	day -= h[month];
    }
    fields->month = month+1;
    fields->dayOfMonth = day;
}

/*
 *----------------------------------------------------------------------
 *
 * GetJulianDayFromEraYearWeekDay --
 *
 *	Given a TclDateFields structure containing era, ISO8601 year, ISO8601
 *	week, and day of week, computes the Julian Day Number.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores 'julianDay' in the fields.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE 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
				 * given year */
    TclDateFields firstWeek;

    firstWeek.tzName = NULL;

    /*
     * Find January 4 in the ISO8601 year, which will always be in week 1.
     */

    firstWeek.era = fields->era;
    firstWeek.year = fields->iso8601Year;
    firstWeek.month = 1;
    firstWeek.dayOfMonth = 4;
    GetJulianDayFromEraYearMonthDay(&firstWeek, changeover);

    /*
     * Find Monday of week 1.
     */

    firstMonday = WeekdayOnOrBefore(1, firstWeek.julianDay);

    /*
     * Advance to the given week and day.
     */

    fields->julianDay = firstMonday + 7 * (fields->iso8601Week - 1)
	    + fields->dayOfWeek - 1;
}

/*
 *----------------------------------------------------------------------
 *
 * GetJulianDayFromEraYearMonthDay --
 *
 *	Given era, year, month, and dayOfMonth (in TclDateFields), and the
 *	Gregorian transition date, computes the Julian Day Number.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores day number in 'julianDay'
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE 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;

    if (fields->era == BCE) {
	year = 1 - fields->year;
    } else {
	year = fields->year;
    }

    /*
     * Reduce month modulo 12.
     */

    month = fields->month;
    mm1 = month - 1;
    q = mm1 / 12;
    r = (mm1 % 12);
    if (r < 0) {
	r += 12;
	q -= 1;
    }
    year += q;
    month = r + 1;
    ym1 = year - 1;

    /*
     * Adjust the year after reducing the month.
     */

    fields->gregorian = 1;
    if (year < 1) {
	fields->era = BCE;
	fields->year = 1-year;
    } else {
	fields->era = CE;
	fields->year = year;
    }

    /*
     * Try an initial conversion in the Gregorian calendar.
     */

#if 0 /* BUG http://core.tcl.tk/tcl/tktview?name=da340d4f32 */
    ym1o4 = ym1 / 4;
#else
    /*
     * Have to make sure quotient is truncated towards 0 when negative.
     * See above bug for details. The casts are necessary.
     */
    if (ym1 >= 0)
	ym1o4 = ym1 / 4;
    else {
	ym1o4 = - (int) (((unsigned int) -ym1) / 4);
    }
#endif
    if (ym1 % 4 < 0) {
	ym1o4--;
    }
    ym1o100 = ym1 / 100;
    if (ym1 % 100 < 0) {
	ym1o100--;
    }
    ym1o400 = ym1 / 400;
    if (ym1 % 400 < 0) {
	ym1o400--;
    }
    fields->julianDay = JDAY_1_JAN_1_CE_GREGORIAN - 1
	    + fields->dayOfMonth
	    + daysInPriorMonths[IsGregorianLeapYear(fields)][month - 1]
	    + (ONE_YEAR * ym1)
	    + ym1o4
	    - ym1o100
	    + ym1o400;

    /*
     * If the resulting date is before the Gregorian changeover, convert in
     * the Julian calendar instead.
     */

    if (fields->julianDay < changeover) {
	fields->gregorian = 0;
	fields->julianDay = JDAY_1_JAN_1_CE_JULIAN - 1
		+ fields->dayOfMonth
		+ daysInPriorMonths[year%4 == 0][month - 1]
		+ (365 * ym1)
		+ ym1o4;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * 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'
 *
 *----------------------------------------------------------------------
 */


MODULE_SCOPE void
GetJulianDayFromEraYearDay(
    TclDateFields *fields,	/* Date to convert */
    int changeover)		/* Gregorian transition date as a Julian Day */
{
    int 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
 *	Gregorian calendar.
 *
 * Results:
 *	Returns 1 for a leap year, 0 otherwise.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE int
IsGregorianLeapYear(
    TclDateFields *fields)	/* Date to test */
{
    int year = fields->year;

    if (fields->era == BCE) {
	year = 1 - year;
    }
    if (year%4 != 0) {
	return 0;
    } else if (!(fields->gregorian)) {
	return 1;
    } else if (year%400 == 0) {
	return 1;
    } else if (year%100 == 0) {
	return 0;
    } else {
	return 1;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * WeekdayOnOrBefore --
 *
 *	Finds the Julian Day Number of a given day of the week that falls on
 *	or before a given date, expressed as Julian Day Number.
 *
 * Results:
 *	Returns the Julian Day Number
 *
 *----------------------------------------------------------------------
 */

static int
WeekdayOnOrBefore(
    int dayOfWeek,		/* Day of week; Sunday == 0 or 7 */
    int julianDay)		/* Reference date */
{
    int k = (dayOfWeek + 6) % 7;
    if (k < 0) {
	k += 7;
    }
    return julianDay - ((julianDay - k) % 7);
}

/*
 *----------------------------------------------------------------------
 *
 * ClockGetenvObjCmd --
 *
 *	Tcl command that reads an environment variable from the system
 *
 * Usage:
 *	::tcl::clock::getEnv NAME
 *
 * Parameters:
 *	NAME - Name of the environment variable desired
 *
 * Results:
 *	Returns a standard Tcl result. Returns an error if the variable does
 *	not exist, with a message left in the interpreter. Returns TCL_OK and
 *	the value of the variable if the variable does exist,
 *
 *----------------------------------------------------------------------
 */

int
ClockGetenvObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    const char *varName;
    const char *varValue;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    varName = TclGetString(objv[1]);
    varValue = getenv(varName);
    if (varValue == NULL) {
	varValue = "";
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ThreadSafeLocalTime --
 *
 *	Wrapper around the 'localtime' library function to make it thread
 *	safe.
 *
 * Results:
 *	Returns a pointer to a 'struct tm' in thread-specific data.
 *
 * Side effects:
 *	Invokes localtime or localtime_r as appropriate.
 *
 *----------------------------------------------------------------------
 */

static struct tm *
ThreadSafeLocalTime(
    const time_t *timePtr)	/* Pointer to the number of seconds since the
				 * local system's epoch */
{
    /*
     * Get a thread-local buffer to hold the returned time.
     */

    struct tm *tmPtr = Tcl_GetThreadData(&tmKey, sizeof(struct tm));
#ifdef HAVE_LOCALTIME_R
    localtime_r(timePtr, tmPtr);
#else
    struct tm *sysTmPtr;

    Tcl_MutexLock(&clockMutex);
    sysTmPtr = localtime(timePtr);
    if (sysTmPtr == NULL) {
	Tcl_MutexUnlock(&clockMutex);
	return NULL;
    }
    memcpy(tmPtr, localtime(timePtr), sizeof(struct tm));
    Tcl_MutexUnlock(&clockMutex);
#endif
    return tmPtr;
}

/*----------------------------------------------------------------------
 *
 * ClockClicksObjCmd --
 *
 *	Returns a high-resolution counter.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 * This function implements the 'clock clicks' Tcl command. Refer to the user
 * documentation for details on what it does.
 *
 *----------------------------------------------------------------------
 */

int
ClockClicksObjCmd(
    ClientData clientData,	/* Client data is unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{
    static const char *const clicksSwitches[] = {
	"-milliseconds", "-microseconds", NULL
    };
    enum ClicksSwitch {
	CLICKS_MILLIS, CLICKS_MICROS, CLICKS_NATIVE
    };
    int index = CLICKS_NATIVE;
    Tcl_Time now;
    Tcl_WideInt clicks = 0;

    switch (objc) {
    case 1:
	break;
    case 2:
	if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	break;
    default:
	Tcl_WrongNumArgs(interp, 0, NULL, "clock clicks ?-switch?");
	return TCL_ERROR;
    }

    switch (index) {
    case CLICKS_MILLIS:
	Tcl_GetTime(&now);
	clicks = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000;
	break;
    case CLICKS_NATIVE:
#ifdef TCL_WIDE_CLICKS
	clicks = TclpGetWideClicks();
#else
	clicks = (Tcl_WideInt) TclpGetClicks();
#endif
	break;
    case CLICKS_MICROS:
	clicks = TclpGetMicroseconds();
	break;
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(clicks));
    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * ClockMillisecondsObjCmd -
 *
 *	Returns a count of milliseconds since the epoch.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 * This function implements the 'clock milliseconds' Tcl command. Refer to the
 * user documentation for details on what it does.
 *
 *----------------------------------------------------------------------
 */

int
ClockMillisecondsObjCmd(
    ClientData clientData,	/* Client data is unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{
    Tcl_Time now;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 0, NULL, "clock milliseconds");
	return TCL_ERROR;
    }
    Tcl_GetTime(&now);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
	    now.sec * 1000 + now.usec / 1000));
    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * ClockMicrosecondsObjCmd -
 *
 *	Returns a count of microseconds since the epoch.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 * This function implements the 'clock microseconds' Tcl command. Refer to the
 * user documentation for details on what it does.
 *
 *----------------------------------------------------------------------
 */

int
ClockMicrosecondsObjCmd(
    ClientData clientData,	/* Client data is unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 0, NULL, "clock microseconds");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds()));
    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;
}

/*
 *-----------------------------------------------------------------------------
 *
 * ClockParseFmtScnArgs --
 *
 *	Parses the arguments for [clock scan] and [clock format].
 *
 * 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
ClockParseFmtScnArgs(
    register
    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 */
    int		flags		/* Flags, differentiates between format, scan, add */
) {
    Tcl_Interp	    *interp =  opts->interp;
    ClockClientData *dataPtr = opts->clientData;
    int gmtFlag = 0;
    static const char *const options[] = {
	"-format",	"-gmt",		"-locale",
	"-timezone",	"-base",	NULL
    };
    enum optionInd {
	CLC_ARGS_FORMAT,    CLC_ARGS_GMT,	CLC_ARGS_LOCALE,
	CLC_ARGS_TIMEZONE,  CLC_ARGS_BASE
    };
    int optionIndex;		/* Index of an option. */
    int saw = 0;		/* Flag == 1 if option was seen already. */
    int i;
    Tcl_WideInt baseVal;	/* Base time, expressed in seconds from the Epoch */

    /* clock value (as current base) */
    if ( !(flags & (CLC_SCN_ARGS)) ) {
	opts->baseObj = objv[1];
	saw |= (1 << CLC_ARGS_BASE);
    }

    /*
     * Extract values for the keywords.
     */

    for (i = 2; i < objc; i+=2) {
	/* 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 badOption;
	}
	/* if already specified */
	if (saw & (1 << optionIndex)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad option \"%s\": doubly present", 
		TclGetString(objv[i]))
	    );
	    goto badOption;
	}
	switch (optionIndex) {
	case CLC_ARGS_FORMAT:
	    if (flags & CLC_ADD_ARGS) {
		goto badOptionMsg;
	    }
	    opts->formatObj = objv[i+1];
	    break;
	case CLC_ARGS_GMT:
	    if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){
		return TCL_ERROR;
	    }
	    break;
	case CLC_ARGS_LOCALE:
	    opts->localeObj = objv[i+1];
	    break;
	case CLC_ARGS_TIMEZONE:
	    opts->timezoneObj = objv[i+1];
	    break;
	case CLC_ARGS_BASE:
	    if ( !(flags & (CLC_SCN_ARGS)) ) {
		goto badOptionMsg;
	    }
	    opts->baseObj = objv[i+1];
	    break;
	}
	saw |= (1 << optionIndex);
    }

    /*
     * Check options.
     */

    if ((saw & (1 << CLC_ARGS_GMT))
	    && (saw & (1 << CLC_ARGS_TIMEZONE))) {
	Tcl_SetResult(interp, "cannot use -gmt and -timezone in same call", TCL_STATIC);
	Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL);
	return TCL_ERROR;
    }
    if (gmtFlag) {
	opts->timezoneObj = dataPtr->literals[LIT_GMT];
    }

    /* 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;
    }

    /* Base (by scan or add) or clock value (by format) */

    if (opts->baseObj != NULL) {
	register 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.
	 */

	if (baseObj->typePtr == &tclBignumType) {
	    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\": unexpected for command \"%s\"",
	TclGetString(objv[i]), TclGetString(objv[0]))
    );

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 = clientData;

    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, 0, NULL, "clock format clockval|-now "
	    "?-format string? "
	    "?-gmt boolean? "
	    "?-locale LOCALE? ?-timezone ZONE?");
	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);
    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 */
{
    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, 0, NULL, "clock scan string "
	    "?-base seconds? "
	    "?-format string? "
	    "?-gmt boolean? "
	    "?-locale LOCALE? ?-timezone ZONE?");
	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);
    if (ret != TCL_OK) {
	goto done;
    }

    /* seconds are in localSeconds (relative base date), so reset time here */
    yyHour = 0; yyMinutes = 0; yySeconds = 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_SetResult(interp,
		"legacy [clock scan] does not support -locale", TCL_STATIC);
	    Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL);
	    return TCL_ERROR;
	}
	ret = ClockFreeScan(&yy, objv[1], &opts);
    } 
    else {
	/* Use compiled version of Scan - */

	ret = ClockScan(&yy, objv[1], &opts);
    }

    /* Convert date info structure into UTC seconds */

    if (ret == TCL_OK) {
	ret = ClockScanCommit(clientData, &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;
}

/*----------------------------------------------------------------------
 *
 * ClockScanCommit --
 *
 *	Converts date info structure into UTC seconds.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ClockScanCommit(
    ClientData clientData,	/* Client data containing literal pool */
    register DateInfo  *info,	/* Clock scan info structure */
    register
    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_ISO8601)) {
	    GetJulianDayFromEraYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE);
	}
	else
	if (!(info->flags & CLF_DAYOFYEAR)) {
	    GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE);
	} else {
	    GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);
	}
    }

    /* some overflow checks, if not extended */
    if (!(opts->flags & CLF_EXTENDED)) {
	if (yydate.julianDay > 5373484) {
	    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|CLF_ASSEMBLE_JULIANDAY)) {
	yydate.localSeconds =
	    -210866803200L
	    + ( SECONDS_PER_DAY * (Tcl_WideInt)yydate.julianDay )
	    + ( yySeconds % SECONDS_PER_DAY );
    }

    if (info->flags & (CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY|CLF_LOCALSEC)) {
	if (ConvertLocalToUTC(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;
}

/*----------------------------------------------------------------------
 *
 * ClockFreeScan --
 *
 *	Used by ClockScanObjCmd for free scanning without format.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
ClockFreeScan(
    register
    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 = 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. yySeconds -> info->date.secondOfDay or 
     *			yySeconds -> 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;
    }

    /*
     * 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.
     */

    if (yyHaveDate) {
	if (yyYear < 100) {
	    if (yyYear >= dataPtr->yearOfCenturySwitch) {
		yyYear -= 100;
	    }
	    yyYear += dataPtr->currentYearCentury;
	}
	yydate.era = CE;
	if (yyHaveTime == 0) {
	    yyHaveTime = -1;
	}
	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 (yyHaveZone) {
	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;
    }
    
    /* 
     * Assemble date, time, zone into seconds-from-epoch
     */

    if (yyHaveTime == -1) {
	yySeconds = 0;
	info->flags |= CLF_ASSEMBLE_SECONDS;
    }
    else
    if (yyHaveTime) {
	yySeconds = ToSeconds(yyHour, yyMinutes,
			    yySeconds, yyMeridian);
	info->flags |= CLF_ASSEMBLE_SECONDS;
    } 
    else 
    if ( (yyHaveDay && !yyHaveDate)
	    || yyHaveOrdinalMonth
	    || ( yyHaveRel
		&& ( yyRelMonth != 0
		     || yyRelDay != 0 ) )
    ) {
	yySeconds = 0;
	info->flags |= CLF_ASSEMBLE_SECONDS;
    } 
    else {
	yySeconds = yydate.localSeconds % SECONDS_PER_DAY;
    }

    /*
     * Do relative times
     */

    ret = ClockCalcRelTime(info, opts);

    /* 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(
    register
    DateInfo	       *info,	/* Date fields used for converting */
    ClockFmtScnCmdArgs *opts)	/* Command options */
{
    /*
     * Because some calculations require in-between conversion of the
     * julian day, we can repeat this processing multiple times 
     */
repeat_rel:

    if (yyHaveRel) {

	/* 
	 * 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;
	    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 = yySeconds + yyRelSeconds;
	       
	    /* if seconds increment outside of current date, increment day */
	    if (newSecs / SECONDS_PER_DAY != yySeconds / SECONDS_PER_DAY) {
		
		yyRelDay += newSecs / SECONDS_PER_DAY;
		yySeconds = 0;		    
		yyRelSeconds = newSecs % SECONDS_PER_DAY;

		goto repeat_rel;
	    }
	}

	yyHaveRel = 0;
    }

    /*
     * Do relative (ordinal) month
     */

    if (yyHaveOrdinalMonth) {
	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 */
	yyHaveRel++;
	yyYear += yyMonthOrdinalIncr;
	yyRelMonth += monthDiff;
	yyHaveOrdinalMonth = 0;

	info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS;

	goto repeat_rel;
    }

    /*
     * Do relative weekday
     */

    if (yyHaveDay && !yyHaveDate) {

	/* 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(yyDayNumber, 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(
    register int dayOfWeek,
    register int offs)
{
    register 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;

    /* resulting day of week */
    {
	register 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 */
{
    ClockClientData *dataPtr = 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, 0, NULL, "clock add clockval|-now ?number units?..."
	    "?-gmt boolean? "
	    "?-locale LOCALE? ?-timezone ZONE?");
	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);
    if (ret != TCL_OK) {
	goto done;
    }

    /* time together as seconds of the day */
    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 ( yyHaveRel
	  && ( 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, &opts) != TCL_OK) {
		goto done;
	    }
	}

	/* process increment by offset + unit */
	yyHaveRel++;
	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 (yyHaveRel) {
	if (ClockCalcRelTime(info, &opts) != TCL_OK) {
	    goto done;
	}
    }

    /* Convert date info structure into UTC seconds */

    ret = ClockScanCommit(clientData, &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;
}

/*----------------------------------------------------------------------
 *
 * ClockSecondsObjCmd -
 *
 *	Returns a count of microseconds since the epoch.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 * This function implements the 'clock seconds' Tcl command. Refer to the user
 * documentation for details on what it does.
 *
 *----------------------------------------------------------------------
 */

int
ClockSecondsObjCmd(
    ClientData clientData,	/* Client data is unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{
    Tcl_Time now;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 0, NULL, "clock seconds");
	return TCL_ERROR;
    }
    Tcl_GetTime(&now);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TzsetGetEpoch --, TzsetIfNecessary --
 *
 *	Calls the tzset() library function if the contents of the TZ
 *	environment variable has changed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Calls tzset.
 *
 *----------------------------------------------------------------------
 */

static unsigned long
TzsetGetEpoch(void)
{
    static char* tzWas = INT2PTR(-1);	 /* Previous value of TZ, protected by
					  * clockMutex. */
    static long	 tzLastRefresh = 0;	 /* Used for latency before next refresh */
    static unsigned long tzWasEpoch = 0; /* Epoch, signals that TZ changed */
    static unsigned long tzEnvEpoch = 0; /* Last env epoch, for faster signaling, 
					    that TZ changed via TCL */
    
    const char *tzIsNow;		 /* Current value of TZ */
    
    /* 
     * 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 chaned with tcl-env (compare both epoch values)
     */
    Tcl_Time now;
    Tcl_GetTime(&now);
    if (now.sec == tzLastRefresh && tzEnvEpoch == TclEnvEpoch) {
	return tzWasEpoch;
    }
    tzEnvEpoch = TclEnvEpoch;
    tzLastRefresh = now.sec;

    /* check in lock */
    Tcl_MutexLock(&clockMutex);
    tzIsNow = getenv("TCL_TZ");
    if (tzIsNow == NULL) {
	tzIsNow = getenv("TZ");
    }
    if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
	    || strcmp(tzIsNow, tzWas) != 0)) {
	tzset();
	if (tzWas != NULL && tzWas != INT2PTR(-1)) {
	    ckfree(tzWas);
	}
	tzWas = ckalloc(strlen(tzIsNow) + 1);
	strcpy(tzWas, tzIsNow);
	tzWasEpoch++;
    } else if (tzIsNow == NULL && tzWas != NULL) {
	tzset();
	if (tzWas != INT2PTR(-1)) ckfree(tzWas);
	tzWas = NULL;
	tzWasEpoch++;
    }
    Tcl_MutexUnlock(&clockMutex);

    return tzWasEpoch;
}

static void
TzsetIfNecessary(void)
{
    TzsetGetEpoch();
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */