sl@0: /* 
sl@0:  * tclClock.c --
sl@0:  *
sl@0:  *	Contains the time and date related commands.  This code
sl@0:  *	is derived from the time and date facilities of TclX,
sl@0:  *	by Mark Diekhans and Karl Lehenbauer.
sl@0:  *
sl@0:  * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
sl@0:  * Copyright (c) 1995 Sun Microsystems, Inc.
sl@0:  *
sl@0:  * See the file "license.terms" for information on usage and redistribution
sl@0:  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclClock.c,v 1.20.2.3 2007/04/21 22:42:49 kennykb Exp $
sl@0:  */
sl@0: 
sl@0: #include "tcl.h"
sl@0: #include "tclInt.h"
sl@0: #include "tclPort.h"
sl@0: 
sl@0: /*
sl@0:  * The date parsing stuff uses lexx and has tons o statics.
sl@0:  */
sl@0: 
sl@0: TCL_DECLARE_MUTEX(clockMutex)
sl@0: 
sl@0: /*
sl@0:  * Function prototypes for local procedures in this file:
sl@0:  */
sl@0: 
sl@0: static int		FormatClock _ANSI_ARGS_((Tcl_Interp *interp,
sl@0: 			    Tcl_WideInt clockVal, int useGMT,
sl@0: 			    char *format));
sl@0: 
sl@0: /*
sl@0:  *-------------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_ClockObjCmd --
sl@0:  *
sl@0:  *	This procedure is invoked to process the "clock" Tcl command.
sl@0:  *	See the user documentation for details on what it does.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A standard Tcl result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	See the user documentation.
sl@0:  *
sl@0:  *-------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int
sl@0: Tcl_ClockObjCmd (client, interp, objc, objv)
sl@0:     ClientData client;			/* Not used. */
sl@0:     Tcl_Interp *interp;			/* Current interpreter. */
sl@0:     int objc;				/* Number of arguments. */
sl@0:     Tcl_Obj *CONST objv[];		/* Argument values. */
sl@0: {
sl@0:     Tcl_Obj *resultPtr;
sl@0:     int index;
sl@0:     Tcl_Obj *CONST *objPtr;
sl@0:     int useGMT = 0;
sl@0:     char *format = "%a %b %d %X %Z %Y";
sl@0:     int dummy;
sl@0:     Tcl_WideInt baseClock, clockVal;
sl@0:     long zone;
sl@0:     Tcl_Obj *baseObjPtr = NULL;
sl@0:     char *scanStr;
sl@0:     int n;
sl@0:     
sl@0:     static CONST char *switches[] =
sl@0: 	{"clicks", "format", "scan", "seconds", (char *) NULL};
sl@0:     enum command { COMMAND_CLICKS, COMMAND_FORMAT, COMMAND_SCAN,
sl@0: 		       COMMAND_SECONDS
sl@0:     };
sl@0:     static CONST char *formatSwitches[] = {"-format", "-gmt", (char *) NULL};
sl@0:     static CONST char *scanSwitches[] = {"-base", "-gmt", (char *) NULL};
sl@0: 
sl@0:     resultPtr = Tcl_GetObjResult(interp);
sl@0:     if (objc < 2) {
sl@0: 	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0: 
sl@0:     if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)
sl@0: 	    != TCL_OK) {
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     switch ((enum command) index) {
sl@0: 	case COMMAND_CLICKS:	{		/* clicks */
sl@0: 	    int forceMilli = 0;
sl@0: 
sl@0: 	    if (objc == 3) {
sl@0: 		format = Tcl_GetStringFromObj(objv[2], &n);
sl@0: 		if ( ( n >= 2 ) 
sl@0: 		     && ( strncmp( format, "-milliseconds",
sl@0: 				   (unsigned int) n) == 0 ) ) {
sl@0: 		    forceMilli = 1;
sl@0: 		} else {
sl@0: 		    Tcl_AppendStringsToObj(resultPtr,
sl@0: 			    "bad switch \"", format,
sl@0: 			    "\": must be -milliseconds", (char *) NULL);
sl@0: 		    return TCL_ERROR;
sl@0: 		}
sl@0: 	    } else if (objc != 2) {
sl@0: 		Tcl_WrongNumArgs(interp, 2, objv, "?-milliseconds?");
sl@0: 		return TCL_ERROR;
sl@0: 	    }
sl@0: 	    if (forceMilli) {
sl@0: 		/*
sl@0: 		 * We can enforce at least millisecond granularity
sl@0: 		 */
sl@0: 		Tcl_Time time;
sl@0: 		Tcl_GetTime(&time);
sl@0: 		Tcl_SetLongObj(resultPtr,
sl@0: 			(long) (time.sec*1000 + time.usec/1000));
sl@0: 	    } else {
sl@0: 		Tcl_SetLongObj(resultPtr, (long) TclpGetClicks());
sl@0: 	    }
sl@0: 	    return TCL_OK;
sl@0: 	}
sl@0: 
sl@0: 	case COMMAND_FORMAT:			/* format */
sl@0: 	    if ((objc < 3) || (objc > 7)) {
sl@0: 		wrongFmtArgs:
sl@0: 		Tcl_WrongNumArgs(interp, 2, objv,
sl@0: 			"clockval ?-format string? ?-gmt boolean?");
sl@0: 		return TCL_ERROR;
sl@0: 	    }
sl@0: 
sl@0: 	    if (Tcl_GetWideIntFromObj(interp, objv[2], &clockVal)
sl@0: 		    != TCL_OK) {
sl@0: 		return TCL_ERROR;
sl@0: 	    }
sl@0:     
sl@0: 	    objPtr = objv+3;
sl@0: 	    objc -= 3;
sl@0: 	    while (objc > 1) {
sl@0: 		if (Tcl_GetIndexFromObj(interp, objPtr[0], formatSwitches,
sl@0: 			"switch", 0, &index) != TCL_OK) {
sl@0: 		    return TCL_ERROR;
sl@0: 		}
sl@0: 		switch (index) {
sl@0: 		    case 0:		/* -format */
sl@0: 			format = Tcl_GetStringFromObj(objPtr[1], &dummy);
sl@0: 			break;
sl@0: 		    case 1:		/* -gmt */
sl@0: 			if (Tcl_GetBooleanFromObj(interp, objPtr[1],
sl@0: 				&useGMT) != TCL_OK) {
sl@0: 			    return TCL_ERROR;
sl@0: 			}
sl@0: 			break;
sl@0: 		}
sl@0: 		objPtr += 2;
sl@0: 		objc -= 2;
sl@0: 	    }
sl@0: 	    if (objc != 0) {
sl@0: 		goto wrongFmtArgs;
sl@0: 	    }
sl@0: 	    return FormatClock(interp, clockVal, useGMT,
sl@0: 		    format);
sl@0: 
sl@0: 	case COMMAND_SCAN:			/* scan */
sl@0: 	    if ((objc < 3) || (objc > 7)) {
sl@0: 		wrongScanArgs:
sl@0: 		Tcl_WrongNumArgs(interp, 2, objv,
sl@0: 			"dateString ?-base clockValue? ?-gmt boolean?");
sl@0: 		return TCL_ERROR;
sl@0: 	    }
sl@0: 
sl@0: 	    objPtr = objv+3;
sl@0: 	    objc -= 3;
sl@0: 	    while (objc > 1) {
sl@0: 		if (Tcl_GetIndexFromObj(interp, objPtr[0], scanSwitches,
sl@0: 			"switch", 0, &index) != TCL_OK) {
sl@0: 		    return TCL_ERROR;
sl@0: 		}
sl@0: 		switch (index) {
sl@0: 		    case 0:		/* -base */
sl@0: 			baseObjPtr = objPtr[1];
sl@0: 			break;
sl@0: 		    case 1:		/* -gmt */
sl@0: 			if (Tcl_GetBooleanFromObj(interp, objPtr[1],
sl@0: 				&useGMT) != TCL_OK) {
sl@0: 			    return TCL_ERROR;
sl@0: 			}
sl@0: 			break;
sl@0: 		}
sl@0: 		objPtr += 2;
sl@0: 		objc -= 2;
sl@0: 	    }
sl@0: 	    if (objc != 0) {
sl@0: 		goto wrongScanArgs;
sl@0: 	    }
sl@0: 
sl@0: 	    if (baseObjPtr != NULL) {
sl@0: 		if (Tcl_GetWideIntFromObj(interp, baseObjPtr,
sl@0: 					  &baseClock) != TCL_OK) {
sl@0: 		    return TCL_ERROR;
sl@0: 		}
sl@0: 	    } else {
sl@0: 		baseClock = TclpGetSeconds();
sl@0: 	    }
sl@0: 
sl@0: 	    if (useGMT) {
sl@0: 		zone = -50000; /* Force GMT */
sl@0: 	    } else {
sl@0: 		zone = TclpGetTimeZone(baseClock);
sl@0: 	    }
sl@0: 
sl@0: 	    scanStr = Tcl_GetStringFromObj(objv[2], &dummy);
sl@0: 	    Tcl_MutexLock(&clockMutex);
sl@0: 	    if (TclGetDate(scanStr, baseClock, zone,
sl@0: 		    &clockVal) < 0) {
sl@0: 		Tcl_MutexUnlock(&clockMutex);
sl@0: 		Tcl_AppendStringsToObj(resultPtr,
sl@0: 			"unable to convert date-time string \"",
sl@0: 			scanStr, "\"", (char *) NULL);
sl@0: 		return TCL_ERROR;
sl@0: 	    }
sl@0: 	    Tcl_MutexUnlock(&clockMutex);
sl@0: 
sl@0: 	    Tcl_SetWideIntObj(resultPtr, clockVal);
sl@0: 	    return TCL_OK;
sl@0: 
sl@0: 	case COMMAND_SECONDS:			/* seconds */
sl@0: 	    if (objc != 2) {
sl@0: 		Tcl_WrongNumArgs(interp, 2, objv, NULL);
sl@0: 		return TCL_ERROR;
sl@0: 	    }
sl@0: 	    Tcl_SetLongObj(resultPtr, (long) TclpGetSeconds());
sl@0: 	    return TCL_OK;
sl@0: 	default:
sl@0: 	    return TCL_ERROR;	/* Should never be reached. */
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *-----------------------------------------------------------------------------
sl@0:  *
sl@0:  * FormatClock --
sl@0:  *
sl@0:  *      Formats a time value based on seconds into a human readable
sl@0:  *	string.
sl@0:  *
sl@0:  * Results:
sl@0:  *      Standard Tcl result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *      None.
sl@0:  *
sl@0:  *-----------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: FormatClock(interp, clockVal, useGMT, format)
sl@0:     Tcl_Interp *interp;			/* Current interpreter. */
sl@0:     Tcl_WideInt clockVal;	       	/* Time in seconds. */
sl@0:     int useGMT;				/* Boolean */
sl@0:     char *format;			/* Format string */
sl@0: {
sl@0:     struct tm *timeDataPtr;
sl@0:     Tcl_DString buffer, uniBuffer;
sl@0:     int bufSize;
sl@0:     char *p;
sl@0:     int result;
sl@0:     time_t tclockVal;
sl@0: #if !defined(HAVE_TM_ZONE) && !defined(WIN32)
sl@0:     TIMEZONE_t savedTimeZone = 0;	/* lint. */
sl@0:     char *savedTZEnv = NULL;		/* lint. */
sl@0: #endif
sl@0: 
sl@0: #ifdef HAVE_TZSET
sl@0:     /*
sl@0:      * Some systems forgot to call tzset in localtime, make sure its done.
sl@0:      */
sl@0:     static int  calledTzset = 0;
sl@0: 
sl@0:     Tcl_MutexLock(&clockMutex);
sl@0:     if (!calledTzset) {
sl@0:         tzset();
sl@0:         calledTzset = 1;
sl@0:     }
sl@0:     Tcl_MutexUnlock(&clockMutex);
sl@0: #endif
sl@0: 
sl@0:     /*
sl@0:      * If the user gave us -format "", just return now
sl@0:      */
sl@0:     if (*format == '\0') {
sl@0: 	return TCL_OK;
sl@0:     }
sl@0: 
sl@0: #if !defined(HAVE_TM_ZONE) && !defined(WIN32)
sl@0:     /*
sl@0:      * This is a kludge for systems not having the timezone string in
sl@0:      * struct tm.  No matter what was specified, they use the local
sl@0:      * timezone string.  Since this kludge requires fiddling with the
sl@0:      * TZ environment variable, it will mess up if done on multiple
sl@0:      * threads at once.  Protect it with a the clock mutex.
sl@0:      */
sl@0: 
sl@0:     Tcl_MutexLock( &clockMutex );
sl@0:     if (useGMT) {
sl@0:         CONST char *varValue;
sl@0: 
sl@0:         varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
sl@0:         if (varValue != NULL) {
sl@0: 	    savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue);
sl@0:         } else {
sl@0:             savedTZEnv = NULL;
sl@0: 	}
sl@0:         Tcl_SetVar2(interp, "env", "TZ", "GMT0", TCL_GLOBAL_ONLY);
sl@0:         savedTimeZone = timezone;
sl@0:         timezone = 0;
sl@0:         tzset();
sl@0:     }
sl@0: #endif
sl@0: 
sl@0:     tclockVal = (time_t) clockVal;
sl@0:     timeDataPtr = TclpGetDate((TclpTime_t) &tclockVal, useGMT);
sl@0:     
sl@0:     /*
sl@0:      * Make a guess at the upper limit on the substituted string size
sl@0:      * based on the number of percents in the string.
sl@0:      */
sl@0: 
sl@0:     for (bufSize = 1, p = format; *p != '\0'; p++) {
sl@0: 	if (*p == '%') {
sl@0: 	    bufSize += 40;
sl@0: 	} else {
sl@0: 	    bufSize++;
sl@0: 	}
sl@0:     }
sl@0:     Tcl_DStringInit(&uniBuffer);
sl@0:     Tcl_UtfToExternalDString(NULL, format, -1, &uniBuffer);
sl@0:     Tcl_DStringInit(&buffer);
sl@0:     Tcl_DStringSetLength(&buffer, bufSize);
sl@0: 
sl@0:     /* If we haven't locked the clock mutex up above, lock it now. */
sl@0: 
sl@0: #if defined(HAVE_TM_ZONE) || defined(WIN32)
sl@0:     Tcl_MutexLock(&clockMutex);
sl@0: #endif
sl@0:     result = TclpStrftime(buffer.string, (unsigned int) bufSize,
sl@0: 	    Tcl_DStringValue(&uniBuffer), timeDataPtr, useGMT);
sl@0: #if defined(HAVE_TM_ZONE) || defined(WIN32)
sl@0:     Tcl_MutexUnlock(&clockMutex);
sl@0: #endif
sl@0:     Tcl_DStringFree(&uniBuffer);
sl@0: 
sl@0: #if !defined(HAVE_TM_ZONE) && !defined(WIN32)
sl@0:     if (useGMT) {
sl@0:         if (savedTZEnv != NULL) {
sl@0:             Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY);
sl@0:             ckfree(savedTZEnv);
sl@0:         } else {
sl@0:             Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
sl@0:         }
sl@0:         timezone = savedTimeZone;
sl@0:         tzset();
sl@0:     }
sl@0:     Tcl_MutexUnlock( &clockMutex );
sl@0: #endif
sl@0: 
sl@0:     if (result == 0) {
sl@0: 	/*
sl@0: 	 * A zero return is the error case (can also mean the strftime
sl@0: 	 * didn't get enough space to write into).  We know it doesn't
sl@0: 	 * mean that we wrote zero chars because the check for an empty
sl@0: 	 * format string is above.
sl@0: 	 */
sl@0: 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
sl@0: 		"bad format string \"", format, "\"", (char *) NULL);
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Convert the time to UTF from external encoding [Bug: 3345]
sl@0:      */
sl@0:     Tcl_DStringInit(&uniBuffer);
sl@0:     Tcl_ExternalToUtfDString(NULL, buffer.string, -1, &uniBuffer);
sl@0: 
sl@0:     Tcl_SetStringObj(Tcl_GetObjResult(interp), uniBuffer.string, -1);
sl@0: 
sl@0:     Tcl_DStringFree(&uniBuffer);
sl@0:     Tcl_DStringFree(&buffer);
sl@0:     return TCL_OK;
sl@0: }
sl@0: