diff options
Diffstat (limited to 'generic/tclClock.c')
| -rw-r--r-- | generic/tclClock.c | 823 |
1 files changed, 531 insertions, 292 deletions
diff --git a/generic/tclClock.c b/generic/tclClock.c index 67570df..91f204b 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -7,17 +7,34 @@ * * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans. * Copyright (c) 1995 Sun Microsystems, Inc. + * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclClock.c,v 1.28 2004/05/14 21:43:28 kennykb Exp $ + * RCS: @(#) $Id: tclClock.c,v 1.29 2004/08/18 19:58:59 kennykb Exp $ */ #include "tclInt.h" /* - * The date parsing stuff uses lexx and has tons o statics. + * Windows has mktime. The configurators do not check. + */ + +#ifdef WIN32 +#define HAVE_MKTIME +#endif + +/* + * 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) @@ -26,358 +43,580 @@ TCL_DECLARE_MUTEX(clockMutex) * Function prototypes for local procedures in this file: */ -static int FormatClock _ANSI_ARGS_((Tcl_Interp *interp, - unsigned long clockVal, int useGMT, - char *format)); +static struct tm* ThreadSafeLocalTime _ANSI_ARGS_(( CONST time_t* )); +static void TzsetIfNecessary _ANSI_ARGS_(( void )); /* *------------------------------------------------------------------------- * - * Tcl_ClockObjCmd -- + * TclClockLocaltimeObjCmd -- + * + * Tcl command that extracts local time using the C library to do + * it. * - * This procedure is invoked to process the "clock" Tcl command. - * See the user documentation for details on what it does. + * Usage: + * ::tcl::clock::Localtime <tick> + * + * Parameters: + * <tick> -- A count of seconds from the Posix epoch. * * Results: - * A standard Tcl result. + * Returns a standard Tcl result. The object result is a Tcl + * list containing the year, month, day, hour, minute, and second + * fields of the local time. It may return an error if the + * argument exceeds the arithmetic range representable by + * 'time_t'. * * Side effects: - * See the user documentation. + * None. + * + * This function is used as a call of last resort if the current time + * zone cannot be determined from environment variables TZ or TCL_TZ. + * It attempts to use the 'localtime' library function to extract the + * time and return it that way. This method suffers from Y2038 problems + * on most platforms. It also provides no portable way to get the + * name of the time zone. * *------------------------------------------------------------------------- */ int -Tcl_ClockObjCmd (client, interp, objc, objv) - ClientData client; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument values. */ +TclClockLocaltimeObjCmd( ClientData clientData, + /* Unused */ + Tcl_Interp* interp, + /* Tcl interpreter */ + int objc, + /* Parameter count */ + Tcl_Obj* CONST* objv ) + /* Parameter vector */ { - Tcl_Obj *resultPtr; - int index; - Tcl_Obj *CONST *objPtr; - int useGMT = 0; - char *format = "%a %b %d %X %Z %Y"; - int clickType = 2; - int dummy; - unsigned long baseClock, clockVal; - long zone; - Tcl_Obj *baseObjPtr = NULL; - char *scanStr; - Tcl_Time now; /* Current time */ + Tcl_WideInt tick; /* Time to convert */ + time_t tock; + struct tm* timeVal; /* Time after conversion */ - static CONST char *switches[] = { - "clicks", "format", "scan", "seconds", (char *) NULL - }; - enum command { - COMMAND_CLICKS, COMMAND_FORMAT, COMMAND_SCAN, COMMAND_SECONDS - }; - static CONST char *clicksSwitches[] = { - "-milliseconds", "-microseconds", (char*) NULL - }; - static CONST char *formatSwitches[] = { - "-format", "-gmt", (char *) NULL - }; - static CONST char *scanSwitches[] = { - "-base", "-gmt", (char *) NULL - }; + Tcl_Obj* returnVec[ 6 ]; + + /* Check args */ - resultPtr = Tcl_GetObjResult(interp); - if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); + if ( objc != 2 ) { + Tcl_WrongNumArgs( interp, 1, objv, "seconds" ); return TCL_ERROR; } - - if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index) - != TCL_OK) { + if ( Tcl_GetWideIntFromObj( interp, objv[1], &tick ) != TCL_OK ) { return TCL_ERROR; } - switch ((enum command) index) { - case COMMAND_CLICKS: { /* clicks */ - if (objc == 3) { - if (Tcl_GetIndexFromObj(interp, objv[2], clicksSwitches, - "option", 0, &clickType) != TCL_OK) { - return TCL_ERROR; - } - } else if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, "?option?"); - return TCL_ERROR; - } - switch (clickType) { - case 0: /* milliseconds */ - Tcl_GetTime(&now); - Tcl_SetWideIntObj(resultPtr, - ((Tcl_WideInt) now.sec * 1000 + now.usec / 1000)); - break; - case 1: /* microseconds */ - Tcl_GetTime(&now); - Tcl_SetWideIntObj(resultPtr, - ((Tcl_WideInt) now.sec * 1000000 + now.usec)); - break; - case 2: /* native clicks */ - Tcl_SetWideIntObj(resultPtr, (Tcl_WideInt) TclpGetClicks()); - break; - } - return TCL_OK; - } + /* Convert the time, checking for overflow */ - case COMMAND_FORMAT: /* format */ - if ((objc < 3) || (objc > 7)) { - wrongFmtArgs: - Tcl_WrongNumArgs(interp, 2, objv, - "clockval ?-format string? ?-gmt boolean?"); - return TCL_ERROR; - } + tock = (time_t) tick; + if ( (Tcl_WideInt) tock != tick ) { + Tcl_SetObjResult + ( interp, + Tcl_NewStringObj("number too large to represent as a Posix time", + -1) ); + Tcl_SetErrorCode( interp, "CLOCK", "argTooLarge", (char*) NULL ); + return TCL_ERROR; + } + TzsetIfNecessary(); + timeVal = ThreadSafeLocalTime( &tock ); + + /* Package the results */ + + returnVec[0] = Tcl_NewIntObj( timeVal->tm_year + 1900 ); + returnVec[1] = Tcl_NewIntObj( timeVal->tm_mon + 1); + returnVec[2] = Tcl_NewIntObj( timeVal->tm_mday ); + returnVec[3] = Tcl_NewIntObj( timeVal->tm_hour ); + returnVec[4] = Tcl_NewIntObj( timeVal->tm_min ); + returnVec[5] = Tcl_NewIntObj( timeVal->tm_sec ); + Tcl_SetObjResult( interp, Tcl_NewListObj( 6, returnVec ) ); + return TCL_OK; - if (Tcl_GetLongFromObj(interp, objv[2], (long*) &clockVal) - != TCL_OK) { - return TCL_ERROR; - } +} + +/* + *---------------------------------------------------------------------- + * + * 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. + * + *---------------------------------------------------------------------- + */ - objPtr = objv+3; - objc -= 3; - while (objc > 1) { - if (Tcl_GetIndexFromObj(interp, objPtr[0], formatSwitches, - "switch", 0, &index) != TCL_OK) { - return TCL_ERROR; - } - switch (index) { - case 0: /* -format */ - format = Tcl_GetStringFromObj(objPtr[1], &dummy); - break; - case 1: /* -gmt */ - if (Tcl_GetBooleanFromObj(interp, objPtr[1], - &useGMT) != TCL_OK) { - return TCL_ERROR; - } - break; - } - objPtr += 2; - objc -= 2; - } - if (objc != 0) { - goto wrongFmtArgs; - } - return FormatClock(interp, (unsigned long) clockVal, useGMT, - format); - - case COMMAND_SCAN: /* scan */ - if ((objc < 3) || (objc > 7)) { - wrongScanArgs: - Tcl_WrongNumArgs(interp, 2, objv, - "dateString ?-base clockValue? ?-gmt boolean?"); - return TCL_ERROR; - } +static struct tm * +ThreadSafeLocalTime(timePtr) + CONST time_t *timePtr; /* Pointer to the number of seconds + * since the local system's epoch + */ - objPtr = objv+3; - objc -= 3; - while (objc > 1) { - if (Tcl_GetIndexFromObj(interp, objPtr[0], scanSwitches, - "switch", 0, &index) != TCL_OK) { - return TCL_ERROR; - } - switch (index) { - case 0: /* -base */ - baseObjPtr = objPtr[1]; - break; - case 1: /* -gmt */ - if (Tcl_GetBooleanFromObj(interp, objPtr[1], - &useGMT) != TCL_OK) { - return TCL_ERROR; - } - break; - } - objPtr += 2; - objc -= 2; - } - if (objc != 0) { - goto wrongScanArgs; - } +{ + /* + * Get a thread-local buffer to hold the returned time. + */ - if (baseObjPtr != NULL) { - if (Tcl_GetLongFromObj(interp, baseObjPtr, - (long*) &baseClock) != TCL_OK) { - return TCL_ERROR; - } - } else { - baseClock = TclpGetSeconds(); - } + struct tm *tmPtr = (struct tm *) + Tcl_GetThreadData(&tmKey, (int) sizeof(struct tm)); +#ifdef HAVE_LOCALTIME_R + localtime_r(timePtr, tmPtr); +#else + Tcl_MutexLock(&clockMutex); + memcpy((VOID *) tmPtr, (VOID *) localtime(timePtr), sizeof(struct tm)); + Tcl_MutexUnlock(&clockMutex); +#endif + return tmPtr; +} + +/* + *---------------------------------------------------------------------- + * + * TclClockMktimeObjCmd -- + * + * Determine seconds from the epoch, given the fields of a local + * time. + * + * Usage: + * mktime <year> <month> <day> <hour> <minute> <second> + * + * Parameters: + * year -- Calendar year + * month -- Calendar month + * day -- Calendar day + * hour -- Hour of day (00-23) + * minute -- Minute of hour + * second -- Second of minute + * + * Results: + * Returns the given local time. + * + * Errors: + * Returns an error if the 'mktime' function does not exist in the + * C library, or if the given time cannot be converted. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ - if (useGMT) { - zone = -50000; /* Force GMT */ - } else { - zone = TclpGetTimeZone((unsigned long) baseClock); - } +int +TclClockMktimeObjCmd( ClientData clientData, + /* Unused */ + Tcl_Interp* interp, + /* Tcl interpreter */ + int objc, + /* Parameter count */ + Tcl_Obj* CONST* objv ) + /* Parameter vector */ +{ + int i; + struct tm toConvert; /* Time to be converted */ + time_t convertedTime; /* Time converted from mktime */ - scanStr = Tcl_GetStringFromObj(objv[2], &dummy); - Tcl_MutexLock(&clockMutex); - if (TclGetDate(scanStr, (unsigned long) baseClock, zone, - (unsigned long *) &clockVal) < 0) { - Tcl_MutexUnlock(&clockMutex); - Tcl_AppendStringsToObj(resultPtr, - "unable to convert date-time string \"", - scanStr, "\"", (char *) NULL); - return TCL_ERROR; - } - Tcl_MutexUnlock(&clockMutex); +#ifndef HAVE_MKTIME + Tcl_SetObjResult( interp, + Tcl_NewStringObj( "cannot determine local time", -1 ) ); + return TCL_ERROR; +#else - Tcl_SetLongObj(resultPtr, (long) clockVal); - return TCL_OK; + /* Convert parameters */ - case COMMAND_SECONDS: /* seconds */ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return TCL_ERROR; - } - Tcl_SetLongObj(resultPtr, (long) TclpGetSeconds()); - return TCL_OK; - default: - return TCL_ERROR; /* Should never be reached. */ + if ( objc != 7 ) { + Tcl_WrongNumArgs( interp, 1, objv, + "year month day hour minute second" ); + return TCL_ERROR; + } + if ( Tcl_GetIntFromObj( interp, objv[1], &i ) != TCL_OK ) { + return TCL_ERROR; + } + toConvert.tm_year = i - 1900; + if ( Tcl_GetIntFromObj( interp, objv[2], &i ) != TCL_OK ) { + return TCL_ERROR; } + toConvert.tm_mon = i; + if ( Tcl_GetIntFromObj( interp, objv[3], &i ) != TCL_OK ) { + return TCL_ERROR; + } + toConvert.tm_mday = i; + if ( Tcl_GetIntFromObj( interp, objv[4], &i ) != TCL_OK ) { + return TCL_ERROR; + } + toConvert.tm_hour = i; + if ( Tcl_GetIntFromObj( interp, objv[5], &i ) != TCL_OK ) { + return TCL_ERROR; + } + toConvert.tm_min = i; + if ( Tcl_GetIntFromObj( interp, objv[6], &i ) != TCL_OK ) { + return TCL_ERROR; + } + toConvert.tm_sec = i; + toConvert.tm_isdst = -1; + toConvert.tm_wday = 0; + toConvert.tm_yday = 0; + + /* Convert the time. It is rumored that mktime is not thread + * safe on some platforms. */ + + TzsetIfNecessary(); + Tcl_MutexLock( &clockMutex ); + convertedTime = mktime( &toConvert ); + Tcl_MutexUnlock( &clockMutex ); + + /* Return the converted time, or an error if conversion fails */ + + if ( convertedTime == -1 ) { + Tcl_SetObjResult + ( interp, + Tcl_NewStringObj( "time value too large/small to represent", + -1 ) ); + return TCL_ERROR; + } else { + Tcl_SetObjResult( interp, + Tcl_NewWideIntObj( (Tcl_WideInt) convertedTime ) ); + return TCL_OK; + } + +#endif + } -/* - *----------------------------------------------------------------------------- + +/*---------------------------------------------------------------------- * - * FormatClock -- + * TclClockClicksObjCmd -- * - * Formats a time value based on seconds into a human readable - * string. + * Returns a high-resolution counter. * * Results: - * Standard Tcl result. + * Returns a standard Tcl result. * * Side effects: - * None. + * None. + * + * This function implements the 'clock clicks' Tcl command. Refer + * to the user documentation for details on what it does. * - *----------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ -static int -FormatClock(interp, clockVal, useGMT, format) - Tcl_Interp *interp; /* Current interpreter. */ - unsigned long clockVal; /* Time in seconds. */ - int useGMT; /* Boolean */ - char *format; /* Format string */ +int +TclClockClicksObjCmd( clientData, interp, objc, objv ) + ClientData clientData; /* Client data is unused */ + Tcl_Interp* interp; /* Tcl interpreter */ + int objc; /* Parameter count */ + Tcl_Obj* CONST* objv; /* Parameter values */ { - struct tm *timeDataPtr; - Tcl_DString buffer; - int bufSize; - char *p; - int result; - time_t tclockVal; -#if !defined(HAVE_TM_ZONE) && !defined(WIN32) - int savedTimeZone = 0; /* lint. */ - char *savedTZEnv = NULL; /* lint. */ + static CONST char *clicksSwitches[] = { + "-milliseconds", "-microseconds", (char*) NULL + }; + enum ClicksSwitch { + CLICKS_MILLIS, CLICKS_MICROS, CLICKS_NATIVE + }; + int index = CLICKS_NATIVE; + Tcl_Time now; + + 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, 1, objv, "?option?" ); + return TCL_ERROR; + } + + switch ( index ) { + case CLICKS_MILLIS: + Tcl_GetTime( &now ); + Tcl_SetObjResult( interp, + Tcl_NewWideIntObj( (Tcl_WideInt) now.sec * 1000 + + now.usec / 1000 ) ); + break; + case CLICKS_NATIVE: +#if 0 + /* + * The following code will be used once this is incorporated + * into Tcl. But TEA bugs prevent it for right now. :( + * So we fall through this case and return the microseconds + * instead. + */ + Tcl_SetObjResult( interp, + Tcl_NewWideIntObj( (Tcl_WideInt) TclpGetClicks() ) ); + break; #endif + case CLICKS_MICROS: + Tcl_GetTime( &now ); + Tcl_SetObjResult( interp, + Tcl_NewWideIntObj( ( (Tcl_WideInt) now.sec + * 1000000 ) + + now.usec ) ); + break; + } -#ifdef HAVE_TZSET - /* - * Some systems forgot to call tzset in localtime, make sure its done. - */ - static int calledTzset = 0; + return TCL_OK; +} + +/*---------------------------------------------------------------------- + * + * TclClockMillisecondsObjCmd - + * + * 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. + * + *---------------------------------------------------------------------- + */ - Tcl_MutexLock(&clockMutex); - if (!calledTzset) { - tzset(); - calledTzset = 1; +int +TclClockMillisecondsObjCmd( clientData, interp, objc, objv ) + 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, 1, objv, "" ); + return TCL_ERROR; } - Tcl_MutexUnlock(&clockMutex); -#endif + Tcl_GetTime( &now ); + Tcl_SetObjResult( interp, + Tcl_NewWideIntObj( (Tcl_WideInt) now.sec * 1000 + + now.usec / 1000 ) ); + return TCL_OK; +} + +/*---------------------------------------------------------------------- + * + * TclClockMicrosecondsObjCmd - + * + * 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. + * + *---------------------------------------------------------------------- + */ - /* - * If the user gave us -format "", just return now - */ - if (*format == '\0') { - return TCL_OK; +int +TclClockMicrosecondsObjCmd( clientData, interp, objc, objv ) + 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, 1, objv, "" ); + return TCL_ERROR; } + Tcl_GetTime( &now ); + Tcl_SetObjResult( interp, + Tcl_NewWideIntObj( ( (Tcl_WideInt) now.sec * 1000000 ) + + now.usec ) ); + return TCL_OK; +} + +/*---------------------------------------------------------------------- + * + * TclClockSecondsObjCmd - + * + * 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. + * + *---------------------------------------------------------------------- + */ -#if !defined(HAVE_TM_ZONE) && !defined(WIN32) - /* - * This is a kludge for systems not having the timezone string in - * struct tm. No matter what was specified, they use the local - * timezone string. Since this kludge requires fiddling with the - * TZ environment variable, it will mess up if done on multiple - * threads at once. Protect it with a the clock mutex. - */ - - Tcl_MutexLock(&clockMutex); - if (useGMT) { - CONST char *varValue; +int +TclClockSecondsObjCmd( clientData, interp, objc, objv ) + 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, 1, objv, "" ); + return TCL_ERROR; + } + Tcl_GetTime( &now ); + Tcl_SetObjResult( interp, Tcl_NewWideIntObj( (Tcl_WideInt) now.sec ) ); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TzsetIfNecessary -- + * + * Calls the tzset() library function if the contents of the TZ + * environment variable has changed. + * + * Results: + * None. + * + * Side effects: + * Calls tzset. + * + *---------------------------------------------------------------------- + */ - varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY); - if (varValue != NULL) { - savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue); - } else { - savedTZEnv = NULL; +static void +TzsetIfNecessary() +{ + static char* tzWas = NULL; /* Previous value of TZ, protected by + * clockMutex. */ + CONST char* tzIsNow; /* Current value of TZ */ + + Tcl_MutexLock( &clockMutex ); + tzIsNow = getenv( "TZ" ); + if ( tzIsNow != NULL + && ( tzWas == NULL || strcmp( tzIsNow, tzWas ) != 0 ) ) { + tzset(); + if ( tzWas != NULL ) { + ckfree( tzWas ); } - Tcl_SetVar2(interp, "env", "TZ", "GMT0", TCL_GLOBAL_ONLY); - savedTimeZone = timezone; - timezone = 0; - tzset(); + tzWas = ckalloc( strlen( tzIsNow ) + 1 ); + strcpy( tzWas, tzIsNow ); + } else if ( tzIsNow == NULL && tzWas != NULL ) { + tzset(); + ckfree( tzWas ); + tzWas = NULL; } -#endif + Tcl_MutexUnlock( &clockMutex ); +} + +/* + *------------------------------------------------------------------------- + * + * TclClockOldscanObjCmd -- + * + * Implements the legacy 'clock scan' Tcl command when no '-format' + * option is supplied. + * + * Results: + * Returns a standard Tcl result. + * + * This function implements the 'clock scan' Tcl command when no + * -format group is present. Refer to the user documentation to see + * what it does. + * + *------------------------------------------------------------------------- + */ - tclockVal = clockVal; - timeDataPtr = TclpGetDate(&tclockVal, useGMT); +int +TclClockOldscanObjCmd( ClientData clientData, /* unused */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *CONST * objv /* Parameter vector */ + ) +{ + int index; + Tcl_Obj *CONST *objPtr; + char *scanStr; + Tcl_Obj *baseObjPtr = NULL; + int useGMT = 0; + unsigned long baseClock; + long clockVal; + long zone; + Tcl_Obj *resultPtr; + int dummy; - /* - * Make a guess at the upper limit on the substituted string size - * based on the number of percents in the string. - */ + static CONST char *scanSwitches[] = { + "-base", "-gmt", (char *) NULL + }; - for (bufSize = 1, p = format; *p != '\0'; p++) { - if (*p == '%') { - bufSize += 40; - } else { - bufSize++; + if ((objc < 2) || (objc > 6)) { + wrongScanArgs: + Tcl_WrongNumArgs(interp, 2, objv, + "dateString ?-base clockValue? ?-gmt boolean?"); + return TCL_ERROR; + } + objPtr = objv+2; + objc -= 2; + while (objc > 1) { + if (Tcl_GetIndexFromObj(interp, objPtr[0], scanSwitches, + "switch", 0, &index) != TCL_OK) { + return TCL_ERROR; } + switch (index) { + case 0: /* -base */ + baseObjPtr = objPtr[1]; + break; + case 1: /* -gmt */ + if (Tcl_GetBooleanFromObj(interp, objPtr[1], + &useGMT) != TCL_OK) { + return TCL_ERROR; + } + break; + } + objPtr += 2; + objc -= 2; } - - Tcl_DStringInit(&buffer); - Tcl_DStringSetLength(&buffer, bufSize); - - /* If we haven't locked the clock mutex up above, lock it now. */ - -#if defined(HAVE_TM_ZONE) || defined(WIN32) - Tcl_MutexLock(&clockMutex); -#endif - result = TclpStrftime(buffer.string, (unsigned int) bufSize, format, - timeDataPtr, useGMT); -#if defined(HAVE_TM_ZONE) || defined(WIN32) - Tcl_MutexUnlock(&clockMutex); -#endif - -#if !defined(HAVE_TM_ZONE) && !defined(WIN32) + if (objc != 0) { + goto wrongScanArgs; + } + + if (baseObjPtr != NULL) { + if (Tcl_GetLongFromObj(interp, baseObjPtr, + (long*) &baseClock) != TCL_OK) { + return TCL_ERROR; + } + } else { + baseClock = TclpGetSeconds(); + } + if (useGMT) { - if (savedTZEnv != NULL) { - Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY); - ckfree(savedTZEnv); - } else { - Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY); - } - timezone = savedTimeZone; - tzset(); + zone = -50000; /* Force GMT */ + } else { + zone = TclpGetTimeZone((unsigned long) baseClock); } - Tcl_MutexUnlock(&clockMutex); -#endif - - if (result == 0) { - /* - * A zero return is the error case (can also mean the strftime - * didn't get enough space to write into). We know it doesn't - * mean that we wrote zero chars because the check for an empty - * format string is above. - */ - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "bad format string \"", format, "\"", (char *) NULL); + + scanStr = Tcl_GetStringFromObj(objv[1], &dummy); + Tcl_MutexLock(&clockMutex); + if (TclGetDate(scanStr, (unsigned long) baseClock, zone, + &clockVal) < 0) { + Tcl_MutexUnlock(&clockMutex); + resultPtr = Tcl_NewObj(); + Tcl_AppendStringsToObj(resultPtr, + "unable to convert date-time string \"", + scanStr, "\"", (char *) NULL); + Tcl_SetObjResult( interp, resultPtr ); return TCL_ERROR; } - - Tcl_SetStringObj(Tcl_GetObjResult(interp), buffer.string, -1); - - Tcl_DStringFree(&buffer); + Tcl_MutexUnlock(&clockMutex); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt) clockVal ) ); return TCL_OK; + } |