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