47#define HAVE_TCL_VERSION(maj,min) \
48 ((TCL_MAJOR_VERSION > maj) || \
49 (TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min))
52#if !HAVE_TCL_VERSION(8,4)
53#error PostgreSQL only supports Tcl 8.4 or later.
61#if !HAVE_TCL_VERSION(8,7)
67#define TEXTDOMAIN PG_TEXTDOMAIN("pltcl")
94 const char *_pltcl_utf_src = NULL; \
95 char *_pltcl_utf_dst = NULL
98 if (_pltcl_utf_src != (const char *) _pltcl_utf_dst) \
99 pfree(_pltcl_utf_dst); \
103 (_pltcl_utf_dst = utf_u2e(_pltcl_utf_src = (x)))
106 (_pltcl_utf_dst = utf_e2u(_pltcl_utf_src = (x)))
265#include "pltclerrcodes.h"
274 Oid prolang,
bool pltrusted);
291 bool is_event_trigger,
294static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
295 int objc, Tcl_Obj *
const objv[]);
298static int pltcl_quote(ClientData cdata, Tcl_Interp *interp,
299 int objc, Tcl_Obj *
const objv[]);
301 int objc, Tcl_Obj *
const objv[]);
303 int objc, Tcl_Obj *
const objv[]);
305 int objc, Tcl_Obj *
const objv[]);
307 int objc, Tcl_Obj *
const objv[]);
309 const char *arrayname,
315 int objc, Tcl_Obj *
const objv[]);
317 int objc, Tcl_Obj *
const objv[]);
319 int objc, Tcl_Obj *
const objv[]);
320static int pltcl_commit(ClientData cdata, Tcl_Interp *interp,
321 int objc, Tcl_Obj *
const objv[]);
323 int objc, Tcl_Obj *
const objv[]);
337 Tcl_Obj **kvObjv,
int kvObjc,
356 static int fakeThreadKey;
358 return (ClientData) &(fakeThreadKey);
378 Tcl_FileProc *proc, ClientData clientData)
410 Tcl_NotifierProcs notifier;
421 Tcl_FindExecutable(
"");
435 Tcl_SetNotifier(¬ifier);
442 elog(
ERROR,
"could not create dummy Tcl interpreter");
444 elog(
ERROR,
"could not initialize dummy Tcl interpreter");
470 gettext_noop(
"PL/Tcl function to call once when pltcl is first used."),
477 gettext_noop(
"PL/TclU function to call once when pltclu is first used."),
504 snprintf(interpname,
sizeof(interpname),
"subsidiary_%u", interp_desc->
user_id);
506 pltrusted ? 1 : 0)) == NULL)
507 elog(
ERROR,
"could not create subsidiary Tcl interpreter");
512 Tcl_InitHashTable(&interp_desc->
query_hash, TCL_STRING_KEYS);
517 Tcl_CreateObjCommand(interp,
"elog",
519 Tcl_CreateObjCommand(interp,
"quote",
521 Tcl_CreateObjCommand(interp,
"argisnull",
523 Tcl_CreateObjCommand(interp,
"return_null",
525 Tcl_CreateObjCommand(interp,
"return_next",
527 Tcl_CreateObjCommand(interp,
"spi_exec",
529 Tcl_CreateObjCommand(interp,
"spi_prepare",
531 Tcl_CreateObjCommand(interp,
"spi_execp",
533 Tcl_CreateObjCommand(interp,
"subtransaction",
535 Tcl_CreateObjCommand(interp,
"commit",
537 Tcl_CreateObjCommand(interp,
"rollback",
549 interp_desc->
interp = interp;
554 interp_desc->
interp = NULL;
555 Tcl_DeleteInterp(interp);
583 interp_desc->
interp = NULL;
613 gucname = pltrusted ?
"pltcl.start_proc" :
"pltclu.start_proc";
616 if (start_proc == NULL || start_proc[0] ==
'\0')
637 elog(
ERROR,
"cache lookup failed for function %u", procOid);
641 if (procStruct->prolang != prolang)
643 (
errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE),
644 errmsg(
"function \"%s\" is in the wrong language",
652 if (procStruct->prosecdef)
654 (
errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE),
655 errmsg(
"function \"%s\" must not be SECURITY DEFINER",
686 const char *gucname = (
const char *)
arg;
689 errcontext(
"processing %s parameter", gucname);
742 memset(¤t_call_state, 0,
sizeof(current_call_state));
772 current_call_state.
fcinfo = fcinfo;
784 if (current_call_state.
prodesc != NULL)
806 Tcl_Interp *
volatile interp;
812 nonatomic = fcinfo->context &&
840 (
errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
841 errmsg(
"set-valued function called in context that cannot accept a set")));
845 (
errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
846 errmsg(
"materialize mode required, but it is not allowed in this context")));
848 call_state->
rsi = rsi;
857 tcl_cmd = Tcl_NewObj();
858 Tcl_ListObjAppendElement(NULL, tcl_cmd,
862 Tcl_IncrRefCount(tcl_cmd);
869 for (
i = 0;
i < prodesc->
nargs;
i++)
876 if (fcinfo->args[
i].isnull)
877 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
897 Tcl_ListObjAppendElement(NULL, tcl_cmd, list_tmp);
908 if (fcinfo->args[
i].isnull)
909 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
915 fcinfo->args[
i].value);
917 Tcl_ListObjAppendElement(NULL, tcl_cmd,
918 Tcl_NewStringObj(
UTF_E2U(tmp), -1));
928 Tcl_DecrRefCount(tcl_cmd);
938 tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
941 Tcl_DecrRefCount(tcl_cmd);
946 if (tcl_rc != TCL_OK)
982 fcinfo->isnull =
true;
984 else if (fcinfo->isnull)
996 Tcl_Obj **resultObjv;
1018 (
errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1019 errmsg(
"function returning record called in context "
1020 "that cannot accept type record")));
1024 elog(
ERROR,
"return type must be a row type");
1034 resultObj = Tcl_GetObjResult(interp);
1035 if (Tcl_ListObjGetElements(interp, resultObj, &resultObjc, &resultObjv) == TCL_ERROR)
1037 (
errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1038 errmsg(
"could not parse function return value: %s",
1039 utf_u2e(Tcl_GetStringResult(interp)))));
1047 utf_u2e(Tcl_GetStringResult(interp)),
1063 Tcl_Interp *
volatile interp;
1069 Tcl_Obj *tcl_trigtup;
1074 Tcl_Obj **result_Objv;
1092 call_state->
prodesc = prodesc;
1103 tcl_cmd = Tcl_NewObj();
1104 Tcl_IncrRefCount(tcl_cmd);
1109 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1113 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1120 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1121 Tcl_NewStringObj(stroid, -1));
1126 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1127 Tcl_NewStringObj(
utf_e2u(stroid), -1));
1132 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1133 Tcl_NewStringObj(
utf_e2u(stroid), -1));
1137 tcl_trigtup = Tcl_NewObj();
1138 Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
1139 for (
i = 0;
i < tupdesc->natts;
i++)
1143 if (att->attisdropped)
1144 Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
1146 Tcl_ListObjAppendElement(NULL, tcl_trigtup,
1149 Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
1153 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1154 Tcl_NewStringObj(
"BEFORE", -1));
1156 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1157 Tcl_NewStringObj(
"AFTER", -1));
1159 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1160 Tcl_NewStringObj(
"INSTEAD OF", -1));
1167 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1168 Tcl_NewStringObj(
"ROW", -1));
1179 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1180 Tcl_NewStringObj(
"INSERT", -1));
1182 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1186 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1192 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1193 Tcl_NewStringObj(
"DELETE", -1));
1195 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1196 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1205 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1206 Tcl_NewStringObj(
"UPDATE", -1));
1208 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1212 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1224 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1225 Tcl_NewStringObj(
"STATEMENT", -1));
1228 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1229 Tcl_NewStringObj(
"INSERT", -1));
1231 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1232 Tcl_NewStringObj(
"DELETE", -1));
1234 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1235 Tcl_NewStringObj(
"UPDATE", -1));
1237 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1238 Tcl_NewStringObj(
"TRUNCATE", -1));
1242 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1243 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1252 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1257 Tcl_DecrRefCount(tcl_cmd);
1267 tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
1270 Tcl_DecrRefCount(tcl_cmd);
1275 if (tcl_rc != TCL_OK)
1289 result = Tcl_GetStringResult(interp);
1291 if (strcmp(result,
"OK") == 0)
1293 if (strcmp(result,
"SKIP") == 0)
1300 if (Tcl_ListObjGetElements(interp, Tcl_GetObjResult(interp),
1301 &result_Objc, &result_Objv) != TCL_OK)
1303 (
errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
1304 errmsg(
"could not parse trigger return value: %s",
1305 utf_u2e(Tcl_GetStringResult(interp)))));
1322 Tcl_Interp *
volatile interp;
1334 call_state->
prodesc = prodesc;
1340 tcl_cmd = Tcl_NewObj();
1341 Tcl_IncrRefCount(tcl_cmd);
1342 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1344 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1346 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1350 tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
1353 Tcl_DecrRefCount(tcl_cmd);
1356 if (tcl_rc != TCL_OK)
1386 econtext =
utf_u2e(Tcl_GetVar(interp,
"errorInfo", TCL_GLOBAL_ONLY));
1392 emsglen = strlen(emsg);
1393 if (strncmp(emsg, econtext, emsglen) == 0 &&
1394 econtext[emsglen] ==
'\n')
1395 econtext += emsglen + 1;
1398 while (*econtext ==
' ')
1403 (
errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1418 bool is_event_trigger,
bool pltrusted)
1428 Tcl_DString proc_internal_def;
1429 Tcl_DString proc_internal_name;
1430 Tcl_DString proc_internal_body;
1435 elog(
ERROR,
"cache lookup failed for function %u", fn_oid);
1459 if (prodesc != NULL &&
1477 Tcl_DStringInit(&proc_internal_def);
1478 Tcl_DStringInit(&proc_internal_name);
1479 Tcl_DStringInit(&proc_internal_body);
1483 Tcl_CmdInfo cmdinfo;
1484 const char *user_proname;
1485 const char *internal_proname;
1486 bool need_underscore;
1503 interp = interp_desc->
interp;
1513 if (prodesc != NULL &&
1539 if (is_event_trigger)
1540 Tcl_DStringAppend(&proc_internal_name,
1541 "__PLTcl_evttrigger_", -1);
1542 else if (is_trigger)
1543 Tcl_DStringAppend(&proc_internal_name,
1544 "__PLTcl_trigger_", -1);
1546 Tcl_DStringAppend(&proc_internal_name,
1547 "__PLTcl_proc_", -1);
1549 need_underscore =
false;
1550 for (
const char *ptr = user_proname; *ptr; ptr++)
1552 if (strchr(
"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
1553 "abcdefghijklmnopqrstuvwxyz"
1554 "0123456789_", *ptr) != NULL)
1557 if (need_underscore)
1559 Tcl_DStringAppend(&proc_internal_name,
"_", 1);
1560 need_underscore =
false;
1562 Tcl_DStringAppend(&proc_internal_name, ptr, 1);
1564 else if (strchr(
"(, ", *ptr) != NULL)
1565 need_underscore =
true;
1568 while (Tcl_GetCommandInfo(interp,
1569 Tcl_DStringValue(&proc_internal_name),
1573 Tcl_DStringAppend(&proc_internal_name,
buf, -1);
1575 internal_proname = Tcl_DStringValue(&proc_internal_name);
1593 prodesc->
fn_cxt = proc_cxt;
1597 prodesc->
nargs = procStruct->pronargs;
1604 (procStruct->provolatile != PROVOLATILE_VOLATILE);
1614 if (!is_trigger && !is_event_trigger)
1616 Oid rettype = procStruct->prorettype;
1620 elog(
ERROR,
"cache lookup failed for type %u", rettype);
1624 if (typeStruct->typtype == TYPTYPE_PSEUDO)
1626 if (rettype == VOIDOID ||
1627 rettype == RECORDOID)
1629 else if (rettype == TRIGGEROID ||
1630 rettype == EVENT_TRIGGEROID)
1632 (
errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1633 errmsg(
"trigger functions can only be called as triggers")));
1636 (
errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1637 errmsg(
"PL/Tcl functions cannot return type %s",
1649 prodesc->
fn_retisdomain = (typeStruct->typtype == TYPTYPE_DOMAIN);
1659 if (!is_trigger && !is_event_trigger)
1661 proc_internal_args[0] =
'\0';
1662 for (
i = 0;
i < prodesc->
nargs;
i++)
1664 Oid argtype = procStruct->proargtypes.values[
i];
1668 elog(
ERROR,
"cache lookup failed for type %u", argtype);
1672 if (typeStruct->typtype == TYPTYPE_PSEUDO &&
1673 argtype != RECORDOID)
1675 (
errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1676 errmsg(
"PL/Tcl functions cannot accept type %s",
1694 strcat(proc_internal_args,
" ");
1695 strcat(proc_internal_args,
buf);
1700 else if (is_trigger)
1703 strcpy(proc_internal_args,
1704 "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");
1706 else if (is_event_trigger)
1709 strcpy(proc_internal_args,
"TG_event TG_tag");
1720 Tcl_DStringAppendElement(&proc_internal_def,
"proc");
1721 Tcl_DStringAppendElement(&proc_internal_def, internal_proname);
1722 Tcl_DStringAppendElement(&proc_internal_def, proc_internal_args);
1729 Tcl_DStringAppend(&proc_internal_body,
"upvar #0 ", -1);
1730 Tcl_DStringAppend(&proc_internal_body, internal_proname, -1);
1731 Tcl_DStringAppend(&proc_internal_body,
" GD\n", -1);
1734 Tcl_DStringAppend(&proc_internal_body,
1735 "array set NEW $__PLTcl_Tup_NEW\n", -1);
1736 Tcl_DStringAppend(&proc_internal_body,
1737 "array set OLD $__PLTcl_Tup_OLD\n", -1);
1738 Tcl_DStringAppend(&proc_internal_body,
1741 "foreach v $args {\n"
1745 "unset i v\n\n", -1);
1747 else if (is_event_trigger)
1753 for (
i = 0;
i < prodesc->
nargs;
i++)
1758 "array set %d $__PLTcl_Tup_%d\n",
1760 Tcl_DStringAppend(&proc_internal_body,
buf, -1);
1769 Anum_pg_proc_prosrc);
1772 Tcl_DStringAppend(&proc_internal_body,
UTF_E2U(proc_source), -1);
1775 Tcl_DStringAppendElement(&proc_internal_def,
1776 Tcl_DStringValue(&proc_internal_body));
1781 tcl_rc = Tcl_EvalEx(interp,
1782 Tcl_DStringValue(&proc_internal_def),
1783 Tcl_DStringLength(&proc_internal_def),
1785 if (tcl_rc != TCL_OK)
1787 (
errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1788 errmsg(
"could not create internal procedure \"%s\": %s",
1790 utf_u2e(Tcl_GetStringResult(interp)))));
1800 Tcl_DStringFree(&proc_internal_def);
1801 Tcl_DStringFree(&proc_internal_name);
1802 Tcl_DStringFree(&proc_internal_body);
1822 if (old_prodesc != NULL)
1829 Tcl_DStringFree(&proc_internal_def);
1830 Tcl_DStringFree(&proc_internal_name);
1831 Tcl_DStringFree(&proc_internal_body);
1844 int objc, Tcl_Obj *
const objv[])
1850 static const char *logpriorities[] = {
1851 "DEBUG",
"LOG",
"INFO",
"NOTICE",
1852 "WARNING",
"ERROR",
"FATAL", (
const char *) NULL
1855 static const int loglevels[] = {
1862 Tcl_WrongNumArgs(interp, 1, objv,
"level msg");
1866 if (Tcl_GetIndexFromObj(interp, objv[1], logpriorities,
"priority",
1867 TCL_EXACT, &priIndex) != TCL_OK)
1870 level = loglevels[priIndex];
1879 Tcl_SetObjResult(interp, objv[2]);
1897 (
errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1913 Tcl_SetObjResult(interp, Tcl_NewStringObj(
UTF_E2U(edata->
message), -1));
1932 Tcl_Obj *obj = Tcl_NewObj();
1934 Tcl_ListObjAppendElement(interp, obj,
1935 Tcl_NewStringObj(
"POSTGRES", -1));
1936 Tcl_ListObjAppendElement(interp, obj,
1937 Tcl_NewStringObj(PG_VERSION, -1));
1938 Tcl_ListObjAppendElement(interp, obj,
1939 Tcl_NewStringObj(
"SQLSTATE", -1));
1940 Tcl_ListObjAppendElement(interp, obj,
1942 Tcl_ListObjAppendElement(interp, obj,
1943 Tcl_NewStringObj(
"condition", -1));
1944 Tcl_ListObjAppendElement(interp, obj,
1946 Tcl_ListObjAppendElement(interp, obj,
1947 Tcl_NewStringObj(
"message", -1));
1949 Tcl_ListObjAppendElement(interp, obj,
1954 Tcl_ListObjAppendElement(interp, obj,
1955 Tcl_NewStringObj(
"detail", -1));
1957 Tcl_ListObjAppendElement(interp, obj,
1963 Tcl_ListObjAppendElement(interp, obj,
1964 Tcl_NewStringObj(
"hint", -1));
1966 Tcl_ListObjAppendElement(interp, obj,
1972 Tcl_ListObjAppendElement(interp, obj,
1973 Tcl_NewStringObj(
"context", -1));
1975 Tcl_ListObjAppendElement(interp, obj,
1981 Tcl_ListObjAppendElement(interp, obj,
1982 Tcl_NewStringObj(
"schema", -1));
1984 Tcl_ListObjAppendElement(interp, obj,
1990 Tcl_ListObjAppendElement(interp, obj,
1991 Tcl_NewStringObj(
"table", -1));
1993 Tcl_ListObjAppendElement(interp, obj,
1999 Tcl_ListObjAppendElement(interp, obj,
2000 Tcl_NewStringObj(
"column", -1));
2002 Tcl_ListObjAppendElement(interp, obj,
2008 Tcl_ListObjAppendElement(interp, obj,
2009 Tcl_NewStringObj(
"datatype", -1));
2011 Tcl_ListObjAppendElement(interp, obj,
2017 Tcl_ListObjAppendElement(interp, obj,
2018 Tcl_NewStringObj(
"constraint", -1));
2020 Tcl_ListObjAppendElement(interp, obj,
2027 Tcl_ListObjAppendElement(interp, obj,
2028 Tcl_NewStringObj(
"statement", -1));
2030 Tcl_ListObjAppendElement(interp, obj,
2036 Tcl_ListObjAppendElement(interp, obj,
2037 Tcl_NewStringObj(
"cursor_position", -1));
2038 Tcl_ListObjAppendElement(interp, obj,
2043 Tcl_ListObjAppendElement(interp, obj,
2044 Tcl_NewStringObj(
"filename", -1));
2046 Tcl_ListObjAppendElement(interp, obj,
2052 Tcl_ListObjAppendElement(interp, obj,
2053 Tcl_NewStringObj(
"lineno", -1));
2054 Tcl_ListObjAppendElement(interp, obj,
2055 Tcl_NewIntObj(edata->
lineno));
2059 Tcl_ListObjAppendElement(interp, obj,
2060 Tcl_NewStringObj(
"funcname", -1));
2062 Tcl_ListObjAppendElement(interp, obj,
2067 Tcl_SetObjErrorCode(interp, obj);
2084 return "unrecognized_sqlstate";
2094 int objc, Tcl_Obj *
const objv[])
2106 Tcl_WrongNumArgs(interp, 1, objv,
"string");
2114 cp1 = Tcl_GetStringFromObj(objv[1], &length);
2115 tmp =
palloc(length * 2 + 1);
2137 Tcl_SetObjResult(interp, Tcl_NewStringObj(tmp, -1));
2148 int objc, Tcl_Obj *
const objv[])
2158 Tcl_WrongNumArgs(interp, 1, objv,
"argno");
2167 Tcl_SetObjResult(interp,
2168 Tcl_NewStringObj(
"argisnull cannot be used in triggers", -1));
2175 if (Tcl_GetIntFromObj(interp, objv[1], &argno) != TCL_OK)
2182 if (argno < 0 || argno >= fcinfo->
nargs)
2184 Tcl_SetObjResult(interp,
2185 Tcl_NewStringObj(
"argno out of range", -1));
2192 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
PG_ARGISNULL(argno)));
2202 int objc, Tcl_Obj *
const objv[])
2211 Tcl_WrongNumArgs(interp, 1, objv,
"");
2220 Tcl_SetObjResult(interp,
2221 Tcl_NewStringObj(
"return_null cannot be used in triggers", -1));
2240 int objc, Tcl_Obj *
const objv[])
2247 volatile int result = TCL_OK;
2254 Tcl_SetObjResult(interp,
2255 Tcl_NewStringObj(
"return_next cannot be used in triggers", -1));
2261 Tcl_SetObjResult(interp,
2262 Tcl_NewStringObj(
"return_next cannot be used in non-set-returning functions", -1));
2271 Tcl_WrongNumArgs(interp, 1, objv,
"result");
2296 if (Tcl_ListObjGetElements(interp, objv[1], &rowObjc, &rowObjv) == TCL_ERROR)
2310 bool isNull =
false;
2314 elog(
ERROR,
"wrong result type supplied in return_next");
2317 utf_u2e((
char *) Tcl_GetString(objv[1])),
2398 Tcl_SetObjResult(interp, Tcl_NewStringObj(
UTF_E2U(edata->
message), -1));
2410 int objc, Tcl_Obj *
const objv[])
2418 const char *
volatile arrayname = NULL;
2419 Tcl_Obj *
volatile loop_body = NULL;
2425 OPT_ARRAY, OPT_COUNT
2428 static const char *
options[] = {
2429 "-array",
"-count", (
const char *) NULL
2437 Tcl_WrongNumArgs(interp, 1, objv,
2438 "?-count n? ?-array name? query ?loop body?");
2445 if (Tcl_GetIndexFromObj(NULL, objv[
i],
options, NULL,
2446 TCL_EXACT, &optIndex) != TCL_OK)
2451 Tcl_SetObjResult(interp,
2452 Tcl_NewStringObj(
"missing argument to -count or -array", -1));
2456 switch ((
enum options) optIndex)
2459 arrayname = Tcl_GetString(objv[
i++]);
2463 if (Tcl_GetIntFromObj(interp, objv[
i++], &count) != TCL_OK)
2470 if (query_idx >= objc || query_idx + 2 < objc)
2472 Tcl_WrongNumArgs(interp, query_idx - 1, objv,
"query ?loop body?");
2476 if (query_idx + 1 < objc)
2477 loop_body = objv[query_idx + 1];
2519 const char *arrayname,
2537 Tcl_SetObjResult(interp, Tcl_NewWideIntObj(ntuples));
2542 if (tuptable == NULL)
2544 Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
2559 tuples = tuptable->
vals;
2562 if (loop_body == NULL)
2570 tuples[0], tupdesc);
2580 for (
i = 0;
i < ntuples;
i++)
2583 tuples[
i], tupdesc);
2585 loop_rc = Tcl_EvalObjEx(interp, loop_body, 0);
2587 if (loop_rc == TCL_OK)
2589 if (loop_rc == TCL_CONTINUE)
2591 if (loop_rc == TCL_RETURN)
2596 if (loop_rc == TCL_BREAK)
2603 if (my_rc == TCL_OK)
2605 Tcl_SetObjResult(interp, Tcl_NewWideIntObj(ntuples));
2610 Tcl_AppendResult(interp,
"pltcl: SPI_execute failed: ",
2632 int objc, Tcl_Obj *
const objv[])
2639 Tcl_HashEntry *hashent;
2641 Tcl_HashTable *query_hash;
2650 Tcl_WrongNumArgs(interp, 1, objv,
"query argtypes");
2657 if (Tcl_ListObjGetElements(interp, objv[2], &nargs, &argsObj) != TCL_OK)
2668 "PL/Tcl spi_prepare query",
2673 qdesc->
nargs = nargs;
2693 for (
i = 0;
i < nargs;
i++)
2701 &typId, &typmod, NULL);
2718 if (qdesc->
plan == NULL)
2746 hashent = Tcl_CreateHashEntry(query_hash, qdesc->
qname, &hashnew);
2747 Tcl_SetHashValue(hashent, (ClientData) qdesc);
2750 Tcl_SetObjResult(interp, Tcl_NewStringObj(qdesc->
qname, -1));
2760 int objc, Tcl_Obj *
const objv[])
2767 Tcl_HashEntry *hashent;
2769 const char *nulls = NULL;
2770 const char *arrayname = NULL;
2771 Tcl_Obj *loop_body = NULL;
2774 Tcl_Obj **callObjv = NULL;
2778 Tcl_HashTable *query_hash;
2782 OPT_ARRAY, OPT_COUNT, OPT_NULLS
2785 static const char *
options[] = {
2786 "-array",
"-count",
"-nulls", (
const char *) NULL
2795 if (Tcl_GetIndexFromObj(NULL, objv[
i],
options, NULL,
2796 TCL_EXACT, &optIndex) != TCL_OK)
2801 Tcl_SetObjResult(interp,
2802 Tcl_NewStringObj(
"missing argument to -array, -count or -nulls", -1));
2806 switch ((
enum options) optIndex)
2809 arrayname = Tcl_GetString(objv[
i++]);
2813 if (Tcl_GetIntFromObj(interp, objv[
i++], &count) != TCL_OK)
2818 nulls = Tcl_GetString(objv[
i++]);
2828 Tcl_SetObjResult(interp,
2829 Tcl_NewStringObj(
"missing argument to -count or -array", -1));
2835 hashent = Tcl_FindHashEntry(query_hash, Tcl_GetString(objv[
i]));
2836 if (hashent == NULL)
2838 Tcl_AppendResult(interp,
"invalid queryid '", Tcl_GetString(objv[
i]),
"'", NULL);
2849 if (strlen(nulls) != qdesc->
nargs)
2851 Tcl_SetObjResult(interp,
2852 Tcl_NewStringObj(
"length of nulls string doesn't match number of arguments",
2862 if (qdesc->
nargs > 0)
2866 Tcl_SetObjResult(interp,
2867 Tcl_NewStringObj(
"argument list length doesn't match number of arguments for query",
2875 if (Tcl_ListObjGetElements(interp, objv[
i++], &callObjc, &callObjv) != TCL_OK)
2881 if (callObjc != qdesc->
nargs)
2883 Tcl_SetObjResult(interp,
2884 Tcl_NewStringObj(
"argument list length doesn't match number of arguments for query",
2896 loop_body = objv[
i++];
2900 Tcl_WrongNumArgs(interp, 1, objv,
2901 "?-count n? ?-array name? ?-nulls string? "
2902 "query ?args? ?loop body?");
2921 for (
j = 0;
j < callObjc;
j++)
2923 if (nulls && nulls[
j] ==
'n')
2934 UTF_U2E(Tcl_GetString(callObjv[
j])),
2976 int objc, Tcl_Obj *
const objv[])
2984 Tcl_WrongNumArgs(interp, 1, objv,
"command");
2996 retcode = Tcl_EvalObjEx(interp, objv[1], 0);
2998 if (retcode == TCL_ERROR)
3024 int objc, Tcl_Obj *
const objv[])
3044 Tcl_SetObjResult(interp, Tcl_NewStringObj(
UTF_E2U(edata->
message), -1));
3063 int objc, Tcl_Obj *
const objv[])
3083 Tcl_SetObjResult(interp, Tcl_NewStringObj(
UTF_E2U(edata->
message), -1));
3112 const char **arrptr;
3113 const char **nameptr;
3114 const char *nullname = NULL;
3119 if (arrayname == NULL)
3122 nameptr = &nullname;
3126 arrptr = &arrayname;
3134 Tcl_SetVar2Ex(interp, arrayname,
".tupno", Tcl_NewWideIntObj(tupno), 0);
3137 for (
i = 0;
i < tupdesc->
natts;
i++)
3142 if (att->attisdropped)
3170 Tcl_SetVar2Ex(interp, *arrptr, *nameptr,
3171 Tcl_NewStringObj(
UTF_E2U(outputstr), -1), 0);
3176 Tcl_UnsetVar2(interp, *arrptr, *nameptr, 0);
3190 Tcl_Obj *retobj = Tcl_NewObj();
3199 for (
i = 0;
i < tupdesc->
natts;
i++)
3204 if (att->attisdropped)
3207 if (att->attgenerated)
3210 if (!include_generated)
3213 if (att->attgenerated == ATTRIBUTE_GENERATED_VIRTUAL)
3238 &typoutput, &typisvarlena);
3241 Tcl_ListObjAppendElement(NULL, retobj,
3245 Tcl_ListObjAppendElement(NULL, retobj,
3246 Tcl_NewStringObj(
UTF_E2U(outputstr), -1));
3288 elog(
ERROR,
"PL/Tcl function does not return a tuple");
3295 if (kvObjc % 2 != 0)
3297 (
errcode(ERRCODE_INVALID_PARAMETER_VALUE),
3298 errmsg(
"column name/value list must have even number of elements")));
3300 for (
i = 0;
i < kvObjc;
i += 2)
3302 char *fieldName =
utf_u2e(Tcl_GetString(kvObjv[
i]));
3312 if (strcmp(fieldName,
".tupno") == 0)
3315 (
errcode(ERRCODE_UNDEFINED_COLUMN),
3316 errmsg(
"column name/value list contains nonexistent column name \"%s\"",
3322 (
errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
3323 errmsg(
"cannot set system attribute \"%s\"",
3328 (
errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
3329 errmsg(
"cannot set generated column \"%s\"",
void aclcheck_error(AclResult aclerr, ObjectType objtype, const char *objectname)
AclResult object_aclcheck(Oid classid, Oid objectid, Oid roleid, AclMode mode)
static Datum values[MAXATTR]
#define TextDatumGetCString(d)
#define unconstify(underlying_type, expr)
#define PG_USED_FOR_ASSERTS_ONLY
#define OidIsValid(objectId)
const char * GetCommandTagName(CommandTag commandTag)
void domain_check(Datum value, bool isnull, Oid domainType, void **extra, MemoryContext mcxt)
void * hash_search(HTAB *hashp, const void *keyPtr, HASHACTION action, bool *foundPtr)
HTAB * hash_create(const char *tabname, long nelem, const HASHCTL *info, int flags)
void FreeErrorData(ErrorData *edata)
ErrorContextCallback * error_context_stack
ErrorData * CopyErrorData(void)
void FlushErrorState(void)
int errcode(int sqlerrcode)
int errmsg(const char *fmt,...)
char * unpack_sql_state(int sql_state)
#define ereport(elevel,...)
#define CALLED_AS_EVENT_TRIGGER(fcinfo)
HeapTuple BuildTupleFromCStrings(AttInMetadata *attinmeta, char **values)
AttInMetadata * TupleDescGetAttInMetadata(TupleDesc tupdesc)
@ SFRM_Materialize_Random
Datum InputFunctionCall(FmgrInfo *flinfo, char *str, Oid typioparam, int32 typmod)
void fmgr_info(Oid functionId, FmgrInfo *finfo)
char * OidOutputFunctionCall(Oid functionId, Datum val)
void fmgr_info_cxt(Oid functionId, FmgrInfo *finfo, MemoryContext mcxt)
char * OutputFunctionCall(FmgrInfo *flinfo, Datum val)
#define DatumGetHeapTupleHeader(X)
#define InitFunctionCallInfoData(Fcinfo, Flinfo, Nargs, Collation, Context, Resultinfo)
#define DirectFunctionCall1(func, arg1)
#define LOCAL_FCINFO(name, nargs)
#define FunctionCallInvoke(fcinfo)
TypeFuncClass get_call_result_type(FunctionCallInfo fcinfo, Oid *resultTypeId, TupleDesc *resultTupleDesc)
@ TYPEFUNC_COMPOSITE_DOMAIN
static Datum HeapTupleGetDatum(const HeapTupleData *tuple)
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 MarkGUCPrefixReserved(const char *className)
Assert(PointerIsAligned(start, uint64))
HeapTupleData * HeapTuple
#define HeapTupleIsValid(tuple)
static Datum heap_getattr(HeapTuple tup, int attnum, TupleDesc tupleDesc, bool *isnull)
static int32 HeapTupleHeaderGetTypMod(const HeapTupleHeaderData *tup)
static TransactionId HeapTupleHeaderGetRawXmin(const HeapTupleHeaderData *tup)
static uint32 HeapTupleHeaderGetDatumLength(const HeapTupleHeaderData *tup)
static void * GETSTRUCT(const HeapTupleData *tuple)
static Oid HeapTupleHeaderGetTypeId(const HeapTupleHeaderData *tup)
if(TABLE==NULL||TABLE_index==NULL)
bool ItemPointerEquals(ItemPointer pointer1, ItemPointer pointer2)
bool type_is_rowtype(Oid typid)
void getTypeOutputInfo(Oid type, Oid *typOutput, bool *typIsVarlena)
void getTypeInputInfo(Oid type, Oid *typInput, Oid *typIOParam)
Oid getTypeIOParam(HeapTuple typeTuple)
char * pg_any_to_server(const char *s, int len, int encoding)
char * pg_server_to_any(const char *s, int len, int encoding)
char * pstrdup(const char *in)
void pfree(void *pointer)
void * palloc0(Size size)
MemoryContext TopMemoryContext
MemoryContext CurrentMemoryContext
void MemoryContextDelete(MemoryContext context)
void MemoryContextSetIdentifier(MemoryContext context, const char *id)
#define AllocSetContextCreate
#define ALLOCSET_SMALL_SIZES
void pg_bindtextdomain(const char *domain)
#define IsA(nodeptr, _type_)
#define castNode(_type_, nodeptr)
#define InvokeFunctionExecuteHook(objectId)
Datum oidout(PG_FUNCTION_ARGS)
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Oid LookupFuncName(List *funcname, int nargs, const Oid *argtypes, bool missing_ok)
bool parseTypeString(const char *str, Oid *typeid_p, int32 *typmod_p, Node *escontext)
FormData_pg_attribute * Form_pg_attribute
static PgChecksumMode mode
FormData_pg_proc * Form_pg_proc
FormData_pg_type * Form_pg_type
void pgstat_init_function_usage(FunctionCallInfo fcinfo, PgStat_FunctionCallUsage *fcu)
void pgstat_end_function_usage(PgStat_FunctionCallUsage *fcu, bool finalize)
static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, bool pltrusted)
PG_FUNCTION_INFO_V1(pltcl_call_handler)
static void pltcl_ServiceModeHook(int mode)
static const char * pltcl_get_condition_name(int sqlstate)
static HTAB * pltcl_proc_htab
static void pltcl_AlertNotifier(ClientData clientData)
static char * utf_e2u(const char *src)
static int pltcl_WaitForEvent(CONST86 Tcl_Time *timePtr)
static void pltcl_init_tuple_store(pltcl_call_state *call_state)
static Tcl_Obj * pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc, bool include_generated)
static pltcl_proc_desc * compile_pltcl_function(Oid fn_oid, Oid tgreloid, bool is_event_trigger, bool pltrusted)
static void call_pltcl_start_proc(Oid prolang, bool pltrusted)
static int pltcl_returnnext(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
static void pltcl_SetTimer(CONST86 Tcl_Time *timePtr)
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, const char *arrayname, Tcl_Obj *loop_body, int spi_rc, SPITupleTable *tuptable, uint64 ntuples)
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
static void pltcl_subtrans_abort(Tcl_Interp *interp, MemoryContext oldcontext, ResourceOwner oldowner)
static void pltcl_DeleteFileHandler(int fd)
static int pltcl_quote(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
struct pltcl_proc_desc pltcl_proc_desc
static void pltcl_FinalizeNotifier(ClientData clientData)
static void throw_tcl_error(Tcl_Interp *interp, const char *proname)
static void pltcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData)
static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
static char * pltcl_start_proc
static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted)
static HTAB * pltcl_interp_htab
struct pltcl_proc_key pltcl_proc_key
static pltcl_interp_desc * pltcl_fetch_interp(Oid prolang, bool pltrusted)
struct pltcl_interp_desc pltcl_interp_desc
static pltcl_call_state * pltcl_current_call_state
static void pltcl_init_interp(pltcl_interp_desc *interp_desc, Oid prolang, bool pltrusted)
static void pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata)
static char * pltclu_start_proc
PG_MODULE_MAGIC_EXT(.name="pltcl",.version=PG_VERSION)
static void pltcl_event_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, bool pltrusted)
static ClientData pltcl_InitNotifier(void)
static char * utf_u2e(const char *src)
struct pltcl_query_desc pltcl_query_desc
static const TclExceptionNameMap exception_name_map[]
static int pltcl_rollback(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
static void pltcl_set_tuple_values(Tcl_Interp *interp, const char *arrayname, uint64 tupno, HeapTuple tuple, TupleDesc tupdesc)
Datum pltclu_call_handler(PG_FUNCTION_ARGS)
static void start_proc_error_callback(void *arg)
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 void pltcl_subtrans_begin(MemoryContext oldcontext, ResourceOwner oldowner)
static Datum pltcl_func_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, bool pltrusted)
static Tcl_Interp * pltcl_hold_interp
static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
struct pltcl_call_state pltcl_call_state
static void pltcl_subtrans_commit(MemoryContext oldcontext, ResourceOwner oldowner)
static HeapTuple pltcl_build_tuple_result(Tcl_Interp *interp, Tcl_Obj **kvObjv, int kvObjc, pltcl_call_state *call_state)
Datum pltcl_call_handler(PG_FUNCTION_ARGS)
static bool pltcl_pm_init_done
static int pltcl_subtransaction(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
struct pltcl_proc_ptr pltcl_proc_ptr
static int pltcl_commit(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
static Datum PointerGetDatum(const void *X)
static Datum ObjectIdGetDatum(Oid X)
static char * DatumGetCString(Datum X)
static int fd(const char *x, int i)
char * format_procedure(Oid procedure_oid)
List * stringToQualifiedNameList(const char *string, Node *escontext)
#define RelationGetRelid(relation)
#define RelationGetDescr(relation)
ResourceOwner CurrentResourceOwner
int SPI_fnumber(TupleDesc tupdesc, const char *fname)
const char * SPI_result_code_string(int code)
SPITupleTable * SPI_tuptable
int SPI_execute_plan(SPIPlanPtr plan, Datum *Values, const char *Nulls, bool read_only, long tcount)
int SPI_register_trigger_data(TriggerData *tdata)
void SPI_freetuptable(SPITupleTable *tuptable)
SPIPlanPtr SPI_prepare(const char *src, int nargs, Oid *argtypes)
int SPI_keepplan(SPIPlanPtr plan)
int SPI_connect_ext(int options)
char * SPI_getnspname(Relation rel)
int SPI_execute(const char *src, bool read_only, long tcount)
char * SPI_getrelname(Relation rel)
#define SPI_OPT_NONATOMIC
#define SPI_OK_UPDATE_RETURNING
#define SPI_ERROR_NOATTRIBUTE
#define SPI_OK_INSERT_RETURNING
#define SPI_OK_DELETE_RETURNING
#define SPI_OK_MERGE_RETURNING
struct ErrorContextCallback * previous
void(* callback)(void *arg)
MemoryContext ecxt_per_query_memory
SetFunctionReturnMode returnMode
Tuplestorestate * setResult
pltcl_proc_desc * prodesc
MemoryContext tuple_store_cxt
Tuplestorestate * tuple_store
ResourceOwner tuple_store_owner
AttInMetadata * attinmeta
pltcl_interp_desc * interp_desc
unsigned long fn_refcount
pltcl_proc_desc * proc_ptr
void ReleaseSysCache(HeapTuple tuple)
HeapTuple SearchSysCache1(int cacheId, Datum key1)
Datum SysCacheGetAttrNotNull(int cacheId, HeapTuple tup, AttrNumber attributeNumber)
#define TRIGGER_FIRED_FOR_STATEMENT(event)
#define TRIGGER_FIRED_BY_DELETE(event)
#define TRIGGER_FIRED_BEFORE(event)
#define CALLED_AS_TRIGGER(fcinfo)
#define TRIGGER_FIRED_FOR_ROW(event)
#define TRIGGER_FIRED_AFTER(event)
#define TRIGGER_FIRED_BY_TRUNCATE(event)
#define TRIGGER_FIRED_BY_INSERT(event)
#define TRIGGER_FIRED_BY_UPDATE(event)
#define TRIGGER_FIRED_INSTEAD(event)
TupleDesc CreateTupleDescCopy(TupleDesc tupdesc)
#define ReleaseTupleDesc(tupdesc)
static FormData_pg_attribute * TupleDescAttr(TupleDesc tupdesc, int i)
Tuplestorestate * tuplestore_begin_heap(bool randomAccess, bool interXact, int maxKBytes)
void tuplestore_putvalues(Tuplestorestate *state, TupleDesc tdesc, const Datum *values, const bool *isnull)
void tuplestore_puttuple(Tuplestorestate *state, HeapTuple tuple)
TupleDesc lookup_rowtype_tupdesc(Oid type_id, int32 typmod)
void BeginInternalSubTransaction(const char *name)
void RollbackAndReleaseCurrentSubTransaction(void)
void ReleaseCurrentSubTransaction(void)