summaryrefslogtreecommitdiffstats
path: root/generic/tclClock.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclClock.c')
-rw-r--r--generic/tclClock.c194
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 */