PostgreSQL Source Code: src/pl/plperl/plperl.c File Reference (original) (raw)

#include "[postgres.h](postgres%5F8h%5Fsource.html)"
#include <ctype.h>
#include <fcntl.h>
#include <limits.h>
#include <[unistd.h](unistd%5F8h%5Fsource.html)>
#include "[access/htup_details.h](htup%5F%5Fdetails%5F8h%5Fsource.html)"
#include "[access/xact.h](xact%5F8h%5Fsource.html)"
#include "[catalog/pg_language.h](pg%5F%5Flanguage%5F8h%5Fsource.html)"
#include "[catalog/pg_proc.h](pg%5F%5Fproc%5F8h%5Fsource.html)"
#include "[catalog/pg_type.h](pg%5F%5Ftype%5F8h%5Fsource.html)"
#include "[commands/event_trigger.h](event%5F%5Ftrigger%5F8h%5Fsource.html)"
#include "[commands/trigger.h](trigger%5F8h%5Fsource.html)"
#include "[executor/spi.h](spi%5F8h%5Fsource.html)"
#include "[funcapi.h](funcapi%5F8h%5Fsource.html)"
#include "[miscadmin.h](miscadmin%5F8h%5Fsource.html)"
#include "[parser/parse_type.h](parse%5F%5Ftype%5F8h%5Fsource.html)"
#include "[storage/ipc.h](ipc%5F8h%5Fsource.html)"
#include "[tcop/tcopprot.h](tcopprot%5F8h%5Fsource.html)"
#include "[utils/builtins.h](builtins%5F8h%5Fsource.html)"
#include "utils/fmgroids.h"
#include "[utils/guc.h](guc%5F8h%5Fsource.html)"
#include "[utils/hsearch.h](hsearch%5F8h%5Fsource.html)"
#include "[utils/lsyscache.h](lsyscache%5F8h%5Fsource.html)"
#include "[utils/memutils.h](memutils%5F8h%5Fsource.html)"
#include "[utils/rel.h](rel%5F8h%5Fsource.html)"
#include "[utils/syscache.h](syscache%5F8h%5Fsource.html)"
#include "[utils/typcache.h](typcache%5F8h%5Fsource.html)"
#include "perlchunks.h"
#include "[plperl.h](plperl%5F8h%5Fsource.html)"
#include "plperl_opmask.h"

Go to the source code of this file.

◆ decrement_prodesc_refcount

| #define decrement_prodesc_refcount | ( | | prodesc | ) | | ------------------------------------ | - | | ------- | - |

Value:

do { \

Assert((prodesc)->fn_refcount > 0); \

if (--((prodesc)->fn_refcount) == 0) \

free_plperl_function(prodesc); \

} while(0)

Definition at line 131 of file plperl.c.

◆ increment_prodesc_refcount

| #define increment_prodesc_refcount | ( | | prodesc | ) | ((prodesc)->fn_refcount++) | | ------------------------------------ | - | | ------- | - | --------------------------- |

◆ setlocale_perl

| #define setlocale_perl | ( | | a, | | ------------------------------------------------------- | -------------------------------------------------------------------------------------------------------------------------- | | ----------------------------------------------------- | | | b | | | | | ) | Perl_setlocale(a,b) | | |

◆ TEXTDOMAIN

◆ plperl_array_info

◆ plperl_call_data

◆ plperl_interp_desc

◆ plperl_proc_desc

◆ plperl_proc_key

◆ plperl_proc_ptr

◆ plperl_query_desc

◆ plperl_query_entry

◆ _PG_init()

Definition at line 382 of file plperl.c.

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}

HTAB * hash_create(const char *tabname, long nelem, const HASHCTL *info, int flags)

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)

void pg_bindtextdomain(const char *domain)

static HTAB * plperl_interp_hash

static char plperl_opmask[MAXO]

static bool plperl_use_strict

struct plperl_proc_key plperl_proc_key

static HTAB * plperl_proc_hash

static PerlInterpreter * plperl_held_interp

static char * plperl_on_init

static char * plperl_on_plperl_init

struct plperl_proc_ptr plperl_proc_ptr

struct plperl_interp_desc plperl_interp_desc

static PerlInterpreter * plperl_init_interp(void)

static char * plperl_on_plperlu_init

References DefineCustomBoolVariable(), DefineCustomStringVariable(), HASHCTL::entrysize, gettext_noop, HASH_BLOBS, hash_create(), HASH_ELEM, HASHCTL::keysize, MarkGUCPrefixReserved(), pg_bindtextdomain(), PGC_SIGHUP, PGC_SUSET, PGC_USERSET, plperl_held_interp, plperl_init_interp(), plperl_interp_hash, plperl_on_init, plperl_on_plperl_init, plperl_on_plperlu_init, plperl_opmask, plperl_proc_hash, plperl_use_strict, and TEXTDOMAIN.

◆ _sv_to_datum_finfo()

◆ activate_interpreter()

Definition at line 686 of file plperl.c.

687{

689 {

691 PERL_SET_CONTEXT(interp_desc->interp);

692

695 }

696}

#define OidIsValid(objectId)

Assert(PointerIsAligned(start, uint64))

static void set_interp_require(bool trusted)

static plperl_interp_desc * plperl_active_interp

References Assert(), plperl_interp_desc::interp, OidIsValid, plperl_active_interp, set_interp_require(), and plperl_interp_desc::user_id.

Referenced by compile_plperl_function(), free_plperl_function(), plperl_call_handler(), plperl_event_trigger_handler(), plperl_fini(), plperl_func_handler(), plperl_inline_handler(), plperl_trigger_handler(), and select_perl_context().

◆ array_to_datum_internal()

Definition at line 1172 of file plperl.c.

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}

ArrayBuildState * accumArrayResult(ArrayBuildState *astate, Datum dvalue, bool disnull, Oid element_type, MemoryContext rcontext)

ArrayBuildState * initArrayResult(Oid element_type, MemoryContext rcontext, bool subcontext)

int errcode(int sqlerrcode)

int errmsg(const char *fmt,...)

#define ereport(elevel,...)

MemoryContext CurrentMemoryContext

static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod, FunctionCallInfo fcinfo, FmgrInfo *finfo, Oid typioparam, bool *isnull)

static SV * get_perl_array_ref(SV *sv)

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)

References accumArrayResult(), array_to_datum_internal(), av, CurrentMemoryContext, dTHX, ereport, errcode(), errmsg(), ERROR, get_perl_array_ref(), i, initArrayResult(), len, MAXDIM, and plperl_sv_to_datum().

