45 #define HAVE_TCL_VERSION(maj,min) \ 46 ((TCL_MAJOR_VERSION > maj) || \ 47 (TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min)) 50 #if !HAVE_TCL_VERSION(8,4) 51 #error PostgreSQL only supports Tcl 8.4 or later. 61 #define TEXTDOMAIN PG_TEXTDOMAIN("pltcl") 88 const char *_pltcl_utf_src = NULL; \ 89 char *_pltcl_utf_dst = NULL 92 if (_pltcl_utf_src != (const char *) _pltcl_utf_dst) \ 93 pfree(_pltcl_utf_dst); \ 97 (_pltcl_utf_dst = utf_u2e(_pltcl_utf_src = (x))) 100 (_pltcl_utf_dst = utf_e2u(_pltcl_utf_src = (x))) 257 #include "pltclerrcodes.h" 267 Oid prolang,
bool pltrusted);
284 bool is_event_trigger,
288 int objc, Tcl_Obj *
const objv[]);
292 int objc, Tcl_Obj *
const objv[]);
294 int objc, Tcl_Obj *
const objv[]);
296 int objc, Tcl_Obj *
const objv[]);
298 int objc, Tcl_Obj *
const objv[]);
300 int objc, Tcl_Obj *
const objv[]);
302 const char *arrayname,
308 int objc, Tcl_Obj *
const objv[]);
310 int objc, Tcl_Obj *
const objv[]);
312 int objc, Tcl_Obj *
const objv[]);
314 int objc, Tcl_Obj *
const objv[]);
316 int objc, Tcl_Obj *
const objv[]);
330 Tcl_Obj **kvObjv,
int kvObjc,
349 static int fakeThreadKey;
351 return (ClientData) &(fakeThreadKey);
371 Tcl_FileProc *proc, ClientData clientData)
403 Tcl_NotifierProcs notifier;
414 Tcl_FindExecutable(
"");
428 Tcl_SetNotifier(¬ifier);
435 elog(
ERROR,
"could not create dummy Tcl interpreter");
437 elog(
ERROR,
"could not initialize dummy Tcl interpreter");
444 pltcl_interp_htab =
hash_create(
"PL/Tcl interpreters",
463 gettext_noop(
"PL/Tcl function to call once when pltcl is first used."),
470 gettext_noop(
"PL/TclU function to call once when pltclu is first used."),
494 snprintf(interpname,
sizeof(interpname),
"subsidiary_%u", interp_desc->
user_id);
496 pltrusted ? 1 : 0)) == NULL)
497 elog(
ERROR,
"could not create subsidiary Tcl interpreter");
502 Tcl_InitHashTable(&interp_desc->
query_hash, TCL_STRING_KEYS);
507 Tcl_CreateObjCommand(interp,
"elog",
509 Tcl_CreateObjCommand(interp,
"quote",
511 Tcl_CreateObjCommand(interp,
"argisnull",
513 Tcl_CreateObjCommand(interp,
"return_null",
515 Tcl_CreateObjCommand(interp,
"return_next",
517 Tcl_CreateObjCommand(interp,
"spi_exec",
519 Tcl_CreateObjCommand(interp,
"spi_prepare",
521 Tcl_CreateObjCommand(interp,
"spi_execp",
523 Tcl_CreateObjCommand(interp,
"subtransaction",
525 Tcl_CreateObjCommand(interp,
"commit",
527 Tcl_CreateObjCommand(interp,
"rollback",
544 interp_desc->
interp = NULL;
545 Tcl_DeleteInterp(interp);
569 interp_desc =
hash_search(pltcl_interp_htab, &user_id,
573 interp_desc->
interp = NULL;
603 gucname = pltrusted ?
"pltcl.start_proc" :
"pltclu.start_proc";
606 if (start_proc == NULL || start_proc[0] ==
'\0')
627 elog(
ERROR,
"cache lookup failed for function %u", procOid);
631 if (procStruct->prolang != prolang)
633 (
errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE),
634 errmsg(
"function \"%s\" is in the wrong language",
642 if (procStruct->prosecdef)
644 (
errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE),
645 errmsg(
"function \"%s\" must not be SECURITY DEFINER",
676 const char *gucname = (
const char *) arg;
679 errcontext(
"processing %s parameter", gucname);
732 memset(¤t_call_state, 0,
sizeof(current_call_state));
738 pltcl_current_call_state = ¤t_call_state;
762 current_call_state.
fcinfo = fcinfo;
773 pltcl_current_call_state = save_call_state;
774 if (current_call_state.
prodesc != NULL)
796 Tcl_Interp *
volatile interp;
802 nonatomic = fcinfo->context &&
808 elog(
ERROR,
"could not connect to SPI manager");
832 (
errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
833 errmsg(
"set-valued function called in context that cannot accept a set")));
835 call_state->
rsi = rsi;
844 tcl_cmd = Tcl_NewObj();
845 Tcl_ListObjAppendElement(NULL, tcl_cmd,
849 Tcl_IncrRefCount(tcl_cmd);
856 for (i = 0; i < prodesc->
nargs; i++)
863 if (fcinfo->args[i].isnull)
864 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
884 Tcl_ListObjAppendElement(NULL, tcl_cmd, list_tmp);
895 if (fcinfo->args[i].isnull)
896 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
902 fcinfo->args[i].value);
904 Tcl_ListObjAppendElement(NULL, tcl_cmd,
905 Tcl_NewStringObj(
UTF_E2U(tmp), -1));
915 Tcl_DecrRefCount(tcl_cmd);
925 tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
928 Tcl_DecrRefCount(tcl_cmd);
933 if (tcl_rc != TCL_OK)
969 fcinfo->isnull =
true;
971 else if (fcinfo->isnull)
983 Tcl_Obj **resultObjv;
1005 (
errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1006 errmsg(
"function returning record called in context " 1007 "that cannot accept type record")));
1011 elog(
ERROR,
"return type must be a row type");
1021 resultObj = Tcl_GetObjResult(interp);
1022 if (Tcl_ListObjGetElements(interp, resultObj, &resultObjc, &resultObjv) == TCL_ERROR)
1031 utf_u2e(Tcl_GetStringResult(interp)),
1047 Tcl_Interp *
volatile interp;
1053 Tcl_Obj *tcl_trigtup;
1058 Tcl_Obj **result_Objv;
1065 elog(
ERROR,
"could not connect to SPI manager");
1077 call_state->
prodesc = prodesc;
1088 tcl_cmd = Tcl_NewObj();
1089 Tcl_IncrRefCount(tcl_cmd);
1094 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1098 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1105 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1106 Tcl_NewStringObj(stroid, -1));
1111 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1112 Tcl_NewStringObj(
utf_e2u(stroid), -1));
1117 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1118 Tcl_NewStringObj(
utf_e2u(stroid), -1));
1122 tcl_trigtup = Tcl_NewObj();
1123 Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
1124 for (
i = 0;
i < tupdesc->
natts;
i++)
1128 if (att->attisdropped)
1129 Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
1131 Tcl_ListObjAppendElement(NULL, tcl_trigtup,
1134 Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
1138 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1139 Tcl_NewStringObj(
"BEFORE", -1));
1141 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1142 Tcl_NewStringObj(
"AFTER", -1));
1144 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1145 Tcl_NewStringObj(
"INSTEAD OF", -1));
1152 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1153 Tcl_NewStringObj(
"ROW", -1));
1164 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1165 Tcl_NewStringObj(
"INSERT", -1));
1167 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1171 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1177 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1178 Tcl_NewStringObj(
"DELETE", -1));
1180 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1181 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1190 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1191 Tcl_NewStringObj(
"UPDATE", -1));
1193 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1197 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1209 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1210 Tcl_NewStringObj(
"STATEMENT", -1));
1213 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1214 Tcl_NewStringObj(
"INSERT", -1));
1216 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1217 Tcl_NewStringObj(
"DELETE", -1));
1219 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1220 Tcl_NewStringObj(
"UPDATE", -1));
1222 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1223 Tcl_NewStringObj(
"TRUNCATE", -1));
1227 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1228 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1237 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1243 Tcl_DecrRefCount(tcl_cmd);
1253 tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
1256 Tcl_DecrRefCount(tcl_cmd);
1261 if (tcl_rc != TCL_OK)
1275 result = Tcl_GetStringResult(interp);
1277 if (strcmp(result,
"OK") == 0)
1279 if (strcmp(result,
"SKIP") == 0)
1286 if (Tcl_ListObjGetElements(interp, Tcl_GetObjResult(interp),
1287 &result_Objc, &result_Objv) != TCL_OK)
1289 (
errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
1290 errmsg(
"could not split return value from trigger: %s",
1291 utf_u2e(Tcl_GetStringResult(interp)))));
1308 Tcl_Interp *
volatile interp;
1315 elog(
ERROR,
"could not connect to SPI manager");
1321 call_state->
prodesc = prodesc;
1327 tcl_cmd = Tcl_NewObj();
1328 Tcl_IncrRefCount(tcl_cmd);
1329 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1331 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1333 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1337 tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
1340 Tcl_DecrRefCount(tcl_cmd);
1343 if (tcl_rc != TCL_OK)
1368 econtext =
utf_u2e(Tcl_GetVar(interp,
"errorInfo", TCL_GLOBAL_ONLY));
1370 (
errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1373 econtext, proname)));
1385 bool is_event_trigger,
bool pltrusted)
1395 Tcl_DString proc_internal_def;
1396 Tcl_DString proc_internal_body;
1401 elog(
ERROR,
"cache lookup failed for function %u", fn_oid);
1412 proc_ptr =
hash_search(pltcl_proc_htab, &proc_key,
1425 if (prodesc != NULL &&
1442 Tcl_DStringInit(&proc_internal_def);
1443 Tcl_DStringInit(&proc_internal_body);
1447 char internal_proname[128];
1465 if (is_event_trigger)
1466 snprintf(internal_proname,
sizeof(internal_proname),
1467 "__PLTcl_proc_%u_evttrigger", fn_oid);
1468 else if (is_trigger)
1469 snprintf(internal_proname,
sizeof(internal_proname),
1470 "__PLTcl_proc_%u_trigger", fn_oid);
1472 snprintf(internal_proname,
sizeof(internal_proname),
1473 "__PLTcl_proc_%u", fn_oid);
1491 prodesc->
fn_cxt = proc_cxt;
1495 prodesc->
nargs = procStruct->pronargs;
1502 (procStruct->provolatile != PROVOLATILE_VOLATILE);
1517 if (!is_trigger && !is_event_trigger)
1519 Oid rettype = procStruct->prorettype;
1523 elog(
ERROR,
"cache lookup failed for type %u", rettype);
1527 if (typeStruct->typtype == TYPTYPE_PSEUDO)
1529 if (rettype == VOIDOID ||
1530 rettype == RECORDOID)
1532 else if (rettype == TRIGGEROID ||
1533 rettype == EVENT_TRIGGEROID)
1535 (
errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1536 errmsg(
"trigger functions can only be called as triggers")));
1539 (
errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1540 errmsg(
"PL/Tcl functions cannot return type %s",
1552 prodesc->
fn_retisdomain = (typeStruct->typtype == TYPTYPE_DOMAIN);
1562 if (!is_trigger && !is_event_trigger)
1564 proc_internal_args[0] =
'\0';
1565 for (i = 0; i < prodesc->
nargs; i++)
1567 Oid argtype = procStruct->proargtypes.values[
i];
1571 elog(
ERROR,
"cache lookup failed for type %u", argtype);
1575 if (typeStruct->typtype == TYPTYPE_PSEUDO &&
1576 argtype != RECORDOID)
1578 (
errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1579 errmsg(
"PL/Tcl functions cannot accept type %s",
1585 snprintf(buf,
sizeof(buf),
"__PLTcl_Tup_%d", i + 1);
1593 snprintf(buf,
sizeof(buf),
"%d", i + 1);
1597 strcat(proc_internal_args,
" ");
1598 strcat(proc_internal_args, buf);
1603 else if (is_trigger)
1606 strcpy(proc_internal_args,
1607 "TG_name TG_relid TG_table_name TG_table_schema TG_relatts TG_when TG_level TG_op __PLTcl_Tup_NEW __PLTcl_Tup_OLD args");
1609 else if (is_event_trigger)
1612 strcpy(proc_internal_args,
"TG_event TG_tag");
1623 Tcl_DStringAppendElement(&proc_internal_def,
"proc");
1624 Tcl_DStringAppendElement(&proc_internal_def, internal_proname);
1625 Tcl_DStringAppendElement(&proc_internal_def, proc_internal_args);
1632 Tcl_DStringAppend(&proc_internal_body,
"upvar #0 ", -1);
1633 Tcl_DStringAppend(&proc_internal_body, internal_proname, -1);
1634 Tcl_DStringAppend(&proc_internal_body,
" GD\n", -1);
1637 Tcl_DStringAppend(&proc_internal_body,
1638 "array set NEW $__PLTcl_Tup_NEW\n", -1);
1639 Tcl_DStringAppend(&proc_internal_body,
1640 "array set OLD $__PLTcl_Tup_OLD\n", -1);
1641 Tcl_DStringAppend(&proc_internal_body,
1644 "foreach v $args {\n" 1648 "unset i v\n\n", -1);
1650 else if (is_event_trigger)
1656 for (i = 0; i < prodesc->
nargs; i++)
1661 "array set %d $__PLTcl_Tup_%d\n",
1663 Tcl_DStringAppend(&proc_internal_body, buf, -1);
1672 Anum_pg_proc_prosrc, &isnull);
1677 Tcl_DStringAppend(&proc_internal_body,
UTF_E2U(proc_source), -1);
1680 Tcl_DStringAppendElement(&proc_internal_def,
1681 Tcl_DStringValue(&proc_internal_body));
1686 tcl_rc = Tcl_EvalEx(interp,
1687 Tcl_DStringValue(&proc_internal_def),
1688 Tcl_DStringLength(&proc_internal_def),
1690 if (tcl_rc != TCL_OK)
1692 (
errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1693 errmsg(
"could not create internal procedure \"%s\": %s",
1695 utf_u2e(Tcl_GetStringResult(interp)))));
1705 Tcl_DStringFree(&proc_internal_def);
1706 Tcl_DStringFree(&proc_internal_body);
1726 if (old_prodesc != NULL)
1733 Tcl_DStringFree(&proc_internal_def);
1734 Tcl_DStringFree(&proc_internal_body);
1747 int objc, Tcl_Obj *
const objv[])
1753 static const char *logpriorities[] = {
1754 "DEBUG",
"LOG",
"INFO",
"NOTICE",
1755 "WARNING",
"ERROR",
"FATAL", (
const char *) NULL
1758 static const int loglevels[] = {
1765 Tcl_WrongNumArgs(interp, 1, objv,
"level msg");
1769 if (Tcl_GetIndexFromObj(interp, objv[1], logpriorities,
"priority",
1770 TCL_EXACT, &priIndex) != TCL_OK)
1773 level = loglevels[priIndex];
1782 Tcl_SetObjResult(interp, objv[2]);
1800 (
errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1816 Tcl_SetObjResult(interp, Tcl_NewStringObj(
UTF_E2U(edata->
message), -1));
1835 Tcl_Obj *obj = Tcl_NewObj();
1837 Tcl_ListObjAppendElement(interp, obj,
1838 Tcl_NewStringObj(
"POSTGRES", -1));
1839 Tcl_ListObjAppendElement(interp, obj,
1840 Tcl_NewStringObj(PG_VERSION, -1));
1841 Tcl_ListObjAppendElement(interp, obj,
1842 Tcl_NewStringObj(
"SQLSTATE", -1));
1843 Tcl_ListObjAppendElement(interp, obj,
1845 Tcl_ListObjAppendElement(interp, obj,
1846 Tcl_NewStringObj(
"condition", -1));
1847 Tcl_ListObjAppendElement(interp, obj,
1849 Tcl_ListObjAppendElement(interp, obj,
1850 Tcl_NewStringObj(
"message", -1));
1852 Tcl_ListObjAppendElement(interp, obj,
1857 Tcl_ListObjAppendElement(interp, obj,
1858 Tcl_NewStringObj(
"detail", -1));
1860 Tcl_ListObjAppendElement(interp, obj,
1866 Tcl_ListObjAppendElement(interp, obj,
1867 Tcl_NewStringObj(
"hint", -1));
1869 Tcl_ListObjAppendElement(interp, obj,
1875 Tcl_ListObjAppendElement(interp, obj,
1876 Tcl_NewStringObj(
"context", -1));
1878 Tcl_ListObjAppendElement(interp, obj,
1884 Tcl_ListObjAppendElement(interp, obj,
1885 Tcl_NewStringObj(
"schema", -1));
1887 Tcl_ListObjAppendElement(interp, obj,
1893 Tcl_ListObjAppendElement(interp, obj,
1894 Tcl_NewStringObj(
"table", -1));
1896 Tcl_ListObjAppendElement(interp, obj,
1902 Tcl_ListObjAppendElement(interp, obj,
1903 Tcl_NewStringObj(
"column", -1));
1905 Tcl_ListObjAppendElement(interp, obj,
1911 Tcl_ListObjAppendElement(interp, obj,
1912 Tcl_NewStringObj(
"datatype", -1));
1914 Tcl_ListObjAppendElement(interp, obj,
1920 Tcl_ListObjAppendElement(interp, obj,
1921 Tcl_NewStringObj(
"constraint", -1));
1923 Tcl_ListObjAppendElement(interp, obj,
1930 Tcl_ListObjAppendElement(interp, obj,
1931 Tcl_NewStringObj(
"statement", -1));
1933 Tcl_ListObjAppendElement(interp, obj,
1939 Tcl_ListObjAppendElement(interp, obj,
1940 Tcl_NewStringObj(
"cursor_position", -1));
1941 Tcl_ListObjAppendElement(interp, obj,
1946 Tcl_ListObjAppendElement(interp, obj,
1947 Tcl_NewStringObj(
"filename", -1));
1949 Tcl_ListObjAppendElement(interp, obj,
1955 Tcl_ListObjAppendElement(interp, obj,
1956 Tcl_NewStringObj(
"lineno", -1));
1957 Tcl_ListObjAppendElement(interp, obj,
1958 Tcl_NewIntObj(edata->
lineno));
1962 Tcl_ListObjAppendElement(interp, obj,
1963 Tcl_NewStringObj(
"funcname", -1));
1965 Tcl_ListObjAppendElement(interp, obj,
1970 Tcl_SetObjErrorCode(interp, obj);
1982 for (i = 0; exception_name_map[
i].
label != NULL; i++)
1984 if (exception_name_map[i].sqlerrstate == sqlstate)
1985 return exception_name_map[
i].
label;
1987 return "unrecognized_sqlstate";
1997 int objc, Tcl_Obj *
const objv[])
2009 Tcl_WrongNumArgs(interp, 1, objv,
"string");
2017 cp1 = Tcl_GetStringFromObj(objv[1], &length);
2018 tmp =
palloc(length * 2 + 1);
2040 Tcl_SetObjResult(interp, Tcl_NewStringObj(tmp, -1));
2051 int objc, Tcl_Obj *
const objv[])
2061 Tcl_WrongNumArgs(interp, 1, objv,
"argno");
2070 Tcl_SetObjResult(interp,
2071 Tcl_NewStringObj(
"argisnull cannot be used in triggers", -1));
2078 if (Tcl_GetIntFromObj(interp, objv[1], &argno) != TCL_OK)
2085 if (argno < 0 || argno >= fcinfo->
nargs)
2087 Tcl_SetObjResult(interp,
2088 Tcl_NewStringObj(
"argno out of range", -1));
2095 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
PG_ARGISNULL(argno)));
2105 int objc, Tcl_Obj *
const objv[])
2114 Tcl_WrongNumArgs(interp, 1, objv,
"");
2123 Tcl_SetObjResult(interp,
2124 Tcl_NewStringObj(
"return_null cannot be used in triggers", -1));
2143 int objc, Tcl_Obj *
const objv[])
2150 volatile int result = TCL_OK;
2157 Tcl_SetObjResult(interp,
2158 Tcl_NewStringObj(
"return_next cannot be used in triggers", -1));
2164 Tcl_SetObjResult(interp,
2165 Tcl_NewStringObj(
"return_next cannot be used in non-set-returning functions", -1));
2174 Tcl_WrongNumArgs(interp, 1, objv,
"result");
2199 if (Tcl_ListObjGetElements(interp, objv[1], &rowObjc, &rowObjv) == TCL_ERROR)
2213 bool isNull =
false;
2217 elog(
ERROR,
"wrong result type supplied in return_next");
2220 utf_u2e((
char *) Tcl_GetString(objv[1])),
2301 Tcl_SetObjResult(interp, Tcl_NewStringObj(
UTF_E2U(edata->
message), -1));
2313 int objc, Tcl_Obj *
const objv[])
2321 const char *
volatile arrayname = NULL;
2322 Tcl_Obj *
volatile loop_body = NULL;
2328 OPT_ARRAY, OPT_COUNT
2331 static const char *
options[] = {
2332 "-array",
"-count", (
const char *) NULL
2340 Tcl_WrongNumArgs(interp, 1, objv,
2341 "?-count n? ?-array name? query ?loop body?");
2348 if (Tcl_GetIndexFromObj(NULL, objv[i], options, NULL,
2349 TCL_EXACT, &optIndex) != TCL_OK)
2354 Tcl_SetObjResult(interp,
2355 Tcl_NewStringObj(
"missing argument to -count or -array", -1));
2359 switch ((
enum options) optIndex)
2362 arrayname = Tcl_GetString(objv[i++]);
2366 if (Tcl_GetIntFromObj(interp, objv[i++], &count) != TCL_OK)
2373 if (query_idx >= objc || query_idx + 2 < objc)
2375 Tcl_WrongNumArgs(interp, query_idx - 1, objv,
"query ?loop body?");
2379 if (query_idx + 1 < objc)
2380 loop_body = objv[query_idx + 1];
2422 const char *arrayname,
2439 Tcl_SetObjResult(interp, Tcl_NewWideIntObj(ntuples));
2444 if (tuptable == NULL)
2446 Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
2460 tuples = tuptable->
vals;
2463 if (loop_body == NULL)
2471 tuples[0], tupdesc);
2481 for (i = 0; i < ntuples; i++)
2484 tuples[i], tupdesc);
2486 loop_rc = Tcl_EvalObjEx(interp, loop_body, 0);
2488 if (loop_rc == TCL_OK)
2490 if (loop_rc == TCL_CONTINUE)
2492 if (loop_rc == TCL_RETURN)
2497 if (loop_rc == TCL_BREAK)
2504 if (my_rc == TCL_OK)
2506 Tcl_SetObjResult(interp, Tcl_NewWideIntObj(ntuples));
2511 Tcl_AppendResult(interp,
"pltcl: SPI_execute failed: ",
2533 int objc, Tcl_Obj *
const objv[])
2540 Tcl_HashEntry *hashent;
2551 Tcl_WrongNumArgs(interp, 1, objv,
"query argtypes");
2558 if (Tcl_ListObjGetElements(interp, objv[2], &nargs, &argsObj) != TCL_OK)
2569 "PL/Tcl spi_prepare query",
2574 qdesc->
nargs = nargs;
2594 for (i = 0; i < nargs; i++)
2618 if (qdesc->
plan == NULL)
2646 hashent = Tcl_CreateHashEntry(query_hash, qdesc->
qname, &hashnew);
2647 Tcl_SetHashValue(hashent, (ClientData) qdesc);
2650 Tcl_SetObjResult(interp, Tcl_NewStringObj(qdesc->qname, -1));
2660 int objc, Tcl_Obj *
const objv[])
2667 Tcl_HashEntry *hashent;
2669 const char *nulls = NULL;
2670 const char *arrayname = NULL;
2671 Tcl_Obj *loop_body = NULL;
2674 Tcl_Obj **callObjv = NULL;
2682 OPT_ARRAY, OPT_COUNT, OPT_NULLS
2685 static const char *
options[] = {
2686 "-array",
"-count",
"-nulls", (
const char *) NULL
2695 if (Tcl_GetIndexFromObj(NULL, objv[i], options, NULL,
2696 TCL_EXACT, &optIndex) != TCL_OK)
2701 Tcl_SetObjResult(interp,
2702 Tcl_NewStringObj(
"missing argument to -array, -count or -nulls", -1));
2706 switch ((
enum options) optIndex)
2709 arrayname = Tcl_GetString(objv[i++]);
2713 if (Tcl_GetIntFromObj(interp, objv[i++], &count) != TCL_OK)
2718 nulls = Tcl_GetString(objv[i++]);
2728 Tcl_SetObjResult(interp,
2729 Tcl_NewStringObj(
"missing argument to -count or -array", -1));
2735 hashent = Tcl_FindHashEntry(query_hash, Tcl_GetString(objv[i]));
2736 if (hashent == NULL)
2738 Tcl_AppendResult(interp,
"invalid queryid '", Tcl_GetString(objv[i]),
"'", NULL);
2749 if (strlen(nulls) != qdesc->
nargs)
2751 Tcl_SetObjResult(interp,
2752 Tcl_NewStringObj(
"length of nulls string doesn't match number of arguments",
2762 if (qdesc->
nargs > 0)
2766 Tcl_SetObjResult(interp,
2767 Tcl_NewStringObj(
"argument list length doesn't match number of arguments for query",
2775 if (Tcl_ListObjGetElements(interp, objv[i++], &callObjc, &callObjv) != TCL_OK)
2781 if (callObjc != qdesc->
nargs)
2783 Tcl_SetObjResult(interp,
2784 Tcl_NewStringObj(
"argument list length doesn't match number of arguments for query",
2796 loop_body = objv[i++];
2800 Tcl_WrongNumArgs(interp, 1, objv,
2801 "?-count n? ?-array name? ?-nulls string? " 2802 "query ?args? ?loop body?");
2821 for (j = 0; j < callObjc; j++)
2823 if (nulls && nulls[j] ==
'n')
2834 UTF_U2E(Tcl_GetString(callObjv[j])),
2876 int objc, Tcl_Obj *
const objv[])
2884 Tcl_WrongNumArgs(interp, 1, objv,
"command");
2896 retcode = Tcl_EvalObjEx(interp, objv[1], 0);
2898 if (retcode == TCL_ERROR)
2924 int objc, Tcl_Obj *
const objv[])
2945 Tcl_SetObjResult(interp, Tcl_NewStringObj(
UTF_E2U(edata->
message), -1));
2964 int objc, Tcl_Obj *
const objv[])
2985 Tcl_SetObjResult(interp, Tcl_NewStringObj(
UTF_E2U(edata->
message), -1));
3014 const char **arrptr;
3015 const char **nameptr;
3016 const char *nullname = NULL;
3021 if (arrayname == NULL)
3024 nameptr = &nullname;
3028 arrptr = &arrayname;
3036 Tcl_SetVar2Ex(interp, arrayname,
".tupno", Tcl_NewWideIntObj(tupno), 0);
3039 for (i = 0; i < tupdesc->
natts; i++)
3044 if (att->attisdropped)
3072 Tcl_SetVar2Ex(interp, *arrptr, *nameptr,
3073 Tcl_NewStringObj(
UTF_E2U(outputstr), -1), 0);
3078 Tcl_UnsetVar2(interp, *arrptr, *nameptr, 0);
3092 Tcl_Obj *retobj = Tcl_NewObj();
3101 for (i = 0; i < tupdesc->
natts; i++)
3106 if (att->attisdropped)
3109 if (att->attgenerated)
3112 if (!include_generated)
3119 attname =
NameStr(att->attname);
3137 &typoutput, &typisvarlena);
3140 Tcl_ListObjAppendElement(NULL, retobj,
3141 Tcl_NewStringObj(
UTF_E2U(attname), -1));
3144 Tcl_ListObjAppendElement(NULL, retobj,
3145 Tcl_NewStringObj(
UTF_E2U(outputstr), -1));
3187 elog(
ERROR,
"PL/Tcl function does not return a tuple");
3192 values = (
char **)
palloc0(tupdesc->
natts *
sizeof(
char *));
3194 if (kvObjc % 2 != 0)
3196 (
errcode(ERRCODE_INVALID_PARAMETER_VALUE),
3197 errmsg(
"column name/value list must have even number of elements")));
3199 for (i = 0; i < kvObjc; i += 2)
3201 char *fieldName =
utf_u2e(Tcl_GetString(kvObjv[i]));
3211 if (strcmp(fieldName,
".tupno") == 0)
3214 (
errcode(ERRCODE_UNDEFINED_COLUMN),
3215 errmsg(
"column name/value list contains nonexistent column name \"%s\"",
3221 (
errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
3222 errmsg(
"cannot set system attribute \"%s\"",
3227 (
errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
3228 errmsg(
"cannot set generated column \"%s\"",
3231 values[attn - 1] =
utf_u2e(Tcl_GetString(kvObjv[i + 1]));
int SPI_fnumber(TupleDesc tupdesc, const char *fname)
void tuplestore_putvalues(Tuplestorestate *state, TupleDesc tdesc, Datum *values, bool *isnull)
static void pltcl_subtrans_begin(MemoryContext oldcontext, ResourceOwner oldowner)
static PgChecksumMode mode
static int pltcl_rollback(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
static void pltcl_init_interp(pltcl_interp_desc *interp_desc, Oid prolang, bool pltrusted)
#define CALLED_AS_EVENT_TRIGGER(fcinfo)
TupleDesc CreateTupleDescCopy(TupleDesc tupdesc)
#define IsA(nodeptr, _type_)
void MemoryContextDelete(MemoryContext context)
#define AllocSetContextCreate
HeapTupleData * HeapTuple
TypeFuncClass get_call_result_type(FunctionCallInfo fcinfo, Oid *resultTypeId, TupleDesc *resultTupleDesc)
void getTypeOutputInfo(Oid type, Oid *typOutput, bool *typIsVarlena)
struct pltcl_proc_ptr pltcl_proc_ptr
static void pltcl_subtrans_abort(Tcl_Interp *interp, MemoryContext oldcontext, ResourceOwner oldowner)
TupleDesc lookup_rowtype_tupdesc(Oid type_id, int32 typmod)
#define RelationGetDescr(relation)
int SPI_connect_ext(int options)
#define SPI_OK_DELETE_RETURNING
#define castNode(_type_, nodeptr)
static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
static void pltcl_init_tuple_store(pltcl_call_state *call_state)
ErrorData * CopyErrorData(void)
#define PointerGetDatum(X)
#define TupleDescAttr(tupdesc, i)
ResourceOwner CurrentResourceOwner
char * pstrdup(const char *in)
SPIPlanPtr SPI_prepare(const char *src, int nargs, Oid *argtypes)
#define ALLOCSET_SMALL_SIZES
void ReleaseCurrentSubTransaction(void)
char * unpack_sql_state(int sql_state)
struct pltcl_proc_key pltcl_proc_key
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
static void pltcl_DeleteFileHandler(int fd)
static int pltcl_commit(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
SPITupleTable * SPI_tuptable
static const char * pltcl_get_condition_name(int sqlstate)
int errcode(int sqlerrcode)
static void pltcl_ServiceModeHook(int mode)
Datum pltcl_call_handler(PG_FUNCTION_ARGS)
struct pltcl_interp_desc pltcl_interp_desc
static void pltcl_subtrans_commit(MemoryContext oldcontext, ResourceOwner oldowner)
#define DirectFunctionCall1(func, arg1)
void * hash_search(HTAB *hashp, const void *keyPtr, HASHACTION action, bool *foundPtr)
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
#define TRIGGER_FIRED_AFTER(event)
Datum oidout(PG_FUNCTION_ARGS)
static void pltcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData)
void(* callback)(void *arg)
struct ErrorContextCallback * previous
#define OidIsValid(objectId)
static int pltcl_subtransaction(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
#define DatumGetHeapTupleHeader(X)
static int fd(const char *x, int i)
static void throw_tcl_error(Tcl_Interp *interp, const char *proname)
ResourceOwner tuple_store_owner
void FlushErrorState(void)
static void pltcl_AlertNotifier(ClientData clientData)
#define TRIGGER_FIRED_FOR_STATEMENT(event)
static bool pltcl_pm_init_done
static char * pltcl_start_proc
static Datum pltcl_func_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, bool pltrusted)
char * pg_server_to_any(const char *s, int len, int encoding)
HeapTuple BuildTupleFromCStrings(AttInMetadata *attinmeta, char **values)
static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
char * OutputFunctionCall(FmgrInfo *flinfo, Datum val)
static pltcl_call_state * pltcl_current_call_state
static int pltcl_quote(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
ErrorContextCallback * error_context_stack
#define HeapTupleHeaderGetTypMod(tup)
struct pltcl_call_state pltcl_call_state
static void pltcl_event_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, bool pltrusted)
static int pltcl_WaitForEvent(CONST86 Tcl_Time *timePtr)
void aclcheck_error(AclResult aclerr, ObjectType objtype, const char *objectname)
static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
void pfree(void *pointer)
#define TRIGGER_FIRED_BY_TRUNCATE(event)
AttInMetadata * attinmeta
void FreeErrorData(ErrorData *edata)
struct pltcl_proc_desc pltcl_proc_desc
#define ObjectIdGetDatum(X)
static ClientData pltcl_InitNotifier(void)
#define DatumGetCString(X)
void pgstat_init_function_usage(FunctionCallInfo fcinfo, PgStat_FunctionCallUsage *fcu)
static void call_pltcl_start_proc(Oid prolang, bool pltrusted)
#define SPI_OPT_NONATOMIC
#define SPI_OK_INSERT_RETURNING
void fmgr_info(Oid functionId, FmgrInfo *finfo)
Oid LookupFuncName(List *funcname, int nargs, const Oid *argtypes, bool missing_ok)
PG_FUNCTION_INFO_V1(pltcl_call_handler)
pltcl_interp_desc * interp_desc
int SPI_execute_plan(SPIPlanPtr plan, Datum *Values, const char *Nulls, bool read_only, long tcount)
static int pltcl_process_SPI_result(Tcl_Interp *interp, const char *arrayname, Tcl_Obj *loop_body, int spi_rc, SPITupleTable *tuptable, uint64 ntuples)
static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted)
const char * SPI_result_code_string(int code)
void tuplestore_puttuple(Tuplestorestate *state, HeapTuple tuple)
static void pltcl_SetTimer(CONST86 Tcl_Time *timePtr)
#define FunctionCallInvoke(fcinfo)
int SPI_keepplan(SPIPlanPtr plan)
static void pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata)
void RollbackAndReleaseCurrentSubTransaction(void)
#define SPI_ERROR_NOATTRIBUTE
static Tcl_Interp * pltcl_hold_interp
struct pltcl_query_desc pltcl_query_desc
static char * utf_u2e(const char *src)
#define SPI_OK_UPDATE_RETURNING
HTAB * hash_create(const char *tabname, long nelem, const HASHCTL *info, int flags)
FormData_pg_attribute * Form_pg_attribute
MemoryContext CurrentMemoryContext
unsigned long fn_refcount
bool type_is_rowtype(Oid typid)
void fmgr_info_cxt(Oid functionId, FmgrInfo *finfo, MemoryContext mcxt)
MemoryContext tuple_store_cxt
Tuplestorestate * tuple_store
void getTypeInputInfo(Oid type, Oid *typInput, Oid *typIOParam)
static const TclExceptionNameMap exception_name_map[]
int SPI_register_trigger_data(TriggerData *tdata)
MemoryContext TopMemoryContext
#define InvokeFunctionExecuteHook(objectId)
static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, bool pltrusted)
#define heap_getattr(tup, attnum, tupleDesc, isnull)
#define unconstify(underlying_type, expr)
void SPI_freetuptable(SPITupleTable *tuptable)
HeapTuple SearchSysCache1(int cacheId, Datum key1)
#define TRIGGER_FIRED_BY_DELETE(event)
Tuplestorestate * tuplestore_begin_heap(bool randomAccess, bool interXact, int maxKBytes)
static pltcl_proc_desc * compile_pltcl_function(Oid fn_oid, Oid tgreloid, bool is_event_trigger, bool pltrusted)
#define TextDatumGetCString(d)
void * palloc0(Size size)
void DefineCustomStringVariable(const char *name, const char *short_desc, const char *long_desc, char **valueAddr, const char *bootValue, GucContext context, int flags, GucStringCheckHook check_hook, GucStringAssignHook assign_hook, GucShowHook show_hook)
void ReleaseSysCache(HeapTuple tuple)
static char * utf_e2u(const char *src)
Datum SysCacheGetAttr(int cacheId, HeapTuple tup, AttrNumber attributeNumber, bool *isNull)
AttInMetadata * TupleDescGetAttInMetadata(TupleDesc tupdesc)
#define HeapTupleHeaderGetTypeId(tup)
Datum pltclu_call_handler(PG_FUNCTION_ARGS)
void domain_check(Datum value, bool isnull, Oid domainType, void **extra, MemoryContext mcxt)
FormData_pg_proc * Form_pg_proc
void parseTypeString(const char *str, Oid *typeid_p, int32 *typmod_p, bool missing_ok)
Datum InputFunctionCall(FmgrInfo *flinfo, char *str, Oid typioparam, int32 typmod)
char * SPI_getrelname(Relation rel)
#define ereport(elevel,...)
static HeapTuple pltcl_build_tuple_result(Tcl_Interp *interp, Tcl_Obj **kvObjv, int kvObjc, pltcl_call_state *call_state)
#define LOCAL_FCINFO(name, nargs)
SetFunctionReturnMode returnMode
#define HeapTupleIsValid(tuple)
#define CALLED_AS_TRIGGER(fcinfo)
#define Assert(condition)
pltcl_proc_desc * proc_ptr
pltcl_proc_desc * prodesc
void BeginInternalSubTransaction(const char *name)
char * SPI_getnspname(Relation rel)
static int pltcl_returnnext(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
#define InitFunctionCallInfoData(Fcinfo, Flinfo, Nargs, Collation, Context, Resultinfo)
FormData_pg_type * Form_pg_type
void MemoryContextSetIdentifier(MemoryContext context, const char *id)
#define HeapTupleHeaderGetRawXmin(tup)
#define HeapTupleGetDatum(tuple)
static pltcl_interp_desc * pltcl_fetch_interp(Oid prolang, bool pltrusted)
static void start_proc_error_callback(void *arg)
MemoryContext ecxt_per_query_memory
bool ItemPointerEquals(ItemPointer pointer1, ItemPointer pointer2)
Tuplestorestate * setResult
void pgstat_end_function_usage(PgStat_FunctionCallUsage *fcu, bool finalize)
static HTAB * pltcl_proc_htab
#define TRIGGER_FIRED_BEFORE(event)
static void pltcl_FinalizeNotifier(ClientData clientData)
static Datum values[MAXATTR]
#define TRIGGER_FIRED_INSTEAD(event)
const char * GetCommandTagName(CommandTag commandTag)
List * stringToQualifiedNameList(const char *string)
#define TRIGGER_FIRED_BY_INSERT(event)
char * OidOutputFunctionCall(Oid functionId, Datum val)
int errmsg(const char *fmt,...)
AclResult pg_proc_aclcheck(Oid proc_oid, Oid roleid, AclMode mode)
Oid getTypeIOParam(HeapTuple typeTuple)
void pg_bindtextdomain(const char *domain)
static HTAB * pltcl_interp_htab
static char * pltclu_start_proc
void SPI_start_transaction(void)
static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
char * pg_any_to_server(const char *s, int len, int encoding)
#define ReleaseTupleDesc(tupdesc)
#define TRIGGER_FIRED_FOR_ROW(event)
static void pltcl_set_tuple_values(Tcl_Interp *interp, const char *arrayname, uint64 tupno, HeapTuple tuple, TupleDesc tupdesc)
#define TRIGGER_FIRED_BY_UPDATE(event)
#define RelationGetRelid(relation)
static Tcl_Obj * pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc, bool include_generated)
static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
int SPI_execute(const char *src, bool read_only, long tcount)
#define PG_USED_FOR_ASSERTS_ONLY
#define HeapTupleHeaderGetDatumLength(tup)