path: root/contrib/tcl/generic/tclClock.c

/* 
 * 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;
}