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{

88 PerlInterpreter *interp;

91

92

93

94

95

96

97

98

99

100

101

103{

104 char *proname;

106 unsigned long fn_refcount;

109 SV *reference;

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

160 Oid user_id;

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)