/* 

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

}