/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclclock.c
ViewVC logotype

Annotation of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclclock.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 64 - (hide annotations) (download)
Sun Oct 30 04:21:11 2016 UTC (7 years, 8 months ago) by dashley
File MIME type: text/plain
File size: 9799 byte(s)
Adjust line endings to Windows style.
Set properties to expand the "Header" keyword.
Change header and footer.
1 dashley 64 /* $Header$ */
2 dashley 25
3     /*
4     * tclClock.c --
5     *
6     * Contains the time and date related commands. This code
7     * is derived from the time and date facilities of TclX,
8     * by Mark Diekhans and Karl Lehenbauer.
9     *
10     * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
11     * Copyright (c) 1995 Sun Microsystems, Inc.
12     *
13     * See the file "license.terms" for information on usage and redistribution
14     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15     *
16     * RCS: @(#) $Id: tclclock.c,v 1.1.1.1 2001/06/13 04:34:06 dtashley Exp $
17     */
18    
19     #include "tcl.h"
20     #include "tclInt.h"
21     #include "tclPort.h"
22    
23     /*
24     * The date parsing stuff uses lexx and has tons o statics.
25     */
26    
27     TCL_DECLARE_MUTEX(clockMutex)
28    
29     /*
30     * Function prototypes for local procedures in this file:
31     */
32    
33     static int FormatClock _ANSI_ARGS_((Tcl_Interp *interp,
34     unsigned long clockVal, int useGMT,
35     char *format));
36    
37     /*
38     *-------------------------------------------------------------------------
39     *
40     * Tcl_ClockObjCmd --
41     *
42     * This procedure is invoked to process the "clock" Tcl command.
43     * See the user documentation for details on what it does.
44     *
45     * Results:
46     * A standard Tcl result.
47     *
48     * Side effects:
49     * See the user documentation.
50     *
51     *-------------------------------------------------------------------------
52     */
53    
54     int
55     Tcl_ClockObjCmd (client, interp, objc, objv)
56     ClientData client; /* Not used. */
57     Tcl_Interp *interp; /* Current interpreter. */
58     int objc; /* Number of arguments. */
59     Tcl_Obj *CONST objv[]; /* Argument values. */
60     {
61     Tcl_Obj *resultPtr;
62     int index;
63     Tcl_Obj *CONST *objPtr;
64     int useGMT = 0;
65     char *format = "%a %b %d %X %Z %Y";
66     int dummy;
67     unsigned long baseClock, clockVal;
68     long zone;
69     Tcl_Obj *baseObjPtr = NULL;
70     char *scanStr;
71    
72     static char *switches[] =
73     {"clicks", "format", "scan", "seconds", (char *) NULL};
74     enum command { COMMAND_CLICKS, COMMAND_FORMAT, COMMAND_SCAN,
75     COMMAND_SECONDS
76     };
77     static char *formatSwitches[] = {"-format", "-gmt", (char *) NULL};
78     static char *scanSwitches[] = {"-base", "-gmt", (char *) NULL};
79    
80     resultPtr = Tcl_GetObjResult(interp);
81     if (objc < 2) {
82     Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
83     return TCL_ERROR;
84     }
85    
86     if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)
87     != TCL_OK) {
88     return TCL_ERROR;
89     }
90     switch ((enum command) index) {
91     case COMMAND_CLICKS: { /* clicks */
92     int forceMilli = 0;
93    
94     if (objc == 3) {
95     format = Tcl_GetStringFromObj(objv[2], &index);
96     if (strncmp(format, "-milliseconds",
97     (unsigned int) index) == 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     TclpGetTime(&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_GetLongFromObj(interp, objv[2], (long*) &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, (unsigned long) 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_GetLongFromObj(interp, baseObjPtr,
198     (long*) &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((unsigned long) baseClock);
209     }
210    
211     scanStr = Tcl_GetStringFromObj(objv[2], &dummy);
212     Tcl_MutexLock(&clockMutex);
213     if (TclGetDate(scanStr, (unsigned long) baseClock, zone,
214     (unsigned long *) &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_SetLongObj(resultPtr, (long) 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    
255     static int
256     FormatClock(interp, clockVal, useGMT, format)
257     Tcl_Interp *interp; /* Current interpreter. */
258     unsigned long clockVal; /* Time in seconds. */
259     int useGMT; /* Boolean */
260     char *format; /* Format string */
261     {
262     struct tm *timeDataPtr;
263     Tcl_DString buffer;
264     int bufSize;
265     char *p;
266     int result;
267     time_t tclockVal;
268     #ifndef HAVE_TM_ZONE
269     int 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     #ifndef HAVE_TM_ZONE
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.
299     */
300    
301     if (useGMT) {
302     char *varValue;
303    
304     varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
305     if (varValue != NULL) {
306     savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue);
307     } else {
308     savedTZEnv = NULL;
309     }
310     Tcl_SetVar2(interp, "env", "TZ", "GMT", TCL_GLOBAL_ONLY);
311     savedTimeZone = timezone;
312     timezone = 0;
313     tzset();
314     }
315     #endif
316    
317     tclockVal = clockVal;
318     timeDataPtr = TclpGetDate((TclpTime_t) &tclockVal, useGMT);
319    
320     /*
321     * Make a guess at the upper limit on the substituted string size
322     * based on the number of percents in the string.
323     */
324    
325     for (bufSize = 1, p = format; *p != '\0'; p++) {
326     if (*p == '%') {
327     bufSize += 40;
328     } else {
329     bufSize++;
330     }
331     }
332     Tcl_DStringInit(&buffer);
333     Tcl_DStringSetLength(&buffer, bufSize);
334    
335     Tcl_MutexLock(&clockMutex);
336     result = TclpStrftime(buffer.string, (unsigned int) bufSize, format,
337     timeDataPtr);
338     Tcl_MutexUnlock(&clockMutex);
339    
340     #ifndef HAVE_TM_ZONE
341     if (useGMT) {
342     if (savedTZEnv != NULL) {
343     Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY);
344     ckfree(savedTZEnv);
345     } else {
346     Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
347     }
348     timezone = savedTimeZone;
349     tzset();
350     }
351     #endif
352    
353     if (result == 0) {
354     /*
355     * A zero return is the error case (can also mean the strftime
356     * didn't get enough space to write into). We know it doesn't
357     * mean that we wrote zero chars because the check for an empty
358     * format string is above.
359     */
360     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
361     "bad format string \"", format, "\"", (char *) NULL);
362     return TCL_ERROR;
363     }
364    
365     Tcl_SetStringObj(Tcl_GetObjResult(interp), buffer.string, -1);
366     Tcl_DStringFree(&buffer);
367     return TCL_OK;
368     }
369    
370    
371     /* $History: tclclock.c $
372     *
373     * ***************** Version 1 *****************
374     * User: Dtashley Date: 1/02/01 Time: 1:31a
375     * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
376     * Initial check-in.
377     */
378    
379     /* End of TCLCLOCK.C */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25