diff options
Diffstat (limited to 'contrib/tcl/generic/tclClock.c')
-rw-r--r-- | contrib/tcl/generic/tclClock.c | 353 |
1 files changed, 353 insertions, 0 deletions
diff --git a/contrib/tcl/generic/tclClock.c b/contrib/tcl/generic/tclClock.c new file mode 100644 index 0000000..3fb4abd --- /dev/null +++ b/contrib/tcl/generic/tclClock.c @@ -0,0 +1,353 @@ +/* + * 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; +} + |