/* 

  * 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.

  *

  * RCS: @(#) $Id: tclClock.c,v 1.20.2.3 2007/04/21 22:42:49 kennykb Exp $

  */

 #include "tcl.h"

 #include "tclInt.h"

 #include "tclPort.h"

 /*

  * The date parsing stuff uses lexx and has tons o statics.

  */

 TCL_DECLARE_MUTEX(clockMutex)

 /*

  * Function prototypes for local procedures in this file:

  */

 static int		FormatClock _ANSI_ARGS_((Tcl_Interp *interp,

 			    Tcl_WideInt clockVal, int useGMT,

 			    char *format));

 /*

  *-------------------------------------------------------------------------

  *

  * Tcl_ClockObjCmd --

  *

  *	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_ClockObjCmd (client, interp, objc, objv)

     ClientData client;			/* Not used. */

     Tcl_Interp *interp;			/* Current interpreter. */

     int objc;				/* Number of arguments. */

     Tcl_Obj *CONST objv[];		/* Argument values. */

 {

     Tcl_Obj *resultPtr;

     int index;

     Tcl_Obj *CONST *objPtr;

     int useGMT = 0;

     char *format = "%a %b %d %X %Z %Y";

     int dummy;

     Tcl_WideInt baseClock, clockVal;

     long zone;

     Tcl_Obj *baseObjPtr = NULL;

     char *scanStr;

     int n;

     static CONST char *switches[] =

 	{"clicks", "format", "scan", "seconds", (char *) NULL};

     enum command { COMMAND_CLICKS, COMMAND_FORMAT, COMMAND_SCAN,

 		       COMMAND_SECONDS

     };

     static CONST char *formatSwitches[] = {"-format", "-gmt", (char *) NULL};

     static CONST char *scanSwitches[] = {"-base", "-gmt", (char *) NULL};

     resultPtr = Tcl_GetObjResult(interp);

     if (objc < 2) {

 	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");

 	return TCL_ERROR;

     }

     if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)

 	    != TCL_OK) {

 	return TCL_ERROR;

     }

     switch ((enum command) index) {

 	case COMMAND_CLICKS:	{		/* clicks */

 	    int forceMilli = 0;

 	    if (objc == 3) {

 		format = Tcl_GetStringFromObj(objv[2], &n);

 		if ( ( n >= 2 ) 

 		     && ( strncmp( format, "-milliseconds",

 				   (unsigned int) n) == 0 ) ) {

 		    forceMilli = 1;

 		} else {

 		    Tcl_AppendStringsToObj(resultPtr,

 			    "bad switch \"", format,

 			    "\": must be -milliseconds", (char *) NULL);

 		    return TCL_ERROR;

 		}

 	    } else if (objc != 2) {

 		Tcl_WrongNumArgs(interp, 2, objv, "?-milliseconds?");

 		return TCL_ERROR;

 	    }

 	    if (forceMilli) {

 		/*

 		 * We can enforce at least millisecond granularity

 		 */

 		Tcl_Time time;

 		Tcl_GetTime(&time);

 		Tcl_SetLongObj(resultPtr,

 			(long) (time.sec*1000 + time.usec/1000));

 	    } else {

 		Tcl_SetLongObj(resultPtr, (long) TclpGetClicks());

 	    }

 	    return TCL_OK;

 	}

 	case COMMAND_FORMAT:			/* format */

 	    if ((objc < 3) || (objc > 7)) {

 		wrongFmtArgs:

 		Tcl_WrongNumArgs(interp, 2, objv,

 			"clockval ?-format string? ?-gmt boolean?");

 		return TCL_ERROR;

 	    }

 	    if (Tcl_GetWideIntFromObj(interp, objv[2], &clockVal)

 		    != TCL_OK) {

 		return TCL_ERROR;

 	    }

 	    objPtr = objv+3;

 	    objc -= 3;

 	    while (objc > 1) {

 		if (Tcl_GetIndexFromObj(interp, objPtr[0], formatSwitches,

 			"switch", 0, &index) != TCL_OK) {

 		    return TCL_ERROR;

 		}

 		switch (index) {

 		    case 0:		/* -format */

 			format = Tcl_GetStringFromObj(objPtr[1], &dummy);

 			break;

 		    case 1:		/* -gmt */

 			if (Tcl_GetBooleanFromObj(interp, objPtr[1],

 				&useGMT) != TCL_OK) {

 			    return TCL_ERROR;

 			}

 			break;

 		}

 		objPtr += 2;

 		objc -= 2;

 	    }

 	    if (objc != 0) {

 		goto wrongFmtArgs;

 	    }

 	    return FormatClock(interp, clockVal, useGMT,

 		    format);

 	case COMMAND_SCAN:			/* scan */

 	    if ((objc < 3) || (objc > 7)) {

 		wrongScanArgs:

 		Tcl_WrongNumArgs(interp, 2, objv,

 			"dateString ?-base clockValue? ?-gmt boolean?");

 		return TCL_ERROR;

 	    }

 	    objPtr = objv+3;

 	    objc -= 3;

 	    while (objc > 1) {

 		if (Tcl_GetIndexFromObj(interp, objPtr[0], scanSwitches,

 			"switch", 0, &index) != TCL_OK) {

 		    return TCL_ERROR;

 		}

 		switch (index) {

 		    case 0:		/* -base */

 			baseObjPtr = objPtr[1];

 			break;

 		    case 1:		/* -gmt */

 			if (Tcl_GetBooleanFromObj(interp, objPtr[1],

 				&useGMT) != TCL_OK) {

 			    return TCL_ERROR;

 			}

 			break;

 		}

 		objPtr += 2;

 		objc -= 2;

 	    }

 	    if (objc != 0) {

 		goto wrongScanArgs;

 	    }

 	    if (baseObjPtr != NULL) {

 		if (Tcl_GetWideIntFromObj(interp, baseObjPtr,

 					  &baseClock) != TCL_OK) {

 		    return TCL_ERROR;

 		}

 	    } else {

 		baseClock = TclpGetSeconds();

 	    }

 	    if (useGMT) {

 		zone = -50000; /* Force GMT */

 	    } else {

 		zone = TclpGetTimeZone(baseClock);

 	    }

 	    scanStr = Tcl_GetStringFromObj(objv[2], &dummy);

 	    Tcl_MutexLock(&clockMutex);

 	    if (TclGetDate(scanStr, baseClock, zone,

 		    &clockVal) < 0) {

 		Tcl_MutexUnlock(&clockMutex);

 		Tcl_AppendStringsToObj(resultPtr,

 			"unable to convert date-time string \"",

 			scanStr, "\"", (char *) NULL);

 		return TCL_ERROR;

 	    }

 	    Tcl_MutexUnlock(&clockMutex);

 	    Tcl_SetWideIntObj(resultPtr, clockVal);

 	    return TCL_OK;

 	case COMMAND_SECONDS:			/* seconds */

 	    if (objc != 2) {

 		Tcl_WrongNumArgs(interp, 2, objv, NULL);

 		return TCL_ERROR;

 	    }

 	    Tcl_SetLongObj(resultPtr, (long) TclpGetSeconds());

 	    return TCL_OK;

 	default:

 	    return TCL_ERROR;	/* Should never be reached. */

     }

 }

 /*

  *-----------------------------------------------------------------------------

  *

  * 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. */

     Tcl_WideInt clockVal;	       	/* Time in seconds. */

     int useGMT;				/* Boolean */

     char *format;			/* Format string */

 {

     struct tm *timeDataPtr;

     Tcl_DString buffer, uniBuffer;

     int bufSize;

     char *p;

     int result;

     time_t tclockVal;

 #if !defined(HAVE_TM_ZONE) && !defined(WIN32)

     TIMEZONE_t savedTimeZone = 0;	/* lint. */

     char *savedTZEnv = NULL;		/* lint. */

 #endif

 #ifdef HAVE_TZSET

     /*

      * Some systems forgot to call tzset in localtime, make sure its done.

      */

     static int  calledTzset = 0;

     Tcl_MutexLock(&clockMutex);

     if (!calledTzset) {

         tzset();

         calledTzset = 1;

     }

     Tcl_MutexUnlock(&clockMutex);

 #endif

     /*

      * If the user gave us -format "", just return now

      */

     if (*format == '\0') {

 	return TCL_OK;

     }

 #if !defined(HAVE_TM_ZONE) && !defined(WIN32)

     /*

      * This is a kludge for systems not having the timezone string in

      * struct tm.  No matter what was specified, they use the local

      * timezone string.  Since this kludge requires fiddling with the

      * TZ environment variable, it will mess up if done on multiple

      * threads at once.  Protect it with a the clock mutex.

      */

     Tcl_MutexLock( &clockMutex );

     if (useGMT) {

         CONST 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", "GMT0", TCL_GLOBAL_ONLY);

         savedTimeZone = timezone;

         timezone = 0;

         tzset();

     }

 #endif

     tclockVal = (time_t) clockVal;

     timeDataPtr = TclpGetDate((TclpTime_t) &tclockVal, useGMT);

     /*

      * Make a guess at the upper limit on the substituted string size

      * based on the number of percents in the string.

      */

     for (bufSize = 1, p = format; *p != '\0'; p++) {

 	if (*p == '%') {

 	    bufSize += 40;

 	} else {

 	    bufSize++;

 	}

     }

     Tcl_DStringInit(&uniBuffer);

     Tcl_UtfToExternalDString(NULL, format, -1, &uniBuffer);

     Tcl_DStringInit(&buffer);

     Tcl_DStringSetLength(&buffer, bufSize);

     /* If we haven't locked the clock mutex up above, lock it now. */

 #if defined(HAVE_TM_ZONE) || defined(WIN32)

     Tcl_MutexLock(&clockMutex);

 #endif

     result = TclpStrftime(buffer.string, (unsigned int) bufSize,

 	    Tcl_DStringValue(&uniBuffer), timeDataPtr, useGMT);

 #if defined(HAVE_TM_ZONE) || defined(WIN32)

     Tcl_MutexUnlock(&clockMutex);

 #endif

     Tcl_DStringFree(&uniBuffer);

 #if !defined(HAVE_TM_ZONE) && !defined(WIN32)

     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();

     }

     Tcl_MutexUnlock( &clockMutex );

 #endif

     if (result == 0) {

 	/*

 	 * A zero return is the error case (can also mean the strftime

 	 * didn't get enough space to write into).  We know it doesn't

 	 * mean that we wrote zero chars because the check for an empty

 	 * format string is above.

 	 */

 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		"bad format string \"", format, "\"", (char *) NULL);

 	return TCL_ERROR;

     }

     /*

      * Convert the time to UTF from external encoding [Bug: 3345]

      */

     Tcl_DStringInit(&uniBuffer);

     Tcl_ExternalToUtfDString(NULL, buffer.string, -1, &uniBuffer);

     Tcl_SetStringObj(Tcl_GetObjResult(interp), uniBuffer.string, -1);

     Tcl_DStringFree(&uniBuffer);

     Tcl_DStringFree(&buffer);

     return TCL_OK;

 }