cde/programs/dtdocbook/tcl/tclClock.c

   1 /*
   2  * CDE - Common Desktop Environment
   3  *
   4  * Copyright (c) 1993-2012, The Open Group. All rights reserved.
   5  *
   6  * These libraries and programs are free software; you can
   7  * redistribute them and/or modify them under the terms of the GNU
   8  * Lesser General Public License as published by the Free Software
   9  * Foundation; either version 2 of the License, or (at your option)
  10  * any later version.
  11  *
  12  * These libraries and programs are distributed in the hope that
  13  * they will be useful, but WITHOUT ANY WARRANTY; without even the
  14  * implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
  15  * PURPOSE. See the GNU Lesser General Public License for more
  16  * details.
  17  *
  18  * You should have received a copy of the GNU Lesser General Public
  19  * License along with these librararies and programs; if not, write
  20  * to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  21  * Floor, Boston, MA 02110-1301 USA
  22  */
  23 /* $XConsortium: tclClock.c /main/2 1996/08/08 14:43:05 cde-hp $ */
  24 /*
  25  * tclClock.c --
  26  *
  27  *      Contains the time and date related commands.  This code
  28  *      is derived from the time and date facilities of TclX,
  29  *      by Mark Diekhans and Karl Lehenbauer.
  30  *
  31  * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
  32  * Copyright (c) 1995 Sun Microsystems, Inc.
  33  *
  34  * See the file "license.terms" for information on usage and redistribution
  35  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  36  *
  37  * SCCS: @(#) tclClock.c 1.19 96/03/13 11:28:45
  38  */
  39
  40 #include "tcl.h"
  41 #include "tclInt.h"
  42 #include "tclPort.h"
  43
  44 /*
  45  * Function prototypes for local procedures in this file:
  46  */
  47
  48 static int              FormatClock _ANSI_ARGS_((Tcl_Interp *interp,
  49                             unsigned long clockVal, int useGMT,
  50                             char *format));
  51 static int              ParseTime _ANSI_ARGS_((Tcl_Interp *interp,
  52                             char *string, unsigned long *timePtr));
  53 \f
  54 /*
  55  *-----------------------------------------------------------------------------
  56  *
  57  * Tcl_ClockCmd --
  58  *
  59  *      This procedure is invoked to process the "clock" Tcl command.
  60  *      See the user documentation for details on what it does.
  61  *
  62  * Results:
  63  *      A standard Tcl result.
  64  *
  65  * Side effects:
  66  *      See the user documentation.
  67  *
  68  *-----------------------------------------------------------------------------
  69  */
  70
  71 int
  72 Tcl_ClockCmd (dummy, interp, argc, argv)
  73     ClientData dummy;                   /* Not used. */
  74     Tcl_Interp *interp;                 /* Current interpreter. */
  75     int argc;                           /* Number of arguments. */
  76     char **argv;                        /* Argument strings. */
  77 {
  78     int c;
  79     size_t length;
  80     char **argPtr;
  81     int useGMT = 0;
  82     unsigned long clockVal;
  83
  84     if (argc < 2) {
  85         Tcl_AppendResult(interp, "wrong # args: should be \"",
  86                 argv[0], " option ?arg ...?\"", (char *) NULL);
  87         return TCL_ERROR;
  88     }
  89     c = argv[1][0];
  90     length = strlen(argv[1]);
  91     if ((c == 'c') && (strncmp(argv[1], "clicks", length) == 0)) {
  92         if (argc != 2) {
  93             Tcl_AppendResult(interp, "wrong # arguments: must be \"",
  94                     argv[0], " clicks\"", (char *) NULL);
  95             return TCL_ERROR;
  96         }
  97         sprintf(interp->result, "%lu", TclGetClicks());
  98         return TCL_OK;
  99     } else if ((c == 'f') && (strncmp(argv[1], "format", length) == 0)) {
 100         char *format = "%a %b %d %X %Z %Y";
 101
 102         if ((argc < 3) || (argc > 7)) {
 103             wrongFmtArgs:
 104             Tcl_AppendResult(interp, "wrong # args: ", argv [0],
 105                     " format clockval ?-format string? ?-gmt boolean?",
 106                     (char *) NULL);
 107             return TCL_ERROR;
 108         }
 109
 110         if (ParseTime(interp, argv[2], &clockVal) != TCL_OK) {
 111             return TCL_ERROR;
 112         }
 113
 114         argPtr = argv+3;
 115         argc -= 3;
 116         while ((argc > 1) && (argPtr[0][0] == '-')) {
 117             if (strcmp(argPtr[0], "-format") == 0) {
 118                 format = argPtr[1];
 119             } else if (strcmp(argPtr[0], "-gmt") == 0) {
 120                 if (Tcl_GetBoolean(interp, argPtr[1], &useGMT) != TCL_OK) {
 121                     return TCL_ERROR;
 122                 }
 123             } else {
 124                 Tcl_AppendResult(interp, "bad option \"", argPtr[0],
 125                         "\": must be -format or -gmt", (char *) NULL);
 126                 return TCL_ERROR;
 127             }
 128             argPtr += 2;
 129             argc -= 2;
 130         }
 131         if (argc != 0) {
 132             goto wrongFmtArgs;
 133         }
 134
 135         return FormatClock(interp, clockVal, useGMT, format);
 136     } else if ((c == 's') && (strncmp(argv[1], "scan", length) == 0)) {
 137         unsigned long baseClock;
 138         long zone;
 139         char * baseStr = NULL;
 140
 141         if ((argc < 3) || (argc > 7)) {
 142             wrongScanArgs:
 143             Tcl_AppendResult (interp, "wrong # args: ", argv [0],
 144                     " scan dateString ?-base clockValue? ?-gmt boolean?",
 145                     (char *) NULL);
 146             return TCL_ERROR;
 147         }
 148
 149         argPtr = argv+3;
 150         argc -= 3;
 151         while ((argc > 1) && (argPtr[0][0] == '-')) {
 152             if (strcmp(argPtr[0], "-base") == 0) {
 153                 baseStr = argPtr[1];
 154             } else if (strcmp(argPtr[0], "-gmt") == 0) {
 155                 if (Tcl_GetBoolean(interp, argPtr[1], &useGMT) != TCL_OK) {
 156                     return TCL_ERROR;
 157                 }
 158             } else {
 159                 Tcl_AppendResult(interp, "bad option \"", argPtr[0],
 160                         "\": must be -base or -gmt", (char *) NULL);
 161                 return TCL_ERROR;
 162             }
 163             argPtr += 2;
 164             argc -= 2;
 165         }
 166         if (argc != 0) {
 167             goto wrongScanArgs;
 168         }
 169
 170         if (baseStr != NULL) {
 171             if (ParseTime(interp, baseStr, &baseClock) != TCL_OK)
 172                 return TCL_ERROR;
 173         } else {
 174             baseClock = TclGetSeconds();
 175         }
 176
 177         if (useGMT) {
 178             zone = -50000; /* Force GMT */
 179         } else {
 180             zone = TclGetTimeZone(baseClock);
 181         }
 182
 183         if (TclGetDate(argv[2], baseClock, zone, &clockVal) < 0) {
 184             Tcl_AppendResult(interp, "unable to convert date-time string \"",
 185                     argv[2], "\"", (char *) NULL);
 186             return TCL_ERROR;
 187         }
 188
 189         sprintf(interp->result, "%lu", (long) clockVal);
 190         return TCL_OK;
 191     } else if ((c == 's') && (strncmp(argv[1], "seconds", length) == 0)) {
 192         if (argc != 2) {
 193             Tcl_AppendResult(interp, "wrong # arguments: must be \"",
 194                     argv[0], " seconds\"", (char *) NULL);
 195             return TCL_ERROR;
 196         }
 197         sprintf(interp->result, "%lu", TclGetSeconds());
 198         return TCL_OK;
 199     } else {
 200         Tcl_AppendResult(interp, "unknown option \"", argv[1],
 201                 "\": must be clicks, format, scan, or seconds",
 202                 (char *) NULL);
 203         return TCL_ERROR;
 204     }
 205 }
 206 \f
 207 /*
 208  *-----------------------------------------------------------------------------
 209  *
 210  * ParseTime --
 211  *
 212  *      Given a string, produce the corresponding time_t value.
 213  *
 214  * Results:
 215  *      The return value is normally TCL_OK;  in this case *timePtr
 216  *      will be set to the integer value equivalent to string.  If
 217  *      string is improperly formed then TCL_ERROR is returned and
 218  *      an error message will be left in interp->result.
 219  *
 220  * Side effects:
 221  *      None.
 222  *
 223  *-----------------------------------------------------------------------------
 224  */
 225
 226 static int
 227 ParseTime(interp, string, timePtr)
 228     Tcl_Interp *interp;
 229     char *string;
 230     unsigned long *timePtr;
 231 {
 232     char *end, *p;
 233     unsigned long  i;
 234
 235     /*
 236      * Since some strtoul functions don't detect negative numbers, check
 237      * in advance.
 238      */
 239     errno = 0;
 240     for (p = (char *) string; isspace(UCHAR(*p)); p++) {
 241         /* Empty loop body. */
 242     }
 243     if (*p == '+') {
 244         p++;
 245     }
 246     i = strtoul(p, &end, 0);
 247     if (end == p) {
 248         goto badTime;
 249     }
 250     if (errno == ERANGE) {
 251         interp->result = "integer value too large to represent";
 252         Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
 253                 interp->result, (char *) NULL);
 254         return TCL_ERROR;
 255     }
 256     while ((*end != '\0') && isspace(UCHAR(*end))) {
 257         end++;
 258     }
 259     if (*end != '\0') {
 260         goto badTime;
 261     }
 262
 263     *timePtr = (time_t) i;
 264     if (*timePtr != i) {
 265         goto badTime;
 266     }
 267     return TCL_OK;
 268
 269   badTime:
 270     Tcl_AppendResult (interp, "expected unsigned time but got \"",
 271                       string, "\"", (char *) NULL);
 272     return TCL_ERROR;
 273 }
 274 \f
 275 /*
 276  *-----------------------------------------------------------------------------
 277  *
 278  * FormatClock --
 279  *
 280  *      Formats a time value based on seconds into a human readable
 281  *      string.
 282  *
 283  * Results:
 284  *      Standard Tcl result.
 285  *
 286  * Side effects:
 287  *      None.
 288  *
 289  *-----------------------------------------------------------------------------
 290  */
 291
 292 static int
 293 FormatClock(interp, clockVal, useGMT, format)
 294     Tcl_Interp *interp;                 /* Current interpreter. */
 295     unsigned long clockVal;             /* Time in seconds. */
 296     int useGMT;                         /* Boolean */
 297     char *format;                       /* Format string */
 298 {
 299     struct tm *timeDataPtr;
 300     Tcl_DString buffer;
 301     int bufSize;
 302 #ifdef TCL_USE_TIMEZONE_VAR
 303     int savedTimeZone;
 304     char *savedTZEnv;
 305 #endif
 306
 307 #ifdef HAVE_TZSET
 308     /*
 309      * Some systems forgot to call tzset in localtime, make sure its done.
 310      */
 311     static int  calledTzset = 0;
 312
 313     if (!calledTzset) {
 314         tzset();
 315         calledTzset = 1;
 316     }
 317 #endif
 318
 319 #ifdef TCL_USE_TIMEZONE_VAR
 320     /*
 321      * This is a horrible kludge for systems not having the timezone in
 322      * struct tm.  No matter what was specified, they use the global time
 323      * zone.  (Thanks Solaris).
 324      */
 325     if (useGMT) {
 326         char *varValue;
 327
 328         varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
 329         if (varValue != NULL) {
 330             savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue);
 331         } else {
 332             savedTZEnv = NULL;
 333         }
 334         Tcl_SetVar2(interp, "env", "TZ", "GMT", TCL_GLOBAL_ONLY);
 335         savedTimeZone = timezone;
 336         timezone = 0;
 337         tzset();
 338     }
 339 #endif
 340
 341     if (useGMT) {
 342         timeDataPtr = gmtime((time_t *) &clockVal);
 343     } else {
 344         timeDataPtr = localtime((time_t *) &clockVal);
 345     }
 346
 347     /*
 348      * Format the time, increasing the buffer size until strftime succeeds.
 349      */
 350     bufSize = TCL_DSTRING_STATIC_SIZE - 1;
 351     Tcl_DStringInit(&buffer);
 352     Tcl_DStringSetLength(&buffer, bufSize);
 353
 354     while (strftime(buffer.string, (unsigned int) bufSize, format,
 355             timeDataPtr) == 0) {
 356         bufSize *= 2;
 357         Tcl_DStringSetLength(&buffer, bufSize);
 358     }
 359
 360 #ifdef TCL_USE_TIMEZONE_VAR
 361     if (useGMT) {
 362         if (savedTZEnv != NULL) {
 363             Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY);
 364             ckfree(savedTZEnv);
 365         } else {
 366             Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
 367         }
 368         timezone = savedTimeZone;
 369         tzset();
 370     }
 371 #endif
 372
 373     Tcl_DStringResult(interp, &buffer);
 374     return TCL_OK;
 375 }
 376