Referenced by array_to_datum_internal(), and plperl_array_to_datum().

◆ boot_DynaLoader()

◆ boot_PostgreSQL__InServer__SPI()

◆ boot_PostgreSQL__InServer__Util()

◆ check_spi_usage_allowed()

Definition at line 3107 of file plperl.c.

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}

static bool plperl_ending

static plperl_call_data * current_call_data

plperl_proc_desc * prodesc

References current_call_data, plperl_ending, and plperl_call_data::prodesc.

Referenced by plperl_return_next(), plperl_spi_commit(), plperl_spi_cursor_close(), plperl_spi_exec(), plperl_spi_exec_prepared(), plperl_spi_execute_fetch_result(), plperl_spi_fetchrow(), plperl_spi_freeplan(), plperl_spi_prepare(), plperl_spi_query(), plperl_spi_query_prepared(), plperl_spi_rollback(), and plperl_sv_to_literal().

◆ compile_plperl_function()

Definition at line 2716 of file plperl.c.

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}

#define TextDatumGetCString(d)

void * hash_search(HTAB *hashp, const void *keyPtr, HASHACTION action, bool *foundPtr)

ErrorContextCallback * error_context_stack

void fmgr_info_cxt(Oid functionId, FmgrInfo *finfo, MemoryContext mcxt)

char * format_type_be(Oid type_oid)

#define HeapTupleIsValid(tuple)

static TransactionId HeapTupleHeaderGetRawXmin(const HeapTupleHeaderData *tup)

static void * GETSTRUCT(const HeapTupleData *tuple)

bool type_is_rowtype(Oid typid)

Oid getTypeIOParam(HeapTuple typeTuple)

char * pstrdup(const char *in)

void pfree(void *pointer)

void * palloc0(Size size)

MemoryContext TopMemoryContext

void MemoryContextDelete(MemoryContext context)

void MemoryContextSetIdentifier(MemoryContext context, const char *id)

#define AllocSetContextCreate

#define ALLOCSET_SMALL_SIZES

static MemoryContext MemoryContextSwitchTo(MemoryContext context)

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 void plperl_create_sub(plperl_proc_desc *desc, const char *s, Oid fn_oid)

#define increment_prodesc_refcount(prodesc)

static void free_plperl_function(plperl_proc_desc *prodesc)

static void select_perl_context(bool trusted)

static void plperl_compile_callback(void *arg)

static bool validate_plperl_function(plperl_proc_ptr *proc_ptr, HeapTuple procTup)

static void activate_interpreter(plperl_interp_desc *interp_desc)

static Datum ObjectIdGetDatum(Oid X)

struct ErrorContextCallback * previous

void(* callback)(void *arg)

unsigned long fn_refcount

plperl_interp_desc * interp

plperl_proc_desc * proc_ptr

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)

References activate_interpreter(), ALLOCSET_SMALL_SIZES, AllocSetContextCreate, ErrorContextCallback::arg, plperl_proc_desc::arg_arraytype, plperl_proc_desc::arg_is_rowtype, plperl_proc_desc::arg_out_func, ErrorContextCallback::callback, elog, ereport, errcode(), errmsg(), ERROR, error_context_stack, fmgr_info_cxt(), plperl_proc_desc::fn_cxt, plperl_proc_desc::fn_readonly, plperl_proc_desc::fn_refcount, plperl_proc_desc::fn_retisarray, plperl_proc_desc::fn_retisset, plperl_proc_desc::fn_retistuple, plperl_proc_desc::fn_tid, plperl_proc_desc::fn_xmin, format_type_be(), free_plperl_function(), GETSTRUCT(), getTypeIOParam(), GetUserId(), HASH_ENTER, HASH_FIND, hash_search(), HeapTupleHeaderGetRawXmin(), HeapTupleIsValid, i, increment_prodesc_refcount, plperl_proc_desc::interp, InvalidOid, plperl_proc_key::is_trigger, plperl_proc_desc::lang_oid, plperl_proc_desc::lanpltrusted, MemoryContextDelete(), MemoryContextSetIdentifier(), MemoryContextSwitchTo(), NameStr, plperl_proc_desc::nargs, NIL, ObjectIdGetDatum(), oid_array_to_list(), palloc0(), pfree(), PG_CATCH, PG_END_TRY, PG_RE_THROW, PG_TRY, plperl_active_interp, plperl_compile_callback(), plperl_create_sub(), plperl_proc_hash, ErrorContextCallback::previous, plperl_proc_key::proc_id, plperl_proc_ptr::proc_ptr, plperl_proc_desc::proname, pstrdup(), plperl_proc_desc::reference, ReleaseSysCache(), plperl_proc_desc::result_in_func, plperl_proc_desc::result_oid, plperl_proc_desc::result_typioparam, SearchSysCache1(), select_perl_context(), SysCacheGetAttr(), SysCacheGetAttrNotNull(), HeapTupleData::t_data, HeapTupleData::t_self, TextDatumGetCString, TopMemoryContext, plperl_proc_desc::trftypes, type_is_rowtype(), plperl_proc_key::user_id, and validate_plperl_function().

Referenced by plperl_event_trigger_handler(), plperl_func_handler(), plperl_trigger_handler(), and plperl_validator().

◆ free_plperl_function()

◆ get_perl_array_ref()

Definition at line 1140 of file plperl.c.

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}

static SV ** hv_fetch_string(HV *hv, const char *key)

References dTHX, elog, ERROR, and hv_fetch_string().

Referenced by array_to_datum_internal(), plperl_func_handler(), and plperl_sv_to_datum().

◆ hek2cstr()

Definition at line 325 of file plperl.c.

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}

static char * sv2cstr(SV *sv)

References dTHX, HeUTF8, and sv2cstr().

Referenced by plperl_build_tuple_result(), and plperl_modify_tuple().

◆ hv_fetch_string()

Definition at line 4121 of file plperl.c.

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}

char * pg_server_to_any(const char *s, int len, int encoding)

References dTHX, sort-test::key, pfree(), pg_server_to_any(), and PG_UTF8.

Referenced by get_perl_array_ref(), plperl_modify_tuple(), and plperl_spi_exec_prepared().

◆ hv_store_string()

Definition at line 4094 of file plperl.c.

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}

References dTHX, sort-test::key, pfree(), pg_server_to_any(), PG_UTF8, and val.

Referenced by plperl_create_sub(), plperl_event_trigger_build_args(), plperl_hash_from_tuple(), plperl_spi_execute_fetch_result(), and plperl_trigger_build_args().

◆ make_array_ref()

