PostgreSQL Source Code: src/pl/plperl/plperl.c Source File (original) (raw)
1
2
3
4
5
6
7
9
10
11#include <ctype.h>
12#include <fcntl.h>
13#include <limits.h>
15
16
31#include "utils/fmgroids.h"
39
40
41#undef TEXTDOMAIN
42#define TEXTDOMAIN PG_TEXTDOMAIN("plperl")
43
44
45
46#include "perlchunks.h"
48
49#include "plperl_opmask.h"
50
54
56 .name = "plperl",
57 .version = PG_VERSION
58);
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
86{
91
92
93
94
95
96
97
98
99
100
101
103{
106 unsigned long fn_refcount;
111 bool fn_readonly;
114 bool lanpltrusted;
116 bool fn_retisset;
118
122
128
129#define increment_prodesc_refcount(prodesc) \
130 ((prodesc)->fn_refcount++)
131#define decrement_prodesc_refcount(prodesc) \
132 do { \
133 Assert((prodesc)->fn_refcount > 0); \
134 if (--((prodesc)->fn_refcount) == 0) \
135 free_plperl_function(prodesc); \
136 } while(0)
137
138
139
140
141
142
143
144
145
146
147
148
149
150
152{
154
155
156
157
158
162
164{
168
169
170
171
172
174{
177
184
185
186
187
189{
198
199
200
202{
206
207
208
209
211{
220
221
222
223
224
228
229
231
232
237
239static OP *(*pp_require_orig) (pTHX) = NULL;
241
242
244
245
246
247
248
253
257
259
261 bool is_trigger,
262 bool is_event_trigger);
263
274 bool *isnull);
278 int *ndims, int *dims, int cur_depth,
282
288static char *hek2cstr(HE *he);
300
301#if defined(WIN32) && PERL_VERSION_LT(5, 28, 0)
303#else
304#define setlocale_perl(a,b) Perl_setlocale(a,b)
305#endif
306
307
308
309
310
311
312
313static inline void
315{
317
318 SvREFCNT_dec(sv);
319}
320
321
322
323
324static char *
326{
328 char *ret;
329 SV *sv;
330
331
332
333
334
335 ENTER;
336 SAVETMPS;
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363 sv = HeSVKEY_force(he);
365 SvUTF8_on(sv);
367
368
369 FREETMPS;
370 LEAVE;
371
372 return ret;
373}
374
375
376
377
378
379
380
381void
383{
384
385
386
387
388
389
390
391
392 static bool inited = false;
394
395 if (inited)
396 return;
397
398
399
400
402
403
404
405
407 gettext_noop("If true, trusted and untrusted Perl code will be compiled in strict mode."),
408 NULL,
410 false,
412 NULL, NULL, NULL);
413
414
415
416
417
418
419
421 gettext_noop("Perl initialization code to execute when a Perl interpreter is initialized."),
422 NULL,
424 NULL,
426 NULL, NULL, NULL);
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
443 gettext_noop("Perl initialization code to execute once when plperl is first used."),
444 NULL,
446 NULL,
448 NULL, NULL, NULL);
449
451 gettext_noop("Perl initialization code to execute once when plperlu is first used."),
452 NULL,
454 NULL,
456 NULL, NULL, NULL);
457
459
460
461
462
466 8,
467 &hash_ctl,
469
473 32,
474 &hash_ctl,
476
477
478
479
481
482
483
484
486
487 inited = true;
488}
489
490
491static void
493{
494 if (trusted)
495 {
498 }
499 else
500 {
503 }
504}
505
506
507
508
509
510static void
512{
515
517
518
519
520
521
522
523
525
526
527 if (code)
528 {
529 elog(DEBUG3, "plperl_fini: skipped");
530 return;
531 }
532
533
535
536
538 while ((interp_desc = hash_seq_search(&hash_seq)) != NULL)
539 {
540 if (interp_desc->interp)
541 {
544 }
545 }
546
548}
549
550
551
552
553
554static void
556{
557 Oid user_id;
559 bool found;
560 PerlInterpreter *interp = NULL;
561
562
563 if (trusted)
565 else
567
570 &found);
571 if (!found)
572 {
573
574 interp_desc->interp = NULL;
576 }
577
578
580 {
582
586 32,
587 &hash_ctl,
589 }
590
591
592
593
594 if (interp_desc->interp)
595 {
597 return;
598 }
599
600
601
602
604 {
605
607
608
609
610
611
613
614 if (trusted)
616 else
618
619
621 }
622 else
623 {
624#ifdef MULTIPLICITY
625
626
627
628
629
630
631
632
634
635
637
638 if (trusted)
640 else
642#else
644 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
645 errmsg("cannot allocate multiple Perl interpreters on this platform")));
646#endif
647 }
648
650
651
652
653
654
655
656
657
658 {
660
661 newXS("PostgreSQL::InServer::SPI::bootstrap",
663
664 eval_pv("PostgreSQL::InServer::SPI::bootstrap()", FALSE);
665 if (SvTRUE(ERRSV))
667 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
669 errcontext("while executing PostgreSQL::InServer::SPI::bootstrap")));
670 }
671
672
673 interp_desc->interp = interp;
674
675
677}
678
679
680
681
682
683
684
685static void
687{
689 {
691 PERL_SET_CONTEXT(interp_desc->interp);
692
695 }
696}
697
698
699
700
701
702
703
704
705
706static PerlInterpreter *
708{
709 PerlInterpreter *plperl;
710
711 static char *embedding[3 + 2] = {
712 "", "-e", PLC_PERLBOOT
713 };
714 int nargs = 3;
715
716#ifdef WIN32
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738 char *loc;
739 char *save_collate,
740 *save_ctype,
741 *save_monetary,
742 *save_numeric,
743 *save_time;
744
745 loc = setlocale(LC_COLLATE, NULL);
746 save_collate = loc ? pstrdup(loc) : NULL;
748 save_ctype = loc ? pstrdup(loc) : NULL;
749 loc = setlocale(LC_MONETARY, NULL);
750 save_monetary = loc ? pstrdup(loc) : NULL;
751 loc = setlocale(LC_NUMERIC, NULL);
752 save_numeric = loc ? pstrdup(loc) : NULL;
754 save_time = loc ? pstrdup(loc) : NULL;
755
756#define PLPERL_RESTORE_LOCALE(name, saved) \
757 STMT_START { \
758 if (saved != NULL) { setlocale_perl(name, saved); pfree(saved); } \
759 } STMT_END
760#endif
761
763 {
764 embedding[nargs++] = "-e";
766 }
767
768
769
770
771
772
773
774
775
776
777#if defined(PERL_SYS_INIT3) && !defined(MYMALLOC)
778 {
779 static int perl_sys_init_done;
780
781
782 if (!perl_sys_init_done)
783 {
784 char *dummy_env[1] = {NULL};
785
786 PERL_SYS_INIT3(&nargs, (char ***) &embedding, (char ***) &dummy_env);
787
788
789
790
791
792
793
794
795
796
798
799 perl_sys_init_done = 1;
800
801 dummy_env[0] = NULL;
802 }
803 }
804#endif
805
806 plperl = perl_alloc();
807 if (!plperl)
808 elog(ERROR, "could not allocate Perl interpreter");
809
810 PERL_SET_CONTEXT(plperl);
811 perl_construct(plperl);
812
813
814
815
816
817
818 {
820
821 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
822
823
824
825
826
827
830 else
831 {
834 }
835
836#ifdef PLPERL_ENABLE_OPMASK_EARLY
837
838
839
840
841
842
843
844
846#endif
847
849 nargs, embedding, NULL) != 0)
851 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
853 errcontext("while parsing Perl initialization")));
854
855 if (perl_run(plperl) != 0)
857 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
859 errcontext("while running Perl initialization")));
860
861#ifdef PLPERL_RESTORE_LOCALE
862 PLPERL_RESTORE_LOCALE(LC_COLLATE, save_collate);
863 PLPERL_RESTORE_LOCALE(LC_CTYPE, save_ctype);
864 PLPERL_RESTORE_LOCALE(LC_MONETARY, save_monetary);
865 PLPERL_RESTORE_LOCALE(LC_NUMERIC, save_numeric);
866 PLPERL_RESTORE_LOCALE(LC_TIME, save_time);
867#endif
868 }
869
870 return plperl;
871}
872
873
874
875
876
877
878
879
880
881static OP *
883{
885 dSP;
886 SV *sv,
887 **svp;
889 STRLEN len;
890
891 sv = POPs;
894 RETPUSHNO;
895
896 svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
898 RETPUSHYES;
899
900 DIE(aTHX_ "Unable to load %s into plperl", name);
901
902
903
904
905
906
907
908
909
910 return NULL;
911}
912
913
914
915
916
917
918
919static void
921{
922 if (interp && *interp)
923 {
924
925
926
927
928
929
930
931
932
933
935
936
937 if (PL_exit_flags & PERL_EXIT_DESTRUCT_END)
938 {
939 dJMPENV;
940 int x = 0;
941
942 JMPENV_PUSH(x);
944 if (PL_endav && !PL_minus_c)
945 call_list(PL_scopestack_ix, PL_endav);
946 JMPENV_POP;
947 }
948 LEAVE;
949 FREETMPS;
950
951 *interp = NULL;
952 }
953}
954
955
956
957
958static void
960{
962 HV *stash;
963 SV *sv;
964 char *key;
965 I32 klen;
966
967
970
971 eval_pv(PLC_TRUSTED, FALSE);
972 if (SvTRUE(ERRSV))
974 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
976 errcontext("while executing PLC_TRUSTED")));
977
978
979
980
981
982
983 eval_pv("my a=chr(0x100);returna=chr(0x100); return a=chr(0x100);returna =~ /\\xa9/i", FALSE);
984 if (SvTRUE(ERRSV))
986 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
988 errcontext("while executing utf8fix")));
989
990
991
992
993
994
997
998
999
1000
1001
1003
1004
1005 stash = gv_stashpv("DynaLoader", GV_ADDWARN);
1006 hv_iterinit(stash);
1007 while ((sv = hv_iternextsv(stash, &key, &klen)))
1008 {
1010 continue;
1011 SvREFCNT_dec(GvCV(sv));
1012 GvCV_set(sv, NULL);
1013 }
1014 hv_clear(stash);
1015
1016
1017 ++PL_sub_generation;
1018 hv_clear(PL_stashcache);
1019
1020
1021
1022
1024 {
1026
1027 if (SvTRUE(ERRSV))
1029 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1031 errcontext("while executing plperl.on_plperl_init")));
1032 }
1033}
1034
1035
1036
1037
1038
1039static void
1041{
1043
1044
1045
1046
1048 {
1050 if (SvTRUE(ERRSV))
1052 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1054 errcontext("while executing plperl.on_plperlu_init")));
1055 }
1056}
1057
1058
1059
1060
1061
1062static char *
1064{
1065 char *res = pstrdup(msg);
1066 int len = strlen(res);
1067
1068 while (len > 0 && isspace((unsigned char) res[len - 1]))
1069 res[--len] = '\0';
1070 return res;
1071}
1072
1073
1074
1075
1078{
1081 bool *nulls;
1082 HE *he;
1084
1086 nulls = palloc(sizeof(bool) * td->natts);
1087 memset(nulls, true, sizeof(bool) * td->natts);
1088
1089 hv_iterinit(perlhash);
1090 while ((he = hv_iternext(perlhash)))
1091 {
1092 SV *val = HeVAL(he);
1096
1099 (errcode(ERRCODE_UNDEFINED_COLUMN),
1100 errmsg("Perl hash contains nonexistent column \"%s\"",
1102 if (attn <= 0)
1104 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1105 errmsg("cannot set system attribute \"%s\"",
1107
1109 attr->atttypid,
1110 attr->atttypmod,
1111 NULL,
1112 NULL,
1114 &nulls[attn - 1]);
1115
1117 }
1118 hv_iterinit(perlhash);
1119
1123 return tup;
1124}
1125
1126
1129{
1131
1133}
1134
1135
1136
1137
1138
1139static SV *
1141{
1143
1144 if (SvOK(sv) && SvROK(sv))
1145 {
1146 if (SvTYPE(SvRV(sv)) == SVt_PVAV)
1147 return sv;
1148 else if (sv_isa(sv, "PostgreSQL::InServer::ARRAY"))
1149 {
1150 HV *hv = (HV *) SvRV(sv);
1152
1153 if (*sav && SvOK(*sav) && SvROK(*sav) &&
1154 SvTYPE(SvRV(*sav)) == SVt_PVAV)
1155 return *sav;
1156
1157 elog(ERROR, "could not get array reference from PostgreSQL::InServer::ARRAY object");
1158 }
1159 }
1160 return NULL;
1161}
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171static void
1173 int *ndims, int *dims, int cur_depth,
1174 Oid elemtypid, int32 typmod,
1176{
1178 int i;
1179 int len = av_len(av) + 1;
1180
1181 for (i = 0; i < len; i++)
1182 {
1183
1184 SV **svp = av_fetch(av, i, FALSE);
1185
1186
1188
1189
1190 if (sav)
1191 {
1192 AV *nav = (AV *) SvRV(sav);
1193
1194
1195 if (i == 0 && *ndims == cur_depth)
1196 {
1197
1198 if (*astatep != NULL)
1200 (errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
1201 errmsg("multidimensional arrays must have array expressions with matching dimensions")));
1202
1203 if (cur_depth + 1 > MAXDIM)
1205 (errcode(ERRCODE_PROGRAM_LIMIT_EXCEEDED),
1206 errmsg("number of array dimensions exceeds the maximum allowed (%d)",
1208
1209 dims[*ndims] = av_len(nav) + 1;
1210 (*ndims)++;
1211 }
1212 else if (cur_depth >= *ndims ||
1213 av_len(nav) + 1 != dims[cur_depth])
1215 (errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
1216 errmsg("multidimensional arrays must have array expressions with matching dimensions")));
1217
1218
1220 ndims, dims, cur_depth + 1,
1221 elemtypid, typmod,
1222 finfo, typioparam);
1223 }
1224 else
1225 {
1227 bool isnull;
1228
1229
1230 if (*ndims != cur_depth)
1232 (errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
1233 errmsg("multidimensional arrays must have array expressions with matching dimensions")));
1234
1236 elemtypid,
1237 typmod,
1238 NULL,
1239 finfo,
1240 typioparam,
1241 &isnull);
1242
1243
1244 if (*astatep == NULL)
1247
1248
1251 }
1252 }
1253}
1254
1255
1256
1257
1260{
1262 AV *nav = (AV *) SvRV(src);
1264 Oid elemtypid;
1266 Oid typioparam;
1269 int ndims = 1;
1270 int i;
1271
1273 if (!elemtypid)
1275 (errcode(ERRCODE_DATATYPE_MISMATCH),
1276 errmsg("cannot convert Perl array to non-array type %s",
1278
1280
1281 memset(dims, 0, sizeof(dims));
1282 dims[0] = av_len(nav) + 1;
1283
1285 &ndims, dims, 1,
1286 elemtypid, typmod,
1287 &finfo, typioparam);
1288
1289
1290 if (astate == NULL)
1292
1293 for (i = 0; i < ndims; i++)
1294 lbs[i] = 1;
1295
1298}
1299
1300
1301static void
1303{
1304 Oid typinput;
1305
1306
1308 &typinput, typioparam);
1310}
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1328 bool *isnull)
1329{
1331 Oid funcid;
1332
1333
1335
1336 *isnull = false;
1337
1338
1339
1340
1341
1342
1343 if (!sv || !SvOK(sv) || typid == VOIDOID)
1344 {
1345
1346 if (!finfo)
1347 {
1349 finfo = &tmp;
1350 }
1351 *isnull = true;
1352
1354 }
1357 else if (SvROK(sv))
1358 {
1359
1361
1362 if (sav)
1363 {
1364
1366 }
1367 else if (SvTYPE(SvRV(sv)) == SVt_PVHV)
1368 {
1369
1372 bool isdomain;
1373
1376 (errcode(ERRCODE_DATATYPE_MISMATCH),
1377 errmsg("cannot convert Perl hash to non-composite type %s",
1379
1381 if (td != NULL)
1382 {
1383
1384 isdomain = (typid != td->tdtypeid);
1385 }
1386 else
1387 {
1388
1390
1391 if (fcinfo)
1393 else
1398 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1399 errmsg("function returning record called in context "
1400 "that cannot accept type record")));
1403 }
1404
1406
1407 if (isdomain)
1408 domain_check(ret, false, typid, NULL, NULL);
1409
1410
1412
1413 return ret;
1414 }
1415
1416
1417
1418
1419
1421 fcinfo, finfo, typioparam,
1422 isnull);
1423 }
1424 else
1425 {
1426
1429
1430
1431 if (!finfo)
1432 {
1434 finfo = &tmp;
1435 }
1436
1439
1440 return ret;
1441 }
1442}
1443
1444
1445char *
1447{
1448 Oid typid;
1449 Oid typoutput;
1451 bool typisvarlena,
1452 isnull;
1453
1455
1459 (errcode(ERRCODE_UNDEFINED_OBJECT),
1460 errmsg("lookup failed for type %s", fqtypename)));
1461
1463 typid, -1,
1465 &isnull);
1466
1467 if (isnull)
1468 return NULL;
1469
1471 &typoutput, &typisvarlena);
1472
1474}
1475
1476
1477
1478
1479
1480
1481static SV *
1483{
1488 bool typbyval;
1490 typdelim;
1491 Oid typioparam;
1492 Oid typoutputfunc;
1493 Oid transform_funcid;
1494 int i,
1496 *dims;
1498 SV *av;
1499 HV *hv;
1500
1501
1502
1503
1504
1506
1507
1509 &typlen, &typbyval, &typalign,
1510 &typdelim, &typioparam, &typoutputfunc);
1511
1512
1516
1517
1520 else
1522
1524
1525
1528
1529
1530 if (info->ndims == 0)
1531 {
1533 }
1534 else
1535 {
1539
1540
1543 for (i = 1; i < info->ndims; i++)
1545
1547 }
1548
1549 hv = newHV();
1550 (void) hv_store(hv, "array", 5, av, 0);
1551 (void) hv_store(hv, "typeoid", 7, newSVuv(typid), 0);
1552
1554 gv_stashpv("PostgreSQL::InServer::ARRAY", 0));
1555}
1556
1557
1558
1559
1560static SV *
1562{
1564 int i;
1565 AV *result;
1566
1567
1569
1570
1572
1573
1574
1575
1576 if (nest >= info->ndims - 1)
1578
1579 result = newAV();
1580 for (i = first; i < last; i += info->nelems[nest + 1])
1581 {
1582
1584
1585 av_push(result, ref);
1586 }
1588}
1589
1590
1591
1592
1593
1594static SV *
1596{
1598 int i;
1599 AV *result = newAV();
1600
1601 for (i = first; i < last; i++)
1602 {
1604 {
1605
1606
1607
1608
1609 av_push(result, newSV(0));
1610 }
1611 else
1612 {
1614
1618
1620 else
1621 {
1623
1625 }
1626 }
1627 }
1629}
1630
1631
1632static SV *
1634{
1638 int i;
1639 char *level;
1640 char *event;
1641 char *relid;
1643 HV *hv;
1644
1645 hv = newHV();
1646 hv_ksplit(hv, 12);
1647
1650
1653
1656
1657
1658
1659
1660
1661
1663 {
1664 event = "INSERT";
1668 tupdesc,
1670 }
1672 {
1673 event = "DELETE";
1677 tupdesc,
1678 true));
1679 }
1681 {
1682 event = "UPDATE";
1684 {
1687 tupdesc,
1688 true));
1691 tupdesc,
1693 }
1694 }
1696 event = "TRUNCATE";
1697 else
1698 event = "UNKNOWN";
1699
1702
1704 {
1705 AV *av = newAV();
1706
1711 }
1712
1715
1718
1721
1723 when = "BEFORE";
1725 when = "AFTER";
1727 when = "INSTEAD OF";
1728 else
1729 when = "UNKNOWN";
1731
1733 level = "ROW";
1735 level = "STATEMENT";
1736 else
1737 level = "UNKNOWN";
1739
1741}
1742
1743
1744
1745static SV *
1747{
1750 HV *hv;
1751
1752 hv = newHV();
1753
1755
1758
1760}
1761
1762
1765{
1767 SV **svp;
1768 HV *hvNew;
1769 HE *he;
1772 int natts;
1773 Datum *modvalues;
1774 bool *modnulls;
1775 bool *modrepls;
1776
1778 if (!svp)
1780 (errcode(ERRCODE_UNDEFINED_COLUMN),
1781 errmsg("$_TD->{new} does not exist")));
1782 if (!SvOK(*svp) || !SvROK(*svp) || SvTYPE(SvRV(*svp)) != SVt_PVHV)
1784 (errcode(ERRCODE_DATATYPE_MISMATCH),
1785 errmsg("$_TD->{new} is not a hash reference")));
1786 hvNew = (HV *) SvRV(*svp);
1787
1789 natts = tupdesc->natts;
1790
1792 modnulls = (bool *) palloc0(natts * sizeof(bool));
1793 modrepls = (bool *) palloc0(natts * sizeof(bool));
1794
1795 hv_iterinit(hvNew);
1796 while ((he = hv_iternext(hvNew)))
1797 {
1799 SV *val = HeVAL(he);
1802
1805 (errcode(ERRCODE_UNDEFINED_COLUMN),
1806 errmsg("Perl hash contains nonexistent column \"%s\"",
1808 if (attn <= 0)
1810 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1811 errmsg("cannot set system attribute \"%s\"",
1813 if (attr->attgenerated)
1815 (errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
1816 errmsg("cannot set generated column \"%s\"",
1818
1820 attr->atttypid,
1821 attr->atttypmod,
1822 NULL,
1823 NULL,
1825 &modnulls[attn - 1]);
1826 modrepls[attn - 1] = true;
1827
1829 }
1830 hv_iterinit(hvNew);
1831
1832 rtup = heap_modify_tuple(otup, tupdesc, modvalues, modnulls, modrepls);
1833
1834 pfree(modvalues);
1835 pfree(modnulls);
1836 pfree(modrepls);
1837
1838 return rtup;
1839}
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1852
1855{
1860
1861
1862 MemSet(&this_call_data, 0, sizeof(this_call_data));
1863 this_call_data.fcinfo = fcinfo;
1864
1866 {
1871 {
1873 retval = (Datum) 0;
1874 }
1875 else
1877 }
1879 {
1882 if (this_call_data.prodesc)
1884 }
1886
1887 return retval;
1888}
1889
1890
1891
1892
1894
1897{
1906
1907
1908 MemSet(&this_call_data, 0, sizeof(this_call_data));
1909
1910
1913 pl_error_context.arg = NULL;
1915
1916
1917
1918
1919
1920
1922 MemSet(&flinfo, 0, sizeof(flinfo));
1923 MemSet(&desc, 0, sizeof(desc));
1924 fake_fcinfo->flinfo = &flinfo;
1927
1928 desc.proname = "inline_code_block";
1930
1934
1941
1942 this_call_data.fcinfo = fake_fcinfo;
1943 this_call_data.prodesc = &desc;
1944
1945
1947 {
1948 SV *perlret;
1949
1951
1953
1955
1957
1958 if (!desc.reference)
1959 elog(ERROR, "could not create internal procedure for anonymous code block");
1960
1962
1964
1966 elog(ERROR, "SPI_finish() failed");
1967 }
1969 {
1974 }
1976
1978
1980}
1981
1982
1983
1984
1985
1986
1988
1991{
1995 char functyptype;
1996 int numargs;
1997 Oid *argtypes;
1998 char **argnames;
1999 char *argmodes;
2000 bool is_trigger = false;
2001 bool is_event_trigger = false;
2002 int i;
2003
2006
2007
2010 elog(ERROR, "cache lookup failed for function %u", funcoid);
2012
2013 functyptype = get_typtype(proc->prorettype);
2014
2015
2016
2017 if (functyptype == TYPTYPE_PSEUDO)
2018 {
2019 if (proc->prorettype == TRIGGEROID)
2020 is_trigger = true;
2021 else if (proc->prorettype == EVENT_TRIGGEROID)
2022 is_event_trigger = true;
2023 else if (proc->prorettype != RECORDOID &&
2024 proc->prorettype != VOIDOID)
2026 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
2027 errmsg("PL/Perl functions cannot return type %s",
2029 }
2030
2031
2033 &argtypes, &argnames, &argmodes);
2034 for (i = 0; i < numargs; i++)
2035 {
2036 if (get_typtype(argtypes[i]) == TYPTYPE_PSEUDO &&
2037 argtypes[i] != RECORDOID)
2039 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
2040 errmsg("PL/Perl functions cannot accept type %s",
2042 }
2043
2045
2046
2048 {
2050 }
2051
2052
2054}
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2066
2069{
2071}
2072
2074
2077{
2079}
2080
2082
2085{
2086
2088}
2089
2090
2091
2092
2093
2094
2095static void
2097{
2099 dSP;
2101 HV *pragma_hv = newHV();
2102 SV *subref = NULL;
2103 int count;
2104
2106
2109
2110 ENTER;
2111 SAVETMPS;
2112 PUSHMARK(SP);
2113 EXTEND(SP, 4);
2115 PUSHs(sv_2mortal(newRV_noinc((SV *) pragma_hv)));
2116
2117
2118
2119
2120
2121
2123 PUSHs(sv_2mortal(cstr2sv(s)));
2124 PUTBACK;
2125
2126
2127
2128
2129
2130
2131 count = call_pv("PostgreSQL::InServer::mkfunc",
2132 G_SCALAR | G_EVAL | G_KEEPERR);
2133 SPAGAIN;
2134
2135 if (count == 1)
2136 {
2137 SV *sub_rv = (SV *) POPs;
2138
2139 if (sub_rv && SvROK(sub_rv) && SvTYPE(SvRV(sub_rv)) == SVt_PVCV)
2140 {
2141 subref = newRV_inc(SvRV(sub_rv));
2142 }
2143 }
2144
2145 PUTBACK;
2146 FREETMPS;
2147 LEAVE;
2148
2149 if (SvTRUE(ERRSV))
2151 (errcode(ERRCODE_SYNTAX_ERROR),
2153
2154 if (!subref)
2156 (errcode(ERRCODE_SYNTAX_ERROR),
2157 errmsg("didn't get a CODE reference from compiling function \"%s\"",
2159
2161}
2162
2163
2164
2165
2166
2167
2168static void
2170{
2171 char *file = __FILE__;
2172
2173 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
2174 newXS("PostgreSQL::InServer::Util::bootstrap",
2176
2177}
2178
2179
2180static SV *
2182{
2184 dSP;
2185 SV *retval;
2186 int i;
2187 int count;
2188 Oid *argtypes = NULL;
2189 int nargs = 0;
2190
2191 ENTER;
2192 SAVETMPS;
2193
2194 PUSHMARK(SP);
2195 EXTEND(sp, desc->nargs);
2196
2197
2201
2202 for (i = 0; i < desc->nargs; i++)
2203 {
2207 {
2209
2210 PUSHs(sv_2mortal(sv));
2211 }
2212 else
2213 {
2214 SV *sv;
2215 Oid funcid;
2216
2221 else
2222 {
2223 char *tmp;
2224
2229 }
2230
2231 PUSHs(sv_2mortal(sv));
2232 }
2233 }
2234 PUTBACK;
2235
2236
2238
2239 SPAGAIN;
2240
2241 if (count != 1)
2242 {
2243 PUTBACK;
2244 FREETMPS;
2245 LEAVE;
2247 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2248 errmsg("didn't get a return item from function")));
2249 }
2250
2251 if (SvTRUE(ERRSV))
2252 {
2253 (void) POPs;
2254 PUTBACK;
2255 FREETMPS;
2256 LEAVE;
2257
2259 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2261 }
2262
2263 retval = newSVsv(POPs);
2264
2265 PUTBACK;
2266 FREETMPS;
2267 LEAVE;
2268
2269 return retval;
2270}
2271
2272
2273static SV *
2275 SV *td)
2276{
2278 dSP;
2279 SV *retval,
2280 *TDsv;
2281 int i,
2282 count;
2284
2285 ENTER;
2286 SAVETMPS;
2287
2288 TDsv = get_sv("main::_TD", 0);
2289 if (!TDsv)
2291 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2292 errmsg("couldn't fetch $_TD")));
2293
2294 save_item(TDsv);
2295 sv_setsv(TDsv, td);
2296
2297 PUSHMARK(sp);
2298 EXTEND(sp, tg_trigger->tgnargs);
2299
2300 for (i = 0; i < tg_trigger->tgnargs; i++)
2302 PUTBACK;
2303
2304
2306
2307 SPAGAIN;
2308
2309 if (count != 1)
2310 {
2311 PUTBACK;
2312 FREETMPS;
2313 LEAVE;
2315 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2316 errmsg("didn't get a return item from trigger function")));
2317 }
2318
2319 if (SvTRUE(ERRSV))
2320 {
2321 (void) POPs;
2322 PUTBACK;
2323 FREETMPS;
2324 LEAVE;
2325
2327 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2329 }
2330
2331 retval = newSVsv(POPs);
2332
2333 PUTBACK;
2334 FREETMPS;
2335 LEAVE;
2336
2337 return retval;
2338}
2339
2340
2341static void
2344 SV *td)
2345{
2347 dSP;
2348 SV *retval,
2349 *TDsv;
2350 int count;
2351
2352 ENTER;
2353 SAVETMPS;
2354
2355 TDsv = get_sv("main::_TD", 0);
2356 if (!TDsv)
2358 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2359 errmsg("couldn't fetch $_TD")));
2360
2361 save_item(TDsv);
2362 sv_setsv(TDsv, td);
2363
2364 PUSHMARK(sp);
2365 PUTBACK;
2366
2367
2369
2370 SPAGAIN;
2371
2372 if (count != 1)
2373 {
2374 PUTBACK;
2375 FREETMPS;
2376 LEAVE;
2378 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2379 errmsg("didn't get a return item from trigger function")));
2380 }
2381
2382 if (SvTRUE(ERRSV))
2383 {
2384 (void) POPs;
2385 PUTBACK;
2386 FREETMPS;
2387 LEAVE;
2388
2390 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2392 }
2393
2394 retval = newSVsv(POPs);
2395 (void) retval;
2396
2397 PUTBACK;
2398 FREETMPS;
2399 LEAVE;
2400}
2401
2404{
2405 bool nonatomic;
2407 SV *perlret;
2408 Datum retval = 0;
2411
2412 nonatomic = fcinfo->context &&
2415
2417
2421
2422
2425 pl_error_context.arg = prodesc->proname;
2427
2429
2431 {
2432
2435 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
2436 errmsg("set-valued function called in context that cannot accept a set")));
2437
2440 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
2441 errmsg("materialize mode required, but it is not allowed in this context")));
2442 }
2443
2445
2447
2448
2449
2450
2451
2452
2453
2455 elog(ERROR, "SPI_finish() failed");
2456
2458 {
2459 SV *sav;
2460
2461
2462
2463
2464
2465
2466
2468 if (sav)
2469 {
2471 int i = 0;
2472 SV **svp = 0;
2473 AV *rav = (AV *) SvRV(sav);
2474
2475 while ((svp = av_fetch(rav, i, FALSE)) != NULL)
2476 {
2478 i++;
2479 }
2480 }
2481 else if (SvOK(perlret))
2482 {
2484 (errcode(ERRCODE_DATATYPE_MISMATCH),
2485 errmsg("set-returning PL/Perl function must return "
2486 "reference to array or use return_next")));
2487 }
2488
2491 {
2494 }
2495 retval = (Datum) 0;
2496 }
2498 {
2501 -1,
2502 fcinfo,
2505 &fcinfo->isnull);
2506
2509 }
2510
2511
2513
2515
2516 return retval;
2517}
2518
2519
2522{
2524 SV *perlret;
2526 SV *svTD;
2527 HV *hvTD;
2531
2532
2534
2535
2536 tdata = (TriggerData *) fcinfo->context;
2539
2540
2544
2545
2548 pl_error_context.arg = prodesc->proname;
2550
2552
2555 hvTD = (HV *) SvRV(svTD);
2556
2557
2558
2559
2560
2561
2562
2564 elog(ERROR, "SPI_finish() failed");
2565
2566 if (perlret == NULL || !SvOK(perlret))
2567 {
2568
2570
2579 else
2580 retval = (Datum) 0;
2581 }
2582 else
2583 {
2585 char *tmp;
2586
2588
2590 trv = NULL;
2592 {
2594
2601 else
2602 {
2604 (errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
2605 errmsg("ignoring modified row in DELETE trigger")));
2606 trv = NULL;
2607 }
2608 }
2609 else
2610 {
2612 (errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
2613 errmsg("result of PL/Perl trigger function must be undef, "
2614 "\"SKIP\", or \"MODIFY\"")));
2615 trv = NULL;
2616 }
2619 }
2620
2621
2623
2625 if (perlret)
2627
2628 return retval;
2629}
2630
2631
2632static void
2634{
2636 SV *svTD;
2638
2639
2641
2642
2646
2647
2650 pl_error_context.arg = prodesc->proname;
2652
2654
2657
2659 elog(ERROR, "SPI_finish() failed");
2660
2661
2663
2665}
2666
2667
2668static bool
2670{
2671 if (proc_ptr && proc_ptr->proc_ptr)
2672 {
2674 bool uptodate;
2675
2676
2677
2678
2679
2680
2683
2684 if (uptodate)
2685 return true;
2686
2687
2689
2691 }
2692
2693 return false;
2694}
2695
2696
2697static void
2699{
2701
2703 {
2705
2709 }
2710
2712}
2713
2714
2717{
2726
2727
2730 elog(ERROR, "cache lookup failed for function %u", fn_oid);
2732
2733
2734
2735
2736
2737
2738
2739 proc_key.proc_id = fn_oid;
2745 {
2746
2749 }
2750
2751
2756 {
2757
2760 }
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2773 plperl_error_context.arg = NameStr(procStruct->proname);
2775
2777 {
2782 Datum protrftypes_datum;
2783 Datum prosrcdatum;
2784 bool isnull;
2785 char *proc_source;
2787
2788
2789
2790
2792 "PL/Perl function",
2794
2795
2796
2797
2798
2803 prodesc->fn_cxt = proc_cxt;
2807 prodesc->nargs = procStruct->pronargs;
2812
2813
2815 (procStruct->provolatile != PROVOLATILE_VOLATILE);
2816
2817
2819 Anum_pg_proc_protrftypes, &isnull);
2823
2824
2825
2826
2830 elog(ERROR, "cache lookup failed for language %u",
2831 procStruct->prolang);
2833 prodesc->lang_oid = langStruct->oid;
2834 prodesc->lanpltrusted = langStruct->lanpltrusted;
2836
2837
2838
2839
2840
2841 if (!is_trigger && !is_event_trigger)
2842 {
2843 Oid rettype = procStruct->prorettype;
2844
2847 elog(ERROR, "cache lookup failed for type %u", rettype);
2849
2850
2851 if (typeStruct->typtype == TYPTYPE_PSEUDO)
2852 {
2853 if (rettype == VOIDOID ||
2854 rettype == RECORDOID)
2855 ;
2856 else if (rettype == TRIGGEROID ||
2857 rettype == EVENT_TRIGGEROID)
2859 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
2860 errmsg("trigger functions can only be called "
2861 "as triggers")));
2862 else
2864 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
2865 errmsg("PL/Perl functions cannot return type %s",
2867 }
2868
2870 prodesc->fn_retisset = procStruct->proretset;
2872 prodesc->fn_retisarray = IsTrueArrayType(typeStruct);
2873
2876 proc_cxt);
2878
2880 }
2881
2882
2883
2884
2885
2886 if (!is_trigger && !is_event_trigger)
2887 {
2888 int i;
2889
2890 for (i = 0; i < prodesc->nargs; i++)
2891 {
2892 Oid argtype = procStruct->proargtypes.values[i];
2893
2896 elog(ERROR, "cache lookup failed for type %u", argtype);
2898
2899
2900 if (typeStruct->typtype == TYPTYPE_PSEUDO &&
2901 argtype != RECORDOID)
2903 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
2904 errmsg("PL/Perl functions cannot accept type %s",
2906
2909 else
2910 {
2914 proc_cxt);
2915 }
2916
2917
2918 if (IsTrueArrayType(typeStruct))
2920 else
2922
2924 }
2925 }
2926
2927
2928
2929
2930
2931
2933 Anum_pg_proc_prosrc);
2935
2936
2937
2938
2939
2941
2943
2945
2947
2948 pfree(proc_source);
2949
2950 if (!prodesc->reference)
2951 elog(ERROR, "could not create PL/Perl internal procedure");
2952
2953
2954
2955
2956
2957
2958
2960
2963
2964 proc_ptr->proc_ptr = prodesc;
2966 }
2968 {
2969
2970
2971
2972
2973
2974 if (prodesc && prodesc->reference)
2976 else if (proc_cxt)
2978
2979
2981
2983 }
2985
2986
2988
2990
2991 return prodesc;
2992}
2993
2994
2995static SV *
2997{
2999 Oid tupType;
3000 int32 tupTypmod;
3003 SV *sv;
3004
3006
3007
3011
3012
3015
3018
3019 return sv;
3020}
3021
3022
3023static SV *
3025{
3027 HV *hv;
3028 int i;
3029
3030
3032
3033 hv = newHV();
3034 hv_ksplit(hv, tupdesc->natts);
3035
3036 for (i = 0; i < tupdesc->natts; i++)
3037 {
3039 bool isnull,
3040 typisvarlena;
3042 Oid typoutput;
3044
3045 if (att->attisdropped)
3046 continue;
3047
3048 if (att->attgenerated)
3049 {
3050
3051 if (!include_generated)
3052 continue;
3053
3054 if (att->attgenerated == ATTRIBUTE_GENERATED_VIRTUAL)
3055 continue;
3056 }
3057
3059 attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
3060
3061 if (isnull)
3062 {
3063
3064
3065
3066
3067
3069 continue;
3070 }
3071
3073 {
3075
3077 }
3078 else
3079 {
3080 SV *sv;
3081 Oid funcid;
3082
3087 else
3088 {
3089 char *outputstr;
3090
3091
3093
3095 sv = cstr2sv(outputstr);
3096 pfree(outputstr);
3097 }
3098
3100 }
3101 }
3103}
3104
3105
3106static void
3108{
3109
3111 {
3112
3113 croak("SPI functions can not be used in END blocks");
3114 }
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3126 {
3127
3128 croak("SPI functions can not be used during function compilation");
3129 }
3130}
3131
3132
3133HV *
3135{
3136 HV *ret_hv;
3137
3138
3139
3140
3141
3144
3146
3148
3150
3152 {
3153 int spi_rv;
3154
3156
3158 limit);
3160 spi_rv);
3161
3162
3166 }
3168 {
3170
3171
3175
3176
3180
3181
3183
3184
3185 return NULL;
3186 }
3188
3189 return ret_hv;
3190}
3191
3192
3193static HV *
3195 int status)
3196{
3198 HV *result;
3199
3201
3202 result = newHV();
3203
3208 newSVnv((NV) processed) :
3209 newSVuv((UV) processed));
3210
3211 if (status > 0 && tuptable)
3212 {
3213 AV *rows;
3214 SV *row;
3216
3217
3220 (errcode(ERRCODE_PROGRAM_LIMIT_EXCEEDED),
3221 errmsg("query result has too many rows to fit in a Perl array")));
3222
3223 rows = newAV();
3224 av_extend(rows, processed);
3225 for (i = 0; i < processed; i++)
3226 {
3228 av_push(rows, row);
3229 }
3232 }
3233
3235
3236 return result;
3237}
3238
3239
3240
3241
3242
3243
3244
3245void
3247{
3249
3251
3253 {
3255 }
3257 {
3259
3260
3264
3265
3267 }
3269}
3270
3271
3272
3273
3274
3275static void
3277{
3282
3283 if (!sv)
3284 return;
3285
3289
3292 (errcode(ERRCODE_SYNTAX_ERROR),
3293 errmsg("cannot use return_next in a non-SETOF function")));
3294
3296 {
3298
3300
3301
3302
3303
3304
3305
3307 {
3309 Oid typid;
3310
3315 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
3316 errmsg("function returning record called in context "
3317 "that cannot accept type record")));
3318
3321 }
3322 else
3323 {
3325
3326 if (tupdesc == NULL || tupdesc->natts != 1)
3327 elog(ERROR, "expected single-column result descriptor for non-composite SETOF result");
3328 }
3329
3330
3331
3332
3333
3335
3340
3342 }
3343
3344
3345
3346
3347
3348
3349
3351 {
3354 "PL/Perl return_next temporary cxt",
3356 }
3357
3359
3361 {
3363
3364 if (!(SvOK(sv) && SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV))
3366 (errcode(ERRCODE_DATATYPE_MISMATCH),
3367 errmsg("SETOF-composite-returning PL/Perl function "
3368 "must call return_next with reference to hash")));
3369
3372
3378
3380 }
3382 {
3384 bool isNull[1];
3385
3388 -1,
3389 fcinfo,
3392 &isNull[0]);
3393
3396 ret, isNull);
3397 }
3398
3401}
3402
3403
3404SV *
3406{
3408
3409
3410
3411
3412
3415
3417
3419
3421
3423 {
3426
3427
3429
3430
3432 if (plan == NULL)
3433 elog(ERROR, "SPI_prepare() failed:%s",
3435
3438 if (portal == NULL)
3439 elog(ERROR, "SPI_cursor_open() failed:%s",
3442
3444
3445
3449 }
3451 {
3453
3454
3458
3459
3463
3464
3466
3467
3468 return NULL;
3469 }
3471
3473}
3474
3475
3476SV *
3478{
3479 SV *row;
3480
3481
3482
3483
3484
3487
3489
3491
3493
3495 {
3498
3499 if (!p)
3500 {
3502 }
3503 else
3504 {
3507 {
3511 }
3512 else
3513 {
3516 true);
3517 }
3519 }
3520
3521
3525 }
3527 {
3529
3530
3534
3535
3539
3540
3542
3543
3544 return NULL;
3545 }
3547
3548 return row;
3549}
3550
3551void
3553{
3555
3557
3559
3560 if (p)
3561 {
3564 }
3565}
3566
3567SV *
3569{
3577 bool found;
3578 int i;
3579
3581
3584
3586 {
3588
3589
3590
3591
3592
3593
3594
3596 "PL/Perl spi_prepare query",
3602 qdesc->nargs = argc;
3607
3608
3609
3610
3611
3613 "PL/Perl spi_prepare workspace",
3616
3617
3618
3619
3620
3621
3622 for (i = 0; i < argc; i++)
3623 {
3624 Oid typId,
3625 typInput,
3626 typIOParam;
3628 char *typstr;
3629
3633
3635
3639 }
3640
3641
3643
3644
3645
3646
3648
3649 if (plan == NULL)
3650 elog(ERROR, "SPI_prepare() failed:%s",
3652
3653
3654
3655
3656
3658 elog(ERROR, "SPI_keepplan() failed");
3660
3661
3662
3663
3668
3669
3671
3672
3676 }
3678 {
3680
3681
3685
3686
3687 if (hash_entry)
3691 if (plan_cxt)
3695
3696
3700
3701
3703
3704
3705 return NULL;
3706 }
3708
3709
3710
3711
3713}
3714
3715HV *
3717{
3718 HV *ret_hv;
3719 SV **sv;
3720 int i,
3721 limit,
3722 spi_rv;
3723 char *nulls;
3724 Datum *argvalues;
3727
3728
3729
3730
3731
3734
3736
3738
3740
3742 {
3744
3745
3746
3747
3750 if (hash_entry == NULL)
3751 elog(ERROR, "spi_exec_prepared: Invalid prepared query passed");
3752
3754 if (qdesc == NULL)
3755 elog(ERROR, "spi_exec_prepared: plperl query_hash value vanished");
3756
3757 if (qdesc->nargs != argc)
3758 elog(ERROR, "spi_exec_prepared: expected %d argument(s), %d passed",
3759 qdesc->nargs, argc);
3760
3761
3762
3763
3764 limit = 0;
3765 if (attr != NULL)
3766 {
3768 if (sv && *sv && SvIOK(*sv))
3769 limit = SvIV(*sv);
3770 }
3771
3772
3773
3774 if (argc > 0)
3775 {
3776 nulls = (char *) palloc(argc);
3778 }
3779 else
3780 {
3781 nulls = NULL;
3782 argvalues = NULL;
3783 }
3784
3785 for (i = 0; i < argc; i++)
3786 {
3787 bool isnull;
3788
3791 -1,
3792 NULL,
3795 &isnull);
3796 nulls[i] = isnull ? 'n' : ' ';
3797 }
3798
3799
3800
3801
3805 spi_rv);
3806 if (argc > 0)
3807 {
3808 pfree(argvalues);
3810 }
3811
3812
3816 }
3818 {
3820
3821
3825
3826
3830
3831
3833
3834
3835 return NULL;
3836 }
3838
3839 return ret_hv;
3840}
3841
3842SV *
3844{
3845 int i;
3846 char *nulls;
3847 Datum *argvalues;
3851 Portal portal = NULL;
3852
3853
3854
3855
3856
3859
3861
3863
3865
3867 {
3868
3869
3870
3873 if (hash_entry == NULL)
3874 elog(ERROR, "spi_query_prepared: Invalid prepared query passed");
3875
3877 if (qdesc == NULL)
3878 elog(ERROR, "spi_query_prepared: plperl query_hash value vanished");
3879
3880 if (qdesc->nargs != argc)
3881 elog(ERROR, "spi_query_prepared: expected %d argument(s), %d passed",
3882 qdesc->nargs, argc);
3883
3884
3885
3886
3887 if (argc > 0)
3888 {
3889 nulls = (char *) palloc(argc);
3891 }
3892 else
3893 {
3894 nulls = NULL;
3895 argvalues = NULL;
3896 }
3897
3898 for (i = 0; i < argc; i++)
3899 {
3900 bool isnull;
3901
3904 -1,
3905 NULL,
3908 &isnull);
3909 nulls[i] = isnull ? 'n' : ' ';
3910 }
3911
3912
3913
3914
3917 if (argc > 0)
3918 {
3919 pfree(argvalues);
3921 }
3922 if (portal == NULL)
3923 elog(ERROR, "SPI_cursor_open() failed:%s",
3925
3927
3929
3930
3934 }
3936 {
3938
3939
3943
3944
3948
3949
3951
3952
3953 return NULL;
3954 }
3956
3958}
3959
3960void
3962{
3966
3968
3971 if (hash_entry == NULL)
3972 elog(ERROR, "spi_freeplan: Invalid prepared query passed");
3973
3975 if (qdesc == NULL)
3976 elog(ERROR, "spi_freeplan: plperl query_hash value vanished");
3978
3979
3980
3981
3982
3985
3987
3989}
3990
3991void
3993{
3995
3997
3999 {
4001 }
4003 {
4005
4006
4010
4011
4013 }
4015}
4016
4017void
4019{
4021
4023
4025 {
4027 }
4029 {
4031
4032
4036
4037
4039 }
4041}
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054void
4056{
4058 char *volatile cmsg = NULL;
4059
4060
4061
4062
4063
4064
4066 {
4068 elog(level, "%s", cmsg);
4070 }
4072 {
4074
4075
4079
4080 if (cmsg)
4082
4083
4085 }
4087}
4088
4089
4090
4091
4092
4093static SV **
4095{
4098 char *hkey;
4099 SV **ret;
4100
4102
4103
4104
4105
4106
4107 hlen = -(int) strlen(hkey);
4108 ret = hv_store(hv, hkey, hlen, val, 0);
4109
4110 if (hkey != key)
4112
4113 return ret;
4114}
4115
4116
4117
4118
4119
4120static SV **
4122{
4125 char *hkey;
4126 SV **ret;
4127
4129
4130
4131 hlen = -(int) strlen(hkey);
4132 ret = hv_fetch(hv, hkey, hlen, 0);
4133
4134 if (hkey != key)
4136
4137 return ret;
4138}
4139
4140
4141
4142
4143static void
4145{
4146 char *procname = (char *) arg;
4147
4148 if (procname)
4149 errcontext("PL/Perl function \"%s\"", procname);
4150}
4151
4152
4153
4154
4155static void
4157{
4158 char *procname = (char *) arg;
4159
4160 if (procname)
4161 errcontext("compilation of PL/Perl function \"%s\"", procname);
4162}
4163
4164
4165
4166
4167static void
4169{
4170 errcontext("PL/Perl anonymous code block");
4171}
4172
4173
4174
4175
4176
4177
4178
4179
4180#if defined(WIN32) && PERL_VERSION_LT(5, 28, 0)
4181static char *
4183{
4186
4187 if (RETVAL)
4188 {
4189#ifdef USE_LOCALE_CTYPE
4190 if (category == LC_CTYPE
4191#ifdef LC_ALL
4192 || category == LC_ALL
4193#endif
4194 )
4195 {
4196 char *newctype;
4197
4198#ifdef LC_ALL
4199 if (category == LC_ALL)
4200 newctype = setlocale(LC_CTYPE, NULL);
4201 else
4202#endif
4203 newctype = RETVAL;
4204 new_ctype(newctype);
4205 }
4206#endif
4207#ifdef USE_LOCALE_COLLATE
4208 if (category == LC_COLLATE
4209#ifdef LC_ALL
4210 || category == LC_ALL
4211#endif
4212 )
4213 {
4214 char *newcoll;
4215
4216#ifdef LC_ALL
4217 if (category == LC_ALL)
4218 newcoll = setlocale(LC_COLLATE, NULL);
4219 else
4220#endif
4221 newcoll = RETVAL;
4222 new_collate(newcoll);
4223 }
4224#endif
4225
4226#ifdef USE_LOCALE_NUMERIC
4227 if (category == LC_NUMERIC
4228#ifdef LC_ALL
4229 || category == LC_ALL
4230#endif
4231 )
4232 {
4233 char *newnum;
4234
4235#ifdef LC_ALL
4236 if (category == LC_ALL)
4237 newnum = setlocale(LC_NUMERIC, NULL);
4238 else
4239#endif
4240 newnum = RETVAL;
4241 new_numeric(newnum);
4242 }
4243#endif
4244 }
4245
4246 return RETVAL;
4247}
4248#endif
#define DatumGetArrayTypeP(X)
ArrayBuildState * accumArrayResult(ArrayBuildState *astate, Datum dvalue, bool disnull, Oid element_type, MemoryContext rcontext)
ArrayType * construct_empty_array(Oid elmtype)
Datum makeMdArrayResult(ArrayBuildState *astate, int ndims, int *dims, int *lbs, MemoryContext rcontext, bool release)
void deconstruct_array(ArrayType *array, Oid elmtype, int elmlen, bool elmbyval, char elmalign, Datum **elemsp, bool **nullsp, int *nelemsp)
ArrayBuildState * initArrayResult(Oid element_type, MemoryContext rcontext, bool subcontext)
static Datum values[MAXATTR]
#define TextDatumGetCString(d)
#define PG_USED_FOR_ASSERTS_ONLY
#define MemSet(start, val, len)
#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)
void * hash_seq_search(HASH_SEQ_STATUS *status)
HTAB * hash_create(const char *tabname, long nelem, const HASHCTL *info, int flags)
void hash_seq_init(HASH_SEQ_STATUS *status, HTAB *hashp)
ErrorContextCallback * error_context_stack
ErrorData * CopyErrorData(void)
void FlushErrorState(void)
int errcode(int sqlerrcode)
int errmsg(const char *fmt,...)
#define ereport(elevel,...)
#define CALLED_AS_EVENT_TRIGGER(fcinfo)
@ SFRM_Materialize_Random
bool CheckFunctionValidatorAccess(Oid validatorOid, Oid functionOid)
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 OidFunctionCall1(functionId, arg1)
#define DatumGetHeapTupleHeader(X)
#define PG_GETARG_POINTER(n)
#define SizeForFunctionCallInfo(nargs)
#define DirectFunctionCall1(func, arg1)
#define LOCAL_FCINFO(name, nargs)
#define FunctionCall1(flinfo, arg1)
char * format_type_be(Oid type_oid)
int get_func_arg_info(HeapTuple procTup, Oid **p_argtypes, char ***p_argnames, char **p_argmodes)
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 DefineCustomBoolVariable(const char *name, const char *short_desc, const char *long_desc, bool *valueAddr, bool bootValue, GucContext context, int flags, GucBoolCheckHook check_hook, GucBoolAssignHook assign_hook, GucShowHook show_hook)
void MarkGUCPrefixReserved(const char *className)
bool check_function_bodies
Assert(PointerIsAligned(start, uint64))
HeapTuple heap_modify_tuple(HeapTuple tuple, TupleDesc tupleDesc, const Datum *replValues, const bool *replIsnull, const bool *doReplace)
HeapTuple heap_form_tuple(TupleDesc tupleDescriptor, const Datum *values, const bool *isnull)
#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)
void on_proc_exit(pg_on_exit_callback function, Datum arg)
if(TABLE==NULL||TABLE_index==NULL)
bool ItemPointerEquals(ItemPointer pointer1, ItemPointer pointer2)
Oid get_element_type(Oid typid)
bool type_is_rowtype(Oid typid)
void getTypeOutputInfo(Oid type, Oid *typOutput, bool *typIsVarlena)
Oid get_func_signature(Oid funcid, Oid **argtypes, int *nargs)
void getTypeInputInfo(Oid type, Oid *typInput, Oid *typIOParam)
Oid get_transform_tosql(Oid typid, Oid langid, List *trftypes)
void get_type_io_data(Oid typid, IOFuncSelector which_func, int16 *typlen, bool *typbyval, char *typalign, char *typdelim, Oid *typioparam, Oid *func)
char get_typtype(Oid typid)
Oid get_base_element_type(Oid typid)
Oid getTypeIOParam(HeapTuple typeTuple)
Oid get_transform_fromsql(Oid typid, Oid langid, List *trftypes)
bool pg_verifymbstr(const char *mbstr, int len, bool noError)
char * pg_server_to_any(const char *s, int len, int encoding)
void MemoryContextReset(MemoryContext context)
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_DEFAULT_SIZES
#define ALLOCSET_SMALL_SIZES
#define CHECK_FOR_INTERRUPTS()
void pg_bindtextdomain(const char *domain)
#define IsA(nodeptr, _type_)
#define castNode(_type_, nodeptr)
Datum oidout(PG_FUNCTION_ARGS)
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
bool parseTypeString(const char *str, Oid *typeid_p, int32 *typmod_p, Node *escontext)
FormData_pg_attribute * Form_pg_attribute
FormData_pg_language * Form_pg_language
List * oid_array_to_list(Datum datum)
FormData_pg_proc * Form_pg_proc
FormData_pg_type * Form_pg_type
static HTAB * plperl_interp_hash
static SV * plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
struct plperl_call_data plperl_call_data
static char plperl_opmask[MAXO]
static void plperl_event_trigger_handler(PG_FUNCTION_ARGS)
static bool plperl_use_strict
HV * plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv)
static void _sv_to_datum_finfo(Oid typid, FmgrInfo *finfo, Oid *typioparam)
static Datum plperl_func_handler(PG_FUNCTION_ARGS)
struct plperl_proc_key plperl_proc_key
static HTAB * plperl_proc_hash
static void set_interp_require(bool trusted)
static bool plperl_ending
SV * plperl_spi_prepare(char *query, int argc, SV **argv)
static void SvREFCNT_dec_current(SV *sv)
void plperl_return_next(SV *sv)
static SV * plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc, bool include_generated)
char * plperl_sv_to_literal(SV *sv, char *fqtypename)
struct plperl_query_desc plperl_query_desc
static plperl_interp_desc * plperl_active_interp
Datum plperlu_call_handler(PG_FUNCTION_ARGS)
static SV * plperl_trigger_build_args(FunctionCallInfo fcinfo)
static PerlInterpreter * plperl_held_interp
static OP *(* pp_require_orig)(pTHX)
static HV * plperl_spi_execute_fetch_result(SPITupleTable *, uint64, int)
SV * plperl_spi_query(char *query)
static void plperl_trusted_init(void)
static SV * make_array_ref(plperl_array_info *info, int first, int last)
void plperl_spi_rollback(void)
Datum plperl_inline_handler(PG_FUNCTION_ARGS)
static HeapTuple plperl_build_tuple_result(HV *perlhash, TupleDesc td)
struct plperl_proc_desc plperl_proc_desc
static void plperl_untrusted_init(void)
static void plperl_create_sub(plperl_proc_desc *desc, const char *s, Oid fn_oid)
Datum plperl_validator(PG_FUNCTION_ARGS)
static void plperl_init_shared_libs(pTHX)
#define increment_prodesc_refcount(prodesc)
static char * hek2cstr(HE *he)
PG_MODULE_MAGIC_EXT(.name="plperl",.version=PG_VERSION)
static void plperl_destroy_interp(PerlInterpreter **)
EXTERN_C void boot_DynaLoader(pTHX_ CV *cv)
static char * strip_trailing_ws(const char *msg)
static OP * pp_require_safe(pTHX)
#define setlocale_perl(a, b)
struct plperl_array_info plperl_array_info
SV * plperl_spi_query_prepared(char *query, int argc, SV **argv)
static void free_plperl_function(plperl_proc_desc *prodesc)
static SV * plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, SV *td)
EXTERN_C void boot_PostgreSQL__InServer__Util(pTHX_ CV *cv)
static void check_spi_usage_allowed(void)
PG_FUNCTION_INFO_V1(plperl_call_handler)
static SV * plperl_hash_from_datum(Datum attr)
static void select_perl_context(bool trusted)
static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod, FunctionCallInfo fcinfo, FmgrInfo *finfo, Oid typioparam, bool *isnull)
SV * plperl_spi_fetchrow(char *cursor)
struct plperl_query_entry plperl_query_entry
static SV * plperl_event_trigger_build_args(FunctionCallInfo fcinfo)
static void plperl_fini(int code, Datum arg)
static void plperl_exec_callback(void *arg)
HV * plperl_spi_exec(char *query, int limit)
static void plperl_inline_callback(void *arg)
static SV * get_perl_array_ref(SV *sv)
static SV ** hv_fetch_string(HV *hv, const char *key)
#define decrement_prodesc_refcount(prodesc)
Datum plperlu_inline_handler(PG_FUNCTION_ARGS)
static void plperl_compile_callback(void *arg)
Datum plperlu_validator(PG_FUNCTION_ARGS)
void plperl_spi_freeplan(char *query)
static SV * plperl_ref_from_pg_array(Datum arg, Oid typid)
static Datum plperl_array_to_datum(SV *src, Oid typid, int32 typmod)
static char * plperl_on_init
static char * plperl_on_plperl_init
static SV * split_array(plperl_array_info *info, int first, int last, int nest)
static Datum plperl_trigger_handler(PG_FUNCTION_ARGS)
Datum plperl_call_handler(PG_FUNCTION_ARGS)
static SV ** hv_store_string(HV *hv, const char *key, SV *val)
static plperl_call_data * current_call_data
void plperl_util_elog(int level, SV *msg)
void plperl_spi_cursor_close(char *cursor)
static plperl_proc_desc * compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
static HeapTuple plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
static void plperl_return_next_internal(SV *sv)
struct plperl_proc_ptr plperl_proc_ptr
struct plperl_interp_desc plperl_interp_desc
static bool validate_plperl_function(plperl_proc_ptr *proc_ptr, HeapTuple procTup)
static void plperl_call_perl_event_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, SV *td)
static PerlInterpreter * plperl_init_interp(void)
static void array_to_datum_internal(AV *av, ArrayBuildState **astatep, int *ndims, int *dims, int cur_depth, Oid elemtypid, int32 typmod, FmgrInfo *finfo, Oid typioparam)
EXTERN_C void boot_PostgreSQL__InServer__SPI(pTHX_ CV *cv)
static char * plperl_on_plperlu_init
static Datum plperl_hash_to_datum(SV *src, TupleDesc td)
void plperl_spi_commit(void)
static void activate_interpreter(plperl_interp_desc *interp_desc)
static char * sv2cstr(SV *sv)
static void croak_cstr(const char *str)
static SV * cstr2sv(const char *str)
int pg_strcasecmp(const char *s1, const char *s2)
void PinPortal(Portal portal)
void UnpinPortal(Portal portal)
void FloatExceptionHandler(SIGNAL_ARGS)
static Datum PointerGetDatum(const void *X)
static Datum ObjectIdGetDatum(Oid X)
static char * DatumGetCString(Datum X)
static Pointer DatumGetPointer(Datum X)
static Datum CStringGetDatum(const char *X)
#define PERL_UNUSED_VAR(x)
Datum regtypein(PG_FUNCTION_ARGS)
ResourceOwner CurrentResourceOwner
int SPI_fnumber(TupleDesc tupdesc, const char *fname)
int SPI_freeplan(SPIPlanPtr plan)
const char * SPI_result_code_string(int code)
SPITupleTable * SPI_tuptable
Portal SPI_cursor_find(const char *name)
void SPI_cursor_fetch(Portal portal, bool forward, long count)
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)
Portal SPI_cursor_open(const char *name, SPIPlanPtr plan, Datum *Values, const char *Nulls, bool read_only)
SPIPlanPtr SPI_prepare(const char *src, int nargs, Oid *argtypes)
int SPI_keepplan(SPIPlanPtr plan)
void SPI_cursor_close(Portal portal)
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_ERROR_NOATTRIBUTE
void check_stack_depth(void)
struct ErrorContextCallback * previous
void(* callback)(void *arg)
MemoryContext ecxt_per_query_memory
NullableDatum args[FLEXIBLE_ARRAY_MEMBER]
SetFunctionReturnMode returnMode
Tuplestorestate * setResult
plperl_proc_desc * prodesc
Tuplestorestate * tuple_store
unsigned long fn_refcount
plperl_interp_desc * interp
plperl_proc_desc * proc_ptr
char query_name[NAMEDATALEN]
plperl_query_desc * query_data
void ReleaseSysCache(HeapTuple tuple)
HeapTuple SearchSysCache1(int cacheId, Datum key1)
Datum SysCacheGetAttr(int cacheId, HeapTuple tup, AttrNumber attributeNumber, bool *isNull)
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)
TupleDesc lookup_rowtype_tupdesc_domain(Oid type_id, int32 typmod, bool noError)
void BeginInternalSubTransaction(const char *name)
void RollbackAndReleaseCurrentSubTransaction(void)
void ReleaseCurrentSubTransaction(void)