PostgreSQL Source Code: src/pl/tcl/pltcl.c Source File (original) (raw)
1
2
3
4
5
6
7
8
10
11#include <tcl.h>
12
14#include <fcntl.h>
15
40
41
43 .name = "pltcl",
44 .version = PG_VERSION
45);
46
47#define HAVE_TCL_VERSION(maj,min) \
48 ((TCL_MAJOR_VERSION > maj) || \
49 (TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min))
50
51
52#if !HAVE_TCL_VERSION(8,4)
53#error PostgreSQL only supports Tcl 8.4 or later.
54#endif
55
56
57#ifndef CONST86
58#define CONST86
59#endif
60
61#if !HAVE_TCL_VERSION(8,7)
63#endif
64
65
66#undef TEXTDOMAIN
67#define TEXTDOMAIN PG_TEXTDOMAIN("pltcl")
68
69
70
71
72
73
74
75
76
77
78
79
80static inline char *
82{
84}
85
86static inline char *
88{
90}
91
92#define UTF_BEGIN \
93 do { \
94 const char *_pltcl_utf_src = NULL; \
95 char *_pltcl_utf_dst = NULL
96
97#define UTF_END \
98 if (_pltcl_utf_src != (const char *) _pltcl_utf_dst) \
99 pfree(_pltcl_utf_dst); \
100 } while (0)
101
102#define UTF_U2E(x) \
103 (_pltcl_utf_dst = utf_u2e(_pltcl_utf_src = (x)))
104
105#define UTF_E2U(x) \
106 (_pltcl_utf_dst = utf_e2u(_pltcl_utf_src = (x)))
107
108
109
110
111
112
113
114
115
116
117
118
120{
123 Tcl_HashTable query_hash;
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
145{
146 char *user_proname;
149 unsigned long fn_refcount;
158 bool fn_retisset;
161 void *domain_info;
163
167
168
169
170
171
173{
181
182
183
184
185
186
187
188
189
190
191
192
193
195{
197
198
199
200
201
205
207{
211
212
213
214
215
217{
218
220
221
223
224
226
227
228
229
230
231
234
240
241
242
243
244
251
252
254
255
256
257
258typedef struct
259{
263
265#include "pltclerrcodes.h"
266 {NULL, 0}
267};
268
269
270
271
272
274 Oid prolang, bool pltrusted);
278
280
282 bool pltrusted);
284 bool pltrusted);
286 bool pltrusted);
287
289
291 bool is_event_trigger,
292 bool pltrusted);
293
294static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
295 int objc, Tcl_Obj *const objv[]);
298static int pltcl_quote(ClientData cdata, Tcl_Interp *interp,
299 int objc, Tcl_Obj *const objv[]);
300static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
301 int objc, Tcl_Obj *const objv[]);
302static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
303 int objc, Tcl_Obj *const objv[]);
304static int pltcl_returnnext(ClientData cdata, Tcl_Interp *interp,
305 int objc, Tcl_Obj *const objv[]);
306static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
307 int objc, Tcl_Obj *const objv[]);
309 const char *arrayname,
310 Tcl_Obj *loop_body,
311 int spi_rc,
314static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
315 int objc, Tcl_Obj *const objv[]);
317 int objc, Tcl_Obj *const objv[]);
319 int objc, Tcl_Obj *const objv[]);
320static int pltcl_commit(ClientData cdata, Tcl_Interp *interp,
321 int objc, Tcl_Obj *const objv[]);
322static int pltcl_rollback(ClientData cdata, Tcl_Interp *interp,
323 int objc, Tcl_Obj *const objv[]);
324
332
337 Tcl_Obj **kvObjv, int kvObjc,
340
341
342
343
344
345
346
347
348
349
350
351
352
353static ClientData
355{
356 static int fakeThreadKey;
357
358 return (ClientData) &(fakeThreadKey);
359}
360
361static void
363{
364}
365
366static void
368{
369}
370
371static void
373{
374}
375
376static void
378 Tcl_FileProc *proc, ClientData clientData)
379{
380}
381
382static void
384{
385}
386
387static void
389{
390}
391
392static int
394{
395 return 0;
396}
397
398
399
400
401
402
403
404
405
406
407void
409{
410 Tcl_NotifierProcs notifier;
412
413
415 return;
416
418
419#ifdef WIN32
420
421 Tcl_FindExecutable("");
422#endif
423
424
425
426
435 Tcl_SetNotifier(¬ifier);
436
437
438
439
440
442 elog(ERROR, "could not create dummy Tcl interpreter");
444 elog(ERROR, "could not initialize dummy Tcl interpreter");
445
446
447
448
452 8,
453 &hash_ctl,
455
456
457
458
462 100,
463 &hash_ctl,
465
466
467
468
470 gettext_noop("PL/Tcl function to call once when pltcl is first used."),
471 NULL,
473 NULL,
475 NULL, NULL, NULL);
477 gettext_noop("PL/TclU function to call once when pltclu is first used."),
478 NULL,
480 NULL,
482 NULL, NULL, NULL);
483
486
488}
489
490
491
492
493static void
495{
496 Tcl_Interp *interp;
497 char interpname[32];
498
499
500
501
502
503
504 snprintf(interpname, sizeof(interpname), "subsidiary_%u", interp_desc->user_id);
506 pltrusted ? 1 : 0)) == NULL)
507 elog(ERROR, "could not create subsidiary Tcl interpreter");
508
509
510
511
512 Tcl_InitHashTable(&interp_desc->query_hash, TCL_STRING_KEYS);
513
514
515
516
517 Tcl_CreateObjCommand(interp, "elog",
519 Tcl_CreateObjCommand(interp, "quote",
521 Tcl_CreateObjCommand(interp, "argisnull",
523 Tcl_CreateObjCommand(interp, "return_null",
525 Tcl_CreateObjCommand(interp, "return_next",
527 Tcl_CreateObjCommand(interp, "spi_exec",
529 Tcl_CreateObjCommand(interp, "spi_prepare",
531 Tcl_CreateObjCommand(interp, "spi_execp",
533 Tcl_CreateObjCommand(interp, "subtransaction",
535 Tcl_CreateObjCommand(interp, "commit",
537 Tcl_CreateObjCommand(interp, "rollback",
539
540
541
542
543
544
545
546
548 {
549 interp_desc->interp = interp;
551 }
553 {
554 interp_desc->interp = NULL;
555 Tcl_DeleteInterp(interp);
557 }
559}
560
561
562
563
564
565
568{
569 Oid user_id;
571 bool found;
572
573
574 if (pltrusted)
576 else
578
581 &found);
582 if (!found)
583 interp_desc->interp = NULL;
584
585
586 if (!interp_desc->interp)
588
589 return interp_desc;
590}
591
592
593
594
595
596static void
598{
600 char *start_proc;
601 const char *gucname;
603 List *namelist;
604 Oid procOid;
610
611
613 gucname = pltrusted ? "pltcl.start_proc" : "pltclu.start_proc";
614
615
616 if (start_proc == NULL || start_proc[0] == '\0')
617 return;
618
619
624
625
628
629
633
634
637 elog(ERROR, "cache lookup failed for function %u", procOid);
639
640
641 if (procStruct->prolang != prolang)
643 (errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE),
644 errmsg("function \"%s\" is in the wrong language",
645 start_proc)));
646
647
648
649
650
651
652 if (procStruct->prosecdef)
654 (errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE),
655 errmsg("function \"%s\" must not be SECURITY DEFINER",
656 start_proc)));
657
658
660
661
662
663
664
665
666
670 0,
675
676
678}
679
680
681
682
683static void
685{
686 const char *gucname = (const char *) arg;
687
688
689 errcontext("processing %s parameter", gucname);
690}
691
692
693
694
695
696
697
698
699
701
702
705{
707}
708
709
710
711
713
714
717{
719}
720
721
722
723
724
725
728{
732
733
734
735
736
737
738
739
740
741
742 memset(¤t_call_state, 0, sizeof(current_call_state));
743
744
745
746
749
751 {
752
753
754
755
757 {
758
760 ¤t_call_state,
761 pltrusted));
762 }
764 {
765
767 retval = (Datum) 0;
768 }
769 else
770 {
771
772 current_call_state.fcinfo = fcinfo;
774 }
775 }
777 {
778
779
780
781
782
784 if (current_call_state.prodesc != NULL)
785 {
789 }
790 }
792
793 return retval;
794}
795
796
797
798
799
802 bool pltrusted)
803{
804 bool nonatomic;
806 Tcl_Interp *volatile interp;
807 Tcl_Obj *tcl_cmd;
808 int i;
809 int tcl_rc;
811
812 nonatomic = fcinfo->context &&
815
816
818
819
821 false, pltrusted);
822
823 call_state->prodesc = prodesc;
825
827
828
829
830
831
832
833
835 {
837
840 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
841 errmsg("set-valued function called in context that cannot accept a set")));
842
845 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
846 errmsg("materialize mode required, but it is not allowed in this context")));
847
848 call_state->rsi = rsi;
851 }
852
853
854
855
856
857 tcl_cmd = Tcl_NewObj();
858 Tcl_ListObjAppendElement(NULL, tcl_cmd,
860
861
862 Tcl_IncrRefCount(tcl_cmd);
863
864
865
866
868 {
869 for (i = 0; i < prodesc->nargs; i++)
870 {
872 {
873
874
875
876 if (fcinfo->args[i].isnull)
877 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
878 else
879 {
881 Oid tupType;
885 Tcl_Obj *list_tmp;
886
888
892
895
897 Tcl_ListObjAppendElement(NULL, tcl_cmd, list_tmp);
898
900 }
901 }
902 else
903 {
904
905
906
907
908 if (fcinfo->args[i].isnull)
909 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
910 else
911 {
912 char *tmp;
913
915 fcinfo->args[i].value);
917 Tcl_ListObjAppendElement(NULL, tcl_cmd,
918 Tcl_NewStringObj(UTF_E2U(tmp), -1));
921 }
922 }
923 }
924 }
926 {
927
928 Tcl_DecrRefCount(tcl_cmd);
930 }
932
933
934
935
936
937
938 tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
939
940
941 Tcl_DecrRefCount(tcl_cmd);
942
943
944
945
946 if (tcl_rc != TCL_OK)
948
949
950
951
952
953
954
955
956
957
959 elog(ERROR, "SPI_finish() failed");
960
962 {
964
965
967
968
970 {
973 {
975
979 }
980 }
981 retval = (Datum) 0;
982 fcinfo->isnull = true;
983 }
984 else if (fcinfo->isnull)
985 {
987 NULL,
989 -1);
990 }
992 {
995 Tcl_Obj *resultObj;
996 Tcl_Obj **resultObjv;
998
999
1000
1001
1002
1003
1004
1005
1006
1008 {
1010
1011 break;
1014 break;
1016
1018 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1019 errmsg("function returning record called in context "
1020 "that cannot accept type record")));
1021 break;
1022 default:
1023
1024 elog(ERROR, "return type must be a row type");
1025 break;
1026 }
1027
1032
1033
1034 resultObj = Tcl_GetObjResult(interp);
1035 if (Tcl_ListObjGetElements(interp, resultObj, &resultObjc, &resultObjv) == TCL_ERROR)
1037 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1038 errmsg("could not parse function return value: %s",
1039 utf_u2e(Tcl_GetStringResult(interp)))));
1040
1042 call_state);
1044 }
1045 else
1047 utf_u2e(Tcl_GetStringResult(interp)),
1049 -1);
1050
1051 return retval;
1052}
1053
1054
1055
1056
1057
1060 bool pltrusted)
1061{
1063 Tcl_Interp *volatile interp;
1065 char *stroid;
1068 Tcl_Obj *tcl_cmd;
1069 Tcl_Obj *tcl_trigtup;
1070 int tcl_rc;
1071 int i;
1072 const char *result;
1074 Tcl_Obj **result_Objv;
1076
1077 call_state->trigdata = trigdata;
1078
1079
1081
1082
1085
1086
1089 false,
1090 pltrusted);
1091
1092 call_state->prodesc = prodesc;
1094
1096
1098
1099
1100
1101
1102
1103 tcl_cmd = Tcl_NewObj();
1104 Tcl_IncrRefCount(tcl_cmd);
1105
1107 {
1108
1109 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1111
1112
1113 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1115
1116
1117
1120 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1121 Tcl_NewStringObj(stroid, -1));
1123
1124
1126 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1127 Tcl_NewStringObj(utf_e2u(stroid), -1));
1129
1130
1132 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1133 Tcl_NewStringObj(utf_e2u(stroid), -1));
1135
1136
1137 tcl_trigtup = Tcl_NewObj();
1138 Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
1139 for (i = 0; i < tupdesc->natts; i++)
1140 {
1142
1143 if (att->attisdropped)
1144 Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
1145 else
1146 Tcl_ListObjAppendElement(NULL, tcl_trigtup,
1147 Tcl_NewStringObj(utf_e2u(NameStr(att->attname)), -1));
1148 }
1149 Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
1150
1151
1153 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1154 Tcl_NewStringObj("BEFORE", -1));
1156 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1157 Tcl_NewStringObj("AFTER", -1));
1159 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1160 Tcl_NewStringObj("INSTEAD OF", -1));
1161 else
1162 elog(ERROR, "unrecognized WHEN tg_event: %u", trigdata->tg_event);
1163
1164
1166 {
1167 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1168 Tcl_NewStringObj("ROW", -1));
1169
1170
1171
1172
1173
1174
1175
1176
1178 {
1179 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1180 Tcl_NewStringObj("INSERT", -1));
1181
1182 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1184 tupdesc,
1186 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1187
1189 }
1191 {
1192 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1193 Tcl_NewStringObj("DELETE", -1));
1194
1195 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1196 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1198 tupdesc,
1199 true));
1200
1202 }
1204 {
1205 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1206 Tcl_NewStringObj("UPDATE", -1));
1207
1208 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1210 tupdesc,
1212 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1214 tupdesc,
1215 true));
1216
1218 }
1219 else
1220 elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);
1221 }
1223 {
1224 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1225 Tcl_NewStringObj("STATEMENT", -1));
1226
1228 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1229 Tcl_NewStringObj("INSERT", -1));
1231 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1232 Tcl_NewStringObj("DELETE", -1));
1234 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1235 Tcl_NewStringObj("UPDATE", -1));
1237 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1238 Tcl_NewStringObj("TRUNCATE", -1));
1239 else
1240 elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);
1241
1242 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1243 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1244
1246 }
1247 else
1248 elog(ERROR, "unrecognized LEVEL tg_event: %u", trigdata->tg_event);
1249
1250
1252 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1254 }
1256 {
1257 Tcl_DecrRefCount(tcl_cmd);
1259 }
1261
1262
1263
1264
1265
1266
1267 tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
1268
1269
1270 Tcl_DecrRefCount(tcl_cmd);
1271
1272
1273
1274
1275 if (tcl_rc != TCL_OK)
1277
1278
1279
1280
1282 elog(ERROR, "SPI_finish() failed");
1283
1284
1285
1286
1287
1288
1289 result = Tcl_GetStringResult(interp);
1290
1291 if (strcmp(result, "OK") == 0)
1292 return rettup;
1293 if (strcmp(result, "SKIP") == 0)
1295
1296
1297
1298
1299
1300 if (Tcl_ListObjGetElements(interp, Tcl_GetObjResult(interp),
1301 &result_Objc, &result_Objv) != TCL_OK)
1303 (errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
1304 errmsg("could not parse trigger return value: %s",
1305 utf_u2e(Tcl_GetStringResult(interp)))));
1306
1307
1309 call_state);
1310
1311 return rettup;
1312}
1313
1314
1315
1316
1317static void
1319 bool pltrusted)
1320{
1322 Tcl_Interp *volatile interp;
1324 Tcl_Obj *tcl_cmd;
1325 int tcl_rc;
1326
1327
1329
1330
1333
1334 call_state->prodesc = prodesc;
1336
1338
1339
1340 tcl_cmd = Tcl_NewObj();
1341 Tcl_IncrRefCount(tcl_cmd);
1342 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1344 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1345 Tcl_NewStringObj(utf_e2u(tdata->event), -1));
1346 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1348 -1));
1349
1350 tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
1351
1352
1353 Tcl_DecrRefCount(tcl_cmd);
1354
1355
1356 if (tcl_rc != TCL_OK)
1358
1360 elog(ERROR, "SPI_finish() failed");
1361}
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371static void
1373{
1374
1375
1376
1377
1378
1379
1380
1381 char *emsg;
1382 char *econtext;
1383 int emsglen;
1384
1385 emsg = pstrdup(utf_u2e(Tcl_GetStringResult(interp)));
1386 econtext = utf_u2e(Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY));
1387
1388
1389
1390
1391
1392 emsglen = strlen(emsg);
1393 if (strncmp(emsg, econtext, emsglen) == 0 &&
1394 econtext[emsglen] == '\n')
1395 econtext += emsglen + 1;
1396
1397
1398 while (*econtext == ' ')
1399 econtext++;
1400
1401
1403 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1405 errcontext("%s\nin PL/Tcl function %s",
1407}
1408
1409
1410
1411
1412
1413
1414
1415
1418 bool is_event_trigger, bool pltrusted)
1419{
1424 bool found;
1428 Tcl_DString proc_internal_def;
1429 Tcl_DString proc_internal_name;
1430 Tcl_DString proc_internal_body;
1431
1432
1435 elog(ERROR, "cache lookup failed for function %u", fn_oid);
1437
1438
1439
1440
1441
1442 proc_key.proc_id = fn_oid;
1445
1448 &found);
1449 if (!found)
1451
1452 prodesc = proc_ptr->proc_ptr;
1453
1454
1455
1456
1457
1458
1459 if (prodesc != NULL &&
1463 {
1464
1466 return prodesc;
1467 }
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477 Tcl_DStringInit(&proc_internal_def);
1478 Tcl_DStringInit(&proc_internal_name);
1479 Tcl_DStringInit(&proc_internal_body);
1481 {
1482 bool is_trigger = OidIsValid(tgreloid);
1483 Tcl_CmdInfo cmdinfo;
1484 const char *user_proname;
1485 const char *internal_proname;
1486 bool need_underscore;
1490 Datum prosrcdatum;
1491 char *proc_source;
1492 char buf[48];
1494 Tcl_Interp *interp;
1495 int i;
1496 int tcl_rc;
1498
1499
1500
1501
1503 interp = interp_desc->interp;
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513 if (prodesc != NULL &&
1515 {
1516
1517 (void) Tcl_DeleteCommand(interp, prodesc->internal_proname);
1518
1520 }
1521
1522
1523
1524
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539 if (is_event_trigger)
1540 Tcl_DStringAppend(&proc_internal_name,
1541 "__PLTcl_evttrigger_", -1);
1542 else if (is_trigger)
1543 Tcl_DStringAppend(&proc_internal_name,
1544 "__PLTcl_trigger_", -1);
1545 else
1546 Tcl_DStringAppend(&proc_internal_name,
1547 "__PLTcl_proc_", -1);
1548
1549 need_underscore = false;
1550 for (const char *ptr = user_proname; *ptr; ptr++)
1551 {
1552 if (strchr("ABCDEFGHIJKLMNOPQRSTUVWXYZ"
1553 "abcdefghijklmnopqrstuvwxyz"
1554 "0123456789_", *ptr) != NULL)
1555 {
1556
1557 if (need_underscore)
1558 {
1559 Tcl_DStringAppend(&proc_internal_name, "_", 1);
1560 need_underscore = false;
1561 }
1562 Tcl_DStringAppend(&proc_internal_name, ptr, 1);
1563 }
1564 else if (strchr("(, ", *ptr) != NULL)
1565 need_underscore = true;
1566 }
1567
1568 while (Tcl_GetCommandInfo(interp,
1569 Tcl_DStringValue(&proc_internal_name),
1570 &cmdinfo))
1571 {
1573 Tcl_DStringAppend(&proc_internal_name, buf, -1);
1574 }
1575 internal_proname = Tcl_DStringValue(&proc_internal_name);
1576
1577
1578
1579
1581 "PL/Tcl function",
1583
1584
1585
1586
1587
1593 prodesc->fn_cxt = proc_cxt;
1597 prodesc->nargs = procStruct->pronargs;
1601
1602
1604 (procStruct->provolatile != PROVOLATILE_VOLATILE);
1605
1607
1609
1610
1611
1612
1613
1614 if (!is_trigger && !is_event_trigger)
1615 {
1616 Oid rettype = procStruct->prorettype;
1617
1620 elog(ERROR, "cache lookup failed for type %u", rettype);
1622
1623
1624 if (typeStruct->typtype == TYPTYPE_PSEUDO)
1625 {
1626 if (rettype == VOIDOID ||
1627 rettype == RECORDOID)
1628 ;
1629 else if (rettype == TRIGGEROID ||
1630 rettype == EVENT_TRIGGEROID)
1632 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1633 errmsg("trigger functions can only be called as triggers")));
1634 else
1636 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1637 errmsg("PL/Tcl functions cannot return type %s",
1639 }
1640
1644 proc_cxt);
1646
1647 prodesc->fn_retisset = procStruct->proretset;
1649 prodesc->fn_retisdomain = (typeStruct->typtype == TYPTYPE_DOMAIN);
1651
1653 }
1654
1655
1656
1657
1658
1659 if (!is_trigger && !is_event_trigger)
1660 {
1661 proc_internal_args[0] = '\0';
1662 for (i = 0; i < prodesc->nargs; i++)
1663 {
1664 Oid argtype = procStruct->proargtypes.values[i];
1665
1668 elog(ERROR, "cache lookup failed for type %u", argtype);
1670
1671
1672 if (typeStruct->typtype == TYPTYPE_PSEUDO &&
1673 argtype != RECORDOID)
1675 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1676 errmsg("PL/Tcl functions cannot accept type %s",
1678
1680 {
1683 }
1684 else
1685 {
1689 proc_cxt);
1691 }
1692
1693 if (i > 0)
1694 strcat(proc_internal_args, " ");
1695 strcat(proc_internal_args, buf);
1696
1698 }
1699 }
1700 else if (is_trigger)
1701 {
1702
1703 strcpy(proc_internal_args,
1704 "TG_name TG_relid TG_table_name TG_table_schema TG_relatts TG_when TG_level TG_op __PLTcl_Tup_NEW __PLTcl_Tup_OLD args");
1705 }
1706 else if (is_event_trigger)
1707 {
1708
1709 strcpy(proc_internal_args, "TG_event TG_tag");
1710 }
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720 Tcl_DStringAppendElement(&proc_internal_def, "proc");
1721 Tcl_DStringAppendElement(&proc_internal_def, internal_proname);
1722 Tcl_DStringAppendElement(&proc_internal_def, proc_internal_args);
1723
1724
1725
1726
1727
1728
1729 Tcl_DStringAppend(&proc_internal_body, "upvar #0 ", -1);
1730 Tcl_DStringAppend(&proc_internal_body, internal_proname, -1);
1731 Tcl_DStringAppend(&proc_internal_body, " GD\n", -1);
1732 if (is_trigger)
1733 {
1734 Tcl_DStringAppend(&proc_internal_body,
1735 "array set NEW $__PLTcl_Tup_NEW\n", -1);
1736 Tcl_DStringAppend(&proc_internal_body,
1737 "array set OLD $__PLTcl_Tup_OLD\n", -1);
1738 Tcl_DStringAppend(&proc_internal_body,
1739 "set i 0\n"
1740 "set v 0\n"
1741 "foreach v $args {\n"
1742 " incr i\n"
1743 " set ii iv\n"
1744 "}\n"
1745 "unset i v\n\n", -1);
1746 }
1747 else if (is_event_trigger)
1748 {
1749
1750 }
1751 else
1752 {
1753 for (i = 0; i < prodesc->nargs; i++)
1754 {
1756 {
1758 "array set %d $__PLTcl_Tup_%d\n",
1760 Tcl_DStringAppend(&proc_internal_body, buf, -1);
1761 }
1762 }
1763 }
1764
1765
1766
1767
1769 Anum_pg_proc_prosrc);
1772 Tcl_DStringAppend(&proc_internal_body, UTF_E2U(proc_source), -1);
1774 pfree(proc_source);
1775 Tcl_DStringAppendElement(&proc_internal_def,
1776 Tcl_DStringValue(&proc_internal_body));
1777
1778
1779
1780
1781 tcl_rc = Tcl_EvalEx(interp,
1782 Tcl_DStringValue(&proc_internal_def),
1783 Tcl_DStringLength(&proc_internal_def),
1784 TCL_EVAL_GLOBAL);
1785 if (tcl_rc != TCL_OK)
1787 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1788 errmsg("could not create internal procedure \"%s\": %s",
1789 internal_proname,
1790 utf_u2e(Tcl_GetStringResult(interp)))));
1791 }
1793 {
1794
1795
1796
1797
1798 if (proc_cxt)
1800 Tcl_DStringFree(&proc_internal_def);
1801 Tcl_DStringFree(&proc_internal_name);
1802 Tcl_DStringFree(&proc_internal_body);
1804 }
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817 old_prodesc = proc_ptr->proc_ptr;
1818
1819 proc_ptr->proc_ptr = prodesc;
1821
1822 if (old_prodesc != NULL)
1823 {
1827 }
1828
1829 Tcl_DStringFree(&proc_internal_def);
1830 Tcl_DStringFree(&proc_internal_name);
1831 Tcl_DStringFree(&proc_internal_body);
1832
1834
1835 return prodesc;
1836}
1837
1838
1839
1840
1841
1842static int
1844 int objc, Tcl_Obj *const objv[])
1845{
1846 volatile int level;
1848 int priIndex;
1849
1850 static const char *logpriorities[] = {
1851 "DEBUG", "LOG", "INFO", "NOTICE",
1852 "WARNING", "ERROR", "FATAL", (const char *) NULL
1853 };
1854
1855 static const int loglevels[] = {
1858 };
1859
1860 if (objc != 3)
1861 {
1862 Tcl_WrongNumArgs(interp, 1, objv, "level msg");
1863 return TCL_ERROR;
1864 }
1865
1866 if (Tcl_GetIndexFromObj(interp, objv[1], logpriorities, "priority",
1867 TCL_EXACT, &priIndex) != TCL_OK)
1868 return TCL_ERROR;
1869
1870 level = loglevels[priIndex];
1871
1872 if (level == ERROR)
1873 {
1874
1875
1876
1877
1878
1879 Tcl_SetObjResult(interp, objv[2]);
1880 return TCL_ERROR;
1881 }
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1894 {
1897 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1898 errmsg("%s", UTF_U2E(Tcl_GetString(objv[2])))));
1900 }
1902 {
1904
1905
1909
1910
1913 Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1));
1916
1917 return TCL_ERROR;
1918 }
1920
1921 return TCL_OK;
1922}
1923
1924
1925
1926
1927
1928
1929static void
1931{
1932 Tcl_Obj *obj = Tcl_NewObj();
1933
1934 Tcl_ListObjAppendElement(interp, obj,
1935 Tcl_NewStringObj("POSTGRES", -1));
1936 Tcl_ListObjAppendElement(interp, obj,
1937 Tcl_NewStringObj(PG_VERSION, -1));
1938 Tcl_ListObjAppendElement(interp, obj,
1939 Tcl_NewStringObj("SQLSTATE", -1));
1940 Tcl_ListObjAppendElement(interp, obj,
1942 Tcl_ListObjAppendElement(interp, obj,
1943 Tcl_NewStringObj("condition", -1));
1944 Tcl_ListObjAppendElement(interp, obj,
1946 Tcl_ListObjAppendElement(interp, obj,
1947 Tcl_NewStringObj("message", -1));
1949 Tcl_ListObjAppendElement(interp, obj,
1953 {
1954 Tcl_ListObjAppendElement(interp, obj,
1955 Tcl_NewStringObj("detail", -1));
1957 Tcl_ListObjAppendElement(interp, obj,
1960 }
1961 if (edata->hint)
1962 {
1963 Tcl_ListObjAppendElement(interp, obj,
1964 Tcl_NewStringObj("hint", -1));
1966 Tcl_ListObjAppendElement(interp, obj,
1967 Tcl_NewStringObj(UTF_E2U(edata->hint), -1));
1969 }
1971 {
1972 Tcl_ListObjAppendElement(interp, obj,
1973 Tcl_NewStringObj("context", -1));
1975 Tcl_ListObjAppendElement(interp, obj,
1978 }
1980 {
1981 Tcl_ListObjAppendElement(interp, obj,
1982 Tcl_NewStringObj("schema", -1));
1984 Tcl_ListObjAppendElement(interp, obj,
1987 }
1989 {
1990 Tcl_ListObjAppendElement(interp, obj,
1991 Tcl_NewStringObj("table", -1));
1993 Tcl_ListObjAppendElement(interp, obj,
1996 }
1998 {
1999 Tcl_ListObjAppendElement(interp, obj,
2000 Tcl_NewStringObj("column", -1));
2002 Tcl_ListObjAppendElement(interp, obj,
2005 }
2007 {
2008 Tcl_ListObjAppendElement(interp, obj,
2009 Tcl_NewStringObj("datatype", -1));
2011 Tcl_ListObjAppendElement(interp, obj,
2014 }
2016 {
2017 Tcl_ListObjAppendElement(interp, obj,
2018 Tcl_NewStringObj("constraint", -1));
2020 Tcl_ListObjAppendElement(interp, obj,
2023 }
2024
2026 {
2027 Tcl_ListObjAppendElement(interp, obj,
2028 Tcl_NewStringObj("statement", -1));
2030 Tcl_ListObjAppendElement(interp, obj,
2033 }
2035 {
2036 Tcl_ListObjAppendElement(interp, obj,
2037 Tcl_NewStringObj("cursor_position", -1));
2038 Tcl_ListObjAppendElement(interp, obj,
2040 }
2042 {
2043 Tcl_ListObjAppendElement(interp, obj,
2044 Tcl_NewStringObj("filename", -1));
2046 Tcl_ListObjAppendElement(interp, obj,
2049 }
2050 if (edata->lineno > 0)
2051 {
2052 Tcl_ListObjAppendElement(interp, obj,
2053 Tcl_NewStringObj("lineno", -1));
2054 Tcl_ListObjAppendElement(interp, obj,
2055 Tcl_NewIntObj(edata->lineno));
2056 }
2058 {
2059 Tcl_ListObjAppendElement(interp, obj,
2060 Tcl_NewStringObj("funcname", -1));
2062 Tcl_ListObjAppendElement(interp, obj,
2065 }
2066
2067 Tcl_SetObjErrorCode(interp, obj);
2068}
2069
2070
2071
2072
2073
2074static const char *
2076{
2077 int i;
2078
2080 {
2083 }
2084 return "unrecognized_sqlstate";
2085}
2086
2087
2088
2089
2090
2091
2092static int
2094 int objc, Tcl_Obj *const objv[])
2095{
2096 char *tmp;
2097 const char *cp1;
2098 char *cp2;
2100
2101
2102
2103
2104 if (objc != 2)
2105 {
2106 Tcl_WrongNumArgs(interp, 1, objv, "string");
2107 return TCL_ERROR;
2108 }
2109
2110
2111
2112
2113
2114 cp1 = Tcl_GetStringFromObj(objv[1], &length);
2115 tmp = palloc(length * 2 + 1);
2116 cp2 = tmp;
2117
2118
2119
2120
2121 while (*cp1)
2122 {
2123 if (*cp1 == '\'')
2124 *cp2++ = '\'';
2125 else
2126 {
2127 if (*cp1 == '\\')
2128 *cp2++ = '\\';
2129 }
2130 *cp2++ = *cp1++;
2131 }
2132
2133
2134
2135
2136 *cp2 = '\0';
2137 Tcl_SetObjResult(interp, Tcl_NewStringObj(tmp, -1));
2139 return TCL_OK;
2140}
2141
2142
2143
2144
2145
2146static int
2148 int objc, Tcl_Obj *const objv[])
2149{
2150 int argno;
2152
2153
2154
2155
2156 if (objc != 2)
2157 {
2158 Tcl_WrongNumArgs(interp, 1, objv, "argno");
2159 return TCL_ERROR;
2160 }
2161
2162
2163
2164
2165 if (fcinfo == NULL)
2166 {
2167 Tcl_SetObjResult(interp,
2168 Tcl_NewStringObj("argisnull cannot be used in triggers", -1));
2169 return TCL_ERROR;
2170 }
2171
2172
2173
2174
2175 if (Tcl_GetIntFromObj(interp, objv[1], &argno) != TCL_OK)
2176 return TCL_ERROR;
2177
2178
2179
2180
2181 argno--;
2182 if (argno < 0 || argno >= fcinfo->nargs)
2183 {
2184 Tcl_SetObjResult(interp,
2185 Tcl_NewStringObj("argno out of range", -1));
2186 return TCL_ERROR;
2187 }
2188
2189
2190
2191
2192 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(PG_ARGISNULL(argno)));
2193 return TCL_OK;
2194}
2195
2196
2197
2198
2199
2200static int
2202 int objc, Tcl_Obj *const objv[])
2203{
2205
2206
2207
2208
2209 if (objc != 1)
2210 {
2211 Tcl_WrongNumArgs(interp, 1, objv, "");
2212 return TCL_ERROR;
2213 }
2214
2215
2216
2217
2218 if (fcinfo == NULL)
2219 {
2220 Tcl_SetObjResult(interp,
2221 Tcl_NewStringObj("return_null cannot be used in triggers", -1));
2222 return TCL_ERROR;
2223 }
2224
2225
2226
2227
2228
2229 fcinfo->isnull = true;
2230
2231 return TCL_RETURN;
2232}
2233
2234
2235
2236
2237
2238static int
2240 int objc, Tcl_Obj *const objv[])
2241{
2247 volatile int result = TCL_OK;
2248
2249
2250
2251
2252 if (fcinfo == NULL)
2253 {
2254 Tcl_SetObjResult(interp,
2255 Tcl_NewStringObj("return_next cannot be used in triggers", -1));
2256 return TCL_ERROR;
2257 }
2258
2260 {
2261 Tcl_SetObjResult(interp,
2262 Tcl_NewStringObj("return_next cannot be used in non-set-returning functions", -1));
2263 return TCL_ERROR;
2264 }
2265
2266
2267
2268
2269 if (objc != 2)
2270 {
2271 Tcl_WrongNumArgs(interp, 1, objv, "result");
2272 return TCL_ERROR;
2273 }
2274
2275
2276
2277
2278
2279
2280
2281
2282
2285 {
2286
2289
2291 {
2292 Tcl_Obj **rowObjv;
2294
2295
2296 if (Tcl_ListObjGetElements(interp, objv[1], &rowObjc, &rowObjv) == TCL_ERROR)
2297 result = TCL_ERROR;
2298 else
2299 {
2301
2303 call_state);
2305 }
2306 }
2307 else
2308 {
2310 bool isNull = false;
2311
2312
2314 elog(ERROR, "wrong result type supplied in return_next");
2315
2317 utf_u2e((char *) Tcl_GetString(objv[1])),
2319 -1);
2321 &retval, &isNull);
2322 }
2323
2325 }
2327 {
2329 return TCL_ERROR;
2330 }
2332
2333 return result;
2334}
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361static void
2363{
2365
2366
2368}
2369
2370static void
2372{
2373
2377}
2378
2379static void
2382{
2384
2385
2389
2390
2394
2395
2398 Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1));
2401}
2402
2403
2404
2405
2406
2407
2408static int
2410 int objc, Tcl_Obj *const objv[])
2411{
2412 int my_rc;
2413 int spi_rc;
2414 int query_idx;
2415 int i;
2416 int optIndex;
2417 int count = 0;
2418 const char *volatile arrayname = NULL;
2419 Tcl_Obj *volatile loop_body = NULL;
2422
2424 {
2425 OPT_ARRAY, OPT_COUNT
2426 };
2427
2428 static const char *options[] = {
2429 "-array", "-count", (const char *) NULL
2430 };
2431
2432
2433
2434
2435 if (objc < 2)
2436 {
2437 Tcl_WrongNumArgs(interp, 1, objv,
2438 "?-count n? ?-array name? query ?loop body?");
2439 return TCL_ERROR;
2440 }
2441
2442 i = 1;
2443 while (i < objc)
2444 {
2445 if (Tcl_GetIndexFromObj(NULL, objv[i], options, NULL,
2446 TCL_EXACT, &optIndex) != TCL_OK)
2447 break;
2448
2449 if (++i >= objc)
2450 {
2451 Tcl_SetObjResult(interp,
2452 Tcl_NewStringObj("missing argument to -count or -array", -1));
2453 return TCL_ERROR;
2454 }
2455
2456 switch ((enum options) optIndex)
2457 {
2458 case OPT_ARRAY:
2459 arrayname = Tcl_GetString(objv[i++]);
2460 break;
2461
2462 case OPT_COUNT:
2463 if (Tcl_GetIntFromObj(interp, objv[i++], &count) != TCL_OK)
2464 return TCL_ERROR;
2465 break;
2466 }
2467 }
2468
2469 query_idx = i;
2470 if (query_idx >= objc || query_idx + 2 < objc)
2471 {
2472 Tcl_WrongNumArgs(interp, query_idx - 1, objv, "query ?loop body?");
2473 return TCL_ERROR;
2474 }
2475
2476 if (query_idx + 1 < objc)
2477 loop_body = objv[query_idx + 1];
2478
2479
2480
2481
2482
2483
2485
2487 {
2492
2494 arrayname,
2495 loop_body,
2496 spi_rc,
2499
2501 }
2503 {
2505 return TCL_ERROR;
2506 }
2508
2509 return my_rc;
2510}
2511
2512
2513
2514
2515
2516
2517static int
2519 const char *arrayname,
2520 Tcl_Obj *loop_body,
2521 int spi_rc,
2524{
2525 int my_rc = TCL_OK;
2526 int loop_rc;
2529
2530 switch (spi_rc)
2531 {
2537 Tcl_SetObjResult(interp, Tcl_NewWideIntObj(ntuples));
2538 break;
2539
2542 if (tuptable == NULL)
2543 {
2544 Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
2545 break;
2546 }
2547
2548
2549
2555
2556
2557
2558
2559 tuples = tuptable->vals;
2560 tupdesc = tuptable->tupdesc;
2561
2562 if (loop_body == NULL)
2563 {
2564
2565
2566
2567
2568 if (ntuples > 0)
2570 tuples[0], tupdesc);
2571 }
2572 else
2573 {
2574
2575
2576
2577
2579
2580 for (i = 0; i < ntuples; i++)
2581 {
2583 tuples[i], tupdesc);
2584
2585 loop_rc = Tcl_EvalObjEx(interp, loop_body, 0);
2586
2587 if (loop_rc == TCL_OK)
2588 continue;
2589 if (loop_rc == TCL_CONTINUE)
2590 continue;
2591 if (loop_rc == TCL_RETURN)
2592 {
2593 my_rc = TCL_RETURN;
2594 break;
2595 }
2596 if (loop_rc == TCL_BREAK)
2597 break;
2598 my_rc = TCL_ERROR;
2599 break;
2600 }
2601 }
2602
2603 if (my_rc == TCL_OK)
2604 {
2605 Tcl_SetObjResult(interp, Tcl_NewWideIntObj(ntuples));
2606 }
2607 break;
2608
2609 default:
2610 Tcl_AppendResult(interp, "pltcl: SPI_execute failed: ",
2612 my_rc = TCL_ERROR;
2613 break;
2614 }
2615
2617
2618 return my_rc;
2619}
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630static int
2632 int objc, Tcl_Obj *const objv[])
2633{
2636 Tcl_Obj **argsObj;
2638 int i;
2639 Tcl_HashEntry *hashent;
2640 int hashnew;
2641 Tcl_HashTable *query_hash;
2644
2645
2646
2647
2648 if (objc != 3)
2649 {
2650 Tcl_WrongNumArgs(interp, 1, objv, "query argtypes");
2651 return TCL_ERROR;
2652 }
2653
2654
2655
2656
2657 if (Tcl_ListObjGetElements(interp, objv[2], &nargs, &argsObj) != TCL_OK)
2658 return TCL_ERROR;
2659
2660
2661
2662
2663
2664
2665
2666
2668 "PL/Tcl spi_prepare query",
2673 qdesc->nargs = nargs;
2678
2679
2680
2681
2682
2683
2685
2687 {
2688
2689
2690
2691
2692
2693 for (i = 0; i < nargs; i++)
2694 {
2695 Oid typId,
2696 typInput,
2697 typIOParam;
2699
2701 &typId, &typmod, NULL);
2702
2704
2708 }
2709
2710
2711
2712
2717
2718 if (qdesc->plan == NULL)
2719 elog(ERROR, "SPI_prepare() failed");
2720
2721
2722
2723
2724
2726 elog(ERROR, "SPI_keepplan() failed");
2727
2729 }
2731 {
2733
2735
2736 return TCL_ERROR;
2737 }
2739
2740
2741
2742
2743
2745
2746 hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
2747 Tcl_SetHashValue(hashent, (ClientData) qdesc);
2748
2749
2750 Tcl_SetObjResult(interp, Tcl_NewStringObj(qdesc->qname, -1));
2751 return TCL_OK;
2752}
2753
2754
2755
2756
2757
2758static int
2760 int objc, Tcl_Obj *const objv[])
2761{
2762 int my_rc;
2763 int spi_rc;
2764 int i;
2765 int j;
2766 int optIndex;
2767 Tcl_HashEntry *hashent;
2769 const char *nulls = NULL;
2770 const char *arrayname = NULL;
2771 Tcl_Obj *loop_body = NULL;
2772 int count = 0;
2774 Tcl_Obj **callObjv = NULL;
2775 Datum *argvalues;
2778 Tcl_HashTable *query_hash;
2779
2781 {
2782 OPT_ARRAY, OPT_COUNT, OPT_NULLS
2783 };
2784
2785 static const char *options[] = {
2786 "-array", "-count", "-nulls", (const char *) NULL
2787 };
2788
2789
2790
2791
2792 i = 1;
2793 while (i < objc)
2794 {
2795 if (Tcl_GetIndexFromObj(NULL, objv[i], options, NULL,
2796 TCL_EXACT, &optIndex) != TCL_OK)
2797 break;
2798
2799 if (++i >= objc)
2800 {
2801 Tcl_SetObjResult(interp,
2802 Tcl_NewStringObj("missing argument to -array, -count or -nulls", -1));
2803 return TCL_ERROR;
2804 }
2805
2806 switch ((enum options) optIndex)
2807 {
2808 case OPT_ARRAY:
2809 arrayname = Tcl_GetString(objv[i++]);
2810 break;
2811
2812 case OPT_COUNT:
2813 if (Tcl_GetIntFromObj(interp, objv[i++], &count) != TCL_OK)
2814 return TCL_ERROR;
2815 break;
2816
2817 case OPT_NULLS:
2818 nulls = Tcl_GetString(objv[i++]);
2819 break;
2820 }
2821 }
2822
2823
2824
2825
2826 if (i >= objc)
2827 {
2828 Tcl_SetObjResult(interp,
2829 Tcl_NewStringObj("missing argument to -count or -array", -1));
2830 return TCL_ERROR;
2831 }
2832
2834
2835 hashent = Tcl_FindHashEntry(query_hash, Tcl_GetString(objv[i]));
2836 if (hashent == NULL)
2837 {
2838 Tcl_AppendResult(interp, "invalid queryid '", Tcl_GetString(objv[i]), "'", NULL);
2839 return TCL_ERROR;
2840 }
2842 i++;
2843
2844
2845
2846
2847 if (nulls != NULL)
2848 {
2849 if (strlen(nulls) != qdesc->nargs)
2850 {
2851 Tcl_SetObjResult(interp,
2852 Tcl_NewStringObj("length of nulls string doesn't match number of arguments",
2853 -1));
2854 return TCL_ERROR;
2855 }
2856 }
2857
2858
2859
2860
2861
2862 if (qdesc->nargs > 0)
2863 {
2864 if (i >= objc)
2865 {
2866 Tcl_SetObjResult(interp,
2867 Tcl_NewStringObj("argument list length doesn't match number of arguments for query",
2868 -1));
2869 return TCL_ERROR;
2870 }
2871
2872
2873
2874
2875 if (Tcl_ListObjGetElements(interp, objv[i++], &callObjc, &callObjv) != TCL_OK)
2876 return TCL_ERROR;
2877
2878
2879
2880
2881 if (callObjc != qdesc->nargs)
2882 {
2883 Tcl_SetObjResult(interp,
2884 Tcl_NewStringObj("argument list length doesn't match number of arguments for query",
2885 -1));
2886 return TCL_ERROR;
2887 }
2888 }
2889 else
2890 callObjc = 0;
2891
2892
2893
2894
2895 if (i < objc)
2896 loop_body = objv[i++];
2897
2898 if (i != objc)
2899 {
2900 Tcl_WrongNumArgs(interp, 1, objv,
2901 "?-count n? ?-array name? ?-nulls string? "
2902 "query ?args? ?loop body?");
2903 return TCL_ERROR;
2904 }
2905
2906
2907
2908
2909
2910
2912
2914 {
2915
2916
2917
2918
2920
2921 for (j = 0; j < callObjc; j++)
2922 {
2923 if (nulls && nulls[j] == 'n')
2924 {
2926 NULL,
2928 -1);
2929 }
2930 else
2931 {
2934 UTF_U2E(Tcl_GetString(callObjv[j])),
2936 -1);
2938 }
2939 }
2940
2941
2942
2943
2946 count);
2947
2949 arrayname,
2950 loop_body,
2951 spi_rc,
2954
2956 }
2958 {
2960 return TCL_ERROR;
2961 }
2963
2964 return my_rc;
2965}
2966
2967
2968
2969
2970
2971
2972
2973
2974static int
2976 int objc, Tcl_Obj *const objv[])
2977{
2980 int retcode;
2981
2982 if (objc != 2)
2983 {
2984 Tcl_WrongNumArgs(interp, 1, objv, "command");
2985 return TCL_ERROR;
2986 }
2987
2988
2989
2990
2991
2992
2995
2996 retcode = Tcl_EvalObjEx(interp, objv[1], 0);
2997
2998 if (retcode == TCL_ERROR)
2999 {
3000
3002 }
3003 else
3004 {
3005
3007 }
3008
3009
3012
3013 return retcode;
3014}
3015
3016
3017
3018
3019
3020
3021
3022static int
3024 int objc, Tcl_Obj *const objv[])
3025{
3027
3029 {
3031 }
3033 {
3035
3036
3040
3041
3044 Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1));
3047
3048 return TCL_ERROR;
3049 }
3051
3052 return TCL_OK;
3053}
3054
3055
3056
3057
3058
3059
3060
3061static int
3063 int objc, Tcl_Obj *const objv[])
3064{
3066
3068 {
3070 }
3072 {
3074
3075
3079
3080
3083 Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1));
3086
3087 return TCL_ERROR;
3088 }
3090
3091 return TCL_OK;
3092}
3093
3094
3095
3096
3097
3098
3099
3100
3101static void
3104{
3105 int i;
3106 char *outputstr;
3108 bool isnull;
3110 Oid typoutput;
3111 bool typisvarlena;
3112 const char **arrptr;
3113 const char **nameptr;
3114 const char *nullname = NULL;
3115
3116
3117
3118
3119 if (arrayname == NULL)
3120 {
3122 nameptr = &nullname;
3123 }
3124 else
3125 {
3126 arrptr = &arrayname;
3128
3129
3130
3131
3132
3133
3134 Tcl_SetVar2Ex(interp, arrayname, ".tupno", Tcl_NewWideIntObj(tupno), 0);
3135 }
3136
3137 for (i = 0; i < tupdesc->natts; i++)
3138 {
3140
3141
3142 if (att->attisdropped)
3143 continue;
3144
3145
3146
3147
3151
3152
3153
3154
3155 attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165 if (!isnull)
3166 {
3170 Tcl_SetVar2Ex(interp, *arrptr, *nameptr,
3171 Tcl_NewStringObj(UTF_E2U(outputstr), -1), 0);
3173 pfree(outputstr);
3174 }
3175 else
3176 Tcl_UnsetVar2(interp, *arrptr, *nameptr, 0);
3177
3179 }
3180}
3181
3182
3183
3184
3185
3186
3187static Tcl_Obj *
3189{
3190 Tcl_Obj *retobj = Tcl_NewObj();
3191 int i;
3192 char *outputstr;
3194 bool isnull;
3196 Oid typoutput;
3197 bool typisvarlena;
3198
3199 for (i = 0; i < tupdesc->natts; i++)
3200 {
3202
3203
3204 if (att->attisdropped)
3205 continue;
3206
3207 if (att->attgenerated)
3208 {
3209
3210 if (!include_generated)
3211 continue;
3212
3213 if (att->attgenerated == ATTRIBUTE_GENERATED_VIRTUAL)
3214 continue;
3215 }
3216
3217
3218
3219
3221
3222
3223
3224
3225 attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235 if (!isnull)
3236 {
3238 &typoutput, &typisvarlena);
3241 Tcl_ListObjAppendElement(NULL, retobj,
3245 Tcl_ListObjAppendElement(NULL, retobj,
3246 Tcl_NewStringObj(UTF_E2U(outputstr), -1));
3248 pfree(outputstr);
3249 }
3250 }
3251
3252 return retobj;
3253}
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3269{
3274 int i;
3275
3277 {
3279 attinmeta = call_state->attinmeta;
3280 }
3281 else if (call_state->trigdata)
3282 {
3285 }
3286 else
3287 {
3288 elog(ERROR, "PL/Tcl function does not return a tuple");
3289 tupdesc = NULL;
3290 attinmeta = NULL;
3291 }
3292
3294
3295 if (kvObjc % 2 != 0)
3297 (errcode(ERRCODE_INVALID_PARAMETER_VALUE),
3298 errmsg("column name/value list must have even number of elements")));
3299
3300 for (i = 0; i < kvObjc; i += 2)
3301 {
3302 char *fieldName = utf_u2e(Tcl_GetString(kvObjv[i]));
3303 int attn = SPI_fnumber(tupdesc, fieldName);
3304
3305
3306
3307
3308
3309
3311 {
3312 if (strcmp(fieldName, ".tupno") == 0)
3313 continue;
3315 (errcode(ERRCODE_UNDEFINED_COLUMN),
3316 errmsg("column name/value list contains nonexistent column name \"%s\"",
3317 fieldName)));
3318 }
3319
3320 if (attn <= 0)
3322 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
3323 errmsg("cannot set system attribute \"%s\"",
3324 fieldName)));
3325
3326 if (TupleDescAttr(tupdesc, attn - 1)->attgenerated)
3328 (errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
3329 errmsg("cannot set generated column \"%s\"",
3330 fieldName)));
3331
3332 values[attn - 1] = utf_u2e(Tcl_GetString(kvObjv[i + 1]));
3333 }
3334
3336
3337
3343
3344 return tuple;
3345}
3346
3347
3348
3349
3350static void
3352{
3356
3357
3359
3362
3363
3366
3367
3368
3369
3370
3371
3372
3373
3377
3381
3382
3384
3387}
void aclcheck_error(AclResult aclerr, ObjectType objtype, const char *objectname)
AclResult object_aclcheck(Oid classid, Oid objectid, Oid roleid, AclMode mode)
static Datum values[MAXATTR]
#define TextDatumGetCString(d)
#define unconstify(underlying_type, expr)
#define PG_USED_FOR_ASSERTS_ONLY
#define OidIsValid(objectId)
const char * GetCommandTagName(CommandTag commandTag)
void domain_check(Datum value, bool isnull, Oid domainType, void **extra, MemoryContext mcxt)
void * hash_search(HTAB *hashp, const void *keyPtr, HASHACTION action, bool *foundPtr)
HTAB * hash_create(const char *tabname, long nelem, const HASHCTL *info, int flags)
void FreeErrorData(ErrorData *edata)
ErrorContextCallback * error_context_stack
ErrorData * CopyErrorData(void)
void FlushErrorState(void)
int errcode(int sqlerrcode)
int errmsg(const char *fmt,...)
char * unpack_sql_state(int sql_state)
#define ereport(elevel,...)
#define CALLED_AS_EVENT_TRIGGER(fcinfo)
HeapTuple BuildTupleFromCStrings(AttInMetadata *attinmeta, char **values)
AttInMetadata * TupleDescGetAttInMetadata(TupleDesc tupdesc)
@ SFRM_Materialize_Random
Datum InputFunctionCall(FmgrInfo *flinfo, char *str, Oid typioparam, int32 typmod)
void fmgr_info(Oid functionId, FmgrInfo *finfo)
char * OidOutputFunctionCall(Oid functionId, Datum val)
void fmgr_info_cxt(Oid functionId, FmgrInfo *finfo, MemoryContext mcxt)
char * OutputFunctionCall(FmgrInfo *flinfo, Datum val)
#define DatumGetHeapTupleHeader(X)
#define InitFunctionCallInfoData(Fcinfo, Flinfo, Nargs, Collation, Context, Resultinfo)
#define DirectFunctionCall1(func, arg1)
#define LOCAL_FCINFO(name, nargs)
#define FunctionCallInvoke(fcinfo)
char * format_type_be(Oid type_oid)
TypeFuncClass get_call_result_type(FunctionCallInfo fcinfo, Oid *resultTypeId, TupleDesc *resultTupleDesc)
@ TYPEFUNC_COMPOSITE_DOMAIN
static Datum HeapTupleGetDatum(const HeapTupleData *tuple)
void DefineCustomStringVariable(const char *name, const char *short_desc, const char *long_desc, char **valueAddr, const char *bootValue, GucContext context, int flags, GucStringCheckHook check_hook, GucStringAssignHook assign_hook, GucShowHook show_hook)
void MarkGUCPrefixReserved(const char *className)
Assert(PointerIsAligned(start, uint64))
HeapTupleData * HeapTuple
#define HeapTupleIsValid(tuple)
static Datum heap_getattr(HeapTuple tup, int attnum, TupleDesc tupleDesc, bool *isnull)
static int32 HeapTupleHeaderGetTypMod(const HeapTupleHeaderData *tup)
static TransactionId HeapTupleHeaderGetRawXmin(const HeapTupleHeaderData *tup)
static uint32 HeapTupleHeaderGetDatumLength(const HeapTupleHeaderData *tup)
static void * GETSTRUCT(const HeapTupleData *tuple)
static Oid HeapTupleHeaderGetTypeId(const HeapTupleHeaderData *tup)
if(TABLE==NULL||TABLE_index==NULL)
bool ItemPointerEquals(ItemPointer pointer1, ItemPointer pointer2)
bool type_is_rowtype(Oid typid)
void getTypeOutputInfo(Oid type, Oid *typOutput, bool *typIsVarlena)
void getTypeInputInfo(Oid type, Oid *typInput, Oid *typIOParam)
Oid getTypeIOParam(HeapTuple typeTuple)
char * pg_any_to_server(const char *s, int len, int encoding)
char * pg_server_to_any(const char *s, int len, int encoding)
char * pstrdup(const char *in)
void pfree(void *pointer)
void * palloc0(Size size)
MemoryContext TopMemoryContext
MemoryContext CurrentMemoryContext
void MemoryContextDelete(MemoryContext context)
void MemoryContextSetIdentifier(MemoryContext context, const char *id)
#define AllocSetContextCreate
#define ALLOCSET_SMALL_SIZES
void pg_bindtextdomain(const char *domain)
#define IsA(nodeptr, _type_)
#define castNode(_type_, nodeptr)
#define InvokeFunctionExecuteHook(objectId)
Datum oidout(PG_FUNCTION_ARGS)
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Oid LookupFuncName(List *funcname, int nargs, const Oid *argtypes, bool missing_ok)
bool parseTypeString(const char *str, Oid *typeid_p, int32 *typmod_p, Node *escontext)
FormData_pg_attribute * Form_pg_attribute
static PgChecksumMode mode
FormData_pg_proc * Form_pg_proc
FormData_pg_type * Form_pg_type
void pgstat_init_function_usage(FunctionCallInfo fcinfo, PgStat_FunctionCallUsage *fcu)
void pgstat_end_function_usage(PgStat_FunctionCallUsage *fcu, bool finalize)
static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, bool pltrusted)
PG_FUNCTION_INFO_V1(pltcl_call_handler)
static void pltcl_ServiceModeHook(int mode)
static const char * pltcl_get_condition_name(int sqlstate)
static HTAB * pltcl_proc_htab
static void pltcl_AlertNotifier(ClientData clientData)
static char * utf_e2u(const char *src)
static int pltcl_WaitForEvent(CONST86 Tcl_Time *timePtr)
static void pltcl_init_tuple_store(pltcl_call_state *call_state)
static Tcl_Obj * pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc, bool include_generated)
static pltcl_proc_desc * compile_pltcl_function(Oid fn_oid, Oid tgreloid, bool is_event_trigger, bool pltrusted)
static void call_pltcl_start_proc(Oid prolang, bool pltrusted)
static int pltcl_returnnext(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
static void pltcl_SetTimer(CONST86 Tcl_Time *timePtr)
static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
static int pltcl_process_SPI_result(Tcl_Interp *interp, const char *arrayname, Tcl_Obj *loop_body, int spi_rc, SPITupleTable *tuptable, uint64 ntuples)
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
static void pltcl_subtrans_abort(Tcl_Interp *interp, MemoryContext oldcontext, ResourceOwner oldowner)
static void pltcl_DeleteFileHandler(int fd)
static int pltcl_quote(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
struct pltcl_proc_desc pltcl_proc_desc
static void pltcl_FinalizeNotifier(ClientData clientData)
static void throw_tcl_error(Tcl_Interp *interp, const char *proname)
static void pltcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData)
static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
static char * pltcl_start_proc
static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted)
static HTAB * pltcl_interp_htab
struct pltcl_proc_key pltcl_proc_key
static pltcl_interp_desc * pltcl_fetch_interp(Oid prolang, bool pltrusted)
struct pltcl_interp_desc pltcl_interp_desc
static pltcl_call_state * pltcl_current_call_state
static void pltcl_init_interp(pltcl_interp_desc *interp_desc, Oid prolang, bool pltrusted)
static void pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata)
static char * pltclu_start_proc
PG_MODULE_MAGIC_EXT(.name="pltcl",.version=PG_VERSION)
static void pltcl_event_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, bool pltrusted)
static ClientData pltcl_InitNotifier(void)
static char * utf_u2e(const char *src)
struct pltcl_query_desc pltcl_query_desc
static const TclExceptionNameMap exception_name_map[]
static int pltcl_rollback(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
static void pltcl_set_tuple_values(Tcl_Interp *interp, const char *arrayname, uint64 tupno, HeapTuple tuple, TupleDesc tupdesc)
Datum pltclu_call_handler(PG_FUNCTION_ARGS)
static void start_proc_error_callback(void *arg)
static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
static void pltcl_subtrans_begin(MemoryContext oldcontext, ResourceOwner oldowner)
static Datum pltcl_func_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state, bool pltrusted)
static Tcl_Interp * pltcl_hold_interp
static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
struct pltcl_call_state pltcl_call_state
static void pltcl_subtrans_commit(MemoryContext oldcontext, ResourceOwner oldowner)
static HeapTuple pltcl_build_tuple_result(Tcl_Interp *interp, Tcl_Obj **kvObjv, int kvObjc, pltcl_call_state *call_state)
Datum pltcl_call_handler(PG_FUNCTION_ARGS)
static bool pltcl_pm_init_done
static int pltcl_subtransaction(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
struct pltcl_proc_ptr pltcl_proc_ptr
static int pltcl_commit(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
static Datum PointerGetDatum(const void *X)
static Datum ObjectIdGetDatum(Oid X)
static char * DatumGetCString(Datum X)
static int fd(const char *x, int i)
char * format_procedure(Oid procedure_oid)
List * stringToQualifiedNameList(const char *string, Node *escontext)
#define RelationGetRelid(relation)
#define RelationGetDescr(relation)
ResourceOwner CurrentResourceOwner
int SPI_fnumber(TupleDesc tupdesc, const char *fname)
const char * SPI_result_code_string(int code)
SPITupleTable * SPI_tuptable
int SPI_execute_plan(SPIPlanPtr plan, Datum *Values, const char *Nulls, bool read_only, long tcount)
int SPI_register_trigger_data(TriggerData *tdata)
void SPI_freetuptable(SPITupleTable *tuptable)
SPIPlanPtr SPI_prepare(const char *src, int nargs, Oid *argtypes)
int SPI_keepplan(SPIPlanPtr plan)
int SPI_connect_ext(int options)
char * SPI_getnspname(Relation rel)
int SPI_execute(const char *src, bool read_only, long tcount)
char * SPI_getrelname(Relation rel)
#define SPI_OPT_NONATOMIC
#define SPI_OK_UPDATE_RETURNING
#define SPI_ERROR_NOATTRIBUTE
#define SPI_OK_INSERT_RETURNING
#define SPI_OK_DELETE_RETURNING
#define SPI_OK_MERGE_RETURNING
struct ErrorContextCallback * previous
void(* callback)(void *arg)
MemoryContext ecxt_per_query_memory
SetFunctionReturnMode returnMode
Tuplestorestate * setResult
pltcl_proc_desc * prodesc
MemoryContext tuple_store_cxt
Tuplestorestate * tuple_store
ResourceOwner tuple_store_owner
AttInMetadata * attinmeta
pltcl_interp_desc * interp_desc
unsigned long fn_refcount
pltcl_proc_desc * proc_ptr
void ReleaseSysCache(HeapTuple tuple)
HeapTuple SearchSysCache1(int cacheId, Datum key1)
Datum SysCacheGetAttrNotNull(int cacheId, HeapTuple tup, AttrNumber attributeNumber)
#define TRIGGER_FIRED_FOR_STATEMENT(event)
#define TRIGGER_FIRED_BY_DELETE(event)
#define TRIGGER_FIRED_BEFORE(event)
#define CALLED_AS_TRIGGER(fcinfo)
#define TRIGGER_FIRED_FOR_ROW(event)
#define TRIGGER_FIRED_AFTER(event)
#define TRIGGER_FIRED_BY_TRUNCATE(event)
#define TRIGGER_FIRED_BY_INSERT(event)
#define TRIGGER_FIRED_BY_UPDATE(event)
#define TRIGGER_FIRED_INSTEAD(event)
TupleDesc CreateTupleDescCopy(TupleDesc tupdesc)
#define ReleaseTupleDesc(tupdesc)
static FormData_pg_attribute * TupleDescAttr(TupleDesc tupdesc, int i)
Tuplestorestate * tuplestore_begin_heap(bool randomAccess, bool interXact, int maxKBytes)
void tuplestore_putvalues(Tuplestorestate *state, TupleDesc tdesc, const Datum *values, const bool *isnull)
void tuplestore_puttuple(Tuplestorestate *state, HeapTuple tuple)
TupleDesc lookup_rowtype_tupdesc(Oid type_id, int32 typmod)
void BeginInternalSubTransaction(const char *name)
void RollbackAndReleaseCurrentSubTransaction(void)
void ReleaseCurrentSubTransaction(void)