Definition at line 1595 of file plperl.c.

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}

char * OutputFunctionCall(FmgrInfo *flinfo, Datum val)

#define FunctionCall1(flinfo, arg1)

static SV * plperl_hash_from_datum(Datum attr)

static SV * cstr2sv(const char *str)

static Pointer DatumGetPointer(Datum X)

References cstr2sv(), DatumGetPointer(), dTHX, plperl_array_info::elem_is_rowtype, plperl_array_info::elements, FmgrInfo::fn_oid, FunctionCall1, i, newRV_noinc, plperl_array_info::nulls, OutputFunctionCall(), plperl_hash_from_datum(), plperl_array_info::proc, plperl_array_info::transform_proc, and val.

Referenced by split_array().

◆ PG_FUNCTION_INFO_V1() [1/6]

◆ PG_FUNCTION_INFO_V1() [2/6]

◆ PG_FUNCTION_INFO_V1() [3/6]

◆ PG_FUNCTION_INFO_V1() [4/6]

◆ PG_FUNCTION_INFO_V1() [5/6]

◆ PG_FUNCTION_INFO_V1() [6/6]

◆ PG_MODULE_MAGIC_EXT()

◆ plperl_array_to_datum()

Definition at line 1259 of file plperl.c.

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}

ArrayType * construct_empty_array(Oid elmtype)

Datum makeMdArrayResult(ArrayBuildState *astate, int ndims, int *dims, int *lbs, MemoryContext rcontext, bool release)

Oid get_element_type(Oid typid)

static void _sv_to_datum_finfo(Oid typid, FmgrInfo *finfo, Oid *typioparam)

static Datum PointerGetDatum(const void *X)

References _sv_to_datum_finfo(), array_to_datum_internal(), construct_empty_array(), CurrentMemoryContext, dTHX, ereport, errcode(), errmsg(), ERROR, format_type_be(), get_element_type(), i, makeMdArrayResult(), MAXDIM, and PointerGetDatum().

Referenced by plperl_sv_to_datum().

◆ plperl_build_tuple_result()

Definition at line 1077 of file plperl.c.

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}

static Datum values[MAXATTR]

HeapTuple heap_form_tuple(TupleDesc tupleDescriptor, const Datum *values, const bool *isnull)

FormData_pg_attribute * Form_pg_attribute

static char * hek2cstr(HE *he)

int SPI_fnumber(TupleDesc tupdesc, const char *fname)

#define SPI_ERROR_NOATTRIBUTE

static FormData_pg_attribute * TupleDescAttr(TupleDesc tupdesc, int i)

References dTHX, ereport, errcode(), errmsg(), ERROR, heap_form_tuple(), hek2cstr(), InvalidOid, sort-test::key, TupleDescData::natts, palloc(), palloc0(), pfree(), plperl_sv_to_datum(), SPI_ERROR_NOATTRIBUTE, SPI_fnumber(), TupleDescAttr(), val, and values.

Referenced by plperl_hash_to_datum(), and plperl_return_next_internal().

◆ plperl_call_handler()

Definition at line 1854 of file plperl.c.

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}

#define MemSet(start, val, len)

#define CALLED_AS_EVENT_TRIGGER(fcinfo)

static void plperl_event_trigger_handler(PG_FUNCTION_ARGS)

static Datum plperl_func_handler(PG_FUNCTION_ARGS)

#define decrement_prodesc_refcount(prodesc)

static Datum plperl_trigger_handler(PG_FUNCTION_ARGS)

#define CALLED_AS_TRIGGER(fcinfo)

References activate_interpreter(), CALLED_AS_EVENT_TRIGGER, CALLED_AS_TRIGGER, current_call_data, decrement_prodesc_refcount, plperl_call_data::fcinfo, MemSet, PG_END_TRY, PG_FINALLY, PG_TRY, plperl_active_interp, plperl_event_trigger_handler(), plperl_func_handler(), plperl_trigger_handler(), and plperl_call_data::prodesc.

Referenced by plperlu_call_handler().

◆ plperl_call_perl_event_trigger_func()

Definition at line 2342 of file plperl.c.

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}

static char * strip_trailing_ws(const char *msg)

References call_sv, dTHX, ereport, errcode(), errmsg(), ERROR, ERRSV, get_sv, plperl_proc_desc::reference, strip_trailing_ws(), and sv2cstr().

Referenced by plperl_event_trigger_handler().

◆ plperl_call_perl_func()

Definition at line 2181 of file plperl.c.

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}

#define OidFunctionCall1(functionId, arg1)

Oid get_func_signature(Oid funcid, Oid **argtypes, int *nargs)

Oid get_transform_fromsql(Oid typid, Oid langid, List *trftypes)

static SV * plperl_ref_from_pg_array(Datum arg, Oid typid)

NullableDatum args[FLEXIBLE_ARRAY_MEMBER]

References plperl_proc_desc::arg_arraytype, plperl_proc_desc::arg_is_rowtype, plperl_proc_desc::arg_out_func, FunctionCallInfoBaseData::args, Assert(), call_sv, cstr2sv(), current_call_data, DatumGetPointer(), dTHX, ereport, errcode(), errmsg(), ERROR, ERRSV, FunctionCallInfoBaseData::flinfo, FmgrInfo::fn_oid, get_func_signature(), get_transform_fromsql(), i, NullableDatum::isnull, plperl_proc_desc::lang_oid, plperl_proc_desc::nargs, OidFunctionCall1, OidIsValid, OutputFunctionCall(), pfree(), PL_sv_undef, plperl_hash_from_datum(), plperl_ref_from_pg_array(), plperl_call_data::prodesc, plperl_proc_desc::reference, strip_trailing_ws(), sv2cstr(), plperl_proc_desc::trftypes, and NullableDatum::value.

Referenced by plperl_func_handler(), and plperl_inline_handler().

◆ plperl_call_perl_trigger_func()

Definition at line 2274 of file plperl.c.

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}

References call_sv, FunctionCallInfoBaseData::context, cstr2sv(), dTHX, ereport, errcode(), errmsg(), ERROR, ERRSV, get_sv, i, plperl_proc_desc::reference, strip_trailing_ws(), sv2cstr(), Trigger::tgargs, and Trigger::tgnargs.

Referenced by plperl_trigger_handler().

◆ plperl_compile_callback()

◆ plperl_create_sub()

Definition at line 2096 of file plperl.c.

2097{

2099 dSP;

2101 HV *pragma_hv = newHV();

2102 SV *subref = NULL;

2103 int count;

2104

2105 sprintf(subname, "%s__%u", prodesc->proname, fn_oid);

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\"",

2158 prodesc->proname)));

