home *** CD-ROM | disk | FTP | other *** search
- /*
- * tclClock.c --
- *
- * Contains the time and date related commands. This code
- * is derived from the time and date facilities of TclX,
- * by Mark Diekhans and Karl Lehenbauer.
- *
- * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
- * Copyright (c) 1995 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * SCCS: @(#) tclClock.c 1.19 96/03/13 11:28:45
- */
-
- #include "tcl.h"
- #include "tclInt.h"
- #include "tclPort.h"
-
- /*
- * Function prototypes for local procedures in this file:
- */
-
- static int FormatClock _ANSI_ARGS_((Tcl_Interp *interp,
- unsigned long clockVal, int useGMT,
- char *format));
- static int ParseTime _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, unsigned long *timePtr));
-
- /*
- *-----------------------------------------------------------------------------
- *
- * Tcl_ClockCmd --
- *
- * This procedure is invoked to process the "clock" Tcl command.
- * See the user documentation for details on what it does.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * See the user documentation.
- *
- *-----------------------------------------------------------------------------
- */
-
- int
- Tcl_ClockCmd (dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
- {
- int c;
- size_t length;
- char **argPtr;
- int useGMT = 0;
- unsigned long clockVal;
-
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option ?arg ...?\"", (char *) NULL);
- return TCL_ERROR;
- }
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'c') && (strncmp(argv[1], "clicks", length) == 0)) {
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # arguments: must be \"",
- argv[0], " clicks\"", (char *) NULL);
- return TCL_ERROR;
- }
- sprintf(interp->result, "%lu", TclGetClicks());
- return TCL_OK;
- } else if ((c == 'f') && (strncmp(argv[1], "format", length) == 0)) {
- char *format = "%a %b %d %X %Z %Y";
-
- if ((argc < 3) || (argc > 7)) {
- wrongFmtArgs:
- Tcl_AppendResult(interp, "wrong # args: ", argv [0],
- " format clockval ?-format string? ?-gmt boolean?",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- if (ParseTime(interp, argv[2], &clockVal) != TCL_OK) {
- return TCL_ERROR;
- }
-
- argPtr = argv+3;
- argc -= 3;
- while ((argc > 1) && (argPtr[0][0] == '-')) {
- if (strcmp(argPtr[0], "-format") == 0) {
- format = argPtr[1];
- } else if (strcmp(argPtr[0], "-gmt") == 0) {
- if (Tcl_GetBoolean(interp, argPtr[1], &useGMT) != TCL_OK) {
- return TCL_ERROR;
- }
- } else {
- Tcl_AppendResult(interp, "bad option \"", argPtr[0],
- "\": must be -format or -gmt", (char *) NULL);
- return TCL_ERROR;
- }
- argPtr += 2;
- argc -= 2;
- }
- if (argc != 0) {
- goto wrongFmtArgs;
- }
-
- return FormatClock(interp, clockVal, useGMT, format);
- } else if ((c == 's') && (strncmp(argv[1], "scan", length) == 0)) {
- unsigned long baseClock;
- long zone;
- char * baseStr = NULL;
-
- if ((argc < 3) || (argc > 7)) {
- wrongScanArgs:
- Tcl_AppendResult (interp, "wrong # args: ", argv [0],
- " scan dateString ?-base clockValue? ?-gmt boolean?",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- argPtr = argv+3;
- argc -= 3;
- while ((argc > 1) && (argPtr[0][0] == '-')) {
- if (strcmp(argPtr[0], "-base") == 0) {
- baseStr = argPtr[1];
- } else if (strcmp(argPtr[0], "-gmt") == 0) {
- if (Tcl_GetBoolean(interp, argPtr[1], &useGMT) != TCL_OK) {
- return TCL_ERROR;
- }
- } else {
- Tcl_AppendResult(interp, "bad option \"", argPtr[0],
- "\": must be -base or -gmt", (char *) NULL);
- return TCL_ERROR;
- }
- argPtr += 2;
- argc -= 2;
- }
- if (argc != 0) {
- goto wrongScanArgs;
- }
-
- if (baseStr != NULL) {
- if (ParseTime(interp, baseStr, &baseClock) != TCL_OK)
- return TCL_ERROR;
- } else {
- baseClock = TclGetSeconds();
- }
-
- if (useGMT) {
- zone = -50000; /* Force GMT */
- } else {
- zone = TclGetTimeZone(baseClock);
- }
-
- if (TclGetDate(argv[2], baseClock, zone, &clockVal) < 0) {
- Tcl_AppendResult(interp, "unable to convert date-time string \"",
- argv[2], "\"", (char *) NULL);
- return TCL_ERROR;
- }
-
- sprintf(interp->result, "%lu", (long) clockVal);
- return TCL_OK;
- } else if ((c == 's') && (strncmp(argv[1], "seconds", length) == 0)) {
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # arguments: must be \"",
- argv[0], " seconds\"", (char *) NULL);
- return TCL_ERROR;
- }
- sprintf(interp->result, "%lu", TclGetSeconds());
- return TCL_OK;
- } else {
- Tcl_AppendResult(interp, "unknown option \"", argv[1],
- "\": must be clicks, format, scan, or seconds",
- (char *) NULL);
- return TCL_ERROR;
- }
- }
-
- /*
- *-----------------------------------------------------------------------------
- *
- * ParseTime --
- *
- * Given a string, produce the corresponding time_t value.
- *
- * Results:
- * The return value is normally TCL_OK; in this case *timePtr
- * will be set to the integer value equivalent to string. If
- * string is improperly formed then TCL_ERROR is returned and
- * an error message will be left in interp->result.
- *
- * Side effects:
- * None.
- *
- *-----------------------------------------------------------------------------
- */
-
- static int
- ParseTime(interp, string, timePtr)
- Tcl_Interp *interp;
- char *string;
- unsigned long *timePtr;
- {
- char *end, *p;
- unsigned long i;
-
- /*
- * Since some strtoul functions don't detect negative numbers, check
- * in advance.
- */
- errno = 0;
- for (p = (char *) string; isspace(UCHAR(*p)); p++) {
- /* Empty loop body. */
- }
- if (*p == '+') {
- p++;
- }
- i = strtoul(p, &end, 0);
- if (end == p) {
- goto badTime;
- }
- if (errno == ERANGE) {
- interp->result = "integer value too large to represent";
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- interp->result, (char *) NULL);
- return TCL_ERROR;
- }
- while ((*end != '\0') && isspace(UCHAR(*end))) {
- end++;
- }
- if (*end != '\0') {
- goto badTime;
- }
-
- *timePtr = (time_t) i;
- if (*timePtr != i) {
- goto badTime;
- }
- return TCL_OK;
-
- badTime:
- Tcl_AppendResult (interp, "expected unsigned time but got \"",
- string, "\"", (char *) NULL);
- return TCL_ERROR;
- }
-
- /*
- *-----------------------------------------------------------------------------
- *
- * FormatClock --
- *
- * Formats a time value based on seconds into a human readable
- * string.
- *
- * Results:
- * Standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *-----------------------------------------------------------------------------
- */
-
- static int
- FormatClock(interp, clockVal, useGMT, format)
- Tcl_Interp *interp; /* Current interpreter. */
- unsigned long clockVal; /* Time in seconds. */
- int useGMT; /* Boolean */
- char *format; /* Format string */
- {
- struct tm *timeDataPtr;
- Tcl_DString buffer;
- int bufSize;
- #ifdef TCL_USE_TIMEZONE_VAR
- int savedTimeZone;
- char *savedTZEnv;
- #endif
-
- #ifdef HAVE_TZSET
- /*
- * Some systems forgot to call tzset in localtime, make sure its done.
- */
- static int calledTzset = 0;
-
- if (!calledTzset) {
- tzset();
- calledTzset = 1;
- }
- #endif
-
- #ifdef TCL_USE_TIMEZONE_VAR
- /*
- * This is a horrible kludge for systems not having the timezone in
- * struct tm. No matter what was specified, they use the global time
- * zone. (Thanks Solaris).
- */
- if (useGMT) {
- char *varValue;
-
- varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
- if (varValue != NULL) {
- savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue);
- } else {
- savedTZEnv = NULL;
- }
- Tcl_SetVar2(interp, "env", "TZ", "GMT", TCL_GLOBAL_ONLY);
- savedTimeZone = timezone;
- timezone = 0;
- tzset();
- }
- #endif
-
- if (useGMT) {
- timeDataPtr = gmtime((time_t *) &clockVal);
- } else {
- timeDataPtr = localtime((time_t *) &clockVal);
- }
-
- /*
- * Format the time, increasing the buffer size until strftime succeeds.
- */
- bufSize = TCL_DSTRING_STATIC_SIZE - 1;
- Tcl_DStringInit(&buffer);
- Tcl_DStringSetLength(&buffer, bufSize);
-
- while (strftime(buffer.string, (unsigned int) bufSize, format,
- timeDataPtr) == 0) {
- bufSize *= 2;
- Tcl_DStringSetLength(&buffer, bufSize);
- }
-
- #ifdef TCL_USE_TIMEZONE_VAR
- if (useGMT) {
- if (savedTZEnv != NULL) {
- Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY);
- ckfree(savedTZEnv);
- } else {
- Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
- }
- timezone = savedTimeZone;
- tzset();
- }
- #endif
-
- Tcl_DStringResult(interp, &buffer);
- return TCL_OK;
- }
-
-