os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclClock.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclClock.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,390 @@
1.4 +/*
1.5 + * tclClock.c --
1.6 + *
1.7 + * Contains the time and date related commands. This code
1.8 + * is derived from the time and date facilities of TclX,
1.9 + * by Mark Diekhans and Karl Lehenbauer.
1.10 + *
1.11 + * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
1.12 + * Copyright (c) 1995 Sun Microsystems, Inc.
1.13 + *
1.14 + * See the file "license.terms" for information on usage and redistribution
1.15 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 + *
1.17 + * RCS: @(#) $Id: tclClock.c,v 1.20.2.3 2007/04/21 22:42:49 kennykb Exp $
1.18 + */
1.19 +
1.20 +#include "tcl.h"
1.21 +#include "tclInt.h"
1.22 +#include "tclPort.h"
1.23 +
1.24 +/*
1.25 + * The date parsing stuff uses lexx and has tons o statics.
1.26 + */
1.27 +
1.28 +TCL_DECLARE_MUTEX(clockMutex)
1.29 +
1.30 +/*
1.31 + * Function prototypes for local procedures in this file:
1.32 + */
1.33 +
1.34 +static int FormatClock _ANSI_ARGS_((Tcl_Interp *interp,
1.35 + Tcl_WideInt clockVal, int useGMT,
1.36 + char *format));
1.37 +
1.38 +/*
1.39 + *-------------------------------------------------------------------------
1.40 + *
1.41 + * Tcl_ClockObjCmd --
1.42 + *
1.43 + * This procedure is invoked to process the "clock" Tcl command.
1.44 + * See the user documentation for details on what it does.
1.45 + *
1.46 + * Results:
1.47 + * A standard Tcl result.
1.48 + *
1.49 + * Side effects:
1.50 + * See the user documentation.
1.51 + *
1.52 + *-------------------------------------------------------------------------
1.53 + */
1.54 +
1.55 +int
1.56 +Tcl_ClockObjCmd (client, interp, objc, objv)
1.57 + ClientData client; /* Not used. */
1.58 + Tcl_Interp *interp; /* Current interpreter. */
1.59 + int objc; /* Number of arguments. */
1.60 + Tcl_Obj *CONST objv[]; /* Argument values. */
1.61 +{
1.62 + Tcl_Obj *resultPtr;
1.63 + int index;
1.64 + Tcl_Obj *CONST *objPtr;
1.65 + int useGMT = 0;
1.66 + char *format = "%a %b %d %X %Z %Y";
1.67 + int dummy;
1.68 + Tcl_WideInt baseClock, clockVal;
1.69 + long zone;
1.70 + Tcl_Obj *baseObjPtr = NULL;
1.71 + char *scanStr;
1.72 + int n;
1.73 +
1.74 + static CONST char *switches[] =
1.75 + {"clicks", "format", "scan", "seconds", (char *) NULL};
1.76 + enum command { COMMAND_CLICKS, COMMAND_FORMAT, COMMAND_SCAN,
1.77 + COMMAND_SECONDS
1.78 + };
1.79 + static CONST char *formatSwitches[] = {"-format", "-gmt", (char *) NULL};
1.80 + static CONST char *scanSwitches[] = {"-base", "-gmt", (char *) NULL};
1.81 +
1.82 + resultPtr = Tcl_GetObjResult(interp);
1.83 + if (objc < 2) {
1.84 + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
1.85 + return TCL_ERROR;
1.86 + }
1.87 +
1.88 + if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)
1.89 + != TCL_OK) {
1.90 + return TCL_ERROR;
1.91 + }
1.92 + switch ((enum command) index) {
1.93 + case COMMAND_CLICKS: { /* clicks */
1.94 + int forceMilli = 0;
1.95 +
1.96 + if (objc == 3) {
1.97 + format = Tcl_GetStringFromObj(objv[2], &n);
1.98 + if ( ( n >= 2 )
1.99 + && ( strncmp( format, "-milliseconds",
1.100 + (unsigned int) n) == 0 ) ) {
1.101 + forceMilli = 1;
1.102 + } else {
1.103 + Tcl_AppendStringsToObj(resultPtr,
1.104 + "bad switch \"", format,
1.105 + "\": must be -milliseconds", (char *) NULL);
1.106 + return TCL_ERROR;
1.107 + }
1.108 + } else if (objc != 2) {
1.109 + Tcl_WrongNumArgs(interp, 2, objv, "?-milliseconds?");
1.110 + return TCL_ERROR;
1.111 + }
1.112 + if (forceMilli) {
1.113 + /*
1.114 + * We can enforce at least millisecond granularity
1.115 + */
1.116 + Tcl_Time time;
1.117 + Tcl_GetTime(&time);
1.118 + Tcl_SetLongObj(resultPtr,
1.119 + (long) (time.sec*1000 + time.usec/1000));
1.120 + } else {
1.121 + Tcl_SetLongObj(resultPtr, (long) TclpGetClicks());
1.122 + }
1.123 + return TCL_OK;
1.124 + }
1.125 +
1.126 + case COMMAND_FORMAT: /* format */
1.127 + if ((objc < 3) || (objc > 7)) {
1.128 + wrongFmtArgs:
1.129 + Tcl_WrongNumArgs(interp, 2, objv,
1.130 + "clockval ?-format string? ?-gmt boolean?");
1.131 + return TCL_ERROR;
1.132 + }
1.133 +
1.134 + if (Tcl_GetWideIntFromObj(interp, objv[2], &clockVal)
1.135 + != TCL_OK) {
1.136 + return TCL_ERROR;
1.137 + }
1.138 +
1.139 + objPtr = objv+3;
1.140 + objc -= 3;
1.141 + while (objc > 1) {
1.142 + if (Tcl_GetIndexFromObj(interp, objPtr[0], formatSwitches,
1.143 + "switch", 0, &index) != TCL_OK) {
1.144 + return TCL_ERROR;
1.145 + }
1.146 + switch (index) {
1.147 + case 0: /* -format */
1.148 + format = Tcl_GetStringFromObj(objPtr[1], &dummy);
1.149 + break;
1.150 + case 1: /* -gmt */
1.151 + if (Tcl_GetBooleanFromObj(interp, objPtr[1],
1.152 + &useGMT) != TCL_OK) {
1.153 + return TCL_ERROR;
1.154 + }
1.155 + break;
1.156 + }
1.157 + objPtr += 2;
1.158 + objc -= 2;
1.159 + }
1.160 + if (objc != 0) {
1.161 + goto wrongFmtArgs;
1.162 + }
1.163 + return FormatClock(interp, clockVal, useGMT,
1.164 + format);
1.165 +
1.166 + case COMMAND_SCAN: /* scan */
1.167 + if ((objc < 3) || (objc > 7)) {
1.168 + wrongScanArgs:
1.169 + Tcl_WrongNumArgs(interp, 2, objv,
1.170 + "dateString ?-base clockValue? ?-gmt boolean?");
1.171 + return TCL_ERROR;
1.172 + }
1.173 +
1.174 + objPtr = objv+3;
1.175 + objc -= 3;
1.176 + while (objc > 1) {
1.177 + if (Tcl_GetIndexFromObj(interp, objPtr[0], scanSwitches,
1.178 + "switch", 0, &index) != TCL_OK) {
1.179 + return TCL_ERROR;
1.180 + }
1.181 + switch (index) {
1.182 + case 0: /* -base */
1.183 + baseObjPtr = objPtr[1];
1.184 + break;
1.185 + case 1: /* -gmt */
1.186 + if (Tcl_GetBooleanFromObj(interp, objPtr[1],
1.187 + &useGMT) != TCL_OK) {
1.188 + return TCL_ERROR;
1.189 + }
1.190 + break;
1.191 + }
1.192 + objPtr += 2;
1.193 + objc -= 2;
1.194 + }
1.195 + if (objc != 0) {
1.196 + goto wrongScanArgs;
1.197 + }
1.198 +
1.199 + if (baseObjPtr != NULL) {
1.200 + if (Tcl_GetWideIntFromObj(interp, baseObjPtr,
1.201 + &baseClock) != TCL_OK) {
1.202 + return TCL_ERROR;
1.203 + }
1.204 + } else {
1.205 + baseClock = TclpGetSeconds();
1.206 + }
1.207 +
1.208 + if (useGMT) {
1.209 + zone = -50000; /* Force GMT */
1.210 + } else {
1.211 + zone = TclpGetTimeZone(baseClock);
1.212 + }
1.213 +
1.214 + scanStr = Tcl_GetStringFromObj(objv[2], &dummy);
1.215 + Tcl_MutexLock(&clockMutex);
1.216 + if (TclGetDate(scanStr, baseClock, zone,
1.217 + &clockVal) < 0) {
1.218 + Tcl_MutexUnlock(&clockMutex);
1.219 + Tcl_AppendStringsToObj(resultPtr,
1.220 + "unable to convert date-time string \"",
1.221 + scanStr, "\"", (char *) NULL);
1.222 + return TCL_ERROR;
1.223 + }
1.224 + Tcl_MutexUnlock(&clockMutex);
1.225 +
1.226 + Tcl_SetWideIntObj(resultPtr, clockVal);
1.227 + return TCL_OK;
1.228 +
1.229 + case COMMAND_SECONDS: /* seconds */
1.230 + if (objc != 2) {
1.231 + Tcl_WrongNumArgs(interp, 2, objv, NULL);
1.232 + return TCL_ERROR;
1.233 + }
1.234 + Tcl_SetLongObj(resultPtr, (long) TclpGetSeconds());
1.235 + return TCL_OK;
1.236 + default:
1.237 + return TCL_ERROR; /* Should never be reached. */
1.238 + }
1.239 +}
1.240 +
1.241 +/*
1.242 + *-----------------------------------------------------------------------------
1.243 + *
1.244 + * FormatClock --
1.245 + *
1.246 + * Formats a time value based on seconds into a human readable
1.247 + * string.
1.248 + *
1.249 + * Results:
1.250 + * Standard Tcl result.
1.251 + *
1.252 + * Side effects:
1.253 + * None.
1.254 + *
1.255 + *-----------------------------------------------------------------------------
1.256 + */
1.257 +
1.258 +static int
1.259 +FormatClock(interp, clockVal, useGMT, format)
1.260 + Tcl_Interp *interp; /* Current interpreter. */
1.261 + Tcl_WideInt clockVal; /* Time in seconds. */
1.262 + int useGMT; /* Boolean */
1.263 + char *format; /* Format string */
1.264 +{
1.265 + struct tm *timeDataPtr;
1.266 + Tcl_DString buffer, uniBuffer;
1.267 + int bufSize;
1.268 + char *p;
1.269 + int result;
1.270 + time_t tclockVal;
1.271 +#if !defined(HAVE_TM_ZONE) && !defined(WIN32)
1.272 + TIMEZONE_t savedTimeZone = 0; /* lint. */
1.273 + char *savedTZEnv = NULL; /* lint. */
1.274 +#endif
1.275 +
1.276 +#ifdef HAVE_TZSET
1.277 + /*
1.278 + * Some systems forgot to call tzset in localtime, make sure its done.
1.279 + */
1.280 + static int calledTzset = 0;
1.281 +
1.282 + Tcl_MutexLock(&clockMutex);
1.283 + if (!calledTzset) {
1.284 + tzset();
1.285 + calledTzset = 1;
1.286 + }
1.287 + Tcl_MutexUnlock(&clockMutex);
1.288 +#endif
1.289 +
1.290 + /*
1.291 + * If the user gave us -format "", just return now
1.292 + */
1.293 + if (*format == '\0') {
1.294 + return TCL_OK;
1.295 + }
1.296 +
1.297 +#if !defined(HAVE_TM_ZONE) && !defined(WIN32)
1.298 + /*
1.299 + * This is a kludge for systems not having the timezone string in
1.300 + * struct tm. No matter what was specified, they use the local
1.301 + * timezone string. Since this kludge requires fiddling with the
1.302 + * TZ environment variable, it will mess up if done on multiple
1.303 + * threads at once. Protect it with a the clock mutex.
1.304 + */
1.305 +
1.306 + Tcl_MutexLock( &clockMutex );
1.307 + if (useGMT) {
1.308 + CONST char *varValue;
1.309 +
1.310 + varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
1.311 + if (varValue != NULL) {
1.312 + savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue);
1.313 + } else {
1.314 + savedTZEnv = NULL;
1.315 + }
1.316 + Tcl_SetVar2(interp, "env", "TZ", "GMT0", TCL_GLOBAL_ONLY);
1.317 + savedTimeZone = timezone;
1.318 + timezone = 0;
1.319 + tzset();
1.320 + }
1.321 +#endif
1.322 +
1.323 + tclockVal = (time_t) clockVal;
1.324 + timeDataPtr = TclpGetDate((TclpTime_t) &tclockVal, useGMT);
1.325 +
1.326 + /*
1.327 + * Make a guess at the upper limit on the substituted string size
1.328 + * based on the number of percents in the string.
1.329 + */
1.330 +
1.331 + for (bufSize = 1, p = format; *p != '\0'; p++) {
1.332 + if (*p == '%') {
1.333 + bufSize += 40;
1.334 + } else {
1.335 + bufSize++;
1.336 + }
1.337 + }
1.338 + Tcl_DStringInit(&uniBuffer);
1.339 + Tcl_UtfToExternalDString(NULL, format, -1, &uniBuffer);
1.340 + Tcl_DStringInit(&buffer);
1.341 + Tcl_DStringSetLength(&buffer, bufSize);
1.342 +
1.343 + /* If we haven't locked the clock mutex up above, lock it now. */
1.344 +
1.345 +#if defined(HAVE_TM_ZONE) || defined(WIN32)
1.346 + Tcl_MutexLock(&clockMutex);
1.347 +#endif
1.348 + result = TclpStrftime(buffer.string, (unsigned int) bufSize,
1.349 + Tcl_DStringValue(&uniBuffer), timeDataPtr, useGMT);
1.350 +#if defined(HAVE_TM_ZONE) || defined(WIN32)
1.351 + Tcl_MutexUnlock(&clockMutex);
1.352 +#endif
1.353 + Tcl_DStringFree(&uniBuffer);
1.354 +
1.355 +#if !defined(HAVE_TM_ZONE) && !defined(WIN32)
1.356 + if (useGMT) {
1.357 + if (savedTZEnv != NULL) {
1.358 + Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY);
1.359 + ckfree(savedTZEnv);
1.360 + } else {
1.361 + Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
1.362 + }
1.363 + timezone = savedTimeZone;
1.364 + tzset();
1.365 + }
1.366 + Tcl_MutexUnlock( &clockMutex );
1.367 +#endif
1.368 +
1.369 + if (result == 0) {
1.370 + /*
1.371 + * A zero return is the error case (can also mean the strftime
1.372 + * didn't get enough space to write into). We know it doesn't
1.373 + * mean that we wrote zero chars because the check for an empty
1.374 + * format string is above.
1.375 + */
1.376 + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1.377 + "bad format string \"", format, "\"", (char *) NULL);
1.378 + return TCL_ERROR;
1.379 + }
1.380 +
1.381 + /*
1.382 + * Convert the time to UTF from external encoding [Bug: 3345]
1.383 + */
1.384 + Tcl_DStringInit(&uniBuffer);
1.385 + Tcl_ExternalToUtfDString(NULL, buffer.string, -1, &uniBuffer);
1.386 +
1.387 + Tcl_SetStringObj(Tcl_GetObjResult(interp), uniBuffer.string, -1);
1.388 +
1.389 + Tcl_DStringFree(&uniBuffer);
1.390 + Tcl_DStringFree(&buffer);
1.391 + return TCL_OK;
1.392 +}
1.393 +