2159

2160 prodesc->reference = subref;

2161}

static SV ** hv_store_string(HV *hv, const char *key, SV *val)

References call_pv, cstr2sv(), dTHX, ereport, errcode(), errmsg(), ERROR, ERRSV, hv_store_string(), NAMEDATALEN, newRV_inc, newRV_noinc, PL_sv_no, plperl_use_strict, plperl_proc_desc::proname, plperl_proc_desc::reference, sprintf, strip_trailing_ws(), subname, and sv2cstr().

Referenced by compile_plperl_function(), and plperl_inline_handler().

◆ plperl_destroy_interp()

Definition at line 920 of file plperl.c.

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}

#define PERL_UNUSED_VAR(x)

References dTHX, PERL_UNUSED_VAR, and x.

Referenced by plperl_fini().

◆ plperl_event_trigger_build_args()

◆ plperl_event_trigger_handler()

Definition at line 2633 of file plperl.c.

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}

static SV * plperl_event_trigger_build_args(FunctionCallInfo fcinfo)

static void plperl_exec_callback(void *arg)

static plperl_proc_desc * compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)

static void plperl_call_perl_event_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, SV *td)

References activate_interpreter(), ErrorContextCallback::arg, ErrorContextCallback::callback, compile_plperl_function(), current_call_data, elog, ERROR, error_context_stack, increment_prodesc_refcount, plperl_proc_desc::interp, plperl_call_perl_event_trigger_func(), plperl_event_trigger_build_args(), plperl_exec_callback(), ErrorContextCallback::previous, plperl_call_data::prodesc, plperl_proc_desc::proname, SPI_connect(), SPI_finish(), SPI_OK_FINISH, and SvREFCNT_dec_current().

Referenced by plperl_call_handler().

◆ plperl_exec_callback()

◆ plperl_fini()

Definition at line 511 of file plperl.c.

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}

void * hash_seq_search(HASH_SEQ_STATUS *status)

void hash_seq_init(HASH_SEQ_STATUS *status, HTAB *hashp)

static void plperl_destroy_interp(PerlInterpreter **)

References activate_interpreter(), DEBUG3, elog, hash_seq_init(), hash_seq_search(), plperl_interp_desc::interp, plperl_destroy_interp(), plperl_ending, plperl_held_interp, and plperl_interp_hash.

Referenced by select_perl_context().

◆ plperl_func_handler()

Definition at line 2403 of file plperl.c.

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}

if(TABLE==NULL||TABLE_index==NULL)

#define IsA(nodeptr, _type_)

#define castNode(_type_, nodeptr)

static SV * plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)

static void plperl_return_next_internal(SV *sv)

int SPI_connect_ext(int options)

#define SPI_OPT_NONATOMIC

SetFunctionReturnMode returnMode

Tuplestorestate * setResult

Tuplestorestate * tuple_store

References activate_interpreter(), ReturnSetInfo::allowedModes, ErrorContextCallback::arg, ErrorContextCallback::callback, castNode, compile_plperl_function(), current_call_data, dTHX, elog, ereport, errcode(), errmsg(), ERROR, error_context_stack, ExprEndResult, plperl_proc_desc::fn_retisset, get_perl_array_ref(), i, if(), increment_prodesc_refcount, plperl_proc_desc::interp, IsA, ReturnSetInfo::isDone, plperl_call_perl_func(), plperl_exec_callback(), plperl_return_next_internal(), plperl_sv_to_datum(), ErrorContextCallback::previous, plperl_call_data::prodesc, plperl_proc_desc::proname, plperl_proc_desc::result_in_func, plperl_proc_desc::result_oid, plperl_proc_desc::result_typioparam, plperl_call_data::ret_tdesc, ReturnSetInfo::returnMode, ReturnSetInfo::setDesc, ReturnSetInfo::setResult, SFRM_Materialize, SPI_connect_ext(), SPI_finish(), SPI_OK_FINISH, SPI_OPT_NONATOMIC, SvREFCNT_dec_current(), and plperl_call_data::tuple_store.

Referenced by plperl_call_handler().

◆ plperl_hash_from_datum()

Definition at line 2996 of file plperl.c.

2997{

2999 Oid tupType;

3000 int32 tupTypmod;

3003 SV *sv;

3004

3006

3007

3011

3012

3015

3018

3019 return sv;

3020}

#define DatumGetHeapTupleHeader(X)

static int32 HeapTupleHeaderGetTypMod(const HeapTupleHeaderData *tup)

static uint32 HeapTupleHeaderGetDatumLength(const HeapTupleHeaderData *tup)

static Oid HeapTupleHeaderGetTypeId(const HeapTupleHeaderData *tup)

static SV * plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc, bool include_generated)

#define ReleaseTupleDesc(tupdesc)

TupleDesc lookup_rowtype_tupdesc(Oid type_id, int32 typmod)

References DatumGetHeapTupleHeader, HeapTupleHeaderGetDatumLength(), HeapTupleHeaderGetTypeId(), HeapTupleHeaderGetTypMod(), lookup_rowtype_tupdesc(), plperl_hash_from_tuple(), ReleaseTupleDesc, HeapTupleData::t_data, and HeapTupleData::t_len.

Referenced by make_array_ref(), plperl_call_perl_func(), and plperl_hash_from_tuple().

◆ plperl_hash_from_tuple()

Definition at line 3024 of file plperl.c.

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}

char * OidOutputFunctionCall(Oid functionId, Datum val)

static Datum heap_getattr(HeapTuple tup, int attnum, TupleDesc tupleDesc, bool *isnull)

void getTypeOutputInfo(Oid type, Oid *typOutput, bool *typIsVarlena)

Oid get_base_element_type(Oid typid)

void check_stack_depth(void)

References attname, check_stack_depth(), cstr2sv(), current_call_data, DatumGetPointer(), dTHX, get_base_element_type(), get_transform_fromsql(), getTypeOutputInfo(), heap_getattr(), hv_store_string(), i, plperl_proc_desc::lang_oid, NameStr, TupleDescData::natts, newRV_noinc, OidFunctionCall1, OidIsValid, OidOutputFunctionCall(), pfree(), plperl_hash_from_datum(), plperl_ref_from_pg_array(), plperl_call_data::prodesc, plperl_proc_desc::trftypes, TupleDescAttr(), and type_is_rowtype().

Referenced by plperl_hash_from_datum(), plperl_spi_execute_fetch_result(), plperl_spi_fetchrow(), and plperl_trigger_build_args().

