1
/**********************************************************************
2
* pltcl.c - PostgreSQL support for Tcl as
3
* procedural language (PL)
5
* This software is copyrighted by Jan Wieck - Hamburg.
7
* The author hereby grants permission to use, copy, modify,
8
* distribute, and license this software and its documentation
9
* for any purpose, provided that existing copyright notices are
10
* retained in all copies and that this notice is included
11
* verbatim in any distributions. No written agreement, license,
12
* or royalty fee is required for any of the authorized uses.
13
* Modifications to this software may be copyrighted by their
14
* author and need not follow the licensing terms described
15
* here, provided that the new terms are clearly indicated on
16
* the first page of each file where they apply.
18
* IN NO EVENT SHALL THE AUTHOR OR DISTRIBUTORS BE LIABLE TO ANY
19
* PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR
20
* CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS
21
* SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN
22
* IF THE AUTHOR HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH
25
* THE AUTHOR AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY
26
* WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
27
* WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
28
* PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON
29
* AN "AS IS" BASIS, AND THE AUTHOR AND DISTRIBUTORS HAVE NO
30
* OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES,
31
* ENHANCEMENTS, OR MODIFICATIONS.
34
* $PostgreSQL: pgsql/src/pl/tcl/pltcl.c,v 1.94 2004-11-21 21:17:05 tgl Exp $
36
**********************************************************************/
45
/* Hack to deal with Tcl 8.4 const-ification without losing compatibility */
50
#include "access/heapam.h"
51
#include "catalog/pg_language.h"
52
#include "catalog/pg_proc.h"
53
#include "commands/trigger.h"
54
#include "executor/spi.h"
56
#include "nodes/makefuncs.h"
57
#include "parser/parse_type.h"
58
#include "tcop/tcopprot.h"
59
#include "utils/builtins.h"
60
#include "utils/lsyscache.h"
61
#include "utils/syscache.h"
62
#include "utils/typcache.h"
65
#if defined(UNICODE_CONVERSION) && TCL_MAJOR_VERSION == 8 \
66
&& TCL_MINOR_VERSION > 0
68
#include "mb/pg_wchar.h"
70
static unsigned char *
71
utf_u2e(unsigned char *src)
73
return pg_do_encoding_conversion(src, strlen(src), PG_UTF8, GetDatabaseEncoding());
76
static unsigned char *
77
utf_e2u(unsigned char *src)
79
return pg_do_encoding_conversion(src, strlen(src), GetDatabaseEncoding(), PG_UTF8);
83
#define UTF_BEGIN do { \
84
unsigned char *_pltcl_utf_src; \
85
unsigned char *_pltcl_utf_dst
86
#define UTF_END if (_pltcl_utf_src!=_pltcl_utf_dst) \
87
pfree(_pltcl_utf_dst); } while (0)
88
#define UTF_U2E(x) (_pltcl_utf_dst=utf_u2e(_pltcl_utf_src=(x)))
89
#define UTF_E2U(x) (_pltcl_utf_dst=utf_e2u(_pltcl_utf_src=(x)))
91
#else /* !PLTCL_UTF */
95
#define UTF_U2E(x) (x)
96
#define UTF_E2U(x) (x)
98
#endif /* PLTCL_UTF */
101
/**********************************************************************
102
* The information we cache about loaded procedures
103
**********************************************************************/
104
typedef struct pltcl_proc_desc
107
TransactionId fn_xmin;
111
FmgrInfo result_in_func;
112
Oid result_typioparam;
114
FmgrInfo arg_out_func[FUNC_MAX_ARGS];
115
Oid arg_typioparam[FUNC_MAX_ARGS];
116
bool arg_is_rowtype[FUNC_MAX_ARGS];
120
/**********************************************************************
121
* The information we cache about prepared and saved plans
122
**********************************************************************/
123
typedef struct pltcl_query_desc
129
FmgrInfo *arginfuncs;
134
/**********************************************************************
136
**********************************************************************/
137
static bool pltcl_pm_init_done = false;
138
static bool pltcl_be_init_done = false;
139
static Tcl_Interp *pltcl_hold_interp = NULL;
140
static Tcl_Interp *pltcl_norm_interp = NULL;
141
static Tcl_Interp *pltcl_safe_interp = NULL;
142
static Tcl_HashTable *pltcl_proc_hash = NULL;
143
static Tcl_HashTable *pltcl_norm_query_hash = NULL;
144
static Tcl_HashTable *pltcl_safe_query_hash = NULL;
146
/* these are saved and restored by pltcl_call_handler */
147
static FunctionCallInfo pltcl_current_fcinfo = NULL;
148
static pltcl_proc_desc *pltcl_current_prodesc = NULL;
150
/**********************************************************************
151
* Forward declarations
152
**********************************************************************/
153
static void pltcl_init_all(void);
154
static void pltcl_init_interp(Tcl_Interp *interp);
156
static void pltcl_init_load_unknown(Tcl_Interp *interp);
158
Datum pltcl_call_handler(PG_FUNCTION_ARGS);
159
Datum pltclu_call_handler(PG_FUNCTION_ARGS);
160
void pltcl_init(void);
162
static Datum pltcl_func_handler(PG_FUNCTION_ARGS);
164
static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS);
166
static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid);
168
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
169
int argc, CONST84 char *argv[]);
170
static int pltcl_quote(ClientData cdata, Tcl_Interp *interp,
171
int argc, CONST84 char *argv[]);
172
static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
173
int argc, CONST84 char *argv[]);
174
static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
175
int argc, CONST84 char *argv[]);
177
static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
178
int argc, CONST84 char *argv[]);
179
static int pltcl_process_SPI_result(Tcl_Interp *interp,
180
CONST84 char *arrayname,
181
CONST84 char *loop_body,
183
SPITupleTable *tuptable,
185
static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
186
int argc, CONST84 char *argv[]);
187
static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
188
int argc, CONST84 char *argv[]);
189
static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
190
int argc, CONST84 char *argv[]);
192
static void pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
193
int tupno, HeapTuple tuple, TupleDesc tupdesc);
194
static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
195
Tcl_DString *retval);
199
* This routine is a crock, and so is everyplace that calls it. The problem
200
* is that the cached form of pltcl functions/queries is allocated permanently
201
* (mostly via malloc()) and never released until backend exit. Subsidiary
202
* data structures such as fmgr info records therefore must live forever
203
* as well. A better implementation would store all this stuff in a per-
204
* function memory context that could be reclaimed at need. In the meantime,
205
* fmgr_info_cxt must be called specifying TopMemoryContext so that whatever
206
* it might allocate, and whatever the eventual function might allocate using
207
* fn_mcxt, will live forever too.
210
perm_fmgr_info(Oid functionId, FmgrInfo *finfo)
212
fmgr_info_cxt(functionId, finfo, TopMemoryContext);
215
/**********************************************************************
216
* pltcl_init() - Initialize all that's safe to do in the postmaster
218
* DO NOT make this static --- it has to be callable by preload
219
**********************************************************************/
223
/************************************************************
224
* Do initialization only once
225
************************************************************/
226
if (pltcl_pm_init_done)
230
/* Required on win32 to prevent error loading init.tcl */
231
Tcl_FindExecutable("");
234
/************************************************************
235
* Create the dummy hold interpreter to prevent close of
236
* stdout and stderr on DeleteInterp
237
************************************************************/
238
if ((pltcl_hold_interp = Tcl_CreateInterp()) == NULL)
239
elog(ERROR, "could not create \"hold\" interpreter");
241
/************************************************************
242
* Create the two interpreters
243
************************************************************/
244
if ((pltcl_norm_interp =
245
Tcl_CreateSlave(pltcl_hold_interp, "norm", 0)) == NULL)
246
elog(ERROR, "could not create \"normal\" interpreter");
247
pltcl_init_interp(pltcl_norm_interp);
249
if ((pltcl_safe_interp =
250
Tcl_CreateSlave(pltcl_hold_interp, "safe", 1)) == NULL)
251
elog(ERROR, "could not create \"safe\" interpreter");
252
pltcl_init_interp(pltcl_safe_interp);
254
/************************************************************
255
* Initialize the proc and query hash tables
256
************************************************************/
257
pltcl_proc_hash = (Tcl_HashTable *) malloc(sizeof(Tcl_HashTable));
258
pltcl_norm_query_hash = (Tcl_HashTable *) malloc(sizeof(Tcl_HashTable));
259
pltcl_safe_query_hash = (Tcl_HashTable *) malloc(sizeof(Tcl_HashTable));
260
Tcl_InitHashTable(pltcl_proc_hash, TCL_STRING_KEYS);
261
Tcl_InitHashTable(pltcl_norm_query_hash, TCL_STRING_KEYS);
262
Tcl_InitHashTable(pltcl_safe_query_hash, TCL_STRING_KEYS);
264
pltcl_pm_init_done = true;
267
/**********************************************************************
268
* pltcl_init_all() - Initialize all
269
**********************************************************************/
273
/************************************************************
274
* Execute postmaster-startup safe initialization
275
************************************************************/
276
if (!pltcl_pm_init_done)
279
/************************************************************
280
* Any other initialization that must be done each time a new
282
* - Try to load the unknown procedure from pltcl_modules
283
************************************************************/
284
if (!pltcl_be_init_done)
286
if (SPI_connect() != SPI_OK_CONNECT)
287
elog(ERROR, "SPI_connect failed");
288
pltcl_init_load_unknown(pltcl_norm_interp);
289
pltcl_init_load_unknown(pltcl_safe_interp);
290
if (SPI_finish() != SPI_OK_FINISH)
291
elog(ERROR, "SPI_finish failed");
292
pltcl_be_init_done = true;
297
/**********************************************************************
298
* pltcl_init_interp() - initialize a Tcl interpreter
299
**********************************************************************/
301
pltcl_init_interp(Tcl_Interp *interp)
303
/************************************************************
304
* Install the commands for SPI support in the interpreter
305
************************************************************/
306
Tcl_CreateCommand(interp, "elog",
307
pltcl_elog, NULL, NULL);
308
Tcl_CreateCommand(interp, "quote",
309
pltcl_quote, NULL, NULL);
310
Tcl_CreateCommand(interp, "argisnull",
311
pltcl_argisnull, NULL, NULL);
312
Tcl_CreateCommand(interp, "return_null",
313
pltcl_returnnull, NULL, NULL);
315
Tcl_CreateCommand(interp, "spi_exec",
316
pltcl_SPI_execute, NULL, NULL);
317
Tcl_CreateCommand(interp, "spi_prepare",
318
pltcl_SPI_prepare, NULL, NULL);
319
Tcl_CreateCommand(interp, "spi_execp",
320
pltcl_SPI_execute_plan, NULL, NULL);
321
Tcl_CreateCommand(interp, "spi_lastoid",
322
pltcl_SPI_lastoid, NULL, NULL);
326
/**********************************************************************
327
* pltcl_init_load_unknown() - Load the unknown procedure from
328
* table pltcl_modules (if it exists)
329
**********************************************************************/
331
pltcl_init_load_unknown(Tcl_Interp *interp)
335
Tcl_DString unknown_src;
340
/************************************************************
341
* Check if table pltcl_modules exists
342
************************************************************/
343
spi_rc = SPI_execute("select 1 from pg_catalog.pg_class "
344
"where relname = 'pltcl_modules'",
346
SPI_freetuptable(SPI_tuptable);
347
if (spi_rc != SPI_OK_SELECT)
348
elog(ERROR, "select from pg_class failed");
349
if (SPI_processed == 0)
352
/************************************************************
353
* Read all the row's from it where modname = 'unknown' in
354
* the order of modseq
355
************************************************************/
356
Tcl_DStringInit(&unknown_src);
358
spi_rc = SPI_execute("select modseq, modsrc from pltcl_modules "
359
"where modname = 'unknown' "
362
if (spi_rc != SPI_OK_SELECT)
363
elog(ERROR, "select from pltcl_modules failed");
365
/************************************************************
366
* If there's nothing, module unknown doesn't exist
367
************************************************************/
368
if (SPI_processed == 0)
370
Tcl_DStringFree(&unknown_src);
371
SPI_freetuptable(SPI_tuptable);
372
elog(WARNING, "module \"unknown\" not found in pltcl_modules");
376
/************************************************************
377
* There is a module named unknown. Resemble the
378
* source from the modsrc attributes and evaluate
379
* it in the Tcl interpreter
380
************************************************************/
381
fno = SPI_fnumber(SPI_tuptable->tupdesc, "modsrc");
383
for (i = 0; i < SPI_processed; i++)
385
part = SPI_getvalue(SPI_tuptable->vals[i],
386
SPI_tuptable->tupdesc, fno);
390
Tcl_DStringAppend(&unknown_src, UTF_E2U(part), -1);
395
tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&unknown_src));
396
Tcl_DStringFree(&unknown_src);
397
SPI_freetuptable(SPI_tuptable);
401
/**********************************************************************
402
* pltcl_call_handler - This is the only visible function
403
* of the PL interpreter. The PostgreSQL
404
* function manager and trigger manager
405
* call this function for execution of
407
**********************************************************************/
408
PG_FUNCTION_INFO_V1(pltcl_call_handler);
410
/* keep non-static */
412
pltcl_call_handler(PG_FUNCTION_ARGS)
415
FunctionCallInfo save_fcinfo;
416
pltcl_proc_desc *save_prodesc;
419
* Initialize interpreters if first time through
424
* Ensure that static pointers are saved/restored properly
426
save_fcinfo = pltcl_current_fcinfo;
427
save_prodesc = pltcl_current_prodesc;
432
* Determine if called as function or trigger and
433
* call appropriate subhandler
435
if (CALLED_AS_TRIGGER(fcinfo))
437
pltcl_current_fcinfo = NULL;
438
retval = PointerGetDatum(pltcl_trigger_handler(fcinfo));
442
pltcl_current_fcinfo = fcinfo;
443
retval = pltcl_func_handler(fcinfo);
448
pltcl_current_fcinfo = save_fcinfo;
449
pltcl_current_prodesc = save_prodesc;
454
pltcl_current_fcinfo = save_fcinfo;
455
pltcl_current_prodesc = save_prodesc;
462
* Alternate handler for unsafe functions
464
PG_FUNCTION_INFO_V1(pltclu_call_handler);
466
/* keep non-static */
468
pltclu_call_handler(PG_FUNCTION_ARGS)
470
return pltcl_call_handler(fcinfo);
473
/**********************************************************************
474
* pltcl_func_handler() - Handler for regular function calls
475
**********************************************************************/
477
pltcl_func_handler(PG_FUNCTION_ARGS)
479
pltcl_proc_desc *prodesc;
480
Tcl_Interp *volatile interp;
482
Tcl_DString list_tmp;
487
/* Connect to SPI manager */
488
if (SPI_connect() != SPI_OK_CONNECT)
489
elog(ERROR, "could not connect to SPI manager");
491
/* Find or compile the function */
492
prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid);
494
pltcl_current_prodesc = prodesc;
496
if (prodesc->lanpltrusted)
497
interp = pltcl_safe_interp;
499
interp = pltcl_norm_interp;
501
/************************************************************
502
* Create the tcl command to call the internal
503
* proc in the Tcl interpreter
504
************************************************************/
505
Tcl_DStringInit(&tcl_cmd);
506
Tcl_DStringInit(&list_tmp);
507
Tcl_DStringAppendElement(&tcl_cmd, prodesc->proname);
509
/************************************************************
510
* Add all call arguments to the command
511
************************************************************/
514
for (i = 0; i < prodesc->nargs; i++)
516
if (prodesc->arg_is_rowtype[i])
518
/**************************************************
519
* For tuple values, add a list for 'array set ...'
520
**************************************************/
521
if (fcinfo->argnull[i])
522
Tcl_DStringAppendElement(&tcl_cmd, "");
529
HeapTupleData tmptup;
531
td = DatumGetHeapTupleHeader(fcinfo->arg[i]);
532
/* Extract rowtype info and find a tupdesc */
533
tupType = HeapTupleHeaderGetTypeId(td);
534
tupTypmod = HeapTupleHeaderGetTypMod(td);
535
tupdesc = lookup_rowtype_tupdesc(tupType, tupTypmod);
536
/* Build a temporary HeapTuple control structure */
537
tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
540
Tcl_DStringSetLength(&list_tmp, 0);
541
pltcl_build_tuple_argument(&tmptup, tupdesc, &list_tmp);
542
Tcl_DStringAppendElement(&tcl_cmd,
543
Tcl_DStringValue(&list_tmp));
548
/**************************************************
549
* Single values are added as string element
550
* of their external representation
551
**************************************************/
552
if (fcinfo->argnull[i])
553
Tcl_DStringAppendElement(&tcl_cmd, "");
558
tmp = DatumGetCString(FunctionCall3(&prodesc->arg_out_func[i],
560
ObjectIdGetDatum(prodesc->arg_typioparam[i]),
563
Tcl_DStringAppendElement(&tcl_cmd, UTF_E2U(tmp));
572
Tcl_DStringFree(&tcl_cmd);
573
Tcl_DStringFree(&list_tmp);
577
Tcl_DStringFree(&list_tmp);
579
/************************************************************
580
* Call the Tcl function
582
* We assume no PG error can be thrown directly from this call.
583
************************************************************/
584
tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
585
Tcl_DStringFree(&tcl_cmd);
587
/************************************************************
588
* Check for errors reported by Tcl.
589
************************************************************/
590
if (tcl_rc != TCL_OK)
594
(errmsg("%s", interp->result),
596
UTF_U2E(Tcl_GetVar(interp, "errorInfo",
597
TCL_GLOBAL_ONLY)))));
601
/************************************************************
602
* Disconnect from SPI manager and then create the return
603
* value datum (if the input function does a palloc for it
604
* this must not be allocated in the SPI memory context
605
* because SPI_finish would free it). But don't try to call
606
* the result_in_func if we've been told to return a NULL;
607
* the contents of interp->result may not be a valid value of
608
* the result type in that case.
609
************************************************************/
610
if (SPI_finish() != SPI_OK_FINISH)
611
elog(ERROR, "SPI_finish() failed");
618
retval = FunctionCall3(&prodesc->result_in_func,
619
PointerGetDatum(UTF_U2E(interp->result)),
620
ObjectIdGetDatum(prodesc->result_typioparam),
629
/**********************************************************************
630
* pltcl_trigger_handler() - Handler for trigger calls
631
**********************************************************************/
633
pltcl_trigger_handler(PG_FUNCTION_ARGS)
635
pltcl_proc_desc *prodesc;
636
Tcl_Interp *volatile interp;
637
TriggerData *trigdata = (TriggerData *) fcinfo->context;
640
volatile HeapTuple rettup;
642
Tcl_DString tcl_trigtup;
643
Tcl_DString tcl_newtup;
650
CONST84 char **ret_values;
652
/* Connect to SPI manager */
653
if (SPI_connect() != SPI_OK_CONNECT)
654
elog(ERROR, "could not connect to SPI manager");
656
/* Find or compile the function */
657
prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid,
658
RelationGetRelid(trigdata->tg_relation));
660
pltcl_current_prodesc = prodesc;
662
if (prodesc->lanpltrusted)
663
interp = pltcl_safe_interp;
665
interp = pltcl_norm_interp;
667
tupdesc = trigdata->tg_relation->rd_att;
669
/************************************************************
670
* Create the tcl command to call the internal
671
* proc in the interpreter
672
************************************************************/
673
Tcl_DStringInit(&tcl_cmd);
674
Tcl_DStringInit(&tcl_trigtup);
675
Tcl_DStringInit(&tcl_newtup);
678
/* The procedure name */
679
Tcl_DStringAppendElement(&tcl_cmd, prodesc->proname);
681
/* The trigger name for argument TG_name */
682
Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgname);
684
/* The oid of the trigger relation for argument TG_relid */
685
stroid = DatumGetCString(DirectFunctionCall1(oidout,
686
ObjectIdGetDatum(trigdata->tg_relation->rd_id)));
687
Tcl_DStringAppendElement(&tcl_cmd, stroid);
690
/* A list of attribute names for argument TG_relatts */
691
Tcl_DStringAppendElement(&tcl_trigtup, "");
692
for (i = 0; i < tupdesc->natts; i++)
694
if (tupdesc->attrs[i]->attisdropped)
695
Tcl_DStringAppendElement(&tcl_trigtup, "");
697
Tcl_DStringAppendElement(&tcl_trigtup,
698
NameStr(tupdesc->attrs[i]->attname));
700
Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
701
Tcl_DStringFree(&tcl_trigtup);
702
Tcl_DStringInit(&tcl_trigtup);
704
/* The when part of the event for TG_when */
705
if (TRIGGER_FIRED_BEFORE(trigdata->tg_event))
706
Tcl_DStringAppendElement(&tcl_cmd, "BEFORE");
707
else if (TRIGGER_FIRED_AFTER(trigdata->tg_event))
708
Tcl_DStringAppendElement(&tcl_cmd, "AFTER");
710
elog(ERROR, "unrecognized WHEN tg_event: %u", trigdata->tg_event);
712
/* The level part of the event for TG_level */
713
if (TRIGGER_FIRED_FOR_ROW(trigdata->tg_event))
715
Tcl_DStringAppendElement(&tcl_cmd, "ROW");
717
/* Build the data list for the trigtuple */
718
pltcl_build_tuple_argument(trigdata->tg_trigtuple,
719
tupdesc, &tcl_trigtup);
722
* Now the command part of the event for TG_op and data for
725
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
727
Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
729
Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
730
Tcl_DStringAppendElement(&tcl_cmd, "");
732
rettup = trigdata->tg_trigtuple;
734
else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
736
Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
738
Tcl_DStringAppendElement(&tcl_cmd, "");
739
Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
741
rettup = trigdata->tg_trigtuple;
743
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
745
Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
747
pltcl_build_tuple_argument(trigdata->tg_newtuple,
748
tupdesc, &tcl_newtup);
750
Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_newtup));
751
Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
753
rettup = trigdata->tg_newtuple;
756
elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);
758
else if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event))
760
Tcl_DStringAppendElement(&tcl_cmd, "STATEMENT");
762
if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
763
Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
764
else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
765
Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
766
else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
767
Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
769
elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);
771
Tcl_DStringAppendElement(&tcl_cmd, "");
772
Tcl_DStringAppendElement(&tcl_cmd, "");
774
rettup = (HeapTuple) NULL;
777
elog(ERROR, "unrecognized LEVEL tg_event: %u", trigdata->tg_event);
779
/* Finally append the arguments from CREATE TRIGGER */
780
for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
781
Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgargs[i]);
786
Tcl_DStringFree(&tcl_cmd);
787
Tcl_DStringFree(&tcl_trigtup);
788
Tcl_DStringFree(&tcl_newtup);
792
Tcl_DStringFree(&tcl_trigtup);
793
Tcl_DStringFree(&tcl_newtup);
795
/************************************************************
796
* Call the Tcl function
798
* We assume no PG error can be thrown directly from this call.
799
************************************************************/
800
tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
801
Tcl_DStringFree(&tcl_cmd);
803
/************************************************************
804
* Check for errors reported by Tcl.
805
************************************************************/
806
if (tcl_rc != TCL_OK)
810
(errmsg("%s", interp->result),
812
UTF_U2E(Tcl_GetVar(interp, "errorInfo",
813
TCL_GLOBAL_ONLY)))));
817
/************************************************************
818
* The return value from the procedure might be one of
819
* the magic strings OK or SKIP or a list from array get
820
************************************************************/
821
if (SPI_finish() != SPI_OK_FINISH)
822
elog(ERROR, "SPI_finish() failed");
824
if (strcmp(interp->result, "OK") == 0)
826
if (strcmp(interp->result, "SKIP") == 0)
827
return (HeapTuple) NULL;
829
/************************************************************
830
* Convert the result value from the Tcl interpreter
831
* and setup structures for SPI_modifytuple();
832
************************************************************/
833
if (Tcl_SplitList(interp, interp->result,
834
&ret_numvals, &ret_values) != TCL_OK)
835
elog(ERROR, "could not split return value from trigger: %s",
838
/* Use a TRY to ensure ret_values will get freed */
842
if (ret_numvals % 2 != 0)
843
elog(ERROR, "invalid return list from trigger - must have even # of elements");
845
modattrs = (int *) palloc(tupdesc->natts * sizeof(int));
846
modvalues = (Datum *) palloc(tupdesc->natts * sizeof(Datum));
847
for (i = 0; i < tupdesc->natts; i++)
850
modvalues[i] = (Datum) NULL;
853
modnulls = palloc(tupdesc->natts);
854
memset(modnulls, 'n', tupdesc->natts);
856
for (i = 0; i < ret_numvals; i += 2)
858
CONST84 char *ret_name = ret_values[i];
859
CONST84 char *ret_value = ret_values[i + 1];
866
/************************************************************
867
* Ignore ".tupno" pseudo elements (see pltcl_set_tuple_values)
868
************************************************************/
869
if (strcmp(ret_name, ".tupno") == 0)
872
/************************************************************
873
* Get the attribute number
874
************************************************************/
875
attnum = SPI_fnumber(tupdesc, ret_name);
876
if (attnum == SPI_ERROR_NOATTRIBUTE)
877
elog(ERROR, "invalid attribute \"%s\"", ret_name);
879
elog(ERROR, "cannot set system attribute \"%s\"", ret_name);
881
/************************************************************
882
* Ignore dropped columns
883
************************************************************/
884
if (tupdesc->attrs[attnum - 1]->attisdropped)
887
/************************************************************
888
* Lookup the attribute type in the syscache
889
* for the input function
890
************************************************************/
891
typeTup = SearchSysCache(TYPEOID,
892
ObjectIdGetDatum(tupdesc->attrs[attnum - 1]->atttypid),
894
if (!HeapTupleIsValid(typeTup))
895
elog(ERROR, "cache lookup failed for type %u",
896
tupdesc->attrs[attnum - 1]->atttypid);
897
typinput = ((Form_pg_type) GETSTRUCT(typeTup))->typinput;
898
typioparam = getTypeIOParam(typeTup);
899
ReleaseSysCache(typeTup);
901
/************************************************************
902
* Set the attribute to NOT NULL and convert the contents
903
************************************************************/
904
modnulls[attnum - 1] = ' ';
905
fmgr_info(typinput, &finfo);
907
modvalues[attnum - 1] =
908
FunctionCall3(&finfo,
909
CStringGetDatum(UTF_U2E(ret_value)),
910
ObjectIdGetDatum(typioparam),
911
Int32GetDatum(tupdesc->attrs[attnum - 1]->atttypmod));
915
rettup = SPI_modifytuple(trigdata->tg_relation, rettup, tupdesc->natts,
916
modattrs, modvalues, modnulls);
923
elog(ERROR, "SPI_modifytuple() failed - RC = %d", SPI_result);
928
ckfree((char *) ret_values);
932
ckfree((char *) ret_values);
938
/**********************************************************************
939
* compile_pltcl_function - compile (or hopefully just look up) function
941
* tgreloid is the OID of the relation when compiling a trigger, or zero
942
* (InvalidOid) when compiling a plain function.
943
**********************************************************************/
944
static pltcl_proc_desc *
945
compile_pltcl_function(Oid fn_oid, Oid tgreloid)
947
bool is_trigger = OidIsValid(tgreloid);
949
Form_pg_proc procStruct;
950
char internal_proname[128];
951
Tcl_HashEntry *hashent;
952
pltcl_proc_desc *prodesc = NULL;
958
/* We'll need the pg_proc tuple in any case... */
959
procTup = SearchSysCache(PROCOID,
960
ObjectIdGetDatum(fn_oid),
962
if (!HeapTupleIsValid(procTup))
963
elog(ERROR, "cache lookup failed for function %u", fn_oid);
964
procStruct = (Form_pg_proc) GETSTRUCT(procTup);
966
/************************************************************
967
* Build our internal proc name from the functions Oid
968
************************************************************/
970
snprintf(internal_proname, sizeof(internal_proname),
971
"__PLTcl_proc_%u", fn_oid);
973
snprintf(internal_proname, sizeof(internal_proname),
974
"__PLTcl_proc_%u_trigger_%u", fn_oid, tgreloid);
976
/************************************************************
977
* Lookup the internal proc name in the hashtable
978
************************************************************/
979
hashent = Tcl_FindHashEntry(pltcl_proc_hash, internal_proname);
981
/************************************************************
982
* If it's present, must check whether it's still up to date.
983
* This is needed because CREATE OR REPLACE FUNCTION can modify the
984
* function's pg_proc entry without changing its OID.
985
************************************************************/
990
prodesc = (pltcl_proc_desc *) Tcl_GetHashValue(hashent);
992
uptodate = (prodesc->fn_xmin == HeapTupleHeaderGetXmin(procTup->t_data) &&
993
prodesc->fn_cmin == HeapTupleHeaderGetCmin(procTup->t_data));
997
Tcl_DeleteHashEntry(hashent);
1002
/************************************************************
1003
* If we haven't found it in the hashtable, we analyze
1004
* the functions arguments and returntype and store
1005
* the in-/out-functions in the prodesc block and create
1006
* a new hashtable entry for it.
1008
* Then we load the procedure into the Tcl interpreter.
1009
************************************************************/
1010
if (hashent == NULL)
1014
Form_pg_language langStruct;
1015
Form_pg_type typeStruct;
1016
Tcl_DString proc_internal_def;
1017
Tcl_DString proc_internal_body;
1018
char proc_internal_args[33 * FUNC_MAX_ARGS];
1024
/************************************************************
1025
* Allocate a new procedure description block
1026
************************************************************/
1027
prodesc = (pltcl_proc_desc *) malloc(sizeof(pltcl_proc_desc));
1028
if (prodesc == NULL)
1030
(errcode(ERRCODE_OUT_OF_MEMORY),
1031
errmsg("out of memory")));
1032
MemSet(prodesc, 0, sizeof(pltcl_proc_desc));
1033
prodesc->proname = strdup(internal_proname);
1034
prodesc->fn_xmin = HeapTupleHeaderGetXmin(procTup->t_data);
1035
prodesc->fn_cmin = HeapTupleHeaderGetCmin(procTup->t_data);
1037
/* Remember if function is STABLE/IMMUTABLE */
1038
prodesc->fn_readonly =
1039
(procStruct->provolatile != PROVOLATILE_VOLATILE);
1041
/************************************************************
1042
* Lookup the pg_language tuple by Oid
1043
************************************************************/
1044
langTup = SearchSysCache(LANGOID,
1045
ObjectIdGetDatum(procStruct->prolang),
1047
if (!HeapTupleIsValid(langTup))
1049
free(prodesc->proname);
1051
elog(ERROR, "cache lookup failed for language %u",
1052
procStruct->prolang);
1054
langStruct = (Form_pg_language) GETSTRUCT(langTup);
1055
prodesc->lanpltrusted = langStruct->lanpltrusted;
1056
ReleaseSysCache(langTup);
1058
if (prodesc->lanpltrusted)
1059
interp = pltcl_safe_interp;
1061
interp = pltcl_norm_interp;
1063
/************************************************************
1064
* Get the required information for input conversion of the
1066
************************************************************/
1069
typeTup = SearchSysCache(TYPEOID,
1070
ObjectIdGetDatum(procStruct->prorettype),
1072
if (!HeapTupleIsValid(typeTup))
1074
free(prodesc->proname);
1076
elog(ERROR, "cache lookup failed for type %u",
1077
procStruct->prorettype);
1079
typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
1081
/* Disallow pseudotype result, except VOID */
1082
if (typeStruct->typtype == 'p')
1084
if (procStruct->prorettype == VOIDOID)
1086
else if (procStruct->prorettype == TRIGGEROID)
1088
free(prodesc->proname);
1091
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1092
errmsg("trigger functions may only be called as triggers")));
1096
free(prodesc->proname);
1099
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1100
errmsg("pltcl functions cannot return type %s",
1101
format_type_be(procStruct->prorettype))));
1105
if (typeStruct->typtype == 'c')
1107
free(prodesc->proname);
1110
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1111
errmsg("pltcl functions cannot return tuples yet")));
1114
perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
1115
prodesc->result_typioparam = getTypeIOParam(typeTup);
1117
ReleaseSysCache(typeTup);
1120
/************************************************************
1121
* Get the required information for output conversion
1122
* of all procedure arguments
1123
************************************************************/
1126
prodesc->nargs = procStruct->pronargs;
1127
proc_internal_args[0] = '\0';
1128
for (i = 0; i < prodesc->nargs; i++)
1130
typeTup = SearchSysCache(TYPEOID,
1131
ObjectIdGetDatum(procStruct->proargtypes[i]),
1133
if (!HeapTupleIsValid(typeTup))
1135
free(prodesc->proname);
1137
elog(ERROR, "cache lookup failed for type %u",
1138
procStruct->proargtypes[i]);
1140
typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
1142
/* Disallow pseudotype argument */
1143
if (typeStruct->typtype == 'p')
1145
free(prodesc->proname);
1148
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1149
errmsg("pltcl functions cannot take type %s",
1150
format_type_be(procStruct->proargtypes[i]))));
1153
if (typeStruct->typtype == 'c')
1155
prodesc->arg_is_rowtype[i] = true;
1156
snprintf(buf, sizeof(buf), "__PLTcl_Tup_%d", i + 1);
1160
prodesc->arg_is_rowtype[i] = false;
1161
perm_fmgr_info(typeStruct->typoutput,
1162
&(prodesc->arg_out_func[i]));
1163
prodesc->arg_typioparam[i] = getTypeIOParam(typeTup);
1164
snprintf(buf, sizeof(buf), "%d", i + 1);
1168
strcat(proc_internal_args, " ");
1169
strcat(proc_internal_args, buf);
1171
ReleaseSysCache(typeTup);
1176
/* trigger procedure has fixed args */
1177
strcpy(proc_internal_args,
1178
"TG_name TG_relid TG_relatts TG_when TG_level TG_op __PLTcl_Tup_NEW __PLTcl_Tup_OLD args");
1181
/************************************************************
1182
* Create the tcl command to define the internal
1184
************************************************************/
1185
Tcl_DStringInit(&proc_internal_def);
1186
Tcl_DStringInit(&proc_internal_body);
1187
Tcl_DStringAppendElement(&proc_internal_def, "proc");
1188
Tcl_DStringAppendElement(&proc_internal_def, internal_proname);
1189
Tcl_DStringAppendElement(&proc_internal_def, proc_internal_args);
1191
/************************************************************
1192
* prefix procedure body with
1193
* upvar #0 <internal_procname> GD
1194
* and with appropriate setting of arguments
1195
************************************************************/
1196
Tcl_DStringAppend(&proc_internal_body, "upvar #0 ", -1);
1197
Tcl_DStringAppend(&proc_internal_body, internal_proname, -1);
1198
Tcl_DStringAppend(&proc_internal_body, " GD\n", -1);
1201
for (i = 0; i < prodesc->nargs; i++)
1203
if (prodesc->arg_is_rowtype[i])
1205
snprintf(buf, sizeof(buf),
1206
"array set %d $__PLTcl_Tup_%d\n",
1208
Tcl_DStringAppend(&proc_internal_body, buf, -1);
1214
Tcl_DStringAppend(&proc_internal_body,
1215
"array set NEW $__PLTcl_Tup_NEW\n", -1);
1216
Tcl_DStringAppend(&proc_internal_body,
1217
"array set OLD $__PLTcl_Tup_OLD\n", -1);
1219
Tcl_DStringAppend(&proc_internal_body,
1222
"foreach v $args {\n"
1226
"unset i v\n\n", -1);
1229
/************************************************************
1230
* Add user's function definition to proc body
1231
************************************************************/
1232
prosrcdatum = SysCacheGetAttr(PROCOID, procTup,
1233
Anum_pg_proc_prosrc, &isnull);
1235
elog(ERROR, "null prosrc");
1236
proc_source = DatumGetCString(DirectFunctionCall1(textout,
1239
Tcl_DStringAppend(&proc_internal_body, UTF_E2U(proc_source), -1);
1242
Tcl_DStringAppendElement(&proc_internal_def,
1243
Tcl_DStringValue(&proc_internal_body));
1244
Tcl_DStringFree(&proc_internal_body);
1246
/************************************************************
1247
* Create the procedure in the interpreter
1248
************************************************************/
1249
tcl_rc = Tcl_GlobalEval(interp,
1250
Tcl_DStringValue(&proc_internal_def));
1251
Tcl_DStringFree(&proc_internal_def);
1252
if (tcl_rc != TCL_OK)
1254
free(prodesc->proname);
1256
elog(ERROR, "could not create internal procedure \"%s\": %s",
1257
internal_proname, interp->result);
1260
/************************************************************
1261
* Add the proc description block to the hashtable
1262
************************************************************/
1263
hashent = Tcl_CreateHashEntry(pltcl_proc_hash,
1264
prodesc->proname, &hashnew);
1265
Tcl_SetHashValue(hashent, (ClientData) prodesc);
1268
ReleaseSysCache(procTup);
1274
/**********************************************************************
1275
* pltcl_elog() - elog() support for PLTcl
1276
**********************************************************************/
1278
pltcl_elog(ClientData cdata, Tcl_Interp *interp,
1279
int argc, CONST84 char *argv[])
1282
MemoryContext oldcontext;
1286
Tcl_SetResult(interp, "syntax error - 'elog level msg'",
1291
if (strcmp(argv[1], "DEBUG") == 0)
1293
else if (strcmp(argv[1], "LOG") == 0)
1295
else if (strcmp(argv[1], "INFO") == 0)
1297
else if (strcmp(argv[1], "NOTICE") == 0)
1299
else if (strcmp(argv[1], "WARNING") == 0)
1301
else if (strcmp(argv[1], "ERROR") == 0)
1303
else if (strcmp(argv[1], "FATAL") == 0)
1307
Tcl_AppendResult(interp, "Unknown elog level '", argv[1],
1312
/************************************************************
1313
* If elog() throws an error, catch it and return the error to the
1314
* Tcl interpreter. Note we are assuming that elog() can't have any
1315
* internal failures that are so bad as to require a transaction abort.
1316
************************************************************/
1317
oldcontext = CurrentMemoryContext;
1321
elog(level, "%s", UTF_U2E(argv[2]));
1328
/* Must reset elog.c's state */
1329
MemoryContextSwitchTo(oldcontext);
1330
edata = CopyErrorData();
1333
/* Pass the error message to Tcl */
1334
Tcl_SetResult(interp, edata->message, TCL_VOLATILE);
1335
FreeErrorData(edata);
1345
/**********************************************************************
1346
* pltcl_quote() - quote literal strings that are to
1347
* be used in SPI_execute query strings
1348
**********************************************************************/
1350
pltcl_quote(ClientData cdata, Tcl_Interp *interp,
1351
int argc, CONST84 char *argv[])
1357
/************************************************************
1359
************************************************************/
1362
Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_VOLATILE);
1366
/************************************************************
1367
* Allocate space for the maximum the string can
1368
* grow to and initialize pointers
1369
************************************************************/
1370
tmp = palloc(strlen(argv[1]) * 2 + 1);
1374
/************************************************************
1375
* Walk through string and double every quote and backslash
1376
************************************************************/
1389
/************************************************************
1390
* Terminate the string and set it as result
1391
************************************************************/
1393
Tcl_SetResult(interp, tmp, TCL_VOLATILE);
1399
/**********************************************************************
1400
* pltcl_argisnull() - determine if a specific argument is NULL
1401
**********************************************************************/
1403
pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
1404
int argc, CONST84 char *argv[])
1407
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
1409
/************************************************************
1411
************************************************************/
1414
Tcl_SetResult(interp, "syntax error - 'argisnull argno'", TCL_VOLATILE);
1418
/************************************************************
1419
* Check that we're called as a normal function
1420
************************************************************/
1423
Tcl_SetResult(interp, "argisnull cannot be used in triggers",
1428
/************************************************************
1429
* Get the argument number
1430
************************************************************/
1431
if (Tcl_GetInt(interp, argv[1], &argno) != TCL_OK)
1434
/************************************************************
1435
* Check that the argno is valid
1436
************************************************************/
1438
if (argno < 0 || argno >= fcinfo->nargs)
1440
Tcl_SetResult(interp, "argno out of range", TCL_VOLATILE);
1444
/************************************************************
1445
* Get the requested NULL state
1446
************************************************************/
1447
if (PG_ARGISNULL(argno))
1448
Tcl_SetResult(interp, "1", TCL_VOLATILE);
1450
Tcl_SetResult(interp, "0", TCL_VOLATILE);
1456
/**********************************************************************
1457
* pltcl_returnnull() - Cause a NULL return from a function
1458
**********************************************************************/
1460
pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
1461
int argc, CONST84 char *argv[])
1463
FunctionCallInfo fcinfo = pltcl_current_fcinfo;
1465
/************************************************************
1467
************************************************************/
1470
Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_VOLATILE);
1474
/************************************************************
1475
* Check that we're called as a normal function
1476
************************************************************/
1479
Tcl_SetResult(interp, "return_null cannot be used in triggers",
1484
/************************************************************
1485
* Set the NULL return flag and cause Tcl to return from the
1487
************************************************************/
1488
fcinfo->isnull = true;
1495
* Support for running SPI operations inside subtransactions
1497
* Intended usage pattern is:
1499
* MemoryContext oldcontext = CurrentMemoryContext;
1500
* ResourceOwner oldowner = CurrentResourceOwner;
1503
* pltcl_subtrans_begin(oldcontext, oldowner);
1506
* do something risky;
1507
* pltcl_subtrans_commit(oldcontext, oldowner);
1511
* pltcl_subtrans_abort(interp, oldcontext, oldowner);
1519
pltcl_subtrans_begin(MemoryContext oldcontext, ResourceOwner oldowner)
1521
BeginInternalSubTransaction(NULL);
1523
/* Want to run inside function's memory context */
1524
MemoryContextSwitchTo(oldcontext);
1528
pltcl_subtrans_commit(MemoryContext oldcontext, ResourceOwner oldowner)
1530
/* Commit the inner transaction, return to outer xact context */
1531
ReleaseCurrentSubTransaction();
1532
MemoryContextSwitchTo(oldcontext);
1533
CurrentResourceOwner = oldowner;
1536
* AtEOSubXact_SPI() should not have popped any SPI context,
1537
* but just in case it did, make sure we remain connected.
1539
SPI_restore_connection();
1543
pltcl_subtrans_abort(Tcl_Interp *interp,
1544
MemoryContext oldcontext, ResourceOwner oldowner)
1548
/* Save error info */
1549
MemoryContextSwitchTo(oldcontext);
1550
edata = CopyErrorData();
1553
/* Abort the inner transaction */
1554
RollbackAndReleaseCurrentSubTransaction();
1555
MemoryContextSwitchTo(oldcontext);
1556
CurrentResourceOwner = oldowner;
1559
* If AtEOSubXact_SPI() popped any SPI context of the subxact,
1560
* it will have left us in a disconnected state. We need this
1561
* hack to return to connected state.
1563
SPI_restore_connection();
1565
/* Pass the error message to Tcl */
1566
Tcl_SetResult(interp, edata->message, TCL_VOLATILE);
1567
FreeErrorData(edata);
1571
/**********************************************************************
1572
* pltcl_SPI_execute() - The builtin SPI_execute command
1573
* for the Tcl interpreter
1574
**********************************************************************/
1576
pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
1577
int argc, CONST84 char *argv[])
1584
CONST84 char *volatile arrayname = NULL;
1585
CONST84 char *volatile loop_body = NULL;
1586
MemoryContext oldcontext = CurrentMemoryContext;
1587
ResourceOwner oldowner = CurrentResourceOwner;
1589
char *usage = "syntax error - 'SPI_exec "
1591
"?-array name? query ?loop body?";
1593
/************************************************************
1594
* Check the call syntax and get the options
1595
************************************************************/
1598
Tcl_SetResult(interp, usage, TCL_VOLATILE);
1605
if (strcmp(argv[i], "-array") == 0)
1609
Tcl_SetResult(interp, usage, TCL_VOLATILE);
1612
arrayname = argv[i++];
1616
if (strcmp(argv[i], "-count") == 0)
1620
Tcl_SetResult(interp, usage, TCL_VOLATILE);
1623
if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
1632
if (query_idx >= argc || query_idx + 2 < argc)
1634
Tcl_SetResult(interp, usage, TCL_VOLATILE);
1637
if (query_idx + 1 < argc)
1638
loop_body = argv[query_idx + 1];
1640
/************************************************************
1641
* Execute the query inside a sub-transaction, so we can cope with
1643
************************************************************/
1645
pltcl_subtrans_begin(oldcontext, oldowner);
1650
spi_rc = SPI_execute(UTF_U2E(argv[query_idx]),
1651
pltcl_current_prodesc->fn_readonly, count);
1654
my_rc = pltcl_process_SPI_result(interp,
1661
pltcl_subtrans_commit(oldcontext, oldowner);
1665
pltcl_subtrans_abort(interp, oldcontext, oldowner);
1674
* Process the result from SPI_execute or SPI_execute_plan
1676
* Shared code between pltcl_SPI_execute and pltcl_SPI_execute_plan
1679
pltcl_process_SPI_result(Tcl_Interp *interp,
1680
CONST84 char *arrayname,
1681
CONST84 char *loop_body,
1683
SPITupleTable *tuptable,
1695
case SPI_OK_UTILITY:
1696
Tcl_SetResult(interp, "0", TCL_VOLATILE);
1699
case SPI_OK_SELINTO:
1703
snprintf(buf, sizeof(buf), "%d", ntuples);
1704
Tcl_SetResult(interp, buf, TCL_VOLATILE);
1709
* Process the tuples we got
1711
tuples = tuptable->vals;
1712
tupdesc = tuptable->tupdesc;
1714
if (loop_body == NULL)
1717
* If there is no loop body given, just set the variables
1718
* from the first tuple (if any)
1721
pltcl_set_tuple_values(interp, arrayname, 0,
1722
tuples[0], tupdesc);
1727
* There is a loop body - process all tuples and evaluate
1730
for (i = 0; i < ntuples; i++)
1732
pltcl_set_tuple_values(interp, arrayname, i,
1733
tuples[i], tupdesc);
1735
loop_rc = Tcl_Eval(interp, loop_body);
1737
if (loop_rc == TCL_OK)
1739
if (loop_rc == TCL_CONTINUE)
1741
if (loop_rc == TCL_RETURN)
1746
if (loop_rc == TCL_BREAK)
1753
if (my_rc == TCL_OK)
1755
snprintf(buf, sizeof(buf), "%d", ntuples);
1756
Tcl_SetResult(interp, buf, TCL_VOLATILE);
1761
Tcl_AppendResult(interp, "pltcl: SPI_execute failed: ",
1762
SPI_result_code_string(spi_rc), NULL);
1767
SPI_freetuptable(tuptable);
1773
/**********************************************************************
1774
* pltcl_SPI_prepare() - Builtin support for prepared plans
1775
* The Tcl command SPI_prepare
1776
* always saves the plan using
1777
* SPI_saveplan and returns a key for
1778
* access. There is no chance to prepare
1779
* and not save the plan currently.
1780
**********************************************************************/
1782
pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
1783
int argc, CONST84 char *argv[])
1786
CONST84 char **args;
1787
pltcl_query_desc *qdesc;
1791
Tcl_HashEntry *hashent;
1793
Tcl_HashTable *query_hash;
1794
MemoryContext oldcontext = CurrentMemoryContext;
1795
ResourceOwner oldowner = CurrentResourceOwner;
1797
/************************************************************
1798
* Check the call syntax
1799
************************************************************/
1802
Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'",
1807
/************************************************************
1808
* Split the argument type list
1809
************************************************************/
1810
if (Tcl_SplitList(interp, argv[2], &nargs, &args) != TCL_OK)
1813
/************************************************************
1814
* Allocate the new querydesc structure
1815
************************************************************/
1816
qdesc = (pltcl_query_desc *) malloc(sizeof(pltcl_query_desc));
1817
snprintf(qdesc->qname, sizeof(qdesc->qname), "%lx", (long) qdesc);
1818
qdesc->nargs = nargs;
1819
qdesc->argtypes = (Oid *) malloc(nargs * sizeof(Oid));
1820
qdesc->arginfuncs = (FmgrInfo *) malloc(nargs * sizeof(FmgrInfo));
1821
qdesc->argtypioparams = (Oid *) malloc(nargs * sizeof(Oid));
1823
/************************************************************
1824
* Execute the prepare inside a sub-transaction, so we can cope with
1826
************************************************************/
1828
pltcl_subtrans_begin(oldcontext, oldowner);
1832
/************************************************************
1833
* Lookup the argument types by name in the system cache
1834
* and remember the required information for input conversion
1835
************************************************************/
1836
for (i = 0; i < nargs; i++)
1843
/************************************************************
1844
* Use SplitIdentifierString() on a copy of the type name,
1845
* turn the resulting pointer list into a TypeName node
1846
* and call typenameType() to get the pg_type tuple.
1847
************************************************************/
1848
argcopy = pstrdup(args[i]);
1849
SplitIdentifierString(argcopy, '.', &names);
1850
typename = makeNode(TypeName);
1852
typename->names = lappend(typename->names, makeString(lfirst(l)));
1854
typeTup = typenameType(typename);
1855
qdesc->argtypes[i] = HeapTupleGetOid(typeTup);
1856
perm_fmgr_info(((Form_pg_type) GETSTRUCT(typeTup))->typinput,
1857
&(qdesc->arginfuncs[i]));
1858
qdesc->argtypioparams[i] = getTypeIOParam(typeTup);
1859
ReleaseSysCache(typeTup);
1861
list_free(typename->names);
1867
/************************************************************
1868
* Prepare the plan and check for errors
1869
************************************************************/
1871
plan = SPI_prepare(UTF_U2E(argv[1]), nargs, qdesc->argtypes);
1875
elog(ERROR, "SPI_prepare() failed");
1877
/************************************************************
1878
* Save the plan into permanent memory (right now it's in the
1879
* SPI procCxt, which will go away at function end).
1880
************************************************************/
1881
qdesc->plan = SPI_saveplan(plan);
1882
if (qdesc->plan == NULL)
1883
elog(ERROR, "SPI_saveplan() failed");
1885
/* Release the procCxt copy to avoid within-function memory leak */
1888
pltcl_subtrans_commit(oldcontext, oldowner);
1892
pltcl_subtrans_abort(interp, oldcontext, oldowner);
1894
free(qdesc->argtypes);
1895
free(qdesc->arginfuncs);
1896
free(qdesc->argtypioparams);
1898
ckfree((char *) args);
1904
/************************************************************
1905
* Insert a hashtable entry for the plan and return
1906
* the key to the caller
1907
************************************************************/
1908
if (interp == pltcl_norm_interp)
1909
query_hash = pltcl_norm_query_hash;
1911
query_hash = pltcl_safe_query_hash;
1913
hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
1914
Tcl_SetHashValue(hashent, (ClientData) qdesc);
1916
ckfree((char *) args);
1918
Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE);
1923
/**********************************************************************
1924
* pltcl_SPI_execute_plan() - Execute a prepared plan
1925
**********************************************************************/
1927
pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
1928
int argc, CONST84 char *argv[])
1934
Tcl_HashEntry *hashent;
1935
pltcl_query_desc *qdesc;
1936
const char *volatile nulls = NULL;
1937
CONST84 char *volatile arrayname = NULL;
1938
CONST84 char *volatile loop_body = NULL;
1941
CONST84 char **callargs = NULL;
1943
MemoryContext oldcontext = CurrentMemoryContext;
1944
ResourceOwner oldowner = CurrentResourceOwner;
1945
Tcl_HashTable *query_hash;
1947
char *usage = "syntax error - 'SPI_execp "
1948
"?-nulls string? ?-count n? "
1949
"?-array name? query ?args? ?loop body?";
1951
/************************************************************
1952
* Get the options and check syntax
1953
************************************************************/
1957
if (strcmp(argv[i], "-array") == 0)
1961
Tcl_SetResult(interp, usage, TCL_VOLATILE);
1964
arrayname = argv[i++];
1967
if (strcmp(argv[i], "-nulls") == 0)
1971
Tcl_SetResult(interp, usage, TCL_VOLATILE);
1977
if (strcmp(argv[i], "-count") == 0)
1981
Tcl_SetResult(interp, usage, TCL_VOLATILE);
1984
if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
1992
/************************************************************
1993
* Get the prepared plan descriptor by its key
1994
************************************************************/
1997
Tcl_SetResult(interp, usage, TCL_VOLATILE);
2001
if (interp == pltcl_norm_interp)
2002
query_hash = pltcl_norm_query_hash;
2004
query_hash = pltcl_safe_query_hash;
2006
hashent = Tcl_FindHashEntry(query_hash, argv[i]);
2007
if (hashent == NULL)
2009
Tcl_AppendResult(interp, "invalid queryid '", argv[i], "'", NULL);
2012
qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent);
2015
/************************************************************
2016
* If a nulls string is given, check for correct length
2017
************************************************************/
2020
if (strlen(nulls) != qdesc->nargs)
2022
Tcl_SetResult(interp,
2023
"length of nulls string doesn't match # of arguments",
2029
/************************************************************
2030
* If there was a argtype list on preparation, we need
2031
* an argument value list now
2032
************************************************************/
2033
if (qdesc->nargs > 0)
2037
Tcl_SetResult(interp, "missing argument list", TCL_VOLATILE);
2041
/************************************************************
2042
* Split the argument values
2043
************************************************************/
2044
if (Tcl_SplitList(interp, argv[i++], &callnargs, &callargs) != TCL_OK)
2047
/************************************************************
2048
* Check that the # of arguments matches
2049
************************************************************/
2050
if (callnargs != qdesc->nargs)
2052
Tcl_SetResult(interp,
2053
"argument list length doesn't match # of arguments for query",
2055
ckfree((char *) callargs);
2062
/************************************************************
2063
* Get loop body if present
2064
************************************************************/
2066
loop_body = argv[i++];
2070
Tcl_SetResult(interp, usage, TCL_VOLATILE);
2074
/************************************************************
2075
* Execute the plan inside a sub-transaction, so we can cope with
2077
************************************************************/
2079
pltcl_subtrans_begin(oldcontext, oldowner);
2083
/************************************************************
2084
* Setup the value array for SPI_execute_plan() using
2085
* the type specific input functions
2086
************************************************************/
2087
argvalues = (Datum *) palloc(callnargs * sizeof(Datum));
2089
for (j = 0; j < callnargs; j++)
2091
if (nulls && nulls[j] == 'n')
2093
/* don't try to convert the input for a null */
2094
argvalues[j] = (Datum) 0;
2100
FunctionCall3(&qdesc->arginfuncs[j],
2101
CStringGetDatum(UTF_U2E(callargs[j])),
2102
ObjectIdGetDatum(qdesc->argtypioparams[j]),
2109
ckfree((char *) callargs);
2112
/************************************************************
2114
************************************************************/
2115
spi_rc = SPI_execute_plan(qdesc->plan, argvalues, nulls,
2116
pltcl_current_prodesc->fn_readonly, count);
2118
my_rc = pltcl_process_SPI_result(interp,
2125
pltcl_subtrans_commit(oldcontext, oldowner);
2129
pltcl_subtrans_abort(interp, oldcontext, oldowner);
2132
ckfree((char *) callargs);
2142
/**********************************************************************
2143
* pltcl_SPI_lastoid() - return the last oid. To
2144
* be used after insert queries
2145
**********************************************************************/
2147
pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
2148
int argc, CONST84 char *argv[])
2152
snprintf(buf, sizeof(buf), "%u", SPI_lastoid);
2153
Tcl_SetResult(interp, buf, TCL_VOLATILE);
2158
/**********************************************************************
2159
* pltcl_set_tuple_values() - Set variables for all attributes
2161
**********************************************************************/
2163
pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
2164
int tupno, HeapTuple tuple, TupleDesc tupdesc)
2172
CONST84 char *attname;
2177
CONST84 char **arrptr;
2178
CONST84 char **nameptr;
2179
CONST84 char *nullname = NULL;
2181
/************************************************************
2182
* Prepare pointers for Tcl_SetVar2() below and in array
2183
* mode set the .tupno element
2184
************************************************************/
2185
if (arrayname == NULL)
2188
nameptr = &nullname;
2192
arrptr = &arrayname;
2194
snprintf(buf, sizeof(buf), "%d", tupno);
2195
Tcl_SetVar2(interp, arrayname, ".tupno", buf, 0);
2198
for (i = 0; i < tupdesc->natts; i++)
2200
/* ignore dropped attributes */
2201
if (tupdesc->attrs[i]->attisdropped)
2204
/************************************************************
2205
* Get the attribute name
2206
************************************************************/
2207
attname = NameStr(tupdesc->attrs[i]->attname);
2209
/************************************************************
2210
* Get the attributes value
2211
************************************************************/
2212
attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
2214
/************************************************************
2215
* Lookup the attribute type in the syscache
2216
* for the output function
2217
************************************************************/
2218
typeTup = SearchSysCache(TYPEOID,
2219
ObjectIdGetDatum(tupdesc->attrs[i]->atttypid),
2221
if (!HeapTupleIsValid(typeTup))
2222
elog(ERROR, "cache lookup failed for type %u",
2223
tupdesc->attrs[i]->atttypid);
2225
typoutput = ((Form_pg_type) GETSTRUCT(typeTup))->typoutput;
2226
typioparam = getTypeIOParam(typeTup);
2227
ReleaseSysCache(typeTup);
2229
/************************************************************
2230
* If there is a value, set the variable
2233
* Hmmm - Null attributes will cause functions to
2234
* crash if they don't expect them - need something
2236
************************************************************/
2237
if (!isnull && OidIsValid(typoutput))
2239
outputstr = DatumGetCString(OidFunctionCall3(typoutput,
2241
ObjectIdGetDatum(typioparam),
2242
Int32GetDatum(tupdesc->attrs[i]->atttypmod)));
2244
Tcl_SetVar2(interp, *arrptr, *nameptr, UTF_E2U(outputstr), 0);
2249
Tcl_UnsetVar2(interp, *arrptr, *nameptr, 0);
2254
/**********************************************************************
2255
* pltcl_build_tuple_argument() - Build a string usable for 'array set'
2256
* from all attributes of a given tuple
2257
**********************************************************************/
2259
pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
2260
Tcl_DString *retval)
2272
for (i = 0; i < tupdesc->natts; i++)
2274
/* ignore dropped attributes */
2275
if (tupdesc->attrs[i]->attisdropped)
2278
/************************************************************
2279
* Get the attribute name
2280
************************************************************/
2281
attname = NameStr(tupdesc->attrs[i]->attname);
2283
/************************************************************
2284
* Get the attributes value
2285
************************************************************/
2286
attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
2288
/************************************************************
2289
* Lookup the attribute type in the syscache
2290
* for the output function
2291
************************************************************/
2292
typeTup = SearchSysCache(TYPEOID,
2293
ObjectIdGetDatum(tupdesc->attrs[i]->atttypid),
2295
if (!HeapTupleIsValid(typeTup))
2296
elog(ERROR, "cache lookup failed for type %u",
2297
tupdesc->attrs[i]->atttypid);
2299
typoutput = ((Form_pg_type) GETSTRUCT(typeTup))->typoutput;
2300
typioparam = getTypeIOParam(typeTup);
2301
ReleaseSysCache(typeTup);
2303
/************************************************************
2304
* If there is a value, append the attribute name and the
2307
* Hmmm - Null attributes will cause functions to
2308
* crash if they don't expect them - need something
2310
************************************************************/
2311
if (!isnull && OidIsValid(typoutput))
2313
outputstr = DatumGetCString(OidFunctionCall3(typoutput,
2315
ObjectIdGetDatum(typioparam),
2316
Int32GetDatum(tupdesc->attrs[i]->atttypmod)));
2317
Tcl_DStringAppendElement(retval, attname);
2319
Tcl_DStringAppendElement(retval, UTF_E2U(outputstr));
added
removed
src/pl/tcl/pltcl.c
