1 /**********************************************************************
2 * pltcl.c - PostgreSQL support for Tcl as
3 * procedural language (PL)
7 **********************************************************************/
16 /* Hack to deal with Tcl 8.4 const-ification without losing compatibility */
21 /* ... and for Tcl 8.6. */
26 #include "access/htup_details.h"
27 #include "access/xact.h"
28 #include "catalog/pg_proc.h"
29 #include "catalog/pg_type.h"
30 #include "commands/event_trigger.h"
31 #include "commands/trigger.h"
32 #include "executor/spi.h"
34 #include "miscadmin.h"
35 #include "nodes/makefuncs.h"
36 #include "parser/parse_type.h"
37 #include "tcop/tcopprot.h"
38 #include "utils/builtins.h"
39 #include "utils/lsyscache.h"
40 #include "utils/memutils.h"
41 #include "utils/rel.h"
42 #include "utils/syscache.h"
43 #include "utils/typcache.h"
46 #define HAVE_TCL_VERSION(maj,min) \
47 ((TCL_MAJOR_VERSION > maj) || \
48 (TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min))
50 /* In Tcl >= 8.0, really not supposed to touch interp->result directly */
51 #if !HAVE_TCL_VERSION(8,0)
52 #define Tcl_GetStringResult(interp) ((interp)->result)
55 /* define our text domain for translations */
57 #define TEXTDOMAIN PG_TEXTDOMAIN("pltcl")
59 #if defined(UNICODE_CONVERSION) && HAVE_TCL_VERSION(8,1)
61 #include "mb/pg_wchar.h"
63 static unsigned char *
64 utf_u2e(unsigned char *src)
66 return pg_do_encoding_conversion(src, strlen(src), PG_UTF8, GetDatabaseEncoding());
69 static unsigned char *
70 utf_e2u(unsigned char *src)
72 return pg_do_encoding_conversion(src, strlen(src), GetDatabaseEncoding(), PG_UTF8);
76 #define UTF_BEGIN do { \
77 unsigned char *_pltcl_utf_src; \
78 unsigned char *_pltcl_utf_dst
79 #define UTF_END if (_pltcl_utf_src!=_pltcl_utf_dst) \
80 pfree(_pltcl_utf_dst); } while (0)
81 #define UTF_U2E(x) (_pltcl_utf_dst=utf_u2e(_pltcl_utf_src=(x)))
82 #define UTF_E2U(x) (_pltcl_utf_dst=utf_e2u(_pltcl_utf_src=(x)))
83 #else /* !PLTCL_UTF */
87 #define UTF_U2E(x) (x)
88 #define UTF_E2U(x) (x)
89 #endif /* PLTCL_UTF */
94 /**********************************************************************
95 * Information associated with a Tcl interpreter. We have one interpreter
96 * that is used for all pltclu (untrusted) functions. For pltcl (trusted)
97 * functions, there is a separate interpreter for each effective SQL userid.
98 * (This is needed to ensure that an unprivileged user can't inject Tcl code
99 * that'll be executed with the privileges of some other SQL user.)
101 * The pltcl_interp_desc structs are kept in a Postgres hash table indexed
102 * by userid OID, with OID 0 used for the single untrusted interpreter.
103 **********************************************************************/
104 typedef struct pltcl_interp_desc
106 Oid user_id; /* Hash key (must be first!) */
107 Tcl_Interp *interp; /* The interpreter */
108 Tcl_HashTable query_hash; /* pltcl_query_desc structs */
112 /**********************************************************************
113 * The information we cache about loaded procedures
114 **********************************************************************/
115 typedef struct pltcl_proc_desc
118 char *internal_proname;
119 TransactionId fn_xmin;
120 ItemPointerData fn_tid;
123 pltcl_interp_desc *interp_desc;
124 FmgrInfo result_in_func;
125 Oid result_typioparam;
127 FmgrInfo arg_out_func[FUNC_MAX_ARGS];
128 bool arg_is_rowtype[FUNC_MAX_ARGS];
132 /**********************************************************************
133 * The information we cache about prepared and saved plans
134 **********************************************************************/
135 typedef struct pltcl_query_desc
141 FmgrInfo *arginfuncs;
146 /**********************************************************************
147 * For speedy lookup, we maintain a hash table mapping from
148 * function OID + trigger flag + user OID to pltcl_proc_desc pointers.
149 * The reason the pltcl_proc_desc struct isn't directly part of the hash
150 * entry is to simplify recovery from errors during compile_pltcl_function.
152 * Note: if the same function is called by multiple userIDs within a session,
153 * there will be a separate pltcl_proc_desc entry for each userID in the case
154 * of pltcl functions, but only one entry for pltclu functions, because we
155 * set user_id = 0 for that case.
156 **********************************************************************/
157 typedef struct pltcl_proc_key
159 Oid proc_id; /* Function OID */
162 * is_trigger is really a bool, but declare as Oid to ensure this struct
163 * contains no padding
165 Oid is_trigger; /* is it a trigger function? */
166 Oid user_id; /* User calling the function, or 0 */
169 typedef struct pltcl_proc_ptr
171 pltcl_proc_key proc_key; /* Hash key (must be first!) */
172 pltcl_proc_desc *proc_ptr;
176 /**********************************************************************
178 **********************************************************************/
179 static bool pltcl_pm_init_done = false;
180 static Tcl_Interp *pltcl_hold_interp = NULL;
181 static HTAB *pltcl_interp_htab = NULL;
182 static HTAB *pltcl_proc_htab = NULL;
184 /* these are saved and restored by pltcl_handler */
185 static FunctionCallInfo pltcl_current_fcinfo = NULL;
186 static pltcl_proc_desc *pltcl_current_prodesc = NULL;
188 /**********************************************************************
189 * Forward declarations
190 **********************************************************************/
191 Datum pltcl_call_handler(PG_FUNCTION_ARGS);
192 Datum pltclu_call_handler(PG_FUNCTION_ARGS);
195 static void pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted);
196 static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted);
197 static void pltcl_init_load_unknown(Tcl_Interp *interp);
199 static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);
201 static Datum pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted);
203 static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted);
204 static void pltcl_event_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted);
206 static void throw_tcl_error(Tcl_Interp *interp, const char *proname);
208 static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid,
209 bool is_event_trigger,
212 static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
213 int argc, CONST84 char *argv[]);
214 static int pltcl_quote(ClientData cdata, Tcl_Interp *interp,
215 int argc, CONST84 char *argv[]);
216 static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
217 int argc, CONST84 char *argv[]);
218 static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
219 int argc, CONST84 char *argv[]);
221 static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
222 int argc, CONST84 char *argv[]);
223 static int pltcl_process_SPI_result(Tcl_Interp *interp,
224 CONST84 char *arrayname,
225 CONST84 char *loop_body,
227 SPITupleTable *tuptable,
229 static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
230 int argc, CONST84 char *argv[]);
231 static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
232 int argc, CONST84 char *argv[]);
233 static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
234 int argc, CONST84 char *argv[]);
236 static void pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
237 int tupno, HeapTuple tuple, TupleDesc tupdesc);
238 static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
239 Tcl_DString *retval);
243 * Hack to override Tcl's builtin Notifier subsystem. This prevents the
244 * backend from becoming multithreaded, which breaks all sorts of things.
245 * That happens in the default version of Tcl_InitNotifier if the TCL library
246 * has been compiled with multithreading support (i.e. when TCL_THREADS is
247 * defined under Unix, and in all cases under Windows).
248 * It's okay to disable the notifier because we never enter the Tcl event loop
249 * from Postgres, so the notifier capabilities are initialized, but never
250 * used. Only InitNotifier and DeleteFileHandler ever seem to get called
251 * within Postgres, but we implement all the functions for completeness.
252 * We can only fix this with Tcl >= 8.4, when Tcl_SetNotifier() appeared.
254 #if HAVE_TCL_VERSION(8,4)
257 pltcl_InitNotifier(void)
259 static int fakeThreadKey; /* To give valid address for ClientData */
261 return (ClientData) &(fakeThreadKey);
265 pltcl_FinalizeNotifier(ClientData clientData)
270 pltcl_SetTimer(CONST86 Tcl_Time *timePtr)
275 pltcl_AlertNotifier(ClientData clientData)
280 pltcl_CreateFileHandler(int fd, int mask,
281 Tcl_FileProc *proc, ClientData clientData)
286 pltcl_DeleteFileHandler(int fd)
291 pltcl_ServiceModeHook(int mode)
296 pltcl_WaitForEvent(CONST86 Tcl_Time *timePtr)
300 #endif /* HAVE_TCL_VERSION(8,4) */
304 * This routine is a crock, and so is everyplace that calls it. The problem
305 * is that the cached form of pltcl functions/queries is allocated permanently
306 * (mostly via malloc()) and never released until backend exit. Subsidiary
307 * data structures such as fmgr info records therefore must live forever
308 * as well. A better implementation would store all this stuff in a per-
309 * function memory context that could be reclaimed at need. In the meantime,
310 * fmgr_info_cxt must be called specifying TopMemoryContext so that whatever
311 * it might allocate, and whatever the eventual function might allocate using
312 * fn_mcxt, will live forever too.
315 perm_fmgr_info(Oid functionId, FmgrInfo *finfo)
317 fmgr_info_cxt(functionId, finfo, TopMemoryContext);
321 * _PG_init() - library load-time initialization
323 * DO NOT make this static nor change its name!
325 * The work done here must be safe to do in the postmaster process,
326 * in case the pltcl library is preloaded in the postmaster.
333 /* Be sure we do initialization only once (should be redundant now) */
334 if (pltcl_pm_init_done)
337 pg_bindtextdomain(TEXTDOMAIN);
340 /* Required on win32 to prevent error loading init.tcl */
341 Tcl_FindExecutable("");
344 #if HAVE_TCL_VERSION(8,4)
347 * Override the functions in the Notifier subsystem. See comments above.
350 Tcl_NotifierProcs notifier;
352 notifier.setTimerProc = pltcl_SetTimer;
353 notifier.waitForEventProc = pltcl_WaitForEvent;
354 notifier.createFileHandlerProc = pltcl_CreateFileHandler;
355 notifier.deleteFileHandlerProc = pltcl_DeleteFileHandler;
356 notifier.initNotifierProc = pltcl_InitNotifier;
357 notifier.finalizeNotifierProc = pltcl_FinalizeNotifier;
358 notifier.alertNotifierProc = pltcl_AlertNotifier;
359 notifier.serviceModeHookProc = pltcl_ServiceModeHook;
360 Tcl_SetNotifier(¬ifier);
364 /************************************************************
365 * Create the dummy hold interpreter to prevent close of
366 * stdout and stderr on DeleteInterp
367 ************************************************************/
368 if ((pltcl_hold_interp = Tcl_CreateInterp()) == NULL)
369 elog(ERROR, "could not create master Tcl interpreter");
370 if (Tcl_Init(pltcl_hold_interp) == TCL_ERROR)
371 elog(ERROR, "could not initialize master Tcl interpreter");
373 /************************************************************
374 * Create the hash table for working interpreters
375 ************************************************************/
376 memset(&hash_ctl, 0, sizeof(hash_ctl));
377 hash_ctl.keysize = sizeof(Oid);
378 hash_ctl.entrysize = sizeof(pltcl_interp_desc);
379 hash_ctl.hash = oid_hash;
380 pltcl_interp_htab = hash_create("PL/Tcl interpreters",
383 HASH_ELEM | HASH_FUNCTION);
385 /************************************************************
386 * Create the hash table for function lookup
387 ************************************************************/
388 memset(&hash_ctl, 0, sizeof(hash_ctl));
389 hash_ctl.keysize = sizeof(pltcl_proc_key);
390 hash_ctl.entrysize = sizeof(pltcl_proc_ptr);
391 hash_ctl.hash = tag_hash;
392 pltcl_proc_htab = hash_create("PL/Tcl functions",
395 HASH_ELEM | HASH_FUNCTION);
397 pltcl_pm_init_done = true;
400 /**********************************************************************
401 * pltcl_init_interp() - initialize a new Tcl interpreter
402 **********************************************************************/
404 pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted)
409 /************************************************************
410 * Create the Tcl interpreter as a slave of pltcl_hold_interp.
411 * Note: Tcl automatically does Tcl_Init in the untrusted case,
412 * and it's not wanted in the trusted case.
413 ************************************************************/
414 snprintf(interpname, sizeof(interpname), "slave_%u", interp_desc->user_id);
415 if ((interp = Tcl_CreateSlave(pltcl_hold_interp, interpname,
416 pltrusted ? 1 : 0)) == NULL)
417 elog(ERROR, "could not create slave Tcl interpreter");
418 interp_desc->interp = interp;
420 /************************************************************
421 * Initialize the query hash table associated with interpreter
422 ************************************************************/
423 Tcl_InitHashTable(&interp_desc->query_hash, TCL_STRING_KEYS);
425 /************************************************************
426 * Install the commands for SPI support in the interpreter
427 ************************************************************/
428 Tcl_CreateCommand(interp, "elog",
429 pltcl_elog, NULL, NULL);
430 Tcl_CreateCommand(interp, "quote",
431 pltcl_quote, NULL, NULL);
432 Tcl_CreateCommand(interp, "argisnull",
433 pltcl_argisnull, NULL, NULL);
434 Tcl_CreateCommand(interp, "return_null",
435 pltcl_returnnull, NULL, NULL);
437 Tcl_CreateCommand(interp, "spi_exec",
438 pltcl_SPI_execute, NULL, NULL);
439 Tcl_CreateCommand(interp, "spi_prepare",
440 pltcl_SPI_prepare, NULL, NULL);
441 Tcl_CreateCommand(interp, "spi_execp",
442 pltcl_SPI_execute_plan, NULL, NULL);
443 Tcl_CreateCommand(interp, "spi_lastoid",
444 pltcl_SPI_lastoid, NULL, NULL);
446 /************************************************************
447 * Try to load the unknown procedure from pltcl_modules
448 ************************************************************/
449 pltcl_init_load_unknown(interp);
452 /**********************************************************************
453 * pltcl_fetch_interp() - fetch the Tcl interpreter to use for a function
455 * This also takes care of any on-first-use initialization required.
456 * Note: we assume caller has already connected to SPI.
457 **********************************************************************/
458 static pltcl_interp_desc *
459 pltcl_fetch_interp(bool pltrusted)
462 pltcl_interp_desc *interp_desc;
465 /* Find or create the interpreter hashtable entry for this userid */
467 user_id = GetUserId();
469 user_id = InvalidOid;
471 interp_desc = hash_search(pltcl_interp_htab, &user_id,
475 pltcl_init_interp(interp_desc, pltrusted);
480 /**********************************************************************
481 * pltcl_init_load_unknown() - Load the unknown procedure from
482 * table pltcl_modules (if it exists)
483 **********************************************************************/
485 pltcl_init_load_unknown(Tcl_Interp *interp)
494 Tcl_DString unknown_src;
499 /************************************************************
500 * Check if table pltcl_modules exists
502 * We allow the table to be found anywhere in the search_path.
503 * This is for backwards compatibility. To ensure that the table
504 * is trustworthy, we require it to be owned by a superuser.
505 ************************************************************/
506 pmrel = relation_openrv_extended(makeRangeVar(NULL, "pltcl_modules", -1),
507 AccessShareLock, true);
510 /* sanity-check the relation kind */
511 if (!(pmrel->rd_rel->relkind == RELKIND_RELATION ||
512 pmrel->rd_rel->relkind == RELKIND_MATVIEW ||
513 pmrel->rd_rel->relkind == RELKIND_VIEW))
515 relation_close(pmrel, AccessShareLock);
518 /* must be owned by superuser, else ignore */
519 if (!superuser_arg(pmrel->rd_rel->relowner))
521 relation_close(pmrel, AccessShareLock);
524 /* get fully qualified table name for use in select command */
525 nspname = get_namespace_name(RelationGetNamespace(pmrel));
527 elog(ERROR, "cache lookup failed for namespace %u",
528 RelationGetNamespace(pmrel));
529 pmrelname = quote_qualified_identifier(nspname,
530 RelationGetRelationName(pmrel));
532 /************************************************************
533 * Read all the rows from it where modname = 'unknown',
534 * in the order of modseq
535 ************************************************************/
536 buflen = strlen(pmrelname) + 100;
537 buf = (char *) palloc(buflen);
538 snprintf(buf, buflen,
539 "select modsrc from %s where modname = 'unknown' order by modseq",
542 spi_rc = SPI_execute(buf, false, 0);
543 if (spi_rc != SPI_OK_SELECT)
544 elog(ERROR, "select from pltcl_modules failed");
548 /************************************************************
549 * If there's nothing, module unknown doesn't exist
550 ************************************************************/
551 if (SPI_processed == 0)
553 SPI_freetuptable(SPI_tuptable);
554 elog(WARNING, "module \"unknown\" not found in pltcl_modules");
555 relation_close(pmrel, AccessShareLock);
559 /************************************************************
560 * There is a module named unknown. Reassemble the
561 * source from the modsrc attributes and evaluate
562 * it in the Tcl interpreter
563 ************************************************************/
564 fno = SPI_fnumber(SPI_tuptable->tupdesc, "modsrc");
566 Tcl_DStringInit(&unknown_src);
568 for (i = 0; i < SPI_processed; i++)
570 part = SPI_getvalue(SPI_tuptable->vals[i],
571 SPI_tuptable->tupdesc, fno);
575 Tcl_DStringAppend(&unknown_src, UTF_E2U(part), -1);
580 tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&unknown_src));
582 Tcl_DStringFree(&unknown_src);
583 SPI_freetuptable(SPI_tuptable);
585 if (tcl_rc != TCL_OK)
588 elog(ERROR, "could not load module \"unknown\": %s",
589 UTF_U2E(Tcl_GetStringResult(interp)));
593 relation_close(pmrel, AccessShareLock);
597 /**********************************************************************
598 * pltcl_call_handler - This is the only visible function
599 * of the PL interpreter. The PostgreSQL
600 * function manager and trigger manager
601 * call this function for execution of
603 **********************************************************************/
604 PG_FUNCTION_INFO_V1(pltcl_call_handler);
606 /* keep non-static */
608 pltcl_call_handler(PG_FUNCTION_ARGS)
610 return pltcl_handler(fcinfo, true);
614 * Alternative handler for unsafe functions
616 PG_FUNCTION_INFO_V1(pltclu_call_handler);
618 /* keep non-static */
620 pltclu_call_handler(PG_FUNCTION_ARGS)
622 return pltcl_handler(fcinfo, false);
627 pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted)
630 FunctionCallInfo save_fcinfo;
631 pltcl_proc_desc *save_prodesc;
634 * Ensure that static pointers are saved/restored properly
636 save_fcinfo = pltcl_current_fcinfo;
637 save_prodesc = pltcl_current_prodesc;
642 * Determine if called as function or trigger and call appropriate
645 if (CALLED_AS_TRIGGER(fcinfo))
647 pltcl_current_fcinfo = NULL;
648 retval = PointerGetDatum(pltcl_trigger_handler(fcinfo, pltrusted));
650 else if (CALLED_AS_EVENT_TRIGGER(fcinfo))
652 pltcl_current_fcinfo = NULL;
653 pltcl_event_trigger_handler(fcinfo, pltrusted);
658 pltcl_current_fcinfo = fcinfo;
659 retval = pltcl_func_handler(fcinfo, pltrusted);
664 pltcl_current_fcinfo = save_fcinfo;
665 pltcl_current_prodesc = save_prodesc;
670 pltcl_current_fcinfo = save_fcinfo;
671 pltcl_current_prodesc = save_prodesc;
677 /**********************************************************************
678 * pltcl_func_handler() - Handler for regular function calls
679 **********************************************************************/
681 pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
683 pltcl_proc_desc *prodesc;
684 Tcl_Interp *volatile interp;
686 Tcl_DString list_tmp;
691 /* Connect to SPI manager */
692 if (SPI_connect() != SPI_OK_CONNECT)
693 elog(ERROR, "could not connect to SPI manager");
695 /* Find or compile the function */
696 prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid,
699 pltcl_current_prodesc = prodesc;
701 interp = prodesc->interp_desc->interp;
703 /************************************************************
704 * Create the tcl command to call the internal
705 * proc in the Tcl interpreter
706 ************************************************************/
707 Tcl_DStringInit(&tcl_cmd);
708 Tcl_DStringInit(&list_tmp);
709 Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
711 /************************************************************
712 * Add all call arguments to the command
713 ************************************************************/
716 for (i = 0; i < prodesc->nargs; i++)
718 if (prodesc->arg_is_rowtype[i])
720 /**************************************************
721 * For tuple values, add a list for 'array set ...'
722 **************************************************/
723 if (fcinfo->argnull[i])
724 Tcl_DStringAppendElement(&tcl_cmd, "");
731 HeapTupleData tmptup;
733 td = DatumGetHeapTupleHeader(fcinfo->arg[i]);
734 /* Extract rowtype info and find a tupdesc */
735 tupType = HeapTupleHeaderGetTypeId(td);
736 tupTypmod = HeapTupleHeaderGetTypMod(td);
737 tupdesc = lookup_rowtype_tupdesc(tupType, tupTypmod);
738 /* Build a temporary HeapTuple control structure */
739 tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
742 Tcl_DStringSetLength(&list_tmp, 0);
743 pltcl_build_tuple_argument(&tmptup, tupdesc, &list_tmp);
744 Tcl_DStringAppendElement(&tcl_cmd,
745 Tcl_DStringValue(&list_tmp));
746 ReleaseTupleDesc(tupdesc);
751 /**************************************************
752 * Single values are added as string element
753 * of their external representation
754 **************************************************/
755 if (fcinfo->argnull[i])
756 Tcl_DStringAppendElement(&tcl_cmd, "");
761 tmp = OutputFunctionCall(&prodesc->arg_out_func[i],
764 Tcl_DStringAppendElement(&tcl_cmd, UTF_E2U(tmp));
773 Tcl_DStringFree(&tcl_cmd);
774 Tcl_DStringFree(&list_tmp);
778 Tcl_DStringFree(&list_tmp);
780 /************************************************************
781 * Call the Tcl function
783 * We assume no PG error can be thrown directly from this call.
784 ************************************************************/
785 tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
786 Tcl_DStringFree(&tcl_cmd);
788 /************************************************************
789 * Check for errors reported by Tcl.
790 ************************************************************/
791 if (tcl_rc != TCL_OK)
792 throw_tcl_error(interp, prodesc->user_proname);
794 /************************************************************
795 * Disconnect from SPI manager and then create the return
796 * value datum (if the input function does a palloc for it
797 * this must not be allocated in the SPI memory context
798 * because SPI_finish would free it). But don't try to call
799 * the result_in_func if we've been told to return a NULL;
800 * the Tcl result may not be a valid value of the result type
802 ************************************************************/
803 if (SPI_finish() != SPI_OK_FINISH)
804 elog(ERROR, "SPI_finish() failed");
807 retval = InputFunctionCall(&prodesc->result_in_func,
809 prodesc->result_typioparam,
814 retval = InputFunctionCall(&prodesc->result_in_func,
815 UTF_U2E((char *) Tcl_GetStringResult(interp)),
816 prodesc->result_typioparam,
825 /**********************************************************************
826 * pltcl_trigger_handler() - Handler for trigger calls
827 **********************************************************************/
829 pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
831 pltcl_proc_desc *prodesc;
832 Tcl_Interp *volatile interp;
833 TriggerData *trigdata = (TriggerData *) fcinfo->context;
836 volatile HeapTuple rettup;
838 Tcl_DString tcl_trigtup;
839 Tcl_DString tcl_newtup;
846 CONST84 char *result;
847 CONST84 char **ret_values;
849 /* Connect to SPI manager */
850 if (SPI_connect() != SPI_OK_CONNECT)
851 elog(ERROR, "could not connect to SPI manager");
853 /* Find or compile the function */
854 prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid,
855 RelationGetRelid(trigdata->tg_relation),
856 false, /* not an event trigger */
859 pltcl_current_prodesc = prodesc;
861 interp = prodesc->interp_desc->interp;
863 tupdesc = trigdata->tg_relation->rd_att;
865 /************************************************************
866 * Create the tcl command to call the internal
867 * proc in the interpreter
868 ************************************************************/
869 Tcl_DStringInit(&tcl_cmd);
870 Tcl_DStringInit(&tcl_trigtup);
871 Tcl_DStringInit(&tcl_newtup);
874 /* The procedure name */
875 Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
877 /* The trigger name for argument TG_name */
878 Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgname);
880 /* The oid of the trigger relation for argument TG_relid */
881 stroid = DatumGetCString(DirectFunctionCall1(oidout,
882 ObjectIdGetDatum(trigdata->tg_relation->rd_id)));
883 Tcl_DStringAppendElement(&tcl_cmd, stroid);
886 /* The name of the table the trigger is acting on: TG_table_name */
887 stroid = SPI_getrelname(trigdata->tg_relation);
888 Tcl_DStringAppendElement(&tcl_cmd, stroid);
891 /* The schema of the table the trigger is acting on: TG_table_schema */
892 stroid = SPI_getnspname(trigdata->tg_relation);
893 Tcl_DStringAppendElement(&tcl_cmd, stroid);
896 /* A list of attribute names for argument TG_relatts */
897 Tcl_DStringAppendElement(&tcl_trigtup, "");
898 for (i = 0; i < tupdesc->natts; i++)
900 if (tupdesc->attrs[i]->attisdropped)
901 Tcl_DStringAppendElement(&tcl_trigtup, "");
903 Tcl_DStringAppendElement(&tcl_trigtup,
904 NameStr(tupdesc->attrs[i]->attname));
906 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
907 Tcl_DStringFree(&tcl_trigtup);
908 Tcl_DStringInit(&tcl_trigtup);
910 /* The when part of the event for TG_when */
911 if (TRIGGER_FIRED_BEFORE(trigdata->tg_event))
912 Tcl_DStringAppendElement(&tcl_cmd, "BEFORE");
913 else if (TRIGGER_FIRED_AFTER(trigdata->tg_event))
914 Tcl_DStringAppendElement(&tcl_cmd, "AFTER");
915 else if (TRIGGER_FIRED_INSTEAD(trigdata->tg_event))
916 Tcl_DStringAppendElement(&tcl_cmd, "INSTEAD OF");
918 elog(ERROR, "unrecognized WHEN tg_event: %u", trigdata->tg_event);
920 /* The level part of the event for TG_level */
921 if (TRIGGER_FIRED_FOR_ROW(trigdata->tg_event))
923 Tcl_DStringAppendElement(&tcl_cmd, "ROW");
925 /* Build the data list for the trigtuple */
926 pltcl_build_tuple_argument(trigdata->tg_trigtuple,
927 tupdesc, &tcl_trigtup);
930 * Now the command part of the event for TG_op and data for NEW
933 if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
935 Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
937 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
938 Tcl_DStringAppendElement(&tcl_cmd, "");
940 rettup = trigdata->tg_trigtuple;
942 else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
944 Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
946 Tcl_DStringAppendElement(&tcl_cmd, "");
947 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
949 rettup = trigdata->tg_trigtuple;
951 else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
953 Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
955 pltcl_build_tuple_argument(trigdata->tg_newtuple,
956 tupdesc, &tcl_newtup);
958 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_newtup));
959 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
961 rettup = trigdata->tg_newtuple;
964 elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);
966 else if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event))
968 Tcl_DStringAppendElement(&tcl_cmd, "STATEMENT");
970 if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
971 Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
972 else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
973 Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
974 else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
975 Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
976 else if (TRIGGER_FIRED_BY_TRUNCATE(trigdata->tg_event))
977 Tcl_DStringAppendElement(&tcl_cmd, "TRUNCATE");
979 elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);
981 Tcl_DStringAppendElement(&tcl_cmd, "");
982 Tcl_DStringAppendElement(&tcl_cmd, "");
984 rettup = (HeapTuple) NULL;
987 elog(ERROR, "unrecognized LEVEL tg_event: %u", trigdata->tg_event);
989 /* Finally append the arguments from CREATE TRIGGER */
990 for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
991 Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgargs[i]);
996 Tcl_DStringFree(&tcl_cmd);
997 Tcl_DStringFree(&tcl_trigtup);
998 Tcl_DStringFree(&tcl_newtup);
1002 Tcl_DStringFree(&tcl_trigtup);
1003 Tcl_DStringFree(&tcl_newtup);
1005 /************************************************************
1006 * Call the Tcl function
1008 * We assume no PG error can be thrown directly from this call.
1009 ************************************************************/
1010 tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
1011 Tcl_DStringFree(&tcl_cmd);
1013 /************************************************************
1014 * Check for errors reported by Tcl.
1015 ************************************************************/
1016 if (tcl_rc != TCL_OK)
1017 throw_tcl_error(interp, prodesc->user_proname);
1019 /************************************************************
1020 * The return value from the procedure might be one of
1021 * the magic strings OK or SKIP or a list from array get.
1022 * We can check for OK or SKIP without worrying about encoding.
1023 ************************************************************/
1024 if (SPI_finish() != SPI_OK_FINISH)
1025 elog(ERROR, "SPI_finish() failed");
1027 result = Tcl_GetStringResult(interp);
1029 if (strcmp(result, "OK") == 0)
1031 if (strcmp(result, "SKIP") == 0)
1032 return (HeapTuple) NULL;
1034 /************************************************************
1035 * Convert the result value from the Tcl interpreter
1036 * and setup structures for SPI_modifytuple();
1037 ************************************************************/
1038 if (Tcl_SplitList(interp, result,
1039 &ret_numvals, &ret_values) != TCL_OK)
1042 elog(ERROR, "could not split return value from trigger: %s",
1043 UTF_U2E(Tcl_GetStringResult(interp)));
1047 /* Use a TRY to ensure ret_values will get freed */
1050 if (ret_numvals % 2 != 0)
1051 elog(ERROR, "invalid return list from trigger - must have even # of elements");
1053 modattrs = (int *) palloc(tupdesc->natts * sizeof(int));
1054 modvalues = (Datum *) palloc(tupdesc->natts * sizeof(Datum));
1055 for (i = 0; i < tupdesc->natts; i++)
1057 modattrs[i] = i + 1;
1058 modvalues[i] = (Datum) NULL;
1061 modnulls = palloc(tupdesc->natts);
1062 memset(modnulls, 'n', tupdesc->natts);
1064 for (i = 0; i < ret_numvals; i += 2)
1066 CONST84 char *ret_name = ret_values[i];
1067 CONST84 char *ret_value = ret_values[i + 1];
1074 /************************************************************
1075 * Ignore ".tupno" pseudo elements (see pltcl_set_tuple_values)
1076 ************************************************************/
1077 if (strcmp(ret_name, ".tupno") == 0)
1080 /************************************************************
1081 * Get the attribute number
1082 ************************************************************/
1083 attnum = SPI_fnumber(tupdesc, ret_name);
1084 if (attnum == SPI_ERROR_NOATTRIBUTE)
1085 elog(ERROR, "invalid attribute \"%s\"", ret_name);
1087 elog(ERROR, "cannot set system attribute \"%s\"", ret_name);
1089 /************************************************************
1090 * Ignore dropped columns
1091 ************************************************************/
1092 if (tupdesc->attrs[attnum - 1]->attisdropped)
1095 /************************************************************
1096 * Lookup the attribute type in the syscache
1097 * for the input function
1098 ************************************************************/
1099 typeTup = SearchSysCache1(TYPEOID,
1100 ObjectIdGetDatum(tupdesc->attrs[attnum - 1]->atttypid));
1101 if (!HeapTupleIsValid(typeTup))
1102 elog(ERROR, "cache lookup failed for type %u",
1103 tupdesc->attrs[attnum - 1]->atttypid);
1104 typinput = ((Form_pg_type) GETSTRUCT(typeTup))->typinput;
1105 typioparam = getTypeIOParam(typeTup);
1106 ReleaseSysCache(typeTup);
1108 /************************************************************
1109 * Set the attribute to NOT NULL and convert the contents
1110 ************************************************************/
1111 modnulls[attnum - 1] = ' ';
1112 fmgr_info(typinput, &finfo);
1114 modvalues[attnum - 1] = InputFunctionCall(&finfo,
1115 (char *) UTF_U2E(ret_value),
1117 tupdesc->attrs[attnum - 1]->atttypmod);
1121 rettup = SPI_modifytuple(trigdata->tg_relation, rettup, tupdesc->natts,
1122 modattrs, modvalues, modnulls);
1129 elog(ERROR, "SPI_modifytuple() failed - RC = %d", SPI_result);
1134 ckfree((char *) ret_values);
1138 ckfree((char *) ret_values);
1143 /**********************************************************************
1144 * pltcl_event_trigger_handler() - Handler for event trigger calls
1145 **********************************************************************/
1147 pltcl_event_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
1149 pltcl_proc_desc *prodesc;
1150 Tcl_Interp *volatile interp;
1151 EventTriggerData *tdata = (EventTriggerData *) fcinfo->context;
1152 Tcl_DString tcl_cmd;
1155 /* Connect to SPI manager */
1156 if (SPI_connect() != SPI_OK_CONNECT)
1157 elog(ERROR, "could not connect to SPI manager");
1159 /* Find or compile the function */
1160 prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid,
1161 InvalidOid, true, pltrusted);
1163 pltcl_current_prodesc = prodesc;
1165 interp = prodesc->interp_desc->interp;
1167 /* Create the tcl command and call the internal proc */
1168 Tcl_DStringInit(&tcl_cmd);
1169 Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
1170 Tcl_DStringAppendElement(&tcl_cmd, tdata->event);
1171 Tcl_DStringAppendElement(&tcl_cmd, tdata->tag);
1173 tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
1174 Tcl_DStringFree(&tcl_cmd);
1176 /* Check for errors reported by Tcl. */
1177 if (tcl_rc != TCL_OK)
1178 throw_tcl_error(interp, prodesc->user_proname);
1180 if (SPI_finish() != SPI_OK_FINISH)
1181 elog(ERROR, "SPI_finish() failed");
1185 /**********************************************************************
1186 * throw_tcl_error - ereport an error returned from the Tcl interpreter
1187 **********************************************************************/
1189 throw_tcl_error(Tcl_Interp *interp, const char *proname)
1192 * Caution is needed here because Tcl_GetVar could overwrite the
1193 * interpreter result (even though it's not really supposed to), and we
1194 * can't control the order of evaluation of ereport arguments. Hence, make
1195 * real sure we have our own copy of the result string before invoking
1202 emsg = pstrdup(UTF_U2E(Tcl_GetStringResult(interp)));
1205 econtext = UTF_U2E((char *) Tcl_GetVar(interp, "errorInfo",
1208 (errmsg("%s", emsg),
1209 errcontext("%s\nin PL/Tcl function \"%s\"",
1210 econtext, proname)));
1215 /**********************************************************************
1216 * compile_pltcl_function - compile (or hopefully just look up) function
1218 * tgreloid is the OID of the relation when compiling a trigger, or zero
1219 * (InvalidOid) when compiling a plain function.
1220 **********************************************************************/
1221 static pltcl_proc_desc *
1222 compile_pltcl_function(Oid fn_oid, Oid tgreloid,
1223 bool is_event_trigger, bool pltrusted)
1226 Form_pg_proc procStruct;
1227 pltcl_proc_key proc_key;
1228 pltcl_proc_ptr *proc_ptr;
1230 pltcl_proc_desc *prodesc;
1232 /* We'll need the pg_proc tuple in any case... */
1233 procTup = SearchSysCache1(PROCOID, ObjectIdGetDatum(fn_oid));
1234 if (!HeapTupleIsValid(procTup))
1235 elog(ERROR, "cache lookup failed for function %u", fn_oid);
1236 procStruct = (Form_pg_proc) GETSTRUCT(procTup);
1238 /* Try to find function in pltcl_proc_htab */
1239 proc_key.proc_id = fn_oid;
1240 proc_key.is_trigger = OidIsValid(tgreloid);
1241 proc_key.user_id = pltrusted ? GetUserId() : InvalidOid;
1243 proc_ptr = hash_search(pltcl_proc_htab, &proc_key,
1247 proc_ptr->proc_ptr = NULL;
1249 prodesc = proc_ptr->proc_ptr;
1251 /************************************************************
1252 * If it's present, must check whether it's still up to date.
1253 * This is needed because CREATE OR REPLACE FUNCTION can modify the
1254 * function's pg_proc entry without changing its OID.
1255 ************************************************************/
1256 if (prodesc != NULL)
1260 uptodate = (prodesc->fn_xmin == HeapTupleHeaderGetRawXmin(procTup->t_data) &&
1261 ItemPointerEquals(&prodesc->fn_tid, &procTup->t_self));
1265 proc_ptr->proc_ptr = NULL;
1270 /************************************************************
1271 * If we haven't found it in the hashtable, we analyze
1272 * the functions arguments and returntype and store
1273 * the in-/out-functions in the prodesc block and create
1274 * a new hashtable entry for it.
1276 * Then we load the procedure into the Tcl interpreter.
1277 ************************************************************/
1278 if (prodesc == NULL)
1280 bool is_trigger = OidIsValid(tgreloid);
1281 char internal_proname[128];
1283 Form_pg_type typeStruct;
1284 Tcl_DString proc_internal_def;
1285 Tcl_DString proc_internal_body;
1286 char proc_internal_args[33 * FUNC_MAX_ARGS];
1295 /************************************************************
1296 * Build our internal proc name from the function's Oid. Append
1297 * "_trigger" when appropriate to ensure the normal and trigger
1298 * cases are kept separate.
1299 ************************************************************/
1300 if (!is_trigger && !is_event_trigger)
1301 snprintf(internal_proname, sizeof(internal_proname),
1302 "__PLTcl_proc_%u", fn_oid);
1303 else if (is_event_trigger)
1304 snprintf(internal_proname, sizeof(internal_proname),
1305 "__PLTcl_proc_%u_evttrigger", fn_oid);
1306 else if (is_trigger)
1307 snprintf(internal_proname, sizeof(internal_proname),
1308 "__PLTcl_proc_%u_trigger", fn_oid);
1310 /************************************************************
1311 * Allocate a new procedure description block
1312 ************************************************************/
1313 prodesc = (pltcl_proc_desc *) malloc(sizeof(pltcl_proc_desc));
1314 if (prodesc == NULL)
1316 (errcode(ERRCODE_OUT_OF_MEMORY),
1317 errmsg("out of memory")));
1318 MemSet(prodesc, 0, sizeof(pltcl_proc_desc));
1319 prodesc->user_proname = strdup(NameStr(procStruct->proname));
1320 prodesc->internal_proname = strdup(internal_proname);
1321 if (prodesc->user_proname == NULL || prodesc->internal_proname == NULL)
1323 (errcode(ERRCODE_OUT_OF_MEMORY),
1324 errmsg("out of memory")));
1325 prodesc->fn_xmin = HeapTupleHeaderGetRawXmin(procTup->t_data);
1326 prodesc->fn_tid = procTup->t_self;
1328 /* Remember if function is STABLE/IMMUTABLE */
1329 prodesc->fn_readonly =
1330 (procStruct->provolatile != PROVOLATILE_VOLATILE);
1331 /* And whether it is trusted */
1332 prodesc->lanpltrusted = pltrusted;
1334 /************************************************************
1335 * Identify the interpreter to use for the function
1336 ************************************************************/
1337 prodesc->interp_desc = pltcl_fetch_interp(prodesc->lanpltrusted);
1338 interp = prodesc->interp_desc->interp;
1340 /************************************************************
1341 * Get the required information for input conversion of the
1343 ************************************************************/
1344 if (!is_trigger && !is_event_trigger)
1347 SearchSysCache1(TYPEOID,
1348 ObjectIdGetDatum(procStruct->prorettype));
1349 if (!HeapTupleIsValid(typeTup))
1351 free(prodesc->user_proname);
1352 free(prodesc->internal_proname);
1354 elog(ERROR, "cache lookup failed for type %u",
1355 procStruct->prorettype);
1357 typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
1359 /* Disallow pseudotype result, except VOID */
1360 if (typeStruct->typtype == TYPTYPE_PSEUDO)
1362 if (procStruct->prorettype == VOIDOID)
1364 else if (procStruct->prorettype == TRIGGEROID ||
1365 procStruct->prorettype == EVTTRIGGEROID)
1367 free(prodesc->user_proname);
1368 free(prodesc->internal_proname);
1371 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1372 errmsg("trigger functions can only be called as triggers")));
1376 free(prodesc->user_proname);
1377 free(prodesc->internal_proname);
1380 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1381 errmsg("PL/Tcl functions cannot return type %s",
1382 format_type_be(procStruct->prorettype))));
1386 if (typeStruct->typtype == TYPTYPE_COMPOSITE)
1388 free(prodesc->user_proname);
1389 free(prodesc->internal_proname);
1392 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1393 errmsg("PL/Tcl functions cannot return composite types")));
1396 perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
1397 prodesc->result_typioparam = getTypeIOParam(typeTup);
1399 ReleaseSysCache(typeTup);
1402 /************************************************************
1403 * Get the required information for output conversion
1404 * of all procedure arguments
1405 ************************************************************/
1406 if (!is_trigger && !is_event_trigger)
1408 prodesc->nargs = procStruct->pronargs;
1409 proc_internal_args[0] = '\0';
1410 for (i = 0; i < prodesc->nargs; i++)
1412 typeTup = SearchSysCache1(TYPEOID,
1413 ObjectIdGetDatum(procStruct->proargtypes.values[i]));
1414 if (!HeapTupleIsValid(typeTup))
1416 free(prodesc->user_proname);
1417 free(prodesc->internal_proname);
1419 elog(ERROR, "cache lookup failed for type %u",
1420 procStruct->proargtypes.values[i]);
1422 typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
1424 /* Disallow pseudotype argument */
1425 if (typeStruct->typtype == TYPTYPE_PSEUDO)
1427 free(prodesc->user_proname);
1428 free(prodesc->internal_proname);
1431 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1432 errmsg("PL/Tcl functions cannot accept type %s",
1433 format_type_be(procStruct->proargtypes.values[i]))));
1436 if (typeStruct->typtype == TYPTYPE_COMPOSITE)
1438 prodesc->arg_is_rowtype[i] = true;
1439 snprintf(buf, sizeof(buf), "__PLTcl_Tup_%d", i + 1);
1443 prodesc->arg_is_rowtype[i] = false;
1444 perm_fmgr_info(typeStruct->typoutput,
1445 &(prodesc->arg_out_func[i]));
1446 snprintf(buf, sizeof(buf), "%d", i + 1);
1450 strcat(proc_internal_args, " ");
1451 strcat(proc_internal_args, buf);
1453 ReleaseSysCache(typeTup);
1456 else if (is_trigger)
1458 /* trigger procedure has fixed args */
1459 strcpy(proc_internal_args,
1460 "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");
1462 else if (is_event_trigger)
1464 /* event trigger procedure has fixed args */
1465 strcpy(proc_internal_args, "TG_event TG_tag");
1468 /************************************************************
1469 * Create the tcl command to define the internal
1471 ************************************************************/
1472 Tcl_DStringInit(&proc_internal_def);
1473 Tcl_DStringInit(&proc_internal_body);
1474 Tcl_DStringAppendElement(&proc_internal_def, "proc");
1475 Tcl_DStringAppendElement(&proc_internal_def, internal_proname);
1476 Tcl_DStringAppendElement(&proc_internal_def, proc_internal_args);
1478 /************************************************************
1479 * prefix procedure body with
1480 * upvar #0 <internal_procname> GD
1481 * and with appropriate setting of arguments
1482 ************************************************************/
1483 Tcl_DStringAppend(&proc_internal_body, "upvar #0 ", -1);
1484 Tcl_DStringAppend(&proc_internal_body, internal_proname, -1);
1485 Tcl_DStringAppend(&proc_internal_body, " GD\n", -1);
1488 Tcl_DStringAppend(&proc_internal_body,
1489 "array set NEW $__PLTcl_Tup_NEW\n", -1);
1490 Tcl_DStringAppend(&proc_internal_body,
1491 "array set OLD $__PLTcl_Tup_OLD\n", -1);
1493 Tcl_DStringAppend(&proc_internal_body,
1496 "foreach v $args {\n"
1500 "unset i v\n\n", -1);
1502 else if (is_event_trigger)
1504 /* no argument support for event triggers */
1508 for (i = 0; i < prodesc->nargs; i++)
1510 if (prodesc->arg_is_rowtype[i])
1512 snprintf(buf, sizeof(buf),
1513 "array set %d $__PLTcl_Tup_%d\n",
1515 Tcl_DStringAppend(&proc_internal_body, buf, -1);
1520 /************************************************************
1521 * Add user's function definition to proc body
1522 ************************************************************/
1523 prosrcdatum = SysCacheGetAttr(PROCOID, procTup,
1524 Anum_pg_proc_prosrc, &isnull);
1526 elog(ERROR, "null prosrc");
1527 proc_source = TextDatumGetCString(prosrcdatum);
1529 Tcl_DStringAppend(&proc_internal_body, UTF_E2U(proc_source), -1);
1532 Tcl_DStringAppendElement(&proc_internal_def,
1533 Tcl_DStringValue(&proc_internal_body));
1534 Tcl_DStringFree(&proc_internal_body);
1536 /************************************************************
1537 * Create the procedure in the interpreter
1538 ************************************************************/
1539 tcl_rc = Tcl_GlobalEval(interp,
1540 Tcl_DStringValue(&proc_internal_def));
1541 Tcl_DStringFree(&proc_internal_def);
1542 if (tcl_rc != TCL_OK)
1544 free(prodesc->user_proname);
1545 free(prodesc->internal_proname);
1548 elog(ERROR, "could not create internal procedure \"%s\": %s",
1549 internal_proname, UTF_U2E(Tcl_GetStringResult(interp)));
1553 /************************************************************
1554 * Add the proc description block to the hashtable. Note we do not
1555 * attempt to free any previously existing prodesc block. This is
1556 * annoying, but necessary since there could be active calls using
1558 ************************************************************/
1559 proc_ptr->proc_ptr = prodesc;
1562 ReleaseSysCache(procTup);
1568 /**********************************************************************
1569 * pltcl_elog() - elog() support for PLTcl
1570 **********************************************************************/
1572 pltcl_elog(ClientData cdata, Tcl_Interp *interp,
1573 int argc, CONST84 char *argv[])
1576 MemoryContext oldcontext;
1580 Tcl_SetResult(interp, "syntax error - 'elog level msg'", TCL_STATIC);
1584 if (strcmp(argv[1], "DEBUG") == 0)
1586 else if (strcmp(argv[1], "LOG") == 0)
1588 else if (strcmp(argv[1], "INFO") == 0)
1590 else if (strcmp(argv[1], "NOTICE") == 0)
1592 else if (strcmp(argv[1], "WARNING") == 0)
1594 else if (strcmp(argv[1], "ERROR") == 0)
1596 else if (strcmp(argv[1], "FATAL") == 0)
1600 Tcl_AppendResult(interp, "Unknown elog level '", argv[1],
1608 * We just pass the error back to Tcl. If it's not caught, it'll
1609 * eventually get converted to a PG error when we reach the call
1612 Tcl_SetResult(interp, (char *) argv[2], TCL_VOLATILE);
1617 * For non-error messages, just pass 'em to elog(). We do not expect that
1618 * this will fail, but just on the off chance it does, report the error
1619 * back to Tcl. Note we are assuming that elog() can't have any internal
1620 * failures that are so bad as to require a transaction abort.
1622 * This path is also used for FATAL errors, which aren't going to come
1623 * back to us at all.
1625 oldcontext = CurrentMemoryContext;
1629 elog(level, "%s", UTF_U2E(argv[2]));
1636 /* Must reset elog.c's state */
1637 MemoryContextSwitchTo(oldcontext);
1638 edata = CopyErrorData();
1641 /* Pass the error message to Tcl */
1643 Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE);
1645 FreeErrorData(edata);
1655 /**********************************************************************
1656 * pltcl_quote() - quote literal strings that are to
1657 * be used in SPI_execute query strings
1658 **********************************************************************/
1660 pltcl_quote(ClientData cdata, Tcl_Interp *interp,
1661 int argc, CONST84 char *argv[])
1667 /************************************************************
1669 ************************************************************/
1672 Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_STATIC);
1676 /************************************************************
1677 * Allocate space for the maximum the string can
1678 * grow to and initialize pointers
1679 ************************************************************/
1680 tmp = palloc(strlen(argv[1]) * 2 + 1);
1684 /************************************************************
1685 * Walk through string and double every quote and backslash
1686 ************************************************************/
1699 /************************************************************
1700 * Terminate the string and set it as result
1701 ************************************************************/
1703 Tcl_SetResult(interp, tmp, TCL_VOLATILE);
1709 /**********************************************************************
1710 * pltcl_argisnull() - determine if a specific argument is NULL
1711 **********************************************************************/
1713 pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
1714 int argc, CONST84 char *argv[])
1717 FunctionCallInfo fcinfo = pltcl_current_fcinfo;
1719 /************************************************************
1721 ************************************************************/
1724 Tcl_SetResult(interp, "syntax error - 'argisnull argno'",
1729 /************************************************************
1730 * Check that we're called as a normal function
1731 ************************************************************/
1734 Tcl_SetResult(interp, "argisnull cannot be used in triggers",
1739 /************************************************************
1740 * Get the argument number
1741 ************************************************************/
1742 if (Tcl_GetInt(interp, argv[1], &argno) != TCL_OK)
1745 /************************************************************
1746 * Check that the argno is valid
1747 ************************************************************/
1749 if (argno < 0 || argno >= fcinfo->nargs)
1751 Tcl_SetResult(interp, "argno out of range", TCL_STATIC);
1755 /************************************************************
1756 * Get the requested NULL state
1757 ************************************************************/
1758 if (PG_ARGISNULL(argno))
1759 Tcl_SetResult(interp, "1", TCL_STATIC);
1761 Tcl_SetResult(interp, "0", TCL_STATIC);
1767 /**********************************************************************
1768 * pltcl_returnnull() - Cause a NULL return from a function
1769 **********************************************************************/
1771 pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
1772 int argc, CONST84 char *argv[])
1774 FunctionCallInfo fcinfo = pltcl_current_fcinfo;
1776 /************************************************************
1778 ************************************************************/
1781 Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_STATIC);
1785 /************************************************************
1786 * Check that we're called as a normal function
1787 ************************************************************/
1790 Tcl_SetResult(interp, "return_null cannot be used in triggers",
1795 /************************************************************
1796 * Set the NULL return flag and cause Tcl to return from the
1798 ************************************************************/
1799 fcinfo->isnull = true;
1806 * Support for running SPI operations inside subtransactions
1808 * Intended usage pattern is:
1810 * MemoryContext oldcontext = CurrentMemoryContext;
1811 * ResourceOwner oldowner = CurrentResourceOwner;
1814 * pltcl_subtrans_begin(oldcontext, oldowner);
1817 * do something risky;
1818 * pltcl_subtrans_commit(oldcontext, oldowner);
1822 * pltcl_subtrans_abort(interp, oldcontext, oldowner);
1830 pltcl_subtrans_begin(MemoryContext oldcontext, ResourceOwner oldowner)
1832 BeginInternalSubTransaction(NULL);
1834 /* Want to run inside function's memory context */
1835 MemoryContextSwitchTo(oldcontext);
1839 pltcl_subtrans_commit(MemoryContext oldcontext, ResourceOwner oldowner)
1841 /* Commit the inner transaction, return to outer xact context */
1842 ReleaseCurrentSubTransaction();
1843 MemoryContextSwitchTo(oldcontext);
1844 CurrentResourceOwner = oldowner;
1847 * AtEOSubXact_SPI() should not have popped any SPI context, but just in
1848 * case it did, make sure we remain connected.
1850 SPI_restore_connection();
1854 pltcl_subtrans_abort(Tcl_Interp *interp,
1855 MemoryContext oldcontext, ResourceOwner oldowner)
1859 /* Save error info */
1860 MemoryContextSwitchTo(oldcontext);
1861 edata = CopyErrorData();
1864 /* Abort the inner transaction */
1865 RollbackAndReleaseCurrentSubTransaction();
1866 MemoryContextSwitchTo(oldcontext);
1867 CurrentResourceOwner = oldowner;
1870 * If AtEOSubXact_SPI() popped any SPI context of the subxact, it will
1871 * have left us in a disconnected state. We need this hack to return to
1874 SPI_restore_connection();
1876 /* Pass the error message to Tcl */
1878 Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE);
1880 FreeErrorData(edata);
1884 /**********************************************************************
1885 * pltcl_SPI_execute() - The builtin SPI_execute command
1886 * for the Tcl interpreter
1887 **********************************************************************/
1889 pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
1890 int argc, CONST84 char *argv[])
1897 CONST84 char *volatile arrayname = NULL;
1898 CONST84 char *volatile loop_body = NULL;
1899 MemoryContext oldcontext = CurrentMemoryContext;
1900 ResourceOwner oldowner = CurrentResourceOwner;
1902 char *usage = "syntax error - 'SPI_exec "
1904 "?-array name? query ?loop body?";
1906 /************************************************************
1907 * Check the call syntax and get the options
1908 ************************************************************/
1911 Tcl_SetResult(interp, usage, TCL_STATIC);
1918 if (strcmp(argv[i], "-array") == 0)
1922 Tcl_SetResult(interp, usage, TCL_STATIC);
1925 arrayname = argv[i++];
1929 if (strcmp(argv[i], "-count") == 0)
1933 Tcl_SetResult(interp, usage, TCL_STATIC);
1936 if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
1945 if (query_idx >= argc || query_idx + 2 < argc)
1947 Tcl_SetResult(interp, usage, TCL_STATIC);
1950 if (query_idx + 1 < argc)
1951 loop_body = argv[query_idx + 1];
1953 /************************************************************
1954 * Execute the query inside a sub-transaction, so we can cope with
1956 ************************************************************/
1958 pltcl_subtrans_begin(oldcontext, oldowner);
1963 spi_rc = SPI_execute(UTF_U2E(argv[query_idx]),
1964 pltcl_current_prodesc->fn_readonly, count);
1967 my_rc = pltcl_process_SPI_result(interp,
1974 pltcl_subtrans_commit(oldcontext, oldowner);
1978 pltcl_subtrans_abort(interp, oldcontext, oldowner);
1987 * Process the result from SPI_execute or SPI_execute_plan
1989 * Shared code between pltcl_SPI_execute and pltcl_SPI_execute_plan
1992 pltcl_process_SPI_result(Tcl_Interp *interp,
1993 CONST84 char *arrayname,
1994 CONST84 char *loop_body,
1996 SPITupleTable *tuptable,
2008 case SPI_OK_SELINTO:
2012 snprintf(buf, sizeof(buf), "%d", ntuples);
2013 Tcl_SetResult(interp, buf, TCL_VOLATILE);
2016 case SPI_OK_UTILITY:
2017 case SPI_OK_REWRITTEN:
2018 if (tuptable == NULL)
2020 Tcl_SetResult(interp, "0", TCL_STATIC);
2023 /* FALL THRU for utility returning tuples */
2026 case SPI_OK_INSERT_RETURNING:
2027 case SPI_OK_DELETE_RETURNING:
2028 case SPI_OK_UPDATE_RETURNING:
2031 * Process the tuples we got
2033 tuples = tuptable->vals;
2034 tupdesc = tuptable->tupdesc;
2036 if (loop_body == NULL)
2039 * If there is no loop body given, just set the variables from
2040 * the first tuple (if any)
2043 pltcl_set_tuple_values(interp, arrayname, 0,
2044 tuples[0], tupdesc);
2049 * There is a loop body - process all tuples and evaluate the
2052 for (i = 0; i < ntuples; i++)
2054 pltcl_set_tuple_values(interp, arrayname, i,
2055 tuples[i], tupdesc);
2057 loop_rc = Tcl_Eval(interp, loop_body);
2059 if (loop_rc == TCL_OK)
2061 if (loop_rc == TCL_CONTINUE)
2063 if (loop_rc == TCL_RETURN)
2068 if (loop_rc == TCL_BREAK)
2075 if (my_rc == TCL_OK)
2077 snprintf(buf, sizeof(buf), "%d", ntuples);
2078 Tcl_SetResult(interp, buf, TCL_VOLATILE);
2083 Tcl_AppendResult(interp, "pltcl: SPI_execute failed: ",
2084 SPI_result_code_string(spi_rc), NULL);
2089 SPI_freetuptable(tuptable);
2095 /**********************************************************************
2096 * pltcl_SPI_prepare() - Builtin support for prepared plans
2097 * The Tcl command SPI_prepare
2098 * always saves the plan using
2099 * SPI_keepplan and returns a key for
2100 * access. There is no chance to prepare
2101 * and not save the plan currently.
2102 **********************************************************************/
2104 pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
2105 int argc, CONST84 char *argv[])
2108 CONST84 char **args;
2109 pltcl_query_desc *qdesc;
2111 Tcl_HashEntry *hashent;
2113 Tcl_HashTable *query_hash;
2114 MemoryContext oldcontext = CurrentMemoryContext;
2115 ResourceOwner oldowner = CurrentResourceOwner;
2117 /************************************************************
2118 * Check the call syntax
2119 ************************************************************/
2122 Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'",
2127 /************************************************************
2128 * Split the argument type list
2129 ************************************************************/
2130 if (Tcl_SplitList(interp, argv[2], &nargs, &args) != TCL_OK)
2133 /************************************************************
2134 * Allocate the new querydesc structure
2135 ************************************************************/
2136 qdesc = (pltcl_query_desc *) malloc(sizeof(pltcl_query_desc));
2137 snprintf(qdesc->qname, sizeof(qdesc->qname), "%p", qdesc);
2138 qdesc->nargs = nargs;
2139 qdesc->argtypes = (Oid *) malloc(nargs * sizeof(Oid));
2140 qdesc->arginfuncs = (FmgrInfo *) malloc(nargs * sizeof(FmgrInfo));
2141 qdesc->argtypioparams = (Oid *) malloc(nargs * sizeof(Oid));
2143 /************************************************************
2144 * Execute the prepare inside a sub-transaction, so we can cope with
2146 ************************************************************/
2148 pltcl_subtrans_begin(oldcontext, oldowner);
2152 /************************************************************
2153 * Resolve argument type names and then look them up by oid
2154 * in the system cache, and remember the required information
2155 * for input conversion.
2156 ************************************************************/
2157 for (i = 0; i < nargs; i++)
2164 parseTypeString(args[i], &typId, &typmod);
2166 getTypeInputInfo(typId, &typInput, &typIOParam);
2168 qdesc->argtypes[i] = typId;
2169 perm_fmgr_info(typInput, &(qdesc->arginfuncs[i]));
2170 qdesc->argtypioparams[i] = typIOParam;
2173 /************************************************************
2174 * Prepare the plan and check for errors
2175 ************************************************************/
2177 qdesc->plan = SPI_prepare(UTF_U2E(argv[1]), nargs, qdesc->argtypes);
2180 if (qdesc->plan == NULL)
2181 elog(ERROR, "SPI_prepare() failed");
2183 /************************************************************
2184 * Save the plan into permanent memory (right now it's in the
2185 * SPI procCxt, which will go away at function end).
2186 ************************************************************/
2187 if (SPI_keepplan(qdesc->plan))
2188 elog(ERROR, "SPI_keepplan() failed");
2190 pltcl_subtrans_commit(oldcontext, oldowner);
2194 pltcl_subtrans_abort(interp, oldcontext, oldowner);
2196 free(qdesc->argtypes);
2197 free(qdesc->arginfuncs);
2198 free(qdesc->argtypioparams);
2200 ckfree((char *) args);
2206 /************************************************************
2207 * Insert a hashtable entry for the plan and return
2208 * the key to the caller
2209 ************************************************************/
2210 query_hash = &pltcl_current_prodesc->interp_desc->query_hash;
2212 hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
2213 Tcl_SetHashValue(hashent, (ClientData) qdesc);
2215 ckfree((char *) args);
2217 /* qname is ASCII, so no need for encoding conversion */
2218 Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE);
2223 /**********************************************************************
2224 * pltcl_SPI_execute_plan() - Execute a prepared plan
2225 **********************************************************************/
2227 pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
2228 int argc, CONST84 char *argv[])
2234 Tcl_HashEntry *hashent;
2235 pltcl_query_desc *qdesc;
2236 const char *volatile nulls = NULL;
2237 CONST84 char *volatile arrayname = NULL;
2238 CONST84 char *volatile loop_body = NULL;
2241 CONST84 char **callargs = NULL;
2243 MemoryContext oldcontext = CurrentMemoryContext;
2244 ResourceOwner oldowner = CurrentResourceOwner;
2245 Tcl_HashTable *query_hash;
2247 char *usage = "syntax error - 'SPI_execp "
2248 "?-nulls string? ?-count n? "
2249 "?-array name? query ?args? ?loop body?";
2251 /************************************************************
2252 * Get the options and check syntax
2253 ************************************************************/
2257 if (strcmp(argv[i], "-array") == 0)
2261 Tcl_SetResult(interp, usage, TCL_STATIC);
2264 arrayname = argv[i++];
2267 if (strcmp(argv[i], "-nulls") == 0)
2271 Tcl_SetResult(interp, usage, TCL_STATIC);
2277 if (strcmp(argv[i], "-count") == 0)
2281 Tcl_SetResult(interp, usage, TCL_STATIC);
2284 if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
2292 /************************************************************
2293 * Get the prepared plan descriptor by its key
2294 ************************************************************/
2297 Tcl_SetResult(interp, usage, TCL_STATIC);
2301 query_hash = &pltcl_current_prodesc->interp_desc->query_hash;
2303 hashent = Tcl_FindHashEntry(query_hash, argv[i]);
2304 if (hashent == NULL)
2306 Tcl_AppendResult(interp, "invalid queryid '", argv[i], "'", NULL);
2309 qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent);
2312 /************************************************************
2313 * If a nulls string is given, check for correct length
2314 ************************************************************/
2317 if (strlen(nulls) != qdesc->nargs)
2319 Tcl_SetResult(interp,
2320 "length of nulls string doesn't match # of arguments",
2326 /************************************************************
2327 * If there was a argtype list on preparation, we need
2328 * an argument value list now
2329 ************************************************************/
2330 if (qdesc->nargs > 0)
2334 Tcl_SetResult(interp, "missing argument list", TCL_STATIC);
2338 /************************************************************
2339 * Split the argument values
2340 ************************************************************/
2341 if (Tcl_SplitList(interp, argv[i++], &callnargs, &callargs) != TCL_OK)
2344 /************************************************************
2345 * Check that the # of arguments matches
2346 ************************************************************/
2347 if (callnargs != qdesc->nargs)
2349 Tcl_SetResult(interp,
2350 "argument list length doesn't match # of arguments for query",
2352 ckfree((char *) callargs);
2359 /************************************************************
2360 * Get loop body if present
2361 ************************************************************/
2363 loop_body = argv[i++];
2367 Tcl_SetResult(interp, usage, TCL_STATIC);
2371 /************************************************************
2372 * Execute the plan inside a sub-transaction, so we can cope with
2374 ************************************************************/
2376 pltcl_subtrans_begin(oldcontext, oldowner);
2380 /************************************************************
2381 * Setup the value array for SPI_execute_plan() using
2382 * the type specific input functions
2383 ************************************************************/
2384 argvalues = (Datum *) palloc(callnargs * sizeof(Datum));
2386 for (j = 0; j < callnargs; j++)
2388 if (nulls && nulls[j] == 'n')
2390 argvalues[j] = InputFunctionCall(&qdesc->arginfuncs[j],
2392 qdesc->argtypioparams[j],
2398 argvalues[j] = InputFunctionCall(&qdesc->arginfuncs[j],
2399 (char *) UTF_U2E(callargs[j]),
2400 qdesc->argtypioparams[j],
2407 ckfree((char *) callargs);
2410 /************************************************************
2412 ************************************************************/
2413 spi_rc = SPI_execute_plan(qdesc->plan, argvalues, nulls,
2414 pltcl_current_prodesc->fn_readonly, count);
2416 my_rc = pltcl_process_SPI_result(interp,
2423 pltcl_subtrans_commit(oldcontext, oldowner);
2427 pltcl_subtrans_abort(interp, oldcontext, oldowner);
2430 ckfree((char *) callargs);
2440 /**********************************************************************
2441 * pltcl_SPI_lastoid() - return the last oid. To
2442 * be used after insert queries
2443 **********************************************************************/
2445 pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
2446 int argc, CONST84 char *argv[])
2450 snprintf(buf, sizeof(buf), "%u", SPI_lastoid);
2451 Tcl_SetResult(interp, buf, TCL_VOLATILE);
2456 /**********************************************************************
2457 * pltcl_set_tuple_values() - Set variables for all attributes
2459 **********************************************************************/
2461 pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
2462 int tupno, HeapTuple tuple, TupleDesc tupdesc)
2470 CONST84 char *attname;
2474 CONST84 char **arrptr;
2475 CONST84 char **nameptr;
2476 CONST84 char *nullname = NULL;
2478 /************************************************************
2479 * Prepare pointers for Tcl_SetVar2() below and in array
2480 * mode set the .tupno element
2481 ************************************************************/
2482 if (arrayname == NULL)
2485 nameptr = &nullname;
2489 arrptr = &arrayname;
2491 snprintf(buf, sizeof(buf), "%d", tupno);
2492 Tcl_SetVar2(interp, arrayname, ".tupno", buf, 0);
2495 for (i = 0; i < tupdesc->natts; i++)
2497 /* ignore dropped attributes */
2498 if (tupdesc->attrs[i]->attisdropped)
2501 /************************************************************
2502 * Get the attribute name
2503 ************************************************************/
2504 attname = NameStr(tupdesc->attrs[i]->attname);
2506 /************************************************************
2507 * Get the attributes value
2508 ************************************************************/
2509 attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
2511 /************************************************************
2512 * Lookup the attribute type in the syscache
2513 * for the output function
2514 ************************************************************/
2515 typeTup = SearchSysCache1(TYPEOID,
2516 ObjectIdGetDatum(tupdesc->attrs[i]->atttypid));
2517 if (!HeapTupleIsValid(typeTup))
2518 elog(ERROR, "cache lookup failed for type %u",
2519 tupdesc->attrs[i]->atttypid);
2521 typoutput = ((Form_pg_type) GETSTRUCT(typeTup))->typoutput;
2522 ReleaseSysCache(typeTup);
2524 /************************************************************
2525 * If there is a value, set the variable
2528 * Hmmm - Null attributes will cause functions to
2529 * crash if they don't expect them - need something
2531 ************************************************************/
2532 if (!isnull && OidIsValid(typoutput))
2534 outputstr = OidOutputFunctionCall(typoutput, attr);
2536 Tcl_SetVar2(interp, *arrptr, *nameptr, UTF_E2U(outputstr), 0);
2541 Tcl_UnsetVar2(interp, *arrptr, *nameptr, 0);
2546 /**********************************************************************
2547 * pltcl_build_tuple_argument() - Build a string usable for 'array set'
2548 * from all attributes of a given tuple
2549 **********************************************************************/
2551 pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
2552 Tcl_DString *retval)
2563 for (i = 0; i < tupdesc->natts; i++)
2565 /* ignore dropped attributes */
2566 if (tupdesc->attrs[i]->attisdropped)
2569 /************************************************************
2570 * Get the attribute name
2571 ************************************************************/
2572 attname = NameStr(tupdesc->attrs[i]->attname);
2574 /************************************************************
2575 * Get the attributes value
2576 ************************************************************/
2577 attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
2579 /************************************************************
2580 * Lookup the attribute type in the syscache
2581 * for the output function
2582 ************************************************************/
2583 typeTup = SearchSysCache1(TYPEOID,
2584 ObjectIdGetDatum(tupdesc->attrs[i]->atttypid));
2585 if (!HeapTupleIsValid(typeTup))
2586 elog(ERROR, "cache lookup failed for type %u",
2587 tupdesc->attrs[i]->atttypid);
2589 typoutput = ((Form_pg_type) GETSTRUCT(typeTup))->typoutput;
2590 ReleaseSysCache(typeTup);
2592 /************************************************************
2593 * If there is a value, append the attribute name and the
2596 * Hmmm - Null attributes will cause functions to
2597 * crash if they don't expect them - need something
2599 ************************************************************/
2600 if (!isnull && OidIsValid(typoutput))
2602 outputstr = OidOutputFunctionCall(typoutput, attr);
2603 Tcl_DStringAppendElement(retval, attname);
2605 Tcl_DStringAppendElement(retval, UTF_E2U(outputstr));