◆ plperl_hash_to_datum()

◆ plperl_init_interp()

Definition at line 707 of file plperl.c.

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}

static OP *(* pp_require_orig)(pTHX)

static void plperl_init_shared_libs(pTHX)

void FloatExceptionHandler(SIGNAL_ARGS)

References dTHX, elog, ereport, errcode(), errcontext, errmsg(), ERROR, ERRSV, FloatExceptionHandler(), PL_ppaddr, plperl_init_shared_libs(), plperl_on_init, plperl_opmask, pp_require_orig, pqsignal, pstrdup(), setlocale, strip_trailing_ws(), and sv2cstr().

Referenced by _PG_init(), and select_perl_context().

◆ plperl_init_shared_libs()

◆ plperl_inline_callback()

◆ plperl_inline_handler()

Definition at line 1896 of file plperl.c.

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}

#define PG_GETARG_POINTER(n)

#define SizeForFunctionCallInfo(nargs)

#define LOCAL_FCINFO(name, nargs)

static void plperl_inline_callback(void *arg)

References activate_interpreter(), ErrorContextCallback::arg, InlineCodeBlock::atomic, ErrorContextCallback::callback, current_call_data, CurrentMemoryContext, elog, ERROR, error_context_stack, plperl_call_data::fcinfo, FmgrInfo::fn_mcxt, FmgrInfo::fn_oid, plperl_proc_desc::fn_readonly, plperl_proc_desc::fn_retisarray, plperl_proc_desc::fn_retisset, plperl_proc_desc::fn_retistuple, InvalidOid, plperl_proc_desc::lang_oid, InlineCodeBlock::langIsTrusted, InlineCodeBlock::langOid, plperl_proc_desc::lanpltrusted, LOCAL_FCINFO, MemSet, plperl_proc_desc::nargs, NIL, PG_END_TRY, PG_FINALLY, PG_GETARG_POINTER, PG_RETURN_VOID, PG_TRY, plperl_active_interp, plperl_call_perl_func(), plperl_create_sub(), plperl_inline_callback(), ErrorContextCallback::previous, plperl_call_data::prodesc, plperl_proc_desc::proname, plperl_proc_desc::reference, plperl_proc_desc::result_oid, select_perl_context(), SizeForFunctionCallInfo, InlineCodeBlock::source_text, SPI_connect_ext(), SPI_finish(), SPI_OK_FINISH, SPI_OPT_NONATOMIC, SvREFCNT_dec_current(), and plperl_proc_desc::trftypes.

Referenced by plperlu_inline_handler().

◆ plperl_modify_tuple()

Definition at line 1764 of file plperl.c.

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}

HeapTuple heap_modify_tuple(HeapTuple tuple, TupleDesc tupleDesc, const Datum *replValues, const bool *replIsnull, const bool *doReplace)

References dTHX, ereport, errcode(), errmsg(), ERROR, heap_modify_tuple(), hek2cstr(), hv_fetch_string(), InvalidOid, sort-test::key, TupleDescData::natts, palloc0(), pfree(), plperl_sv_to_datum(), RelationData::rd_att, SPI_ERROR_NOATTRIBUTE, SPI_fnumber(), TriggerData::tg_relation, TupleDescAttr(), and val.

Referenced by plperl_trigger_handler().

◆ plperl_ref_from_pg_array()

Definition at line 1482 of file plperl.c.

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}

#define DatumGetArrayTypeP(X)

void deconstruct_array(ArrayType *array, Oid elmtype, int elmlen, bool elmbyval, char elmalign, Datum **elemsp, bool **nullsp, int *nelemsp)

void get_type_io_data(Oid typid, IOFuncSelector which_func, int16 *typlen, bool *typbyval, char *typalign, char *typdelim, Oid *typioparam, Oid *func)

static SV * split_array(plperl_array_info *info, int first, int last, int nest)

References arg, ARR_DIMS, ARR_ELEMTYPE, ARR_NDIM, av, current_call_data, DatumGetArrayTypeP, deconstruct_array(), dTHX, plperl_array_info::elem_is_rowtype, plperl_array_info::elements, fmgr_info(), get_transform_fromsql(), get_type_io_data(), i, IOFunc_output, plperl_proc_desc::lang_oid, plperl_array_info::ndims, plperl_array_info::nelems, newRV_noinc, newSVuv, nitems, plperl_array_info::nulls, OidIsValid, palloc(), palloc0(), plperl_array_info::proc, plperl_call_data::prodesc, split_array(), plperl_array_info::transform_proc, plperl_proc_desc::trftypes, typalign, and type_is_rowtype().

Referenced by plperl_call_perl_func(), and plperl_hash_from_tuple().

◆ plperl_return_next()

Definition at line 3246 of file plperl.c.

3247{

3249

3251

3253 {

3255 }

3257 {

3259

3260

3264

3265

3267 }

3269}

ErrorData * CopyErrorData(void)

void FlushErrorState(void)

static void check_spi_usage_allowed(void)

static void croak_cstr(const char *str)

References check_spi_usage_allowed(), CopyErrorData(), croak_cstr(), CurrentMemoryContext, FlushErrorState(), MemoryContextSwitchTo(), ErrorData::message, PG_CATCH, PG_END_TRY, PG_TRY, and plperl_return_next_internal().

◆ plperl_return_next_internal()

Definition at line 3276 of file plperl.c.

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}

void domain_check(Datum value, bool isnull, Oid domainType, void **extra, MemoryContext mcxt)

@ SFRM_Materialize_Random

TypeFuncClass get_call_result_type(FunctionCallInfo fcinfo, Oid *resultTypeId, TupleDesc *resultTupleDesc)

@ TYPEFUNC_COMPOSITE_DOMAIN

void MemoryContextReset(MemoryContext context)

#define ALLOCSET_DEFAULT_SIZES

MemoryContext ecxt_per_query_memory

TupleDesc CreateTupleDescCopy(TupleDesc tupdesc)

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)

