On Wed, 18 Jul 2001, Tom Lane wrote:
> Reinhard Max <[EMAIL PROTECTED]> writes:
> > On Wed, 18 Jul 2001, Bruce Momjian wrote:
> >> Do you have any idea how this will work with earlier TCL versions?
>
> > It won't. If pgtcl is supposed to still be able to compile with older
> > versions of Tcl, the changes have to be made a compile time option.
>
> Please do that and resubmit the patch.
Here it is, but I consider it still incomplete and I have not done
exhaustive testing. Some more occurrences of PQexec and PQgetvalue
need to be wrapped up with UTF8 conversion, but I'll not have the time
to do it for the next 1-2 weeks.
cu
Reinhard
--- pgtclCmds.c.orig Thu Jul 19 10:08:27 2001
+++ pgtclCmds.c Thu Jul 19 13:33:06 2001
@@ -439,6 +439,9 @@
Pg_ConnectionId *connid;
PGconn *conn;
PGresult *result;
+#ifdef TCL_UTF8
+ Tcl_DString putString;
+#endif
if (argc != 3)
{
@@ -456,8 +459,13 @@
Tcl_SetResult(interp, "Attempt to query while COPY in progress",
TCL_STATIC);
return TCL_ERROR;
}
-
+#ifdef TCL_UTF8
+ Tcl_UtfToExternalDString(NULL, argv[2], -1, &putString);
+ result = PQexec(conn, Tcl_DStringValue(&putString));
+ Tcl_DStringFree(&putString);
+#else
result = PQexec(conn, argv[2]);
+#endif /* TCL_UTF8 */
/* Transfer any notify events from libpq to Tcl event queue. */
PgNotifyTransferEvents(connid);
@@ -543,6 +551,9 @@
char *arrVar;
char nameBuffer[256];
const char *appendstr;
+#ifdef TCL_UTF8
+ Tcl_DString retString;
+#endif
if (argc < 3 || argc > 5)
{
@@ -693,10 +704,27 @@
}
#ifdef TCL_ARRAYS
for (i = 0; i < PQnfields(result); i++)
- Tcl_AppendElement(interp, tcl_value(PQgetvalue(result, tupno,
i)));
+#ifdef TCL_UTF8
+ {
+ Tcl_ExternalToUtfDString(NULL,
+tcl_value(PQgetvalue(result,tupno, i)), -1, &retString);
+ Tcl_AppendElement(interp, Tcl_DStringValue(&retString));
+ }
#else
+ Tcl_AppendElement(interp, tcl_value(PQgetvalue(result, tupno,
+i)));
+#endif /* TCL_UTF8 */
+#else /* TCL_ARRAYS */
for (i = 0; i < PQnfields(result); i++)
+#ifdef TCL_UTF8
+ {
+ Tcl_ExternalToUtfDString(NULL, PQgetvalue(result, tupno, i),
+-1, &retString);
+ Tcl_AppendElement(interp, Tcl_DStringValue(&retString));
+ }
+#else
Tcl_AppendElement(interp, PQgetvalue(result, tupno, i));
+#endif /* TCL_UTF8 */
+#endif /* TCL_ARRAYS */
+#ifdef TCL_UTF8
+ Tcl_DStringFree(&retString);
#endif
return TCL_OK;
}
@@ -715,6 +743,20 @@
}
for (i = 0; i < PQnfields(result); i++)
{
+#ifdef TCL_UTF8
+ Tcl_ExternalToUtfDString(NULL,
+#ifdef TCL_ARRAYS
+ tcl_value(PQgetvalue(result,tupno, i)),
+#else
+ PQgetvalue(result, tupno, i),
+#endif /* TCL_ARRAYS */
+ -1, &retString);
+ if (Tcl_SetVar2(interp, argv[4], PQfname(result, i),
+ Tcl_DStringValue(&retString),
+ TCL_LEAVE_ERR_MSG) == NULL)
+ {
+ Tcl_DStringFree(&retString);
+#else /* ndef TCL_UTF8 */
if (Tcl_SetVar2(interp, argv[4], PQfname(result, i),
#ifdef TCL_ARRAYS
tcl_value(PQgetvalue(result,
tupno, i)),
@@ -722,14 +764,28 @@
PQgetvalue(result, tupno, i),
#endif
TCL_LEAVE_ERR_MSG) == NULL)
+ {
+#endif /* TCL_UTF8 */
return TCL_ERROR;
+ }
}
+#ifdef TCL_UTF8
+ Tcl_DStringFree(&retString);
+#endif
return TCL_OK;
}
else if (strcmp(opt, "-attributes") == 0)
{
for (i = 0; i < PQnfields(result); i++)
+#ifdef TCL_UTF8
+ {
+ Tcl_ExternalToUtfDString(NULL, PQfname(result, i), -1,
+&retString);
+ Tcl_AppendElement(interp, Tcl_DStringValue(&retString));
+ Tcl_DStringFree(&retString);
+ }
+#else
Tcl_AppendElement(interp, PQfname(result, i));
+#endif
return TCL_OK;
}
else if (strcmp(opt, "-lAttributes") == 0)
@@ -806,6 +862,9 @@
char *oid_varname = NULL;
char *array_varname = NULL;
char buf[64];
+#ifdef TCL_UTF8
+ Tcl_DString dString;
+#endif
char *usage = "Wrong # of arguments\n"
"pg_execute ?-array arrayname? ?-oid varname? "
@@ -882,7 +941,12 @@
/*
* Execute the query
*/
+#ifdef TCL_UTF8
+ result = PQexec(conn, Tcl_UtfToExternalDString(NULL, argv[i++], -1,
+&dString));
+ Tcl_DStringFree(&dString);
+#else
result = PQexec(conn, argv[i++]);
+#endif
/*
* Transfer any notify events from libpq to Tcl event queue.
@@ -1022,6 +1086,9 @@
int n;
char *fname;
char *value;
+#ifdef TCL_UTF8
+ Tcl_DString dString;
+#endif
/*
* For each column get the column name and value and put it into a Tcl
@@ -1031,19 +1098,36 @@
for (i = 0; i < n; i++)
{
fname = PQfname(result, i);
+#ifdef TCL_UTF8
+ value = Tcl_ExternalToUtfDString(NULL, PQgetvalue(result, tupno, i),
+-1, &dString);
+#else
value = PQgetvalue(result, tupno, i);
+#endif
if (array_varname != NULL)
{
if (Tcl_SetVar2(interp, array_varname, fname, value,
TCL_LEAVE_ERR_MSG) == NULL)
+ {
+#ifdef TCL_UTF8
+ Tcl_DStringFree(&dString);
+#endif
return TCL_ERROR;
+ }
}
else
{
if (Tcl_SetVar(interp, fname, value, TCL_LEAVE_ERR_MSG) ==
NULL)
+ {
+#ifdef TCL_UTF8
+ Tcl_DStringFree(&dString);
+#endif
return TCL_ERROR;
+ }
}
+#ifdef TCL_UTF8
+ Tcl_DStringFree(&dString);
+#endif
}
return TCL_OK;
@@ -1658,6 +1742,10 @@
column,
ncols;
Tcl_DString headers;
+#ifdef TCL_UTF8
+ Tcl_DString retString;
+ Tcl_DString putString;
+#endif
char buffer[2048];
struct info_s
{
@@ -1676,7 +1764,15 @@
if (conn == (PGconn *) NULL)
return TCL_ERROR;
+#ifdef TCL_UTF8
+ Tcl_UtfToExternalDString(NULL, argv[2], -1, &putString);
+ result = PQexec(conn, Tcl_DStringValue(&putString));
+ Tcl_DStringFree(&putString);
+
+ if (result == 0)
+#else
if ((result = PQexec(conn, argv[2])) == 0)
+#endif
{
/* error occurred sending the query */
Tcl_SetResult(interp, PQerrorMessage(conn), TCL_VOLATILE);
@@ -1724,6 +1820,19 @@
Tcl_SetVar2(interp, argv[3], ".tupno", buffer, 0);
for (column = 0; column < ncols; column++)
+#ifdef TCL_UTF8
+ {
+ Tcl_ExternalToUtfDString(NULL,
+#ifdef TCL_ARRAYS
+ tcl_value(PQgetvalue(result, tupno, column)),
+#else
+ PQgetvalue(result, tupno, column),
+#endif /* TCL_ARRAYS */
+ -1, &retString);
+ Tcl_SetVar2(interp, argv[3], info[column].cname,
+Tcl_DStringValue(&retString), 0);
+ Tcl_DStringFree(&retString);
+ }
+#else /* ndef TCL_UTF8 */
Tcl_SetVar2(interp, argv[3], info[column].cname,
#ifdef TCL_ARRAYS
tcl_value(PQgetvalue(result, tupno,
column)),
@@ -1731,7 +1840,7 @@
PQgetvalue(result, tupno, column),
#endif
0);
-
+#endif /* TCL_UTF8 */
Tcl_SetVar2(interp, argv[3], ".command", "update", 0);
if ((r = Tcl_Eval(interp, argv[4])) != TCL_OK && r != TCL_CONTINUE)
--- pgtclCmds.h.orig Thu Jul 19 11:31:00 2001
+++ pgtclCmds.h Thu Jul 19 11:34:40 2001
@@ -20,14 +20,24 @@
#define RES_HARD_MAX 128
#define RES_START 16
+#ifdef TCL_MAJOR_VERSION
+
/*
* From Tcl verion 8.0 on we can make large object access binary.
*/
-#ifdef TCL_MAJOR_VERSION
#if (TCL_MAJOR_VERSION >= 8)
#define PGTCL_USE_TCLOBJ
#endif
+
+
+/*
+ * Tcl >= 8.1 uses UTF8 encoding for internal string representation.
+ */
+#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0) || TCL_MAJOR_VERSION > 8
+#define TCL_UTF8
#endif
+
+#endif /* TCL_MAJOR_VERSION */
/*
* Each Pg_ConnectionId has a list of Pg_TclNotifies structs, one for each
---------------------------(end of broadcast)---------------------------
TIP 3: if posting/reading through Usenet, please send an appropriate
subscribe-nomail command to [EMAIL PROTECTED] so that your
message can get through to the mailing list cleanly
