diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c index 9eaf22b..06e7acd 100644 *** a/src/pl/tcl/pltcl.c --- b/src/pl/tcl/pltcl.c *************** static pltcl_proc_desc *compile_pltcl_fu *** 199,226 **** bool pltrusted); static int pltcl_elog(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]); static int pltcl_quote(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]); static int pltcl_argisnull(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]); static int pltcl_returnnull(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]); static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]); static int pltcl_process_SPI_result(Tcl_Interp * interp, CONST84 char *arrayname, ! CONST84 char *loop_body, int spi_rc, SPITupleTable * tuptable, int ntuples); static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]); static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]); static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]); static void pltcl_set_tuple_values(Tcl_Interp * interp, CONST84 char *arrayname, int tupno, HeapTuple tuple, TupleDesc tupdesc); --- 199,226 ---- bool pltrusted); static int pltcl_elog(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]); static int pltcl_quote(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]); static int pltcl_argisnull(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]); static int pltcl_returnnull(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]); static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]); static int pltcl_process_SPI_result(Tcl_Interp * interp, CONST84 char *arrayname, ! Tcl_Obj * loop_body, int spi_rc, SPITupleTable * tuptable, int ntuples); static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]); static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]); static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]); static void pltcl_set_tuple_values(Tcl_Interp * interp, CONST84 char *arrayname, int tupno, HeapTuple tuple, TupleDesc tupdesc); *************** pltcl_init_interp(pltcl_interp_desc * in *** 414,436 **** /************************************************************ * Install the commands for SPI support in the interpreter ************************************************************/ ! Tcl_CreateCommand(interp, "elog", ! pltcl_elog, NULL, NULL); ! Tcl_CreateCommand(interp, "quote", ! pltcl_quote, NULL, NULL); ! Tcl_CreateCommand(interp, "argisnull", ! pltcl_argisnull, NULL, NULL); ! Tcl_CreateCommand(interp, "return_null", ! pltcl_returnnull, NULL, NULL); ! Tcl_CreateCommand(interp, "spi_exec", ! pltcl_SPI_execute, NULL, NULL); ! Tcl_CreateCommand(interp, "spi_prepare", ! pltcl_SPI_prepare, NULL, NULL); ! Tcl_CreateCommand(interp, "spi_execp", ! pltcl_SPI_execute_plan, NULL, NULL); ! Tcl_CreateCommand(interp, "spi_lastoid", ! pltcl_SPI_lastoid, NULL, NULL); /************************************************************ * Try to load the unknown procedure from pltcl_modules --- 414,436 ---- /************************************************************ * Install the commands for SPI support in the interpreter ************************************************************/ ! Tcl_CreateObjCommand(interp, "elog", ! pltcl_elog, NULL, NULL); ! Tcl_CreateObjCommand(interp, "quote", ! pltcl_quote, NULL, NULL); ! Tcl_CreateObjCommand(interp, "argisnull", ! pltcl_argisnull, NULL, NULL); ! Tcl_CreateObjCommand(interp, "return_null", ! pltcl_returnnull, NULL, NULL); ! Tcl_CreateObjCommand(interp, "spi_exec", ! pltcl_SPI_execute, NULL, NULL); ! Tcl_CreateObjCommand(interp, "spi_prepare", ! pltcl_SPI_prepare, NULL, NULL); ! Tcl_CreateObjCommand(interp, "spi_execp", ! pltcl_SPI_execute_plan, NULL, NULL); ! Tcl_CreateObjCommand(interp, "spi_lastoid", ! pltcl_SPI_lastoid, NULL, NULL); /************************************************************ * Try to load the unknown procedure from pltcl_modules *************** compile_pltcl_function(Oid fn_oid, Oid t *** 1496,1533 **** **********************************************************************/ static int pltcl_elog(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]) { volatile int level; MemoryContext oldcontext; ! if (argc != 3) { ! Tcl_SetResult(interp, "syntax error - 'elog level msg'", TCL_STATIC); return TCL_ERROR; } ! if (strcmp(argv[1], "DEBUG") == 0) ! level = DEBUG2; ! else if (strcmp(argv[1], "LOG") == 0) ! level = LOG; ! else if (strcmp(argv[1], "INFO") == 0) ! level = INFO; ! else if (strcmp(argv[1], "NOTICE") == 0) ! level = NOTICE; ! else if (strcmp(argv[1], "WARNING") == 0) ! level = WARNING; ! else if (strcmp(argv[1], "ERROR") == 0) ! level = ERROR; ! else if (strcmp(argv[1], "FATAL") == 0) ! level = FATAL; ! else { - Tcl_AppendResult(interp, "Unknown elog level '", argv[1], - "'", NULL); return TCL_ERROR; } if (level == ERROR) { /* --- 1496,1561 ---- **********************************************************************/ static int pltcl_elog(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]) { volatile int level; MemoryContext oldcontext; + int priIndex; ! enum logpriority { ! LOG_DEBUG, LOG_LOG, LOG_INFO, LOG_NOTICE, ! LOG_WARNING, LOG_ERROR, LOG_FATAL ! }; ! ! static CONST84 char *logpriorities[] = { ! "DEBUG", "LOG", "INFO", "NOTICE", ! "WARNING", "ERROR", "FATAL", (char *) NULL ! }; ! ! if (objc != 3) ! { ! Tcl_WrongNumArgs(interp, 1, objv, "level msg"); return TCL_ERROR; } ! if (Tcl_GetIndexFromObj(interp, objv[1], logpriorities, "priority", ! TCL_EXACT, &priIndex) != TCL_OK) { return TCL_ERROR; } + switch ((enum logpriority) priIndex) + { + case LOG_DEBUG: + level = DEBUG2; + break; + + case LOG_LOG: + level = LOG; + break; + + case LOG_INFO: + level = INFO; + break; + + case LOG_NOTICE: + level = NOTICE; + break; + + case LOG_WARNING: + level = WARNING; + break; + + case LOG_ERROR: + level = ERROR; + break; + + case LOG_FATAL: + level = FATAL; + break; + } + if (level == ERROR) { /* *************** pltcl_elog(ClientData cdata, Tcl_Interp *** 1535,1541 **** * eventually get converted to a PG error when we reach the call * handler. */ ! Tcl_SetResult(interp, (char *) argv[2], TCL_VOLATILE); return TCL_ERROR; } --- 1563,1569 ---- * eventually get converted to a PG error when we reach the call * handler. */ ! Tcl_SetObjResult(interp, objv[2]); return TCL_ERROR; } *************** pltcl_elog(ClientData cdata, Tcl_Interp *** 1552,1558 **** PG_TRY(); { UTF_BEGIN; ! elog(level, "%s", UTF_U2E(argv[2])); UTF_END; } PG_CATCH(); --- 1580,1586 ---- PG_TRY(); { UTF_BEGIN; ! elog(level, "%s", UTF_U2E(Tcl_GetString(objv[2]))); UTF_END; } PG_CATCH(); *************** pltcl_elog(ClientData cdata, Tcl_Interp *** 1566,1572 **** /* Pass the error message to Tcl */ UTF_BEGIN; ! Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE); UTF_END; FreeErrorData(edata); --- 1594,1600 ---- /* Pass the error message to Tcl */ UTF_BEGIN; ! Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1)); UTF_END; FreeErrorData(edata); *************** pltcl_elog(ClientData cdata, Tcl_Interp *** 1584,1590 **** **********************************************************************/ static int pltcl_quote(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]) { char *tmp; const char *cp1; --- 1612,1618 ---- **********************************************************************/ static int pltcl_quote(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]) { char *tmp; const char *cp1; *************** pltcl_quote(ClientData cdata, Tcl_Interp *** 1593,1601 **** /************************************************************ * Check call syntax ************************************************************/ ! if (argc != 2) { ! Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_STATIC); return TCL_ERROR; } --- 1621,1629 ---- /************************************************************ * Check call syntax ************************************************************/ ! if (objc != 2) { ! Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } *************** pltcl_quote(ClientData cdata, Tcl_Interp *** 1603,1610 **** * Allocate space for the maximum the string can * grow to and initialize pointers ************************************************************/ ! tmp = palloc(strlen(argv[1]) * 2 + 1); ! cp1 = argv[1]; cp2 = tmp; /************************************************************ --- 1631,1638 ---- * Allocate space for the maximum the string can * grow to and initialize pointers ************************************************************/ ! tmp = palloc(strlen(Tcl_GetString(objv[1])) * 2 + 1); ! cp1 = Tcl_GetString(objv[1]); cp2 = tmp; /************************************************************ *************** pltcl_quote(ClientData cdata, Tcl_Interp *** 1626,1632 **** * Terminate the string and set it as result ************************************************************/ *cp2 = '\0'; ! Tcl_SetResult(interp, tmp, TCL_VOLATILE); pfree(tmp); return TCL_OK; } --- 1654,1660 ---- * Terminate the string and set it as result ************************************************************/ *cp2 = '\0'; ! Tcl_SetObjResult(interp, Tcl_NewStringObj(tmp, -1)); pfree(tmp); return TCL_OK; } *************** pltcl_quote(ClientData cdata, Tcl_Interp *** 1637,1643 **** **********************************************************************/ static int pltcl_argisnull(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]) { int argno; FunctionCallInfo fcinfo = pltcl_current_fcinfo; --- 1665,1671 ---- **********************************************************************/ static int pltcl_argisnull(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]) { int argno; FunctionCallInfo fcinfo = pltcl_current_fcinfo; *************** pltcl_argisnull(ClientData cdata, Tcl_In *** 1645,1654 **** /************************************************************ * Check call syntax ************************************************************/ ! if (argc != 2) { ! Tcl_SetResult(interp, "syntax error - 'argisnull argno'", ! TCL_STATIC); return TCL_ERROR; } --- 1673,1681 ---- /************************************************************ * Check call syntax ************************************************************/ ! if (objc != 2) { ! Tcl_WrongNumArgs(interp, 1, objv, "argno"); return TCL_ERROR; } *************** pltcl_argisnull(ClientData cdata, Tcl_In *** 1657,1671 **** ************************************************************/ if (fcinfo == NULL) { ! Tcl_SetResult(interp, "argisnull cannot be used in triggers", ! TCL_STATIC); return TCL_ERROR; } /************************************************************ * Get the argument number ************************************************************/ ! if (Tcl_GetInt(interp, argv[1], &argno) != TCL_OK) return TCL_ERROR; /************************************************************ --- 1684,1698 ---- ************************************************************/ if (fcinfo == NULL) { ! Tcl_SetObjResult(interp, ! Tcl_NewStringObj("argisnull cannot be used in triggers", -1)); return TCL_ERROR; } /************************************************************ * Get the argument number ************************************************************/ ! if (Tcl_GetIntFromObj(interp, objv[1], &argno) != TCL_OK) return TCL_ERROR; /************************************************************ *************** pltcl_argisnull(ClientData cdata, Tcl_In *** 1674,1691 **** argno--; if (argno < 0 || argno >= fcinfo->nargs) { ! Tcl_SetResult(interp, "argno out of range", TCL_STATIC); return TCL_ERROR; } /************************************************************ * Get the requested NULL state ************************************************************/ ! if (PG_ARGISNULL(argno)) ! Tcl_SetResult(interp, "1", TCL_STATIC); ! else ! Tcl_SetResult(interp, "0", TCL_STATIC); ! return TCL_OK; } --- 1701,1715 ---- argno--; if (argno < 0 || argno >= fcinfo->nargs) { ! Tcl_SetObjResult(interp, ! Tcl_NewStringObj("argno out of range", -1)); return TCL_ERROR; } /************************************************************ * Get the requested NULL state ************************************************************/ ! Tcl_SetObjResult(interp, Tcl_NewBooleanObj(PG_ARGISNULL(argno))); return TCL_OK; } *************** pltcl_argisnull(ClientData cdata, Tcl_In *** 1695,1710 **** **********************************************************************/ static int pltcl_returnnull(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]) { FunctionCallInfo fcinfo = pltcl_current_fcinfo; /************************************************************ * Check call syntax ************************************************************/ ! if (argc != 1) { ! Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_STATIC); return TCL_ERROR; } --- 1719,1734 ---- **********************************************************************/ static int pltcl_returnnull(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]) { FunctionCallInfo fcinfo = pltcl_current_fcinfo; /************************************************************ * Check call syntax ************************************************************/ ! if (objc != 1) { ! Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } *************** pltcl_returnnull(ClientData cdata, Tcl_I *** 1713,1720 **** ************************************************************/ if (fcinfo == NULL) { ! Tcl_SetResult(interp, "return_null cannot be used in triggers", ! TCL_STATIC); return TCL_ERROR; } --- 1737,1744 ---- ************************************************************/ if (fcinfo == NULL) { ! Tcl_SetObjResult(interp, ! Tcl_NewStringObj("return_null cannot be used in triggers", -1)); return TCL_ERROR; } *************** pltcl_subtrans_abort(Tcl_Interp * interp *** 1813,1830 **** **********************************************************************/ static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]) { int my_rc; int spi_rc; int query_idx; int i; int count = 0; CONST84 char *volatile arrayname = NULL; ! CONST84 char *volatile loop_body = NULL; MemoryContext oldcontext = CurrentMemoryContext; ResourceOwner oldowner = CurrentResourceOwner; char *usage = "syntax error - 'SPI_exec " "?-count n? " "?-array name? query ?loop body?"; --- 1837,1864 ---- **********************************************************************/ static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]) { int my_rc; int spi_rc; int query_idx; int i; + int optIndex; int count = 0; CONST84 char *volatile arrayname = NULL; ! Tcl_Obj *loop_body = NULL; MemoryContext oldcontext = CurrentMemoryContext; ResourceOwner oldowner = CurrentResourceOwner; + enum options + { + OPT_ARRAY, OPT_COUNT + }; + + static CONST84 char *options[] = { + "-array", "-count", (char *) NULL + }; + char *usage = "syntax error - 'SPI_exec " "?-count n? " "?-array name? query ?loop body?"; *************** pltcl_SPI_execute(ClientData cdata, Tcl_ *** 1832,1880 **** /************************************************************ * Check the call syntax and get the options ************************************************************/ ! if (argc < 2) { Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } i = 1; ! while (i < argc) { ! if (strcmp(argv[i], "-array") == 0) { ! if (++i >= argc) ! { ! Tcl_SetResult(interp, usage, TCL_STATIC); ! return TCL_ERROR; ! } ! arrayname = argv[i++]; ! continue; } ! if (strcmp(argv[i], "-count") == 0) { ! if (++i >= argc) ! { ! Tcl_SetResult(interp, usage, TCL_STATIC); ! return TCL_ERROR; ! } ! if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK) ! return TCL_ERROR; ! continue; } ! break; } query_idx = i; ! if (query_idx >= argc || query_idx + 2 < argc) { Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } ! if (query_idx + 1 < argc) ! loop_body = argv[query_idx + 1]; /************************************************************ * Execute the query inside a sub-transaction, so we can cope with --- 1866,1918 ---- /************************************************************ * Check the call syntax and get the options ************************************************************/ ! if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, + "?-count n? ?-array name? query ?loop body?"); Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } i = 1; ! while (i < objc) { ! if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", ! TCL_EXACT, &optIndex) != TCL_OK) { ! return TCL_ERROR; } ! if (++i >= objc) { ! Tcl_SetObjResult(interp, ! Tcl_NewStringObj("missing argument to -count or -array", -1)); ! return TCL_ERROR; } ! switch ((enum options) optIndex) ! { ! case OPT_ARRAY: ! arrayname = Tcl_GetString(objv[i++]); ! break; ! ! case OPT_COUNT: ! if (Tcl_GetIntFromObj(interp, objv[i++], &count) != TCL_OK) ! return TCL_ERROR; ! break; ! } } query_idx = i; ! if (query_idx >= objc || query_idx + 2 < objc) { Tcl_SetResult(interp, usage, TCL_STATIC); + Tcl_WrongNumArgs(interp, query_idx - 1, objv, "query ?loop body?"); return TCL_ERROR; } ! ! if (query_idx + 1 < objc) ! loop_body = objv[query_idx + 1]; /************************************************************ * Execute the query inside a sub-transaction, so we can cope with *************** pltcl_SPI_execute(ClientData cdata, Tcl_ *** 1886,1892 **** PG_TRY(); { UTF_BEGIN; ! spi_rc = SPI_execute(UTF_U2E(argv[query_idx]), pltcl_current_prodesc->fn_readonly, count); UTF_END; --- 1924,1930 ---- PG_TRY(); { UTF_BEGIN; ! spi_rc = SPI_execute(UTF_U2E(Tcl_GetString(objv[query_idx])), pltcl_current_prodesc->fn_readonly, count); UTF_END; *************** pltcl_SPI_execute(ClientData cdata, Tcl_ *** 1917,1929 **** static int pltcl_process_SPI_result(Tcl_Interp * interp, CONST84 char *arrayname, ! CONST84 char *loop_body, int spi_rc, SPITupleTable * tuptable, int ntuples) { int my_rc = TCL_OK; - char buf[64]; int i; int loop_rc; HeapTuple *tuples; --- 1955,1966 ---- static int pltcl_process_SPI_result(Tcl_Interp * interp, CONST84 char *arrayname, ! Tcl_Obj * loop_body, int spi_rc, SPITupleTable * tuptable, int ntuples) { int my_rc = TCL_OK; int i; int loop_rc; HeapTuple *tuples; *************** pltcl_process_SPI_result(Tcl_Interp * in *** 1935,1949 **** case SPI_OK_INSERT: case SPI_OK_DELETE: case SPI_OK_UPDATE: ! snprintf(buf, sizeof(buf), "%d", ntuples); ! Tcl_SetResult(interp, buf, TCL_VOLATILE); break; case SPI_OK_UTILITY: case SPI_OK_REWRITTEN: if (tuptable == NULL) { ! Tcl_SetResult(interp, "0", TCL_STATIC); break; } /* FALL THRU for utility returning tuples */ --- 1972,1985 ---- case SPI_OK_INSERT: case SPI_OK_DELETE: case SPI_OK_UPDATE: ! Tcl_SetObjResult(interp, Tcl_NewIntObj(ntuples)); break; case SPI_OK_UTILITY: case SPI_OK_REWRITTEN: if (tuptable == NULL) { ! Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); break; } /* FALL THRU for utility returning tuples */ *************** pltcl_process_SPI_result(Tcl_Interp * in *** 1980,1986 **** pltcl_set_tuple_values(interp, arrayname, i, tuples[i], tupdesc); ! loop_rc = Tcl_Eval(interp, loop_body); if (loop_rc == TCL_OK) continue; --- 2016,2022 ---- pltcl_set_tuple_values(interp, arrayname, i, tuples[i], tupdesc); ! loop_rc = Tcl_EvalObjEx(interp, loop_body, 0); if (loop_rc == TCL_OK) continue; *************** pltcl_process_SPI_result(Tcl_Interp * in *** 2000,2007 **** if (my_rc == TCL_OK) { ! snprintf(buf, sizeof(buf), "%d", ntuples); ! Tcl_SetResult(interp, buf, TCL_VOLATILE); } break; --- 2036,2042 ---- if (my_rc == TCL_OK) { ! Tcl_SetObjResult(interp, Tcl_NewIntObj(ntuples)); } break; *************** pltcl_process_SPI_result(Tcl_Interp * in *** 2028,2037 **** **********************************************************************/ static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]) { int nargs; ! CONST84 char **args; pltcl_query_desc *qdesc; void *plan; int i; --- 2063,2072 ---- **********************************************************************/ static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]) { int nargs; ! Tcl_Obj **argsObj; pltcl_query_desc *qdesc; void *plan; int i; *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2044,2060 **** /************************************************************ * Check the call syntax ************************************************************/ ! if (argc != 3) { ! Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'", ! TCL_STATIC); return TCL_ERROR; } /************************************************************ * Split the argument type list ************************************************************/ ! if (Tcl_SplitList(interp, argv[2], &nargs, &args) != TCL_OK) return TCL_ERROR; /************************************************************ --- 2079,2094 ---- /************************************************************ * Check the call syntax ************************************************************/ ! if (objc != 3) { ! Tcl_WrongNumArgs(interp, 1, objv, "query argtypes"); return TCL_ERROR; } /************************************************************ * Split the argument type list ************************************************************/ ! if (Tcl_ListObjGetElements(interp, objv[2], &nargs, &argsObj) != TCL_OK) return TCL_ERROR; /************************************************************ *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2088,2094 **** typIOParam; int32 typmod; ! parseTypeString(args[i], &typId, &typmod); getTypeInputInfo(typId, &typInput, &typIOParam); --- 2122,2128 ---- typIOParam; int32 typmod; ! parseTypeString(Tcl_GetString(argsObj[i]), &typId, &typmod); getTypeInputInfo(typId, &typInput, &typIOParam); *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2101,2107 **** * Prepare the plan and check for errors ************************************************************/ UTF_BEGIN; ! plan = SPI_prepare(UTF_U2E(argv[1]), nargs, qdesc->argtypes); UTF_END; if (plan == NULL) --- 2135,2141 ---- * Prepare the plan and check for errors ************************************************************/ UTF_BEGIN; ! plan = SPI_prepare(UTF_U2E(Tcl_GetString(argsObj[1])), nargs, qdesc->argtypes); UTF_END; if (plan == NULL) *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2128,2134 **** free(qdesc->arginfuncs); free(qdesc->argtypioparams); free(qdesc); ! ckfree((char *) args); return TCL_ERROR; } --- 2162,2168 ---- free(qdesc->arginfuncs); free(qdesc->argtypioparams); free(qdesc); ! /* ckfree((char *) args); */ return TCL_ERROR; } *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2143,2152 **** hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew); Tcl_SetHashValue(hashent, (ClientData) qdesc); ! ckfree((char *) args); /* qname is ASCII, so no need for encoding conversion */ ! Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE); return TCL_OK; } --- 2177,2186 ---- hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew); Tcl_SetHashValue(hashent, (ClientData) qdesc); ! /* ckfree((char *) args); */ /* qname is ASCII, so no need for encoding conversion */ ! Tcl_SetObjResult(interp, Tcl_NewStringObj(qdesc->qname, -1)); return TCL_OK; } *************** pltcl_SPI_prepare(ClientData cdata, Tcl_ *** 2156,2172 **** **********************************************************************/ static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]) { int my_rc; int spi_rc; int i; int j; Tcl_HashEntry *hashent; pltcl_query_desc *qdesc; const char *volatile nulls = NULL; CONST84 char *volatile arrayname = NULL; ! CONST84 char *volatile loop_body = NULL; int count = 0; int callnargs; CONST84 char **callargs = NULL; --- 2190,2207 ---- **********************************************************************/ static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]) { int my_rc; int spi_rc; int i; int j; + int optIndex; Tcl_HashEntry *hashent; pltcl_query_desc *qdesc; const char *volatile nulls = NULL; CONST84 char *volatile arrayname = NULL; ! Tcl_Obj *loop_body = NULL; int count = 0; int callnargs; CONST84 char **callargs = NULL; *************** pltcl_SPI_execute_plan(ClientData cdata, *** 2175,2180 **** --- 2210,2224 ---- ResourceOwner oldowner = CurrentResourceOwner; Tcl_HashTable *query_hash; + enum options + { + OPT_ARRAY, OPT_COUNT, OPT_NULLS + }; + + static CONST84 char *options[] = { + "-array", "-count", "-nulls", (char *) NULL + }; + char *usage = "syntax error - 'SPI_execp " "?-nulls string? ?-count n? " "?-array name? query ?args? ?loop body?"; *************** pltcl_SPI_execute_plan(ClientData cdata, *** 2183,2240 **** * Get the options and check syntax ************************************************************/ i = 1; ! while (i < argc) { ! if (strcmp(argv[i], "-array") == 0) { ! if (++i >= argc) ! { ! Tcl_SetResult(interp, usage, TCL_STATIC); ! return TCL_ERROR; ! } ! arrayname = argv[i++]; ! continue; } ! if (strcmp(argv[i], "-nulls") == 0) { ! if (++i >= argc) ! { ! Tcl_SetResult(interp, usage, TCL_STATIC); ! return TCL_ERROR; ! } ! nulls = argv[i++]; ! continue; } ! if (strcmp(argv[i], "-count") == 0) { ! if (++i >= argc) ! { ! Tcl_SetResult(interp, usage, TCL_STATIC); ! return TCL_ERROR; ! } ! if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK) ! return TCL_ERROR; ! continue; ! } ! break; } /************************************************************ * Get the prepared plan descriptor by its key ************************************************************/ ! if (i >= argc) { ! Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } query_hash = &pltcl_current_prodesc->interp_desc->query_hash; ! hashent = Tcl_FindHashEntry(query_hash, argv[i]); if (hashent == NULL) { ! Tcl_AppendResult(interp, "invalid queryid '", argv[i], "'", NULL); return TCL_ERROR; } qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent); --- 2227,2280 ---- * Get the options and check syntax ************************************************************/ i = 1; ! while (i < objc) { ! if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", ! TCL_EXACT, &optIndex) != TCL_OK) { ! return TCL_ERROR; } ! ! if (++i >= objc) { ! Tcl_SetObjResult(interp, ! Tcl_NewStringObj("missing argument to -count or -array", -1)); ! return TCL_ERROR; } ! ! switch ((enum options) optIndex) { ! case OPT_ARRAY: ! arrayname = Tcl_GetString(objv[i++]); ! break; ! case OPT_COUNT: ! if (Tcl_GetIntFromObj(interp, objv[i++], &count) != TCL_OK) ! return TCL_ERROR; ! break; ! ! case OPT_NULLS: ! nulls = Tcl_GetString(objv[i++]); ! break; ! } } /************************************************************ * Get the prepared plan descriptor by its key ************************************************************/ ! if (i >= objc) { ! Tcl_SetObjResult(interp, ! Tcl_NewStringObj("missing argument to -count or -array", -1)); return TCL_ERROR; } query_hash = &pltcl_current_prodesc->interp_desc->query_hash; ! hashent = Tcl_FindHashEntry(query_hash, Tcl_GetString(objv[i])); if (hashent == NULL) { ! Tcl_AppendResult(interp, "invalid queryid '", Tcl_GetString(objv[i]), "'", NULL); return TCL_ERROR; } qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent); *************** pltcl_SPI_execute_plan(ClientData cdata, *** 2260,2266 **** ************************************************************/ if (qdesc->nargs > 0) { ! if (i >= argc) { Tcl_SetResult(interp, "missing argument list", TCL_STATIC); return TCL_ERROR; --- 2300,2306 ---- ************************************************************/ if (qdesc->nargs > 0) { ! if (i >= objc) { Tcl_SetResult(interp, "missing argument list", TCL_STATIC); return TCL_ERROR; *************** pltcl_SPI_execute_plan(ClientData cdata, *** 2269,2275 **** /************************************************************ * Split the argument values ************************************************************/ ! if (Tcl_SplitList(interp, argv[i++], &callnargs, &callargs) != TCL_OK) return TCL_ERROR; /************************************************************ --- 2309,2315 ---- /************************************************************ * Split the argument values ************************************************************/ ! if (Tcl_SplitList(interp, Tcl_GetString(objv[i++]), &callnargs, &callargs) != TCL_OK) return TCL_ERROR; /************************************************************ *************** pltcl_SPI_execute_plan(ClientData cdata, *** 2290,2299 **** /************************************************************ * Get loop body if present ************************************************************/ ! if (i < argc) ! loop_body = argv[i++]; ! if (i != argc) { Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; --- 2330,2339 ---- /************************************************************ * Get loop body if present ************************************************************/ ! if (i < objc) ! loop_body = objv[i++]; ! if (i != objc) { Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; *************** pltcl_SPI_execute_plan(ClientData cdata, *** 2374,2385 **** **********************************************************************/ static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp * interp, ! int argc, CONST84 char *argv[]) { ! char buf[64]; ! ! snprintf(buf, sizeof(buf), "%u", SPI_lastoid); ! Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } --- 2414,2422 ---- **********************************************************************/ static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp * interp, ! int objc, Tcl_Obj * const objv[]) { ! Tcl_SetObjResult(interp, Tcl_NewWideIntObj(SPI_lastoid)); return TCL_OK; } *************** pltcl_set_tuple_values(Tcl_Interp * inte *** 2394,2400 **** { int i; char *outputstr; - char buf[64]; Datum attr; bool isnull; --- 2431,2436 ---- *************** pltcl_set_tuple_values(Tcl_Interp * inte *** 2419,2426 **** { arrptr = &arrayname; nameptr = &attname; ! snprintf(buf, sizeof(buf), "%d", tupno); ! Tcl_SetVar2(interp, arrayname, ".tupno", buf, 0); } for (i = 0; i < tupdesc->natts; i++) --- 2455,2461 ---- { arrptr = &arrayname; nameptr = &attname; ! Tcl_SetVar2Ex(interp, arrayname, ".tupno", Tcl_NewIntObj(tupno), 0); } for (i = 0; i < tupdesc->natts; i++) *************** pltcl_set_tuple_values(Tcl_Interp * inte *** 2464,2470 **** { outputstr = OidOutputFunctionCall(typoutput, attr); UTF_BEGIN; ! Tcl_SetVar2(interp, *arrptr, *nameptr, UTF_E2U(outputstr), 0); UTF_END; pfree(outputstr); } --- 2499,2506 ---- { outputstr = OidOutputFunctionCall(typoutput, attr); UTF_BEGIN; ! Tcl_SetVar2Ex(interp, *arrptr, *nameptr, ! Tcl_NewStringObj(UTF_E2U(outputstr), -1), 0); UTF_END; pfree(outputstr); }