References ALLOCSET_DEFAULT_SIZES, AllocSetContextCreate, ReturnSetInfo::allowedModes, Assert(), plperl_call_data::cdomain_info, plperl_call_data::cdomain_oid, CreateTupleDescCopy(), current_call_data, CurrentMemoryContext, domain_check(), ReturnSetInfo::econtext, ExprContext::ecxt_per_query_memory, elog, ereport, errcode(), errmsg(), ERROR, ReturnSetInfo::expectedDesc, plperl_call_data::fcinfo, plperl_proc_desc::fn_retisset, plperl_proc_desc::fn_retistuple, get_call_result_type(), HeapTupleGetDatum(), if(), MemoryContextReset(), MemoryContextSwitchTo(), TupleDescData::natts, OidIsValid, plperl_build_tuple_result(), plperl_sv_to_datum(), plperl_call_data::prodesc, plperl_proc_desc::result_in_func, plperl_proc_desc::result_oid, plperl_proc_desc::result_typioparam, FunctionCallInfoBaseData::resultinfo, plperl_call_data::ret_tdesc, SFRM_Materialize_Random, plperl_call_data::tmp_cxt, plperl_call_data::tuple_store, tuplestore_begin_heap(), tuplestore_puttuple(), tuplestore_putvalues(), TYPEFUNC_COMPOSITE, TYPEFUNC_COMPOSITE_DOMAIN, and work_mem.

Referenced by plperl_func_handler(), and plperl_return_next().

◆ plperl_spi_commit()

Definition at line 3992 of file plperl.c.

3993{

3995

3997

3999 {

4001 }

4003 {

4005

4006

4010

4011

4013 }

4015}

References check_spi_usage_allowed(), CopyErrorData(), croak_cstr(), CurrentMemoryContext, FlushErrorState(), MemoryContextSwitchTo(), ErrorData::message, PG_CATCH, PG_END_TRY, PG_TRY, and SPI_commit().

◆ plperl_spi_cursor_close()

◆ plperl_spi_exec()

Definition at line 3134 of file plperl.c.

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}

bool pg_verifymbstr(const char *mbstr, int len, bool noError)

static HV * plperl_spi_execute_fetch_result(SPITupleTable *, uint64, int)

ResourceOwner CurrentResourceOwner

SPITupleTable * SPI_tuptable

int SPI_execute(const char *src, bool read_only, long tcount)

void BeginInternalSubTransaction(const char *name)

void RollbackAndReleaseCurrentSubTransaction(void)

void ReleaseCurrentSubTransaction(void)

References BeginInternalSubTransaction(), check_spi_usage_allowed(), CopyErrorData(), croak_cstr(), current_call_data, CurrentMemoryContext, CurrentResourceOwner, FlushErrorState(), plperl_proc_desc::fn_readonly, MemoryContextSwitchTo(), ErrorData::message, PG_CATCH, PG_END_TRY, PG_TRY, pg_verifymbstr(), plperl_spi_execute_fetch_result(), plperl_call_data::prodesc, ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), SPI_execute(), SPI_processed, and SPI_tuptable.

◆ plperl_spi_exec_prepared()

Definition at line 3716 of file plperl.c.

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}

int SPI_execute_plan(SPIPlanPtr plan, Datum *Values, const char *Nulls, bool read_only, long tcount)

plperl_query_desc * query_data

References plperl_query_desc::arginfuncs, plperl_query_desc::argtypes, plperl_query_desc::argtypioparams, BeginInternalSubTransaction(), check_spi_usage_allowed(), CopyErrorData(), croak_cstr(), current_call_data, CurrentMemoryContext, CurrentResourceOwner, dTHX, elog, ERROR, FlushErrorState(), plperl_proc_desc::fn_readonly, HASH_FIND, hash_search(), hv_fetch_string(), i, MemoryContextSwitchTo(), ErrorData::message, plperl_query_desc::nargs, palloc(), pfree(), PG_CATCH, PG_END_TRY, PG_TRY, plperl_query_desc::plan, plperl_active_interp, plperl_spi_execute_fetch_result(), plperl_sv_to_datum(), plperl_call_data::prodesc, plperl_query_entry::query_data, plperl_interp_desc::query_hash, ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), SPI_execute_plan(), SPI_processed, and SPI_tuptable.

◆ plperl_spi_execute_fetch_result()

Definition at line 3194 of file plperl.c.

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}

const char * SPI_result_code_string(int code)

void SPI_freetuptable(SPITupleTable *tuptable)

References AV_SIZE_MAX, check_spi_usage_allowed(), cstr2sv(), dTHX, ereport, errcode(), errmsg(), ERROR, hv_store_string(), i, newRV_noinc, newSVuv, plperl_hash_from_tuple(), SPI_freetuptable(), SPI_result_code_string(), SPITupleTable::tupdesc, UV_MAX, and SPITupleTable::vals.

Referenced by plperl_spi_exec(), and plperl_spi_exec_prepared().

◆ plperl_spi_fetchrow()

Definition at line 3477 of file plperl.c.

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}

void SPI_cursor_fetch(Portal portal, bool forward, long count)

References BeginInternalSubTransaction(), check_spi_usage_allowed(), CopyErrorData(), croak_cstr(), CurrentMemoryContext, CurrentResourceOwner, dTHX, FlushErrorState(), MemoryContextSwitchTo(), ErrorData::message, PG_CATCH, PG_END_TRY, PG_TRY, PL_sv_undef, plperl_hash_from_tuple(), ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), SPI_cursor_close(), SPI_cursor_fetch(), SPI_cursor_find(), SPI_freetuptable(), SPI_processed, SPI_tuptable, SPITupleTable::tupdesc, UnpinPortal(), and SPITupleTable::vals.

◆ plperl_spi_freeplan()

Definition at line 3961 of file plperl.c.

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}

int SPI_freeplan(SPIPlanPtr plan)

References check_spi_usage_allowed(), elog, ERROR, HASH_FIND, HASH_REMOVE, hash_search(), MemoryContextDelete(), plperl_query_desc::plan, plan, plperl_query_desc::plan_cxt, plperl_active_interp, plperl_query_entry::query_data, plperl_interp_desc::query_hash, and SPI_freeplan().

◆ plperl_spi_prepare()

Definition at line 3568 of file plperl.c.

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}

#define CHECK_FOR_INTERRUPTS()

bool parseTypeString(const char *str, Oid *typeid_p, int32 *typmod_p, Node *escontext)

SPIPlanPtr SPI_prepare(const char *src, int nargs, Oid *argtypes)

int SPI_keepplan(SPIPlanPtr plan)

