1/* 2 * tclClock.c -- 3 * 4 * Contains the time and date related commands. This code 5 * is derived from the time and date facilities of TclX, 6 * by Mark Diekhans and Karl Lehenbauer. 7 * 8 * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans. 9 * Copyright (c) 1995 Sun Microsystems, Inc. 10 * 11 * See the file "license.terms" for information on usage and redistribution 12 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13 * 14 * RCS: @(#) $Id: tclClock.c,v 1.20.2.4 2007/08/25 17:12:20 kennykb Exp $ 15 */ 16 17#include "tcl.h" 18#include "tclInt.h" 19#include "tclPort.h" 20 21/* 22 * The date parsing stuff uses lexx and has tons o statics. 23 */ 24 25TCL_DECLARE_MUTEX(clockMutex) 26 27/* 28 * Function prototypes for local procedures in this file: 29 */ 30 31static int FormatClock _ANSI_ARGS_((Tcl_Interp *interp, 32 Tcl_WideInt clockVal, int useGMT, 33 char *format)); 34 35/* 36 *------------------------------------------------------------------------- 37 * 38 * Tcl_ClockObjCmd -- 39 * 40 * This procedure is invoked to process the "clock" Tcl command. 41 * See the user documentation for details on what it does. 42 * 43 * Results: 44 * A standard Tcl result. 45 * 46 * Side effects: 47 * See the user documentation. 48 * 49 *------------------------------------------------------------------------- 50 */ 51 52int 53Tcl_ClockObjCmd (client, interp, objc, objv) 54 ClientData client; /* Not used. */ 55 Tcl_Interp *interp; /* Current interpreter. */ 56 int objc; /* Number of arguments. */ 57 Tcl_Obj *CONST objv[]; /* Argument values. */ 58{ 59 Tcl_Obj *resultPtr; 60 int index; 61 Tcl_Obj *CONST *objPtr; 62 int useGMT = 0; 63 char *format = "%a %b %d %X %Z %Y"; 64 int dummy; 65 Tcl_WideInt baseClock, clockVal; 66 long zone; 67 Tcl_Obj *baseObjPtr = NULL; 68 char *scanStr; 69 int n; 70 71 static CONST char *switches[] = 72 {"clicks", "format", "scan", "seconds", (char *) NULL}; 73 enum command { COMMAND_CLICKS, COMMAND_FORMAT, COMMAND_SCAN, 74 COMMAND_SECONDS 75 }; 76 static CONST char *formatSwitches[] = {"-format", "-gmt", (char *) NULL}; 77 static CONST char *scanSwitches[] = {"-base", "-gmt", (char *) NULL}; 78 79 resultPtr = Tcl_GetObjResult(interp); 80 if (objc < 2) { 81 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); 82 return TCL_ERROR; 83 } 84 85 if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index) 86 != TCL_OK) { 87 return TCL_ERROR; 88 } 89 switch ((enum command) index) { 90 case COMMAND_CLICKS: { /* clicks */ 91 int forceMilli = 0; 92 93 if (objc == 3) { 94 format = Tcl_GetStringFromObj(objv[2], &n); 95 if ( ( n >= 2 ) 96 && ( strncmp( format, "-milliseconds", 97 (unsigned int) n) == 0 ) ) { 98 forceMilli = 1; 99 } else { 100 Tcl_AppendStringsToObj(resultPtr, 101 "bad switch \"", format, 102 "\": must be -milliseconds", (char *) NULL); 103 return TCL_ERROR; 104 } 105 } else if (objc != 2) { 106 Tcl_WrongNumArgs(interp, 2, objv, "?-milliseconds?"); 107 return TCL_ERROR; 108 } 109 if (forceMilli) { 110 /* 111 * We can enforce at least millisecond granularity 112 */ 113 Tcl_Time time; 114 Tcl_GetTime(&time); 115 Tcl_SetLongObj(resultPtr, 116 (long) (time.sec*1000 + time.usec/1000)); 117 } else { 118 Tcl_SetLongObj(resultPtr, (long) TclpGetClicks()); 119 } 120 return TCL_OK; 121 } 122 123 case COMMAND_FORMAT: /* format */ 124 if ((objc < 3) || (objc > 7)) { 125 wrongFmtArgs: 126 Tcl_WrongNumArgs(interp, 2, objv, 127 "clockval ?-format string? ?-gmt boolean?"); 128 return TCL_ERROR; 129 } 130 131 if (Tcl_GetWideIntFromObj(interp, objv[2], &clockVal) 132 != TCL_OK) { 133 return TCL_ERROR; 134 } 135 136 objPtr = objv+3; 137 objc -= 3; 138 while (objc > 1) { 139 if (Tcl_GetIndexFromObj(interp, objPtr[0], formatSwitches, 140 "switch", 0, &index) != TCL_OK) { 141 return TCL_ERROR; 142 } 143 switch (index) { 144 case 0: /* -format */ 145 format = Tcl_GetStringFromObj(objPtr[1], &dummy); 146 break; 147 case 1: /* -gmt */ 148 if (Tcl_GetBooleanFromObj(interp, objPtr[1], 149 &useGMT) != TCL_OK) { 150 return TCL_ERROR; 151 } 152 break; 153 } 154 objPtr += 2; 155 objc -= 2; 156 } 157 if (objc != 0) { 158 goto wrongFmtArgs; 159 } 160 return FormatClock(interp, clockVal, useGMT, 161 format); 162 163 case COMMAND_SCAN: /* scan */ 164 if ((objc < 3) || (objc > 7)) { 165 wrongScanArgs: 166 Tcl_WrongNumArgs(interp, 2, objv, 167 "dateString ?-base clockValue? ?-gmt boolean?"); 168 return TCL_ERROR; 169 } 170 171 objPtr = objv+3; 172 objc -= 3; 173 while (objc > 1) { 174 if (Tcl_GetIndexFromObj(interp, objPtr[0], scanSwitches, 175 "switch", 0, &index) != TCL_OK) { 176 return TCL_ERROR; 177 } 178 switch (index) { 179 case 0: /* -base */ 180 baseObjPtr = objPtr[1]; 181 break; 182 case 1: /* -gmt */ 183 if (Tcl_GetBooleanFromObj(interp, objPtr[1], 184 &useGMT) != TCL_OK) { 185 return TCL_ERROR; 186 } 187 break; 188 } 189 objPtr += 2; 190 objc -= 2; 191 } 192 if (objc != 0) { 193 goto wrongScanArgs; 194 } 195 196 if (baseObjPtr != NULL) { 197 if (Tcl_GetWideIntFromObj(interp, baseObjPtr, 198 &baseClock) != TCL_OK) { 199 return TCL_ERROR; 200 } 201 } else { 202 baseClock = TclpGetSeconds(); 203 } 204 205 if (useGMT) { 206 zone = -50000; /* Force GMT */ 207 } else { 208 zone = TclpGetTimeZone(baseClock); 209 } 210 211 scanStr = Tcl_GetStringFromObj(objv[2], &dummy); 212 Tcl_MutexLock(&clockMutex); 213 if (TclGetDate(scanStr, baseClock, zone, 214 &clockVal) < 0) { 215 Tcl_MutexUnlock(&clockMutex); 216 Tcl_AppendStringsToObj(resultPtr, 217 "unable to convert date-time string \"", 218 scanStr, "\"", (char *) NULL); 219 return TCL_ERROR; 220 } 221 Tcl_MutexUnlock(&clockMutex); 222 223 Tcl_SetWideIntObj(resultPtr, clockVal); 224 return TCL_OK; 225 226 case COMMAND_SECONDS: /* seconds */ 227 if (objc != 2) { 228 Tcl_WrongNumArgs(interp, 2, objv, NULL); 229 return TCL_ERROR; 230 } 231 Tcl_SetLongObj(resultPtr, (long) TclpGetSeconds()); 232 return TCL_OK; 233 default: 234 return TCL_ERROR; /* Should never be reached. */ 235 } 236} 237 238/* 239 *----------------------------------------------------------------------------- 240 * 241 * FormatClock -- 242 * 243 * Formats a time value based on seconds into a human readable 244 * string. 245 * 246 * Results: 247 * Standard Tcl result. 248 * 249 * Side effects: 250 * None. 251 * 252 *----------------------------------------------------------------------------- 253 */ 254 255static int 256FormatClock(interp, clockVal, useGMT, format) 257 Tcl_Interp *interp; /* Current interpreter. */ 258 Tcl_WideInt clockVal; /* Time in seconds. */ 259 int useGMT; /* Boolean */ 260 char *format; /* Format string */ 261{ 262 struct tm *timeDataPtr; 263 Tcl_DString buffer, uniBuffer; 264 int bufSize; 265 char *p; 266 int result; 267 time_t tclockVal; 268#if !defined(HAVE_TM_ZONE) && !defined(WIN32) 269 TIMEZONE_t savedTimeZone = 0; /* lint. */ 270 char *savedTZEnv = NULL; /* lint. */ 271#endif 272 273#ifdef HAVE_TZSET 274 /* 275 * Some systems forgot to call tzset in localtime, make sure its done. 276 */ 277 static int calledTzset = 0; 278 279 Tcl_MutexLock(&clockMutex); 280 if (!calledTzset) { 281 tzset(); 282 calledTzset = 1; 283 } 284 Tcl_MutexUnlock(&clockMutex); 285#endif 286 287 /* 288 * If the user gave us -format "", just return now 289 */ 290 if (*format == '\0') { 291 return TCL_OK; 292 } 293 294#if !defined(HAVE_TM_ZONE) && !defined(WIN32) 295 /* 296 * This is a kludge for systems not having the timezone string in 297 * struct tm. No matter what was specified, they use the local 298 * timezone string. Since this kludge requires fiddling with the 299 * TZ environment variable, it will mess up if done on multiple 300 * threads at once. Protect it with a the clock mutex. 301 */ 302 303 Tcl_MutexLock( &clockMutex ); 304 if (useGMT) { 305 CONST char *varValue; 306 307 varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY); 308 if (varValue != NULL) { 309 savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue); 310 } else { 311 savedTZEnv = NULL; 312 } 313 Tcl_SetVar2(interp, "env", "TZ", "GMT0", TCL_GLOBAL_ONLY); 314 savedTimeZone = timezone; 315 timezone = 0; 316 tzset(); 317 } 318#endif 319 320 tclockVal = (time_t) clockVal; 321 timeDataPtr = TclpGetDate((TclpTime_t) &tclockVal, useGMT); 322 323 /* 324 * Make a guess at the upper limit on the substituted string size 325 * based on the number of percents in the string. 326 */ 327 328 for (bufSize = 1, p = format; *p != '\0'; p++) { 329 if (*p == '%') { 330 bufSize += 40; 331 if (p[1] == 'c') { 332 bufSize += 226; 333 } 334 } else { 335 bufSize++; 336 } 337 } 338 Tcl_DStringInit(&uniBuffer); 339 Tcl_UtfToExternalDString(NULL, format, -1, &uniBuffer); 340 Tcl_DStringInit(&buffer); 341 Tcl_DStringSetLength(&buffer, bufSize); 342 343 /* If we haven't locked the clock mutex up above, lock it now. */ 344 345#if defined(HAVE_TM_ZONE) || defined(WIN32) 346 Tcl_MutexLock(&clockMutex); 347#endif 348 result = TclpStrftime(buffer.string, (unsigned int) bufSize, 349 Tcl_DStringValue(&uniBuffer), timeDataPtr, useGMT); 350#if defined(HAVE_TM_ZONE) || defined(WIN32) 351 Tcl_MutexUnlock(&clockMutex); 352#endif 353 Tcl_DStringFree(&uniBuffer); 354 355#if !defined(HAVE_TM_ZONE) && !defined(WIN32) 356 if (useGMT) { 357 if (savedTZEnv != NULL) { 358 Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY); 359 ckfree(savedTZEnv); 360 } else { 361 Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY); 362 } 363 timezone = savedTimeZone; 364 tzset(); 365 } 366 Tcl_MutexUnlock( &clockMutex ); 367#endif 368 369 if (result == 0) { 370 /* 371 * A zero return is the error case (can also mean the strftime 372 * didn't get enough space to write into). We know it doesn't 373 * mean that we wrote zero chars because the check for an empty 374 * format string is above. 375 */ 376 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 377 "bad format string \"", format, "\"", (char *) NULL); 378 return TCL_ERROR; 379 } 380 381 /* 382 * Convert the time to UTF from external encoding [Bug: 3345] 383 */ 384 Tcl_DStringInit(&uniBuffer); 385 Tcl_ExternalToUtfDString(NULL, buffer.string, -1, &uniBuffer); 386 387 Tcl_SetStringObj(Tcl_GetObjResult(interp), uniBuffer.string, -1); 388 389 Tcl_DStringFree(&uniBuffer); 390 Tcl_DStringFree(&buffer); 391 return TCL_OK; 392} 393 394