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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.70  
changed lines
  Added in v.71

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25