References ALLOCSET_DEFAULT_SIZES, ALLOCSET_SMALL_SIZES, AllocSetContextCreate, plperl_query_desc::arginfuncs, plperl_query_desc::argtypes, plperl_query_desc::argtypioparams, BeginInternalSubTransaction(), CHECK_FOR_INTERRUPTS, check_spi_usage_allowed(), CopyErrorData(), croak_cstr(), cstr2sv(), CurrentMemoryContext, CurrentResourceOwner, elog, ERROR, FlushErrorState(), fmgr_info_cxt(), getTypeInputInfo(), HASH_ENTER, HASH_REMOVE, hash_search(), i, MemoryContextDelete(), MemoryContextSwitchTo(), ErrorData::message, plperl_query_desc::nargs, palloc(), palloc0(), parseTypeString(), pfree(), PG_CATCH, PG_END_TRY, PG_TRY, pg_verifymbstr(), plperl_query_desc::plan, plan, plperl_query_desc::plan_cxt, plperl_active_interp, plperl_query_desc::qname, plperl_query_entry::query_data, plperl_interp_desc::query_hash, ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), snprintf, SPI_freeplan(), SPI_keepplan(), SPI_prepare(), SPI_result, SPI_result_code_string(), sv2cstr(), and TopMemoryContext.

◆ plperl_spi_query()

Definition at line 3405 of file plperl.c.

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}

void PinPortal(Portal portal)

Portal SPI_cursor_open(const char *name, SPIPlanPtr plan, Datum *Values, const char *Nulls, bool read_only)

References BeginInternalSubTransaction(), check_spi_usage_allowed(), CopyErrorData(), croak_cstr(), cstr2sv(), CurrentMemoryContext, CurrentResourceOwner, elog, ERROR, FlushErrorState(), MemoryContextSwitchTo(), ErrorData::message, PortalData::name, PG_CATCH, PG_END_TRY, PG_TRY, pg_verifymbstr(), PinPortal(), plan, ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), SPI_cursor_open(), SPI_freeplan(), SPI_prepare(), SPI_result, and SPI_result_code_string().

◆ plperl_spi_query_prepared()

Definition at line 3843 of file plperl.c.

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}

References plperl_query_desc::arginfuncs, plperl_query_desc::argtypes, plperl_query_desc::argtypioparams, BeginInternalSubTransaction(), check_spi_usage_allowed(), CopyErrorData(), croak_cstr(), cstr2sv(), current_call_data, CurrentMemoryContext, CurrentResourceOwner, elog, ERROR, FlushErrorState(), plperl_proc_desc::fn_readonly, HASH_FIND, hash_search(), i, MemoryContextSwitchTo(), ErrorData::message, PortalData::name, plperl_query_desc::nargs, palloc(), pfree(), PG_CATCH, PG_END_TRY, PG_TRY, PinPortal(), plperl_query_desc::plan, plperl_active_interp, plperl_sv_to_datum(), plperl_call_data::prodesc, plperl_query_entry::query_data, plperl_interp_desc::query_hash, ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), SPI_cursor_open(), SPI_result, and SPI_result_code_string().

◆ plperl_spi_rollback()

Definition at line 4018 of file plperl.c.

4019{

4021

4023

4025 {

4027 }

4029 {

4031

4032

4036

4037

4039 }

4041}

References check_spi_usage_allowed(), CopyErrorData(), croak_cstr(), CurrentMemoryContext, FlushErrorState(), MemoryContextSwitchTo(), ErrorData::message, PG_CATCH, PG_END_TRY, PG_TRY, and SPI_rollback().

◆ plperl_sv_to_datum()

Definition at line 1325 of file plperl.c.

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}

Datum InputFunctionCall(FmgrInfo *flinfo, char *str, Oid typioparam, int32 typmod)

Oid get_transform_tosql(Oid typid, Oid langid, List *trftypes)

static Datum plperl_array_to_datum(SV *src, Oid typid, int32 typmod)

static Datum plperl_hash_to_datum(SV *src, TupleDesc td)

TupleDesc lookup_rowtype_tupdesc_domain(Oid type_id, int32 typmod, bool noError)

References _sv_to_datum_finfo(), Assert(), check_stack_depth(), current_call_data, domain_check(), ereport, errcode(), errmsg(), ERROR, format_type_be(), get_call_result_type(), get_perl_array_ref(), get_transform_tosql(), InputFunctionCall(), plperl_proc_desc::lang_oid, lookup_rowtype_tupdesc_domain(), OidFunctionCall1, pfree(), plperl_array_to_datum(), plperl_hash_to_datum(), plperl_sv_to_datum(), PointerGetDatum(), plperl_call_data::prodesc, ReleaseTupleDesc, str, sv2cstr(), TupleDescData::tdtypeid, plperl_proc_desc::trftypes, type_is_rowtype(), TYPEFUNC_COMPOSITE, TYPEFUNC_COMPOSITE_DOMAIN, and TYPEFUNC_OTHER.

Referenced by array_to_datum_internal(), plperl_build_tuple_result(), plperl_func_handler(), plperl_modify_tuple(), plperl_return_next_internal(), plperl_spi_exec_prepared(), plperl_spi_query_prepared(), plperl_sv_to_datum(), and plperl_sv_to_literal().

◆ plperl_sv_to_literal()

Definition at line 1446 of file plperl.c.

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}

#define DirectFunctionCall1(func, arg1)

static Datum CStringGetDatum(const char *X)

Datum regtypein(PG_FUNCTION_ARGS)

References check_spi_usage_allowed(), CStringGetDatum(), DirectFunctionCall1, ereport, errcode(), errmsg(), ERROR, getTypeOutputInfo(), InvalidOid, OidIsValid, OidOutputFunctionCall(), plperl_sv_to_datum(), and regtypein().

◆ plperl_trigger_build_args()

Definition at line 1633 of file plperl.c.

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}

Datum oidout(PG_FUNCTION_ARGS)

static char * DatumGetCString(Datum X)

char * SPI_getnspname(Relation rel)

char * SPI_getrelname(Relation rel)

#define TRIGGER_FIRED_FOR_STATEMENT(event)

#define TRIGGER_FIRED_BY_DELETE(event)

#define TRIGGER_FIRED_BEFORE(event)

#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)

References av, FunctionCallInfoBaseData::context, cstr2sv(), DatumGetCString(), DirectFunctionCall1, dTHX, hv_store_string(), i, newRV_noinc, ObjectIdGetDatum(), oidout(), plperl_hash_from_tuple(), RelationData::rd_att, RelationData::rd_id, SPI_getnspname(), SPI_getrelname(), TriggerData::tg_event, TriggerData::tg_newtuple, TriggerData::tg_relation, TriggerData::tg_trigger, TriggerData::tg_trigtuple, Trigger::tgargs, Trigger::tgname, Trigger::tgnargs, TRIGGER_FIRED_AFTER, TRIGGER_FIRED_BEFORE, TRIGGER_FIRED_BY_DELETE, TRIGGER_FIRED_BY_INSERT, TRIGGER_FIRED_BY_TRUNCATE, TRIGGER_FIRED_BY_UPDATE, TRIGGER_FIRED_FOR_ROW, TRIGGER_FIRED_FOR_STATEMENT, and TRIGGER_FIRED_INSTEAD.

