diff options
Diffstat (limited to 'generic/tclClock.c')
| -rw-r--r-- | generic/tclClock.c | 194 |
1 files changed, 191 insertions, 3 deletions
diff --git a/generic/tclClock.c b/generic/tclClock.c index 340a06c..a29de78 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -12,7 +12,7 @@ * 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.46 2005/11/30 15:39:37 kennykb Exp $ + * RCS: @(#) $Id: tclClock.c,v 1.47 2005/11/30 19:34:13 kennykb Exp $ */ #include "tclInt.h" @@ -112,6 +112,7 @@ typedef struct TclDateFields { int dayOfWeek; /* Day of the week */ } TclDateFields; +static CONST char* eras[] = { "CE", "BCE", NULL }; /* * Thread specific data block holding a 'struct tm' for the 'gmtime' and @@ -161,6 +162,12 @@ static int ClockConvertlocaltoutcObjCmd( static int ClockGetdatefieldsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); +static int ClockGetjuliandayfromerayearmonthdayObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int ClockGetjuliandayfromerayearweekdayObjCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); static int ClockGetenvObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); @@ -240,6 +247,16 @@ TclClockInit( ClockGetdatefieldsObjCmd,(ClientData) data, ClockDeleteCmdProc); ++data->refCount; + Tcl_CreateObjCommand(interp, + "::tcl::clock::GetJulianDayFromEraYearMonthDay", + ClockGetjuliandayfromerayearmonthdayObjCmd,(ClientData) data, + ClockDeleteCmdProc); + ++data->refCount; + Tcl_CreateObjCommand(interp, + "::tcl::clock::GetJulianDayFromEraYearWeekDay", + ClockGetjuliandayfromerayearweekdayObjCmd,(ClientData) data, + ClockDeleteCmdProc); + ++data->refCount; } @@ -432,6 +449,170 @@ ClockGetdatefieldsObjCmd( /* *---------------------------------------------------------------------- * + * ClockGetjuliandayfromerayearmonthdayObjCmd -- + * + * Tcl command that converts a time from era-year-month-day to + * a Julian Day Number. + * + * Parameters: + * dict - Dictionary that contains 'era', 'year', 'month' and + * 'dayOfMonth' keys. + * changeover - Julian Day of changeover to the Gregorian calendar + * + * Results: + * Result is either TCL_OK, with the interpreter result being the + * dictionary augmented with a 'julianDay' key, or TCL_ERROR, + * with the result being an error message. + * + *---------------------------------------------------------------------- + */ + +static int +ClockGetjuliandayfromerayearmonthdayObjCmd ( + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *CONST *objv /* Parameter vector */ +) { + TclDateFields fields; + Tcl_Obj* dict; + ClockClientData* data = (ClockClientData*) clientData; + Tcl_Obj* CONST * literals = data->literals; + Tcl_Obj* fieldPtr; + int changeover; + int copied = 0; + int status; + + /* Check params */ + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "dict changeover"); + return TCL_ERROR; + } + dict = objv[1]; + if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK + || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT, + &(fields.era)) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR], + &fieldPtr) != TCL_OK + || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.year)) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH], + &fieldPtr) != TCL_OK + || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.month)) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH], + &fieldPtr) != TCL_OK + || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.dayOfMonth)) != TCL_OK + || Tcl_GetIntFromObj(interp, objv[2], &changeover) != TCL_OK) { + return TCL_ERROR; + } + + /* Get Julian day */ + + GetJulianDayFromEraYearMonthDay(&fields, changeover); + + /* Store Julian day in the dictionary - copy on write */ + + if (Tcl_IsShared(dict)) { + dict = Tcl_DuplicateObj(dict); + Tcl_IncrRefCount(dict); + copied = 1; + } + status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY], + Tcl_NewIntObj(fields.julianDay)); + if (status == TCL_OK) { + Tcl_SetObjResult(interp, dict); + } + if (copied) { + Tcl_DecrRefCount(dict); + } + return status; +} + +/* + *---------------------------------------------------------------------- + * + * ClockGetjuliandayfromerayearweekdayObjCmd -- + * + * Tcl command that converts a time from the ISO calendar to + * a Julian Day Number. + * + * Parameters: + * dict - Dictionary that contains 'era', 'iso8601Year', 'iso8601Week' + * and 'dayOfWeek' keys. + * changeover - Julian Day of changeover to the Gregorian calendar + * + * Results: + * Result is either TCL_OK, with the interpreter result being the + * dictionary augmented with a 'julianDay' key, or TCL_ERROR, + * with the result being an error message. + * + *---------------------------------------------------------------------- + */ + +static int +ClockGetjuliandayfromerayearweekdayObjCmd ( + ClientData clientData, /* Opaque pointer to literal pool, etc. */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *CONST *objv /* Parameter vector */ +) { + TclDateFields fields; + Tcl_Obj* dict; + ClockClientData* data = (ClockClientData*) clientData; + Tcl_Obj* CONST * literals = data->literals; + Tcl_Obj* fieldPtr; + int changeover; + int copied = 0; + int status; + + /* Check params */ + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "dict changeover"); + return TCL_ERROR; + } + dict = objv[1]; + if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK + || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT, + &(fields.era)) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR], + &fieldPtr) != TCL_OK + || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.iso8601Year)) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK], + &fieldPtr) != TCL_OK + || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.iso8601Week)) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK], + &fieldPtr) != TCL_OK + || Tcl_GetIntFromObj(interp, fieldPtr, &(fields.dayOfWeek)) != TCL_OK + || Tcl_GetIntFromObj(interp, objv[2], &changeover) != TCL_OK) { + return TCL_ERROR; + } + + /* Get Julian day */ + + GetJulianDayFromEraYearWeekDay(&fields, changeover); + + /* Store Julian day in the dictionary - copy on write */ + + if (Tcl_IsShared(dict)) { + dict = Tcl_DuplicateObj(dict); + Tcl_IncrRefCount(dict); + copied = 1; + } + status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY], + Tcl_NewIntObj(fields.julianDay)); + if (status == TCL_OK) { + Tcl_SetObjResult(interp, dict); + } + if (copied) { + Tcl_DecrRefCount(dict); + } + return status; +} + +/* + *---------------------------------------------------------------------- + * * ConvertLocalToUTC -- * * Converts a time (in a TclDateFields structure) from the @@ -1137,6 +1318,7 @@ GetJulianDayFromEraYearMonthDay( ) { int year; int ym1; int month; int mm1; + int q; int r; if (fields->era == BCE) { year = 1 - fields->year; @@ -1148,8 +1330,14 @@ GetJulianDayFromEraYearMonthDay( month = fields->month; mm1 = month - 1; - year += mm1 / 12; - month = (mm1 % 12) + 1; + q = mm1 / 12; + r = (mm1 % 12); + if (r < 0) { + r += 12; + q -= 1; + } + year += q; + month = r + 1; ym1 = year - 1; /* Adjust the year after reducing the month */ |