Referenced by plperl_trigger_handler().

◆ plperl_trigger_handler()

Definition at line 2521 of file plperl.c.

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}

#define PG_USED_FOR_ASSERTS_ONLY

static SV * plperl_trigger_build_args(FunctionCallInfo fcinfo)

static SV * plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, SV *td)

static HeapTuple plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)

int pg_strcasecmp(const char *s1, const char *s2)

int SPI_register_trigger_data(TriggerData *tdata)

References activate_interpreter(), ErrorContextCallback::arg, Assert(), ErrorContextCallback::callback, compile_plperl_function(), current_call_data, elog, ereport, errcode(), errmsg(), ERROR, error_context_stack, if(), increment_prodesc_refcount, plperl_proc_desc::interp, pfree(), pg_strcasecmp(), PG_USED_FOR_ASSERTS_ONLY, plperl_call_perl_trigger_func(), plperl_exec_callback(), plperl_modify_tuple(), plperl_trigger_build_args(), PointerGetDatum(), ErrorContextCallback::previous, plperl_call_data::prodesc, plperl_proc_desc::proname, SPI_connect(), SPI_finish(), SPI_OK_FINISH, SPI_register_trigger_data(), sv2cstr(), SvREFCNT_dec_current(), TriggerData::tg_event, TriggerData::tg_newtuple, TriggerData::tg_trigtuple, TRIGGER_FIRED_BY_DELETE, TRIGGER_FIRED_BY_INSERT, TRIGGER_FIRED_BY_TRUNCATE, TRIGGER_FIRED_BY_UPDATE, and WARNING.

Referenced by plperl_call_handler().

◆ plperl_trusted_init()

Definition at line 959 of file plperl.c.

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}

static OP * pp_require_safe(pTHX)

References dTHX, ereport, errcode(), errcontext, errmsg(), ERROR, ERRSV, GvCV_set, isGV_with_GP, sort-test::key, PL_ppaddr, plperl_on_plperl_init, plperl_opmask, pp_require_orig, pp_require_safe(), strip_trailing_ws(), and sv2cstr().

Referenced by select_perl_context().

◆ plperl_untrusted_init()

Definition at line 1040 of file plperl.c.

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}

References dTHX, ereport, errcode(), errcontext, errmsg(), ERROR, ERRSV, plperl_on_plperlu_init, strip_trailing_ws(), and sv2cstr().

Referenced by select_perl_context().

◆ plperl_util_elog()

Definition at line 4055 of file plperl.c.

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}

References CopyErrorData(), croak_cstr(), CurrentMemoryContext, elog, FlushErrorState(), MemoryContextSwitchTo(), ErrorData::message, pfree(), PG_CATCH, PG_END_TRY, PG_TRY, and sv2cstr().

◆ plperl_validator()

Definition at line 1990 of file plperl.c.

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}

bool CheckFunctionValidatorAccess(Oid validatorOid, Oid functionOid)

int get_func_arg_info(HeapTuple procTup, Oid **p_argtypes, char ***p_argnames, char **p_argmodes)

bool check_function_bodies

char get_typtype(Oid typid)

References check_function_bodies, CheckFunctionValidatorAccess(), compile_plperl_function(), elog, ereport, errcode(), errmsg(), ERROR, format_type_be(), get_func_arg_info(), get_typtype(), GETSTRUCT(), HeapTupleIsValid, i, ObjectIdGetDatum(), PG_GETARG_OID, PG_RETURN_VOID, ReleaseSysCache(), and SearchSysCache1().

Referenced by plperlu_validator().

◆ plperlu_call_handler()

◆ plperlu_inline_handler()

◆ plperlu_validator()

◆ pp_require_safe()

Definition at line 882 of file plperl.c.

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}

References aTHX_, dVAR, len, name, and PL_sv_undef.

Referenced by plperl_trusted_init(), and set_interp_require().

◆ select_perl_context()

Definition at line 555 of file plperl.c.

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}

void on_proc_exit(pg_on_exit_callback function, Datum arg)

static void plperl_trusted_init(void)

static void plperl_untrusted_init(void)

struct plperl_query_entry plperl_query_entry

static void plperl_fini(int code, Datum arg)

EXTERN_C void boot_PostgreSQL__InServer__SPI(pTHX_ CV *cv)

References activate_interpreter(), boot_PostgreSQL__InServer__SPI(), dTHX, HASHCTL::entrysize, ereport, errcode(), errcontext, errmsg(), ERROR, ERRSV, GetUserId(), hash_create(), HASH_ELEM, HASH_ENTER, hash_search(), HASH_STRINGS, plperl_interp_desc::interp, InvalidOid, HASHCTL::keysize, NAMEDATALEN, on_proc_exit(), plperl_active_interp, plperl_fini(), plperl_held_interp, plperl_init_interp(), plperl_interp_hash, plperl_trusted_init(), plperl_untrusted_init(), plperl_interp_desc::query_hash, set_interp_require(), strip_trailing_ws(), and sv2cstr().

Referenced by compile_plperl_function(), and plperl_inline_handler().

◆ set_interp_require()

◆ split_array()

Definition at line 1561 of file plperl.c.

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}

static SV * make_array_ref(plperl_array_info *info, int first, int last)

References Assert(), check_stack_depth(), dTHX, i, make_array_ref(), plperl_array_info::ndims, plperl_array_info::nelems, newRV_noinc, and split_array().

Referenced by plperl_ref_from_pg_array(), and split_array().

◆ strip_trailing_ws()

◆ SvREFCNT_dec_current()

◆ validate_plperl_function()

◆ current_call_data

Definition at line 243 of file plperl.c.

Referenced by check_spi_usage_allowed(), plperl_call_handler(), plperl_call_perl_func(), plperl_event_trigger_handler(), plperl_func_handler(), plperl_hash_from_tuple(), plperl_inline_handler(), plperl_ref_from_pg_array(), plperl_return_next_internal(), plperl_spi_exec(), plperl_spi_exec_prepared(), plperl_spi_query_prepared(), plperl_sv_to_datum(), and plperl_trigger_handler().

◆ plperl_active_interp

◆ plperl_ending

◆ plperl_held_interp

◆ plperl_interp_hash

◆ plperl_on_init

◆ plperl_on_plperl_init

◆ plperl_on_plperlu_init

◆ plperl_opmask

◆ plperl_proc_hash

◆ plperl_use_strict

◆ pp_require_orig