PostgreSQL Source Code  git master
plperl.c File Reference
#include "postgres.h"
#include <ctype.h>
#include <fcntl.h>
#include <limits.h>
#include <unistd.h>
#include "access/htup_details.h"
#include "access/xact.h"
#include "catalog/pg_language.h"
#include "catalog/pg_proc.h"
#include "catalog/pg_type.h"
#include "commands/event_trigger.h"
#include "commands/trigger.h"
#include "executor/spi.h"
#include "funcapi.h"
#include "mb/pg_wchar.h"
#include "miscadmin.h"
#include "nodes/makefuncs.h"
#include "parser/parse_type.h"
#include "storage/ipc.h"
#include "tcop/tcopprot.h"
#include "utils/builtins.h"
#include "utils/fmgroids.h"
#include "utils/guc.h"
#include "utils/hsearch.h"
#include "utils/lsyscache.h"
#include "utils/memutils.h"
#include "utils/rel.h"
#include "utils/syscache.h"
#include "utils/typcache.h"
#include "plperl.h"
#include "plperl_helpers.h"
#include "perlchunks.h"
#include "plperl_opmask.h"
Include dependency graph for plperl.c:

Go to the source code of this file.

Data Structures

struct  plperl_interp_desc
 
struct  plperl_proc_desc
 
struct  plperl_proc_key
 
struct  plperl_proc_ptr
 
struct  plperl_call_data
 
struct  plperl_query_desc
 
struct  plperl_query_entry
 
struct  plperl_array_info
 

Macros

#define TEXTDOMAIN   PG_TEXTDOMAIN("plperl")
 
#define increment_prodesc_refcount(prodesc)   ((prodesc)->fn_refcount++)
 
#define decrement_prodesc_refcount(prodesc)
 

Typedefs

typedef struct plperl_interp_desc plperl_interp_desc
 
typedef struct plperl_proc_desc plperl_proc_desc
 
typedef struct plperl_proc_key plperl_proc_key
 
typedef struct plperl_proc_ptr plperl_proc_ptr
 
typedef struct plperl_call_data plperl_call_data
 
typedef struct plperl_query_desc plperl_query_desc
 
typedef struct plperl_query_entry plperl_query_entry
 
typedef struct plperl_array_info plperl_array_info
 

Functions

EXTERN_C void boot_DynaLoader (pTHX_ CV *cv)
 
EXTERN_C void boot_PostgreSQL__InServer__Util (pTHX_ CV *cv)
 
EXTERN_C void boot_PostgreSQL__InServer__SPI (pTHX_ CV *cv)
 
void _PG_init (void)
 
static PerlInterpreter * plperl_init_interp (void)
 
static void plperl_destroy_interp (PerlInterpreter **)
 
static void plperl_fini (int code, Datum arg)
 
static void set_interp_require (bool trusted)
 
static Datum plperl_func_handler (PG_FUNCTION_ARGS)
 
static Datum plperl_trigger_handler (PG_FUNCTION_ARGS)
 
static void plperl_event_trigger_handler (PG_FUNCTION_ARGS)
 
static void free_plperl_function (plperl_proc_desc *prodesc)
 
static plperl_proc_desccompile_plperl_function (Oid fn_oid, bool is_trigger, bool is_event_trigger)
 
static SV * plperl_hash_from_tuple (HeapTuple tuple, TupleDesc tupdesc, bool include_generated)
 
static SV * plperl_hash_from_datum (Datum attr)
 
static SV * plperl_ref_from_pg_array (Datum arg, Oid typid)
 
static SV * split_array (plperl_array_info *info, int first, int last, int nest)
 
static SV * make_array_ref (plperl_array_info *info, int first, int last)
 
static SV * get_perl_array_ref (SV *sv)
 
static Datum plperl_sv_to_datum (SV *sv, Oid typid, int32 typmod, FunctionCallInfo fcinfo, FmgrInfo *finfo, Oid typioparam, bool *isnull)
 
static void _sv_to_datum_finfo (Oid typid, FmgrInfo *finfo, Oid *typioparam)
 
static Datum plperl_array_to_datum (SV *src, Oid typid, int32 typmod)
 
static void array_to_datum_internal (AV *av, ArrayBuildState *astate, int *ndims, int *dims, int cur_depth, Oid arraytypid, Oid elemtypid, int32 typmod, FmgrInfo *finfo, Oid typioparam)
 
static Datum plperl_hash_to_datum (SV *src, TupleDesc td)
 
static void plperl_init_shared_libs (pTHX)
 
static void plperl_trusted_init (void)
 
static void plperl_untrusted_init (void)
 
static HV * plperl_spi_execute_fetch_result (SPITupleTable *, uint64, int)
 
static void plperl_return_next_internal (SV *sv)
 
static char * hek2cstr (HE *he)
 
static SV ** hv_store_string (HV *hv, const char *key, SV *val)
 
static SV ** hv_fetch_string (HV *hv, const char *key)
 
static void plperl_create_sub (plperl_proc_desc *desc, const char *s, Oid fn_oid)
 
static SV * plperl_call_perl_func (plperl_proc_desc *desc, FunctionCallInfo fcinfo)
 
static void plperl_compile_callback (void *arg)
 
static void plperl_exec_callback (void *arg)
 
static void plperl_inline_callback (void *arg)
 
static char * strip_trailing_ws (const char *msg)
 
static OP * pp_require_safe (pTHX)
 
static void activate_interpreter (plperl_interp_desc *interp_desc)
 
static void SvREFCNT_dec_current (SV *sv)
 
static void select_perl_context (bool trusted)
 
static HeapTuple plperl_build_tuple_result (HV *perlhash, TupleDesc td)
 
char * plperl_sv_to_literal (SV *sv, char *fqtypename)
 
static SV * plperl_trigger_build_args (FunctionCallInfo fcinfo)
 
static SV * plperl_event_trigger_build_args (FunctionCallInfo fcinfo)
 
static HeapTuple plperl_modify_tuple (HV *hvTD, TriggerData *tdata, HeapTuple otup)
 
 PG_FUNCTION_INFO_V1 (plperl_call_handler)
 
Datum plperl_call_handler (PG_FUNCTION_ARGS)
 
 PG_FUNCTION_INFO_V1 (plperl_inline_handler)
 
Datum plperl_inline_handler (PG_FUNCTION_ARGS)
 
 PG_FUNCTION_INFO_V1 (plperl_validator)
 
Datum plperl_validator (PG_FUNCTION_ARGS)
 
 PG_FUNCTION_INFO_V1 (plperlu_call_handler)
 
Datum plperlu_call_handler (PG_FUNCTION_ARGS)
 
 PG_FUNCTION_INFO_V1 (plperlu_inline_handler)
 
Datum plperlu_inline_handler (PG_FUNCTION_ARGS)
 
 PG_FUNCTION_INFO_V1 (plperlu_validator)
 
Datum plperlu_validator (PG_FUNCTION_ARGS)
 
static SV * plperl_call_perl_trigger_func (plperl_proc_desc *desc, FunctionCallInfo fcinfo, SV *td)
 
static void plperl_call_perl_event_trigger_func (plperl_proc_desc *desc, FunctionCallInfo fcinfo, SV *td)
 
static bool validate_plperl_function (plperl_proc_ptr *proc_ptr, HeapTuple procTup)
 
static void check_spi_usage_allowed (void)
 
HV * plperl_spi_exec (char *query, int limit)
 
void plperl_return_next (SV *sv)
 
SV * plperl_spi_query (char *query)
 
SV * plperl_spi_fetchrow (char *cursor)
 
void plperl_spi_cursor_close (char *cursor)
 
SV * plperl_spi_prepare (char *query, int argc, SV **argv)
 
HV * plperl_spi_exec_prepared (char *query, HV *attr, int argc, SV **argv)
 
SV * plperl_spi_query_prepared (char *query, int argc, SV **argv)
 
void plperl_spi_freeplan (char *query)
 
void plperl_spi_commit (void)
 
void plperl_spi_rollback (void)
 
void plperl_util_elog (int level, SV *msg)
 

Variables

 PG_MODULE_MAGIC
 
static HTABplperl_interp_hash = NULL
 
static HTABplperl_proc_hash = NULL
 
static plperl_interp_descplperl_active_interp = NULL
 
static PerlInterpreter * plperl_held_interp = NULL
 
static bool plperl_use_strict = false
 
static char * plperl_on_init = NULL
 
static char * plperl_on_plperl_init = NULL
 
static char * plperl_on_plperlu_init = NULL
 
static bool plperl_ending = false
 
static OP *(* pp_require_orig )(pTHX) = NULL
 
static char plperl_opmask [MAXO]
 
static plperl_call_datacurrent_call_data = NULL
 

Macro Definition Documentation

◆ 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 132 of file plperl.c.

Referenced by plperl_call_handler(), and validate_plperl_function().

◆ increment_prodesc_refcount

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

◆ TEXTDOMAIN

#define TEXTDOMAIN   PG_TEXTDOMAIN("plperl")

Definition at line 44 of file plperl.c.

Referenced by _PG_init().

Typedef Documentation

◆ plperl_array_info

◆ plperl_call_data

◆ plperl_interp_desc

◆ plperl_proc_desc

◆ plperl_proc_key

◆ plperl_proc_ptr

◆ plperl_query_desc

◆ plperl_query_entry

Function Documentation

◆ _PG_init()

void _PG_init ( void  )

Definition at line 381 of file plperl.c.

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

382 {
383  /*
384  * Be sure we do initialization only once.
385  *
386  * If initialization fails due to, e.g., plperl_init_interp() throwing an
387  * exception, then we'll return here on the next usage and the user will
388  * get a rather cryptic: ERROR: attempt to redefine parameter
389  * "plperl.use_strict"
390  */
391  static bool inited = false;
392  HASHCTL hash_ctl;
393 
394  if (inited)
395  return;
396 
397  /*
398  * Support localized messages.
399  */
401 
402  /*
403  * Initialize plperl's GUCs.
404  */
405  DefineCustomBoolVariable("plperl.use_strict",
406  gettext_noop("If true, trusted and untrusted Perl code will be compiled in strict mode."),
407  NULL,
409  false,
410  PGC_USERSET, 0,
411  NULL, NULL, NULL);
412 
413  /*
414  * plperl.on_init is marked PGC_SIGHUP to support the idea that it might
415  * be executed in the postmaster (if plperl is loaded into the postmaster
416  * via shared_preload_libraries). This isn't really right either way,
417  * though.
418  */
419  DefineCustomStringVariable("plperl.on_init",
420  gettext_noop("Perl initialization code to execute when a Perl interpreter is initialized."),
421  NULL,
423  NULL,
424  PGC_SIGHUP, 0,
425  NULL, NULL, NULL);
426 
427  /*
428  * plperl.on_plperl_init is marked PGC_SUSET to avoid issues whereby a
429  * user who might not even have USAGE privilege on the plperl language
430  * could nonetheless use SET plperl.on_plperl_init='...' to influence the
431  * behaviour of any existing plperl function that they can execute (which
432  * might be SECURITY DEFINER, leading to a privilege escalation). See
433  * http://archives.postgresql.org/pgsql-hackers/2010-02/msg00281.php and
434  * the overall thread.
435  *
436  * Note that because plperl.use_strict is USERSET, a nefarious user could
437  * set it to be applied against other people's functions. This is judged
438  * OK since the worst result would be an error. Your code oughta pass
439  * use_strict anyway ;-)
440  */
441  DefineCustomStringVariable("plperl.on_plperl_init",
442  gettext_noop("Perl initialization code to execute once when plperl is first used."),
443  NULL,
445  NULL,
446  PGC_SUSET, 0,
447  NULL, NULL, NULL);
448 
449  DefineCustomStringVariable("plperl.on_plperlu_init",
450  gettext_noop("Perl initialization code to execute once when plperlu is first used."),
451  NULL,
453  NULL,
454  PGC_SUSET, 0,
455  NULL, NULL, NULL);
456 
457  EmitWarningsOnPlaceholders("plperl");
458 
459  /*
460  * Create hash tables.
461  */
462  memset(&hash_ctl, 0, sizeof(hash_ctl));
463  hash_ctl.keysize = sizeof(Oid);
464  hash_ctl.entrysize = sizeof(plperl_interp_desc);
465  plperl_interp_hash = hash_create("PL/Perl interpreters",
466  8,
467  &hash_ctl,
469 
470  memset(&hash_ctl, 0, sizeof(hash_ctl));
471  hash_ctl.keysize = sizeof(plperl_proc_key);
472  hash_ctl.entrysize = sizeof(plperl_proc_ptr);
473  plperl_proc_hash = hash_create("PL/Perl procedures",
474  32,
475  &hash_ctl,
477 
478  /*
479  * Save the default opmask.
480  */
481  PLPERL_SET_OPMASK(plperl_opmask);
482 
483  /*
484  * Create the first Perl interpreter, but only partially initialize it.
485  */
487 
488  inited = true;
489 }
static char plperl_opmask[MAXO]
Definition: plperl.c:241
static PerlInterpreter * plperl_init_interp(void)
Definition: plperl.c:709
static HTAB * plperl_proc_hash
Definition: plperl.c:227
#define TEXTDOMAIN
Definition: plperl.c:44
#define HASH_ELEM
Definition: hsearch.h:87
static char * plperl_on_init
Definition: plperl.c:235
struct plperl_interp_desc plperl_interp_desc
Size entrysize
Definition: hsearch.h:73
#define gettext_noop(x)
Definition: c.h:1117
unsigned int Oid
Definition: postgres_ext.h:31
Definition: guc.h:75
void EmitWarningsOnPlaceholders(const char *className)
Definition: guc.c:8712
Definition: guc.h:72
#define HASH_BLOBS
Definition: hsearch.h:88
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)
Definition: guc.c:8659
HTAB * hash_create(const char *tabname, long nelem, HASHCTL *info, int flags)
Definition: dynahash.c:316
Size keysize
Definition: hsearch.h:72
static char * plperl_on_plperl_init
Definition: plperl.c:236
static bool plperl_use_strict
Definition: plperl.c:234
static char * plperl_on_plperlu_init
Definition: plperl.c:237
struct plperl_proc_key plperl_proc_key
static PerlInterpreter * plperl_held_interp
Definition: plperl.c:231
static HTAB * plperl_interp_hash
Definition: plperl.c:226
void pg_bindtextdomain(const char *domain)
Definition: miscinit.c:1607
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)
Definition: guc.c:8573
struct plperl_proc_ptr plperl_proc_ptr

◆ _sv_to_datum_finfo()

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

Definition at line 1288 of file plperl.c.

References fmgr_info(), and getTypeInputInfo().

Referenced by plperl_array_to_datum(), and plperl_sv_to_datum().

1289 {
1290  Oid typinput;
1291 
1292  /* XXX would be better to cache these lookups */
1293  getTypeInputInfo(typid,
1294  &typinput, typioparam);
1295  fmgr_info(typinput, finfo);
1296 }
unsigned int Oid
Definition: postgres_ext.h:31
void fmgr_info(Oid functionId, FmgrInfo *finfo)
Definition: fmgr.c:124
void getTypeInputInfo(Oid type, Oid *typInput, Oid *typIOParam)
Definition: lsyscache.c:2641

◆ activate_interpreter()

static void activate_interpreter ( plperl_interp_desc interp_desc)
static

Definition at line 688 of file plperl.c.

References Assert, plperl_interp_desc::interp, OidIsValid, 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().

689 {
690  if (interp_desc && plperl_active_interp != interp_desc)
691  {
692  Assert(interp_desc->interp);
693  PERL_SET_CONTEXT(interp_desc->interp);
694  /* trusted iff user_id isn't InvalidOid */
695  set_interp_require(OidIsValid(interp_desc->user_id));
696  plperl_active_interp = interp_desc;
697  }
698 }
static void set_interp_require(bool trusted)
Definition: plperl.c:493
static plperl_interp_desc * plperl_active_interp
Definition: plperl.c:228
PerlInterpreter * interp
Definition: plperl.c:89
#define OidIsValid(objectId)
Definition: c.h:638
#define Assert(condition)
Definition: c.h:732

◆ array_to_datum_internal()

static void array_to_datum_internal ( AV *  av,
ArrayBuildState astate,
int *  ndims,
int *  dims,
int  cur_depth,
Oid  arraytypid,
Oid  elemtypid,
int32  typmod,
FmgrInfo finfo,
Oid  typioparam 
)
static

Definition at line 1169 of file plperl.c.

References accumArrayResult(), CurrentMemoryContext, dTHX, ereport, errcode(), errmsg(), ERROR, FALSE, get_perl_array_ref(), i, MAXDIM, and plperl_sv_to_datum().

Referenced by plperl_array_to_datum().

1173 {
1174  dTHX;
1175  int i;
1176  int len = av_len(av) + 1;
1177 
1178  for (i = 0; i < len; i++)
1179  {
1180  /* fetch the array element */
1181  SV **svp = av_fetch(av, i, FALSE);
1182 
1183  /* see if this element is an array, if so get that */
1184  SV *sav = svp ? get_perl_array_ref(*svp) : NULL;
1185 
1186  /* multi-dimensional array? */
1187  if (sav)
1188  {
1189  AV *nav = (AV *) SvRV(sav);
1190 
1191  /* dimensionality checks */
1192  if (cur_depth + 1 > MAXDIM)
1193  ereport(ERROR,
1194  (errcode(ERRCODE_PROGRAM_LIMIT_EXCEEDED),
1195  errmsg("number of array dimensions (%d) exceeds the maximum allowed (%d)",
1196  cur_depth + 1, MAXDIM)));
1197 
1198  /* set size when at first element in this level, else compare */
1199  if (i == 0 && *ndims == cur_depth)
1200  {
1201  dims[*ndims] = av_len(nav) + 1;
1202  (*ndims)++;
1203  }
1204  else if (av_len(nav) + 1 != dims[cur_depth])
1205  ereport(ERROR,
1206  (errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
1207  errmsg("multidimensional arrays must have array expressions with matching dimensions")));
1208 
1209  /* recurse to fetch elements of this sub-array */
1210  array_to_datum_internal(nav, astate,
1211  ndims, dims, cur_depth + 1,
1212  arraytypid, elemtypid, typmod,
1213  finfo, typioparam);
1214  }
1215  else
1216  {
1217  Datum dat;
1218  bool isnull;
1219 
1220  /* scalar after some sub-arrays at same level? */
1221  if (*ndims != cur_depth)
1222  ereport(ERROR,
1223  (errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
1224  errmsg("multidimensional arrays must have array expressions with matching dimensions")));
1225 
1226  dat = plperl_sv_to_datum(svp ? *svp : NULL,
1227  elemtypid,
1228  typmod,
1229  NULL,
1230  finfo,
1231  typioparam,
1232  &isnull);
1233 
1234  (void) accumArrayResult(astate, dat, isnull,
1235  elemtypid, CurrentMemoryContext);
1236  }
1237  }
1238 }
static SV * get_perl_array_ref(SV *sv)
Definition: plperl.c:1142
static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod, FunctionCallInfo fcinfo, FmgrInfo *finfo, Oid typioparam, bool *isnull)
Definition: plperl.c:1311
#define dTHX
Definition: ppport.h:3208
#define MAXDIM
Definition: c.h:529
#define FALSE
Definition: ecpglib.h:39
int errcode(int sqlerrcode)
Definition: elog.c:570
#define ERROR
Definition: elog.h:43
MemoryContext CurrentMemoryContext
Definition: mcxt.c:38
#define ereport(elevel, rest)
Definition: elog.h:141
struct @18::@19 av[32]
uintptr_t Datum
Definition: postgres.h:367
ArrayBuildState * accumArrayResult(ArrayBuildState *astate, Datum dvalue, bool disnull, Oid element_type, MemoryContext rcontext)
Definition: arrayfuncs.c:5053
int errmsg(const char *fmt,...)
Definition: elog.c:784
int i
static void array_to_datum_internal(AV *av, ArrayBuildState *astate, int *ndims, int *dims, int cur_depth, Oid arraytypid, Oid elemtypid, int32 typmod, FmgrInfo *finfo, Oid typioparam)
Definition: plperl.c:1169

◆ boot_DynaLoader()

EXTERN_C void boot_DynaLoader ( pTHX_ CV *  cv)

Referenced by plperl_init_shared_libs().

◆ boot_PostgreSQL__InServer__SPI()

EXTERN_C void boot_PostgreSQL__InServer__SPI ( pTHX_ CV *  cv)

Referenced by select_perl_context().

◆ boot_PostgreSQL__InServer__Util()

EXTERN_C void boot_PostgreSQL__InServer__Util ( pTHX_ CV *  cv)

Referenced by plperl_init_shared_libs().

◆ check_spi_usage_allowed()

static void check_spi_usage_allowed ( void  )
static

Definition at line 3114 of file plperl.c.

References plperl_ending.

Referenced by 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(), and plperl_spi_query_prepared().

3115 {
3116  /* see comment in plperl_fini() */
3117  if (plperl_ending)
3118  {
3119  /* simple croak as we don't want to involve PostgreSQL code */
3120  croak("SPI functions can not be used in END blocks");
3121  }
3122 }
static bool plperl_ending
Definition: plperl.c:239

◆ compile_plperl_function()

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

Definition at line 2722 of file plperl.c.

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, LANGOID, 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(), ErrorContextCallback::previous, plperl_proc_key::proc_id, plperl_proc_ptr::proc_ptr, PROCOID, 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(), HeapTupleData::t_data, HeapTupleData::t_self, TextDatumGetCString, TopMemoryContext, plperl_proc_desc::trftypes, type_is_rowtype(), TYPEOID, plperl_proc_key::user_id, and validate_plperl_function().

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

2723 {
2724  HeapTuple procTup;
2725  Form_pg_proc procStruct;
2726  plperl_proc_key proc_key;
2727  plperl_proc_ptr *proc_ptr;
2728  plperl_proc_desc *volatile prodesc = NULL;
2729  volatile MemoryContext proc_cxt = NULL;
2731  ErrorContextCallback plperl_error_context;
2732 
2733  /* We'll need the pg_proc tuple in any case... */
2734  procTup = SearchSysCache1(PROCOID, ObjectIdGetDatum(fn_oid));
2735  if (!HeapTupleIsValid(procTup))
2736  elog(ERROR, "cache lookup failed for function %u", fn_oid);
2737  procStruct = (Form_pg_proc) GETSTRUCT(procTup);
2738 
2739  /*
2740  * Try to find function in plperl_proc_hash. The reason for this
2741  * overcomplicated-seeming lookup procedure is that we don't know whether
2742  * it's plperl or plperlu, and don't want to spend a lookup in pg_language
2743  * to find out.
2744  */
2745  proc_key.proc_id = fn_oid;
2746  proc_key.is_trigger = is_trigger;
2747  proc_key.user_id = GetUserId();
2748  proc_ptr = hash_search(plperl_proc_hash, &proc_key,
2749  HASH_FIND, NULL);
2750  if (validate_plperl_function(proc_ptr, procTup))
2751  {
2752  /* Found valid plperl entry */
2753  ReleaseSysCache(procTup);
2754  return proc_ptr->proc_ptr;
2755  }
2756 
2757  /* If not found or obsolete, maybe it's plperlu */
2758  proc_key.user_id = InvalidOid;
2759  proc_ptr = hash_search(plperl_proc_hash, &proc_key,
2760  HASH_FIND, NULL);
2761  if (validate_plperl_function(proc_ptr, procTup))
2762  {
2763  /* Found valid plperlu entry */
2764  ReleaseSysCache(procTup);
2765  return proc_ptr->proc_ptr;
2766  }
2767 
2768  /************************************************************
2769  * If we haven't found it in the hashtable, we analyze
2770  * the function's arguments and return type and store
2771  * the in-/out-functions in the prodesc block,
2772  * then we load the procedure into the Perl interpreter,
2773  * and last we create a new hashtable entry for it.
2774  ************************************************************/
2775 
2776  /* Set a callback for reporting compilation errors */
2777  plperl_error_context.callback = plperl_compile_callback;
2778  plperl_error_context.previous = error_context_stack;
2779  plperl_error_context.arg = NameStr(procStruct->proname);
2780  error_context_stack = &plperl_error_context;
2781 
2782  PG_TRY();
2783  {
2784  HeapTuple langTup;
2785  HeapTuple typeTup;
2786  Form_pg_language langStruct;
2787  Form_pg_type typeStruct;
2788  Datum protrftypes_datum;
2789  Datum prosrcdatum;
2790  bool isnull;
2791  char *proc_source;
2792  MemoryContext oldcontext;
2793 
2794  /************************************************************
2795  * Allocate a context that will hold all PG data for the procedure.
2796  ************************************************************/
2798  "PL/Perl function",
2800 
2801  /************************************************************
2802  * Allocate and fill a new procedure description block.
2803  * struct prodesc and subsidiary data must all live in proc_cxt.
2804  ************************************************************/
2805  oldcontext = MemoryContextSwitchTo(proc_cxt);
2806  prodesc = (plperl_proc_desc *) palloc0(sizeof(plperl_proc_desc));
2807  prodesc->proname = pstrdup(NameStr(procStruct->proname));
2808  MemoryContextSetIdentifier(proc_cxt, prodesc->proname);
2809  prodesc->fn_cxt = proc_cxt;
2810  prodesc->fn_refcount = 0;
2811  prodesc->fn_xmin = HeapTupleHeaderGetRawXmin(procTup->t_data);
2812  prodesc->fn_tid = procTup->t_self;
2813  prodesc->nargs = procStruct->pronargs;
2814  prodesc->arg_out_func = (FmgrInfo *) palloc0(prodesc->nargs * sizeof(FmgrInfo));
2815  prodesc->arg_is_rowtype = (bool *) palloc0(prodesc->nargs * sizeof(bool));
2816  prodesc->arg_arraytype = (Oid *) palloc0(prodesc->nargs * sizeof(Oid));
2817  MemoryContextSwitchTo(oldcontext);
2818 
2819  /* Remember if function is STABLE/IMMUTABLE */
2820  prodesc->fn_readonly =
2821  (procStruct->provolatile != PROVOLATILE_VOLATILE);
2822 
2823  /* Fetch protrftypes */
2824  protrftypes_datum = SysCacheGetAttr(PROCOID, procTup,
2825  Anum_pg_proc_protrftypes, &isnull);
2826  MemoryContextSwitchTo(proc_cxt);
2827  prodesc->trftypes = isnull ? NIL : oid_array_to_list(protrftypes_datum);
2828  MemoryContextSwitchTo(oldcontext);
2829 
2830  /************************************************************
2831  * Lookup the pg_language tuple by Oid
2832  ************************************************************/
2833  langTup = SearchSysCache1(LANGOID,
2834  ObjectIdGetDatum(procStruct->prolang));
2835  if (!HeapTupleIsValid(langTup))
2836  elog(ERROR, "cache lookup failed for language %u",
2837  procStruct->prolang);
2838  langStruct = (Form_pg_language) GETSTRUCT(langTup);
2839  prodesc->lang_oid = langStruct->oid;
2840  prodesc->lanpltrusted = langStruct->lanpltrusted;
2841  ReleaseSysCache(langTup);
2842 
2843  /************************************************************
2844  * Get the required information for input conversion of the
2845  * return value.
2846  ************************************************************/
2847  if (!is_trigger && !is_event_trigger)
2848  {
2849  Oid rettype = procStruct->prorettype;
2850 
2851  typeTup = SearchSysCache1(TYPEOID, ObjectIdGetDatum(rettype));
2852  if (!HeapTupleIsValid(typeTup))
2853  elog(ERROR, "cache lookup failed for type %u", rettype);
2854  typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
2855 
2856  /* Disallow pseudotype result, except VOID or RECORD */
2857  if (typeStruct->typtype == TYPTYPE_PSEUDO)
2858  {
2859  if (rettype == VOIDOID ||
2860  rettype == RECORDOID)
2861  /* okay */ ;
2862  else if (rettype == TRIGGEROID ||
2863  rettype == EVTTRIGGEROID)
2864  ereport(ERROR,
2865  (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
2866  errmsg("trigger functions can only be called "
2867  "as triggers")));
2868  else
2869  ereport(ERROR,
2870  (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
2871  errmsg("PL/Perl functions cannot return type %s",
2872  format_type_be(rettype))));
2873  }
2874 
2875  prodesc->result_oid = rettype;
2876  prodesc->fn_retisset = procStruct->proretset;
2877  prodesc->fn_retistuple = type_is_rowtype(rettype);
2878 
2879  prodesc->fn_retisarray =
2880  (typeStruct->typlen == -1 && typeStruct->typelem);
2881 
2882  fmgr_info_cxt(typeStruct->typinput,
2883  &(prodesc->result_in_func),
2884  proc_cxt);
2885  prodesc->result_typioparam = getTypeIOParam(typeTup);
2886 
2887  ReleaseSysCache(typeTup);
2888  }
2889 
2890  /************************************************************
2891  * Get the required information for output conversion
2892  * of all procedure arguments
2893  ************************************************************/
2894  if (!is_trigger && !is_event_trigger)
2895  {
2896  int i;
2897 
2898  for (i = 0; i < prodesc->nargs; i++)
2899  {
2900  Oid argtype = procStruct->proargtypes.values[i];
2901 
2902  typeTup = SearchSysCache1(TYPEOID, ObjectIdGetDatum(argtype));
2903  if (!HeapTupleIsValid(typeTup))
2904  elog(ERROR, "cache lookup failed for type %u", argtype);
2905  typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
2906 
2907  /* Disallow pseudotype argument, except RECORD */
2908  if (typeStruct->typtype == TYPTYPE_PSEUDO &&
2909  argtype != RECORDOID)
2910  ereport(ERROR,
2911  (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
2912  errmsg("PL/Perl functions cannot accept type %s",
2913  format_type_be(argtype))));
2914 
2915  if (type_is_rowtype(argtype))
2916  prodesc->arg_is_rowtype[i] = true;
2917  else
2918  {
2919  prodesc->arg_is_rowtype[i] = false;
2920  fmgr_info_cxt(typeStruct->typoutput,
2921  &(prodesc->arg_out_func[i]),
2922  proc_cxt);
2923  }
2924 
2925  /* Identify array-type arguments */
2926  if (typeStruct->typelem != 0 && typeStruct->typlen == -1)
2927  prodesc->arg_arraytype[i] = argtype;
2928  else
2929  prodesc->arg_arraytype[i] = InvalidOid;
2930 
2931  ReleaseSysCache(typeTup);
2932  }
2933  }
2934 
2935  /************************************************************
2936  * create the text of the anonymous subroutine.
2937  * we do not use a named subroutine so that we can call directly
2938  * through the reference.
2939  ************************************************************/
2940  prosrcdatum = SysCacheGetAttr(PROCOID, procTup,
2941  Anum_pg_proc_prosrc, &isnull);
2942  if (isnull)
2943  elog(ERROR, "null prosrc");
2944  proc_source = TextDatumGetCString(prosrcdatum);
2945 
2946  /************************************************************
2947  * Create the procedure in the appropriate interpreter
2948  ************************************************************/
2949 
2951 
2952  prodesc->interp = plperl_active_interp;
2953 
2954  plperl_create_sub(prodesc, proc_source, fn_oid);
2955 
2956  activate_interpreter(oldinterp);
2957 
2958  pfree(proc_source);
2959 
2960  if (!prodesc->reference) /* can this happen? */
2961  elog(ERROR, "could not create PL/Perl internal procedure");
2962 
2963  /************************************************************
2964  * OK, link the procedure into the correct hashtable entry.
2965  * Note we assume that the hashtable entry either doesn't exist yet,
2966  * or we already cleared its proc_ptr during the validation attempts
2967  * above. So no need to decrement an old refcount here.
2968  ************************************************************/
2969  proc_key.user_id = prodesc->lanpltrusted ? GetUserId() : InvalidOid;
2970 
2971  proc_ptr = hash_search(plperl_proc_hash, &proc_key,
2972  HASH_ENTER, NULL);
2973  /* We assume these two steps can't throw an error: */
2974  proc_ptr->proc_ptr = prodesc;
2975  increment_prodesc_refcount(prodesc);
2976  }
2977  PG_CATCH();
2978  {
2979  /*
2980  * If we got as far as creating a reference, we should be able to use
2981  * free_plperl_function() to clean up. If not, then at most we have
2982  * some PG memory resources in proc_cxt, which we can just delete.
2983  */
2984  if (prodesc && prodesc->reference)
2985  free_plperl_function(prodesc);
2986  else if (proc_cxt)
2987  MemoryContextDelete(proc_cxt);
2988 
2989  /* Be sure to restore the previous interpreter, too, for luck */
2990  activate_interpreter(oldinterp);
2991 
2992  PG_RE_THROW();
2993  }
2994  PG_END_TRY();
2995 
2996  /* restore previous error callback */
2997  error_context_stack = plperl_error_context.previous;
2998 
2999  ReleaseSysCache(procTup);
3000 
3001  return prodesc;
3002 }
#define NIL
Definition: pg_list.h:65
Definition: fmgr.h:56
static bool validate_plperl_function(plperl_proc_ptr *proc_ptr, HeapTuple procTup)
Definition: plperl.c:2675
List * trftypes
Definition: plperl.c:114
void MemoryContextDelete(MemoryContext context)
Definition: mcxt.c:211
#define AllocSetContextCreate
Definition: memutils.h:169
static HTAB * plperl_proc_hash
Definition: plperl.c:227
bool * arg_is_rowtype
Definition: plperl.c:126
#define GETSTRUCT(TUP)
Definition: htup_details.h:655
static void select_perl_context(bool trusted)
Definition: plperl.c:556
Oid GetUserId(void)
Definition: miscinit.c:380
char * pstrdup(const char *in)
Definition: mcxt.c:1161
#define ALLOCSET_SMALL_SIZES
Definition: memutils.h:201
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Definition: palloc.h:109
int errcode(int sqlerrcode)
Definition: elog.c:570
MemoryContext fn_cxt
Definition: plperl.c:106
char * format_type_be(Oid type_oid)
Definition: format_type.c:326
static plperl_interp_desc * plperl_active_interp
Definition: plperl.c:228
void * hash_search(HTAB *hashp, const void *keyPtr, HASHACTION action, bool *foundPtr)
Definition: dynahash.c:906
unsigned int Oid
Definition: postgres_ext.h:31
void(* callback)(void *arg)
Definition: elog.h:254
FmgrInfo * arg_out_func
Definition: plperl.c:125
struct ErrorContextCallback * previous
Definition: elog.h:253
HeapTupleHeader t_data
Definition: htup.h:68
ErrorContextCallback * error_context_stack
Definition: elog.c:88
List * oid_array_to_list(Datum datum)
Definition: pg_proc.c:1159
void pfree(void *pointer)
Definition: mcxt.c:1031
bool fn_retisset
Definition: plperl.c:117
#define ObjectIdGetDatum(X)
Definition: postgres.h:507
#define ERROR
Definition: elog.h:43
plperl_proc_desc * proc_ptr
Definition: plperl.c:167
ItemPointerData fn_tid
Definition: plperl.c:109
ItemPointerData t_self
Definition: htup.h:65
FmgrInfo result_in_func
Definition: plperl.c:121
static void activate_interpreter(plperl_interp_desc *interp_desc)
Definition: plperl.c:688
bool type_is_rowtype(Oid typid)
Definition: lsyscache.c:2433
void fmgr_info_cxt(Oid functionId, FmgrInfo *finfo, MemoryContext mcxt)
Definition: fmgr.c:134
#define increment_prodesc_refcount(prodesc)
Definition: plperl.c:130
Oid result_typioparam
Definition: plperl.c:122
#define ereport(elevel, rest)
Definition: elog.h:141
Oid * arg_arraytype
Definition: plperl.c:127
MemoryContext TopMemoryContext
Definition: mcxt.c:44
unsigned long fn_refcount
Definition: plperl.c:107
HeapTuple SearchSysCache1(int cacheId, Datum key1)
Definition: syscache.c:1124
#define TextDatumGetCString(d)
Definition: builtins.h:84
Oid is_trigger
Definition: plperl.c:160
void * palloc0(Size size)
Definition: mcxt.c:955
uintptr_t Datum
Definition: postgres.h:367
void ReleaseSysCache(HeapTuple tuple)
Definition: syscache.c:1172
Datum SysCacheGetAttr(int cacheId, HeapTuple tup, AttrNumber attributeNumber, bool *isNull)
Definition: syscache.c:1385
static void free_plperl_function(plperl_proc_desc *prodesc)
Definition: plperl.c:2704
FormData_pg_proc * Form_pg_proc
Definition: pg_proc.h:134
#define InvalidOid
Definition: postgres_ext.h:36
bool fn_readonly
Definition: plperl.c:112
#define PG_CATCH()
Definition: elog.h:310
#define HeapTupleIsValid(tuple)
Definition: htup.h:78
SV * reference
Definition: plperl.c:110
FormData_pg_type * Form_pg_type
Definition: pg_type.h:251
void MemoryContextSetIdentifier(MemoryContext context, const char *id)
Definition: mcxt.c:329
#define HeapTupleHeaderGetRawXmin(tup)
Definition: htup_details.h:308
#define PG_RE_THROW()
Definition: elog.h:331
static void plperl_compile_callback(void *arg)
Definition: plperl.c:4139
FormData_pg_language * Form_pg_language
Definition: pg_language.h:65
int errmsg(const char *fmt,...)
Definition: elog.c:784
bool fn_retistuple
Definition: plperl.c:116
#define elog(elevel,...)
Definition: elog.h:226
int i
Oid getTypeIOParam(HeapTuple typeTuple)
Definition: lsyscache.c:2081
#define NameStr(name)
Definition: c.h:609
static void plperl_create_sub(plperl_proc_desc *desc, const char *s, Oid fn_oid)
Definition: plperl.c:2098
char * proname
Definition: plperl.c:105
TransactionId fn_xmin
Definition: plperl.c:108
#define PG_TRY()
Definition: elog.h:301
plperl_interp_desc * interp
Definition: plperl.c:111
#define PG_END_TRY()
Definition: elog.h:317
bool lanpltrusted
Definition: plperl.c:115
bool fn_retisarray
Definition: plperl.c:118

◆ free_plperl_function()

static void free_plperl_function ( plperl_proc_desc prodesc)
static

Definition at line 2704 of file plperl.c.

References activate_interpreter(), Assert, plperl_proc_desc::fn_cxt, plperl_proc_desc::fn_refcount, plperl_proc_desc::interp, MemoryContextDelete(), plperl_active_interp, plperl_proc_desc::reference, and SvREFCNT_dec_current().

Referenced by compile_plperl_function().

2705 {
2706  Assert(prodesc->fn_refcount == 0);
2707  /* Release CODE reference, if we have one, from the appropriate interp */
2708  if (prodesc->reference)
2709  {
2711 
2712  activate_interpreter(prodesc->interp);
2713  SvREFCNT_dec_current(prodesc->reference);
2714  activate_interpreter(oldinterp);
2715  }
2716  /* Release all PG-owned data for this proc */
2717  MemoryContextDelete(prodesc->fn_cxt);
2718 }
void MemoryContextDelete(MemoryContext context)
Definition: mcxt.c:211
MemoryContext fn_cxt
Definition: plperl.c:106
static plperl_interp_desc * plperl_active_interp
Definition: plperl.c:228
static void activate_interpreter(plperl_interp_desc *interp_desc)
Definition: plperl.c:688
unsigned long fn_refcount
Definition: plperl.c:107
static void SvREFCNT_dec_current(SV *sv)
Definition: plperl.c:313
#define Assert(condition)
Definition: c.h:732
SV * reference
Definition: plperl.c:110
plperl_interp_desc * interp
Definition: plperl.c:111

◆ get_perl_array_ref()

static SV * get_perl_array_ref ( SV *  sv)
static

Definition at line 1142 of file plperl.c.

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

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

1143 {
1144  dTHX;
1145 
1146  if (SvOK(sv) && SvROK(sv))
1147  {
1148  if (SvTYPE(SvRV(sv)) == SVt_PVAV)
1149  return sv;
1150  else if (sv_isa(sv, "PostgreSQL::InServer::ARRAY"))
1151  {
1152  HV *hv = (HV *) SvRV(sv);
1153  SV **sav = hv_fetch_string(hv, "array");
1154 
1155  if (*sav && SvOK(*sav) && SvROK(*sav) &&
1156  SvTYPE(SvRV(*sav)) == SVt_PVAV)
1157  return *sav;
1158 
1159  elog(ERROR, "could not get array reference from PostgreSQL::InServer::ARRAY object");
1160  }
1161  }
1162  return NULL;
1163 }
#define dTHX
Definition: ppport.h:3208
static SV ** hv_fetch_string(HV *hv, const char *key)
Definition: plperl.c:4104
#define ERROR
Definition: elog.h:43
#define elog(elevel,...)
Definition: elog.h:226

◆ hek2cstr()

static char * hek2cstr ( HE *  he)
static

Definition at line 324 of file plperl.c.

References dTHX, HeUTF8, and sv2cstr().

Referenced by plperl_build_tuple_result(), and plperl_modify_tuple().

325 {
326  dTHX;
327  char *ret;
328  SV *sv;
329 
330  /*
331  * HeSVKEY_force will return a temporary mortal SV*, so we need to make
332  * sure to free it with ENTER/SAVE/FREE/LEAVE
333  */
334  ENTER;
335  SAVETMPS;
336 
337  /*-------------------------
338  * Unfortunately, while HeUTF8 is true for most things > 256, for values
339  * 128..255 it's not, but perl will treat them as unicode code points if
340  * the utf8 flag is not set ( see The "Unicode Bug" in perldoc perlunicode
341  * for more)
342  *
343  * So if we did the expected:
344  * if (HeUTF8(he))
345  * utf_u2e(key...);
346  * else // must be ascii
347  * return HePV(he);
348  * we won't match columns with codepoints from 128..255
349  *
350  * For a more concrete example given a column with the name of the unicode
351  * codepoint U+00ae (registered sign) and a UTF8 database and the perl
352  * return_next { "\N{U+00ae}=>'text } would always fail as heUTF8 returns
353  * 0 and HePV() would give us a char * with 1 byte contains the decimal
354  * value 174
355  *
356  * Perl has the brains to know when it should utf8 encode 174 properly, so
357  * here we force it into an SV so that perl will figure it out and do the
358  * right thing
359  *-------------------------
360  */
361 
362  sv = HeSVKEY_force(he);
363  if (HeUTF8(he))
364  SvUTF8_on(sv);
365  ret = sv2cstr(sv);
366 
367  /* free sv */
368  FREETMPS;
369  LEAVE;
370 
371  return ret;
372 }
#define HeUTF8(he)
Definition: plperl.h:186
#define dTHX
Definition: ppport.h:3208
static char * sv2cstr(SV *sv)

◆ hv_fetch_string()

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

Definition at line 4104 of file plperl.c.

References dTHX, pfree(), pg_server_to_any(), and PG_UTF8.

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

4105 {
4106  dTHX;
4107  int32 hlen;
4108  char *hkey;
4109  SV **ret;
4110 
4111  hkey = pg_server_to_any(key, strlen(key), PG_UTF8);
4112 
4113  /* See notes in hv_store_string */
4114  hlen = -(int) strlen(hkey);
4115  ret = hv_fetch(hv, hkey, hlen, 0);
4116 
4117  if (hkey != key)
4118  pfree(hkey);
4119 
4120  return ret;
4121 }
#define dTHX
Definition: ppport.h:3208
char * pg_server_to_any(const char *s, int len, int encoding)
Definition: mbutils.c:626
signed int int32
Definition: c.h:346
void pfree(void *pointer)
Definition: mcxt.c:1031

◆ hv_store_string()

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

Definition at line 4077 of file plperl.c.

References dTHX, pfree(), pg_server_to_any(), and PG_UTF8.

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

4078 {
4079  dTHX;
4080  int32 hlen;
4081  char *hkey;
4082  SV **ret;
4083 
4084  hkey = pg_server_to_any(key, strlen(key), PG_UTF8);
4085 
4086  /*
4087  * hv_store() recognizes a negative klen parameter as meaning a UTF-8
4088  * encoded key.
4089  */
4090  hlen = -(int) strlen(hkey);
4091  ret = hv_store(hv, hkey, hlen, val, 0);
4092 
4093  if (hkey != key)
4094  pfree(hkey);
4095 
4096  return ret;
4097 }
#define dTHX
Definition: ppport.h:3208
char * pg_server_to_any(const char *s, int len, int encoding)
Definition: mbutils.c:626
signed int int32
Definition: c.h:346
void pfree(void *pointer)
Definition: mcxt.c:1031
long val
Definition: informix.c:684

◆ make_array_ref()

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

Definition at line 1579 of file plperl.c.

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().

1580 {
1581  dTHX;
1582  int i;
1583  AV *result = newAV();
1584 
1585  for (i = first; i < last; i++)
1586  {
1587  if (info->nulls[i])
1588  {
1589  /*
1590  * We can't use &PL_sv_undef here. See "AVs, HVs and undefined
1591  * values" in perlguts.
1592  */
1593  av_push(result, newSV(0));
1594  }
1595  else
1596  {
1597  Datum itemvalue = info->elements[i];
1598 
1599  if (info->transform_proc.fn_oid)
1600  av_push(result, (SV *) DatumGetPointer(FunctionCall1(&info->transform_proc, itemvalue)));
1601  else if (info->elem_is_rowtype)
1602  /* Handle composite type elements */
1603  av_push(result, plperl_hash_from_datum(itemvalue));
1604  else
1605  {
1606  char *val = OutputFunctionCall(&info->proc, itemvalue);
1607 
1608  av_push(result, cstr2sv(val));
1609  }
1610  }
1611  }
1612  return newRV_noinc((SV *) result);
1613 }
FmgrInfo transform_proc
Definition: plperl.c:219
#define dTHX
Definition: ppport.h:3208
static SV * plperl_hash_from_datum(Datum attr)
Definition: plperl.c:3006
char * OutputFunctionCall(FmgrInfo *flinfo, Datum val)
Definition: fmgr.c:1575
#define newRV_noinc(a)
Definition: ppport.h:4456
uintptr_t Datum
Definition: postgres.h:367
bool elem_is_rowtype
Definition: plperl.c:214
static SV * cstr2sv(const char *str)
Oid fn_oid
Definition: fmgr.h:59
FmgrInfo proc
Definition: plperl.c:218
#define DatumGetPointer(X)
Definition: postgres.h:549
bool * nulls
Definition: plperl.c:216
int i
Datum * elements
Definition: plperl.c:215
#define FunctionCall1(flinfo, arg1)
Definition: fmgr.h:634
long val
Definition: informix.c:684

◆ PG_FUNCTION_INFO_V1() [1/6]

◆ PG_FUNCTION_INFO_V1() [2/6]

PG_FUNCTION_INFO_V1 ( plperl_inline_handler  )

◆ PG_FUNCTION_INFO_V1() [3/6]

PG_FUNCTION_INFO_V1 ( plperl_validator  )

◆ PG_FUNCTION_INFO_V1() [4/6]

PG_FUNCTION_INFO_V1 ( plperlu_call_handler  )

◆ PG_FUNCTION_INFO_V1() [5/6]

PG_FUNCTION_INFO_V1 ( plperlu_inline_handler  )

◆ PG_FUNCTION_INFO_V1() [6/6]

PG_FUNCTION_INFO_V1 ( plperlu_validator  )

◆ plperl_array_to_datum()

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

Definition at line 1244 of file plperl.c.

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

Referenced by plperl_sv_to_datum().

1245 {
1246  dTHX;
1247  ArrayBuildState *astate;
1248  Oid elemtypid;
1249  FmgrInfo finfo;
1250  Oid typioparam;
1251  int dims[MAXDIM];
1252  int lbs[MAXDIM];
1253  int ndims = 1;
1254  int i;
1255 
1256  elemtypid = get_element_type(typid);
1257  if (!elemtypid)
1258  ereport(ERROR,
1259  (errcode(ERRCODE_DATATYPE_MISMATCH),
1260  errmsg("cannot convert Perl array to non-array type %s",
1261  format_type_be(typid))));
1262 
1263  astate = initArrayResult(elemtypid, CurrentMemoryContext, true);
1264 
1265  _sv_to_datum_finfo(elemtypid, &finfo, &typioparam);
1266 
1267  memset(dims, 0, sizeof(dims));
1268  dims[0] = av_len((AV *) SvRV(src)) + 1;
1269 
1270  array_to_datum_internal((AV *) SvRV(src), astate,
1271  &ndims, dims, 1,
1272  typid, elemtypid, typmod,
1273  &finfo, typioparam);
1274 
1275  /* ensure we get zero-D array for no inputs, as per PG convention */
1276  if (dims[0] <= 0)
1277  ndims = 0;
1278 
1279  for (i = 0; i < ndims; i++)
1280  lbs[i] = 1;
1281 
1282  return makeMdArrayResult(astate, ndims, dims, lbs,
1283  CurrentMemoryContext, true);
1284 }
Datum makeMdArrayResult(ArrayBuildState *astate, int ndims, int *dims, int *lbs, MemoryContext rcontext, bool release)
Definition: arrayfuncs.c:5149
Definition: fmgr.h:56
ArrayBuildState * initArrayResult(Oid element_type, MemoryContext rcontext, bool subcontext)
Definition: arrayfuncs.c:5014
#define dTHX
Definition: ppport.h:3208
#define MAXDIM
Definition: c.h:529
Oid get_element_type(Oid typid)
Definition: lsyscache.c:2526
int errcode(int sqlerrcode)
Definition: elog.c:570
char * format_type_be(Oid type_oid)
Definition: format_type.c:326
unsigned int Oid
Definition: postgres_ext.h:31
#define ERROR
Definition: elog.h:43
MemoryContext CurrentMemoryContext
Definition: mcxt.c:38
#define ereport(elevel, rest)
Definition: elog.h:141
int errmsg(const char *fmt,...)
Definition: elog.c:784
int i
static void _sv_to_datum_finfo(Oid typid, FmgrInfo *finfo, Oid *typioparam)
Definition: plperl.c:1288
static void array_to_datum_internal(AV *av, ArrayBuildState *astate, int *ndims, int *dims, int cur_depth, Oid arraytypid, Oid elemtypid, int32 typmod, FmgrInfo *finfo, Oid typioparam)
Definition: plperl.c:1169

◆ plperl_build_tuple_result()

static HeapTuple plperl_build_tuple_result ( HV *  perlhash,
TupleDesc  td 
)
static

Definition at line 1079 of file plperl.c.

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().

1080 {
1081  dTHX;
1082  Datum *values;
1083  bool *nulls;
1084  HE *he;
1085  HeapTuple tup;
1086 
1087  values = palloc0(sizeof(Datum) * td->natts);
1088  nulls = palloc(sizeof(bool) * td->natts);
1089  memset(nulls, true, sizeof(bool) * td->natts);
1090 
1091  hv_iterinit(perlhash);
1092  while ((he = hv_iternext(perlhash)))
1093  {
1094  SV *val = HeVAL(he);
1095  char *key = hek2cstr(he);
1096  int attn = SPI_fnumber(td, key);
1097  Form_pg_attribute attr = TupleDescAttr(td, attn - 1);
1098 
1099  if (attn == SPI_ERROR_NOATTRIBUTE)
1100  ereport(ERROR,
1101  (errcode(ERRCODE_UNDEFINED_COLUMN),
1102  errmsg("Perl hash contains nonexistent column \"%s\"",
1103  key)));
1104  if (attn <= 0)
1105  ereport(ERROR,
1106  (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1107  errmsg("cannot set system attribute \"%s\"",
1108  key)));
1109 
1110  values[attn - 1] = plperl_sv_to_datum(val,
1111  attr->atttypid,
1112  attr->atttypmod,
1113  NULL,
1114  NULL,
1115  InvalidOid,
1116  &nulls[attn - 1]);
1117 
1118  pfree(key);
1119  }
1120  hv_iterinit(perlhash);
1121 
1122  tup = heap_form_tuple(td, values, nulls);
1123  pfree(values);
1124  pfree(nulls);
1125  return tup;
1126 }
int SPI_fnumber(TupleDesc tupdesc, const char *fname)
Definition: spi.c:951
static char * hek2cstr(HE *he)
Definition: plperl.c:324
static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod, FunctionCallInfo fcinfo, FmgrInfo *finfo, Oid typioparam, bool *isnull)
Definition: plperl.c:1311
#define dTHX
Definition: ppport.h:3208
#define TupleDescAttr(tupdesc, i)
Definition: tupdesc.h:92
int errcode(int sqlerrcode)
Definition: elog.c:570
HeapTuple heap_form_tuple(TupleDesc tupleDescriptor, Datum *values, bool *isnull)
Definition: heaptuple.c:1020
void pfree(void *pointer)
Definition: mcxt.c:1031
#define ERROR
Definition: elog.h:43
#define SPI_ERROR_NOATTRIBUTE
Definition: spi.h:47
FormData_pg_attribute * Form_pg_attribute
Definition: pg_attribute.h:200
#define ereport(elevel, rest)
Definition: elog.h:141
void * palloc0(Size size)
Definition: mcxt.c:955
uintptr_t Datum
Definition: postgres.h:367
#define InvalidOid
Definition: postgres_ext.h:36
static Datum values[MAXATTR]
Definition: bootstrap.c:167
void * palloc(Size size)
Definition: mcxt.c:924
int errmsg(const char *fmt,...)
Definition: elog.c:784
long val
Definition: informix.c:684

◆ plperl_call_handler()

Datum plperl_call_handler ( PG_FUNCTION_ARGS  )

Definition at line 1841 of file plperl.c.

References activate_interpreter(), CALLED_AS_EVENT_TRIGGER, CALLED_AS_TRIGGER, current_call_data, decrement_prodesc_refcount, plperl_call_data::fcinfo, MemSet, PG_CATCH, PG_END_TRY, PG_FUNCTION_INFO_V1(), PG_RE_THROW, PG_TRY, plperl_active_interp, plperl_event_trigger_handler(), plperl_func_handler(), plperl_inline_handler(), plperl_trigger_handler(), PointerGetDatum, and plperl_call_data::prodesc.

Referenced by plperl_modify_tuple(), and plperlu_call_handler().

1842 {
1843  Datum retval;
1844  plperl_call_data *volatile save_call_data = current_call_data;
1845  plperl_interp_desc *volatile oldinterp = plperl_active_interp;
1846  plperl_call_data this_call_data;
1847 
1848  /* Initialize current-call status record */
1849  MemSet(&this_call_data, 0, sizeof(this_call_data));
1850  this_call_data.fcinfo = fcinfo;
1851 
1852  PG_TRY();
1853  {
1854  current_call_data = &this_call_data;
1855  if (CALLED_AS_TRIGGER(fcinfo))
1856  retval = PointerGetDatum(plperl_trigger_handler(fcinfo));
1857  else if (CALLED_AS_EVENT_TRIGGER(fcinfo))
1858  {
1860  retval = (Datum) 0;
1861  }
1862  else
1863  retval = plperl_func_handler(fcinfo);
1864  }
1865  PG_CATCH();
1866  {
1867  current_call_data = save_call_data;
1868  activate_interpreter(oldinterp);
1869  if (this_call_data.prodesc)
1870  decrement_prodesc_refcount(this_call_data.prodesc);
1871  PG_RE_THROW();
1872  }
1873  PG_END_TRY();
1874 
1875  current_call_data = save_call_data;
1876  activate_interpreter(oldinterp);
1877  if (this_call_data.prodesc)
1878  decrement_prodesc_refcount(this_call_data.prodesc);
1879  return retval;
1880 }
#define CALLED_AS_EVENT_TRIGGER(fcinfo)
Definition: event_trigger.h:39
static Datum plperl_func_handler(PG_FUNCTION_ARGS)
Definition: plperl.c:2409
#define decrement_prodesc_refcount(prodesc)
Definition: plperl.c:132
FunctionCallInfo fcinfo
Definition: plperl.c:177
#define PointerGetDatum(X)
Definition: postgres.h:556
#define MemSet(start, val, len)
Definition: c.h:955
static plperl_interp_desc * plperl_active_interp
Definition: plperl.c:228
static void plperl_event_trigger_handler(PG_FUNCTION_ARGS)
Definition: plperl.c:2638
static Datum plperl_trigger_handler(PG_FUNCTION_ARGS)
Definition: plperl.c:2525
static void activate_interpreter(plperl_interp_desc *interp_desc)
Definition: plperl.c:688
uintptr_t Datum
Definition: postgres.h:367
#define PG_CATCH()
Definition: elog.h:310
#define CALLED_AS_TRIGGER(fcinfo)
Definition: trigger.h:25
#define PG_RE_THROW()
Definition: elog.h:331
plperl_proc_desc * prodesc
Definition: plperl.c:176
#define PG_TRY()
Definition: elog.h:301
static plperl_call_data * current_call_data
Definition: plperl.c:244
#define PG_END_TRY()
Definition: elog.h:317

◆ plperl_call_perl_event_trigger_func()

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

Definition at line 2346 of file plperl.c.

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

Referenced by plperl_event_trigger_handler().

2349 {
2350  dTHX;
2351  dSP;
2352  SV *retval,
2353  *TDsv;
2354  int count;
2355 
2356  ENTER;
2357  SAVETMPS;
2358 
2359  TDsv = get_sv("main::_TD", 0);
2360  if (!TDsv)
2361  ereport(ERROR,
2362  (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2363  errmsg("couldn't fetch $_TD")));
2364 
2365  save_item(TDsv); /* local $_TD */
2366  sv_setsv(TDsv, td);
2367 
2368  PUSHMARK(sp);
2369  PUTBACK;
2370 
2371  /* Do NOT use G_KEEPERR here */
2372  count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL);
2373 
2374  SPAGAIN;
2375 
2376  if (count != 1)
2377  {
2378  PUTBACK;
2379  FREETMPS;
2380  LEAVE;
2381  ereport(ERROR,
2382  (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2383  errmsg("didn't get a return item from trigger function")));
2384  }
2385 
2386  if (SvTRUE(ERRSV))
2387  {
2388  (void) POPs;
2389  PUTBACK;
2390  FREETMPS;
2391  LEAVE;
2392  /* XXX need to find a way to determine a better errcode here */
2393  ereport(ERROR,
2394  (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2396  }
2397 
2398  retval = newSVsv(POPs);
2399  (void) retval; /* silence compiler warning */
2400 
2401  PUTBACK;
2402  FREETMPS;
2403  LEAVE;
2404 
2405  return;
2406 }
#define dTHX
Definition: ppport.h:3208
int errcode(int sqlerrcode)
Definition: elog.c:570
#define ERRSV
Definition: ppport.h:3859
#define ERROR
Definition: elog.h:43
#define ereport(elevel, rest)
Definition: elog.h:141
SV * reference
Definition: plperl.c:110
static char * strip_trailing_ws(const char *msg)
Definition: plperl.c:1065
int errmsg(const char *fmt,...)
Definition: elog.c:784
#define get_sv
Definition: ppport.h:3878
static char * sv2cstr(SV *sv)

◆ plperl_call_perl_func()

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

Definition at line 2185 of file plperl.c.

References plperl_proc_desc::arg_arraytype, plperl_proc_desc::arg_is_rowtype, plperl_proc_desc::arg_out_func, FunctionCallInfoBaseData::args, Assert, cstr2sv(), 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().

2186 {
2187  dTHX;
2188  dSP;
2189  SV *retval;
2190  int i;
2191  int count;
2192  Oid *argtypes = NULL;
2193  int nargs = 0;
2194 
2195  ENTER;
2196  SAVETMPS;
2197 
2198  PUSHMARK(SP);
2199  EXTEND(sp, desc->nargs);
2200 
2201  /* Get signature for true functions; inline blocks have no args. */
2202  if (fcinfo->flinfo->fn_oid)
2203  get_func_signature(fcinfo->flinfo->fn_oid, &argtypes, &nargs);
2204  Assert(nargs == desc->nargs);
2205 
2206  for (i = 0; i < desc->nargs; i++)
2207  {
2208  if (fcinfo->args[i].isnull)
2209  PUSHs(&PL_sv_undef);
2210  else if (desc->arg_is_rowtype[i])
2211  {
2212  SV *sv = plperl_hash_from_datum(fcinfo->args[i].value);
2213 
2214  PUSHs(sv_2mortal(sv));
2215  }
2216  else
2217  {
2218  SV *sv;
2219  Oid funcid;
2220 
2221  if (OidIsValid(desc->arg_arraytype[i]))
2222  sv = plperl_ref_from_pg_array(fcinfo->args[i].value, desc->arg_arraytype[i]);
2224  sv = (SV *) DatumGetPointer(OidFunctionCall1(funcid, fcinfo->args[i].value));
2225  else
2226  {
2227  char *tmp;
2228 
2229  tmp = OutputFunctionCall(&(desc->arg_out_func[i]),
2230  fcinfo->args[i].value);
2231  sv = cstr2sv(tmp);
2232  pfree(tmp);
2233  }
2234 
2235  PUSHs(sv_2mortal(sv));
2236  }
2237  }
2238  PUTBACK;
2239 
2240  /* Do NOT use G_KEEPERR here */
2241  count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL);
2242 
2243  SPAGAIN;
2244 
2245  if (count != 1)
2246  {
2247  PUTBACK;
2248  FREETMPS;
2249  LEAVE;
2250  ereport(ERROR,
2251  (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2252  errmsg("didn't get a return item from function")));
2253  }
2254 
2255  if (SvTRUE(ERRSV))
2256  {
2257  (void) POPs;
2258  PUTBACK;
2259  FREETMPS;
2260  LEAVE;
2261  /* XXX need to find a way to determine a better errcode here */
2262  ereport(ERROR,
2263  (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2265  }
2266 
2267  retval = newSVsv(POPs);
2268 
2269  PUTBACK;
2270  FREETMPS;
2271  LEAVE;
2272 
2273  return retval;
2274 }
static SV * plperl_ref_from_pg_array(Datum arg, Oid typid)
Definition: plperl.c:1466
Oid get_transform_fromsql(Oid typid, Oid langid, List *trftypes)
Definition: lsyscache.c:1900
List * trftypes
Definition: plperl.c:114
bool * arg_is_rowtype
Definition: plperl.c:126
#define dTHX
Definition: ppport.h:3208
Oid get_func_signature(Oid funcid, Oid **argtypes, int *nargs)
Definition: lsyscache.c:1498
#define PL_sv_undef
Definition: ppport.h:4129
int errcode(int sqlerrcode)
Definition: elog.c:570
#define ERRSV
Definition: ppport.h:3859
static SV * plperl_hash_from_datum(Datum attr)
Definition: plperl.c:3006
unsigned int Oid
Definition: postgres_ext.h:31
FmgrInfo * arg_out_func
Definition: plperl.c:125
#define OidIsValid(objectId)
Definition: c.h:638
char * OutputFunctionCall(FmgrInfo *flinfo, Datum val)
Definition: fmgr.c:1575
void pfree(void *pointer)
Definition: mcxt.c:1031
#define ERROR
Definition: elog.h:43
NullableDatum args[FLEXIBLE_ARRAY_MEMBER]
Definition: fmgr.h:95
#define OidFunctionCall1(functionId, arg1)
Definition: fmgr.h:654
#define ereport(elevel, rest)
Definition: elog.h:141
Datum value
Definition: postgres.h:378
Oid * arg_arraytype
Definition: plperl.c:127
FmgrInfo * flinfo
Definition: fmgr.h:87
static SV * cstr2sv(const char *str)
Oid fn_oid
Definition: fmgr.h:59
#define Assert(condition)
Definition: c.h:732
SV * reference
Definition: plperl.c:110
static char * strip_trailing_ws(const char *msg)
Definition: plperl.c:1065
#define DatumGetPointer(X)
Definition: postgres.h:549
int errmsg(const char *fmt,...)
Definition: elog.c:784
int i
plperl_proc_desc * prodesc
Definition: plperl.c:176
static plperl_call_data * current_call_data
Definition: plperl.c:244
static char * sv2cstr(SV *sv)

◆ plperl_call_perl_trigger_func()

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

Definition at line 2278 of file plperl.c.

References 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().

2280 {
2281  dTHX;
2282  dSP;
2283  SV *retval,
2284  *TDsv;
2285  int i,
2286  count;
2287  Trigger *tg_trigger = ((TriggerData *) fcinfo->context)->tg_trigger;
2288 
2289  ENTER;
2290  SAVETMPS;
2291 
2292  TDsv = get_sv("main::_TD", 0);
2293  if (!TDsv)
2294  ereport(ERROR,
2295  (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2296  errmsg("couldn't fetch $_TD")));
2297 
2298  save_item(TDsv); /* local $_TD */
2299  sv_setsv(TDsv, td);
2300 
2301  PUSHMARK(sp);
2302  EXTEND(sp, tg_trigger->tgnargs);
2303 
2304  for (i = 0; i < tg_trigger->tgnargs; i++)
2305  PUSHs(sv_2mortal(cstr2sv(tg_trigger->tgargs[i])));
2306  PUTBACK;
2307 
2308  /* Do NOT use G_KEEPERR here */
2309  count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL);
2310 
2311  SPAGAIN;
2312 
2313  if (count != 1)
2314  {
2315  PUTBACK;
2316  FREETMPS;
2317  LEAVE;
2318  ereport(ERROR,
2319  (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2320  errmsg("didn't get a return item from trigger function")));
2321  }
2322 
2323  if (SvTRUE(ERRSV))
2324  {
2325  (void) POPs;
2326  PUTBACK;
2327  FREETMPS;
2328  LEAVE;
2329  /* XXX need to find a way to determine a better errcode here */
2330  ereport(ERROR,
2331  (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
2333  }
2334 
2335  retval = newSVsv(POPs);
2336 
2337  PUTBACK;
2338  FREETMPS;
2339  LEAVE;
2340 
2341  return retval;
2342 }
#define dTHX
Definition: ppport.h:3208
int errcode(int sqlerrcode)
Definition: elog.c:570
#define ERRSV
Definition: ppport.h:3859
fmNodePtr context
Definition: fmgr.h:88
#define ERROR
Definition: elog.h:43
#define ereport(elevel, rest)
Definition: elog.h:141
char ** tgargs
Definition: reltrigger.h:40
static SV * cstr2sv(const char *str)
SV * reference
Definition: plperl.c:110
static char * strip_trailing_ws(const char *msg)
Definition: plperl.c:1065
int errmsg(const char *fmt,...)
Definition: elog.c:784
#define get_sv
Definition: ppport.h:3878
int i
int16 tgnargs
Definition: reltrigger.h:37
static char * sv2cstr(SV *sv)

◆ plperl_compile_callback()

static void plperl_compile_callback ( void *  arg)
static

Definition at line 4139 of file plperl.c.

References errcontext.

Referenced by compile_plperl_function().

4140 {
4141  char *procname = (char *) arg;
4142 
4143  if (procname)
4144  errcontext("compilation of PL/Perl function \"%s\"", procname);
4145 }
#define errcontext
Definition: elog.h:183
void * arg

◆ plperl_create_sub()

static void plperl_create_sub ( plperl_proc_desc desc,
const char *  s,
Oid  fn_oid 
)
static

Definition at line 2098 of file plperl.c.

References 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().

2099 {
2100  dTHX;
2101  dSP;
2102  char subname[NAMEDATALEN + 40];
2103  HV *pragma_hv = newHV();
2104  SV *subref = NULL;
2105  int count;
2106 
2107  sprintf(subname, "%s__%u", prodesc->proname, fn_oid);
2108 
2109  if (plperl_use_strict)
2110  hv_store_string(pragma_hv, "strict", (SV *) newAV());
2111 
2112  ENTER;
2113  SAVETMPS;
2114  PUSHMARK(SP);
2115  EXTEND(SP, 4);
2116  PUSHs(sv_2mortal(cstr2sv(subname)));
2117  PUSHs(sv_2mortal(newRV_noinc((SV *) pragma_hv)));
2118 
2119  /*
2120  * Use 'false' for $prolog in mkfunc, which is kept for compatibility in
2121  * case a module such as PostgreSQL::PLPerl::NYTprof replaces the function
2122  * compiler.
2123  */
2124  PUSHs(&PL_sv_no);
2125  PUSHs(sv_2mortal(cstr2sv(s)));
2126  PUTBACK;
2127 
2128  /*
2129  * G_KEEPERR seems to be needed here, else we don't recognize compile
2130  * errors properly. Perhaps it's because there's another level of eval
2131  * inside mksafefunc?
2132  */
2133  count = perl_call_pv("PostgreSQL::InServer::mkfunc",
2134  G_SCALAR | G_EVAL | G_KEEPERR);
2135  SPAGAIN;
2136 
2137  if (count == 1)
2138  {
2139  SV *sub_rv = (SV *) POPs;
2140 
2141  if (sub_rv && SvROK(sub_rv) && SvTYPE(SvRV(sub_rv)) == SVt_PVCV)
2142  {
2143  subref = newRV_inc(SvRV(sub_rv));
2144  }
2145  }
2146 
2147  PUTBACK;
2148  FREETMPS;
2149  LEAVE;
2150 
2151  if (SvTRUE(ERRSV))
2152  ereport(ERROR,
2153  (errcode(ERRCODE_SYNTAX_ERROR),
2155 
2156  if (!subref)
2157  ereport(ERROR,
2158  (errcode(ERRCODE_SYNTAX_ERROR),
2159  errmsg("didn't get a CODE reference from compiling function \"%s\"",
2160  prodesc->proname)));
2161 
2162  prodesc->reference = subref;
2163 
2164  return;
2165 }
#define dTHX
Definition: ppport.h:3208
int errcode(int sqlerrcode)
Definition: elog.c:570
#define ERRSV
Definition: ppport.h:3859
static SV ** hv_store_string(HV *hv, const char *key, SV *val)
Definition: plperl.c:4077
NameData subname
#define NAMEDATALEN
#define sprintf
Definition: port.h:194
#define ERROR
Definition: elog.h:43
#define ereport(elevel, rest)
Definition: elog.h:141
#define newRV_noinc(a)
Definition: ppport.h:4456
#define newRV_inc(sv)
Definition: ppport.h:4442
static SV * cstr2sv(const char *str)
static bool plperl_use_strict
Definition: plperl.c:234
static char * strip_trailing_ws(const char *msg)
Definition: plperl.c:1065
int errmsg(const char *fmt,...)
Definition: elog.c:784
#define PL_sv_no
Definition: ppport.h:4128
static char * sv2cstr(SV *sv)

◆ plperl_destroy_interp()

static void plperl_destroy_interp ( PerlInterpreter **  interp)
static

Definition at line 922 of file plperl.c.

References dTHX, and PERL_UNUSED_VAR.

Referenced by plperl_fini().

923 {
924  if (interp && *interp)
925  {
926  /*
927  * Only a very minimal destruction is performed: - just call END
928  * blocks.
929  *
930  * We could call perl_destruct() but we'd need to audit its actions
931  * very carefully and work-around any that impact us. (Calling
932  * sv_clean_objs() isn't an option because it's not part of perl's
933  * public API so isn't portably available.) Meanwhile END blocks can
934  * be used to perform manual cleanup.
935  */
936  dTHX;
937 
938  /* Run END blocks - based on perl's perl_destruct() */
939  if (PL_exit_flags & PERL_EXIT_DESTRUCT_END)
940  {
941  dJMPENV;
942  int x = 0;
943 
944  JMPENV_PUSH(x);
945  PERL_UNUSED_VAR(x);
946  if (PL_endav && !PL_minus_c)
947  call_list(PL_scopestack_ix, PL_endav);
948  JMPENV_POP;
949  }
950  LEAVE;
951  FREETMPS;
952 
953  *interp = NULL;
954  }
955 }
#define dTHX
Definition: ppport.h:3208
#define PERL_UNUSED_VAR(x)
Definition: ppport.h:3730

◆ plperl_event_trigger_build_args()

static SV* plperl_event_trigger_build_args ( FunctionCallInfo  fcinfo)
static

Definition at line 1733 of file plperl.c.

References FunctionCallInfoBaseData::context, cstr2sv(), dTHX, EventTriggerData::event, hv_store_string(), newRV_noinc, and EventTriggerData::tag.

Referenced by plperl_event_trigger_handler().

1734 {
1735  dTHX;
1736  EventTriggerData *tdata;
1737  HV *hv;
1738 
1739  hv = newHV();
1740 
1741  tdata = (EventTriggerData *) fcinfo->context;
1742 
1743  hv_store_string(hv, "event", cstr2sv(tdata->event));
1744  hv_store_string(hv, "tag", cstr2sv(tdata->tag));
1745 
1746  return newRV_noinc((SV *) hv);
1747 }
#define dTHX
Definition: ppport.h:3208
const char * tag
Definition: event_trigger.h:28
fmNodePtr context
Definition: fmgr.h:88
static SV ** hv_store_string(HV *hv, const char *key, SV *val)
Definition: plperl.c:4077
const char * event
Definition: event_trigger.h:26
#define newRV_noinc(a)
Definition: ppport.h:4456
static SV * cstr2sv(const char *str)

◆ plperl_event_trigger_handler()

static void plperl_event_trigger_handler ( PG_FUNCTION_ARGS  )
static

Definition at line 2638 of file plperl.c.

References activate_interpreter(), ErrorContextCallback::arg, ErrorContextCallback::callback, compile_plperl_function(), 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_CONNECT, SPI_OK_FINISH, and SvREFCNT_dec_current().

Referenced by plperl_call_handler().

2639 {
2640  plperl_proc_desc *prodesc;
2641  SV *svTD;
2642  ErrorContextCallback pl_error_context;
2643 
2644  /* Connect to SPI manager */
2645  if (SPI_connect() != SPI_OK_CONNECT)
2646  elog(ERROR, "could not connect to SPI manager");
2647 
2648  /* Find or compile the function */
2649  prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false, true);
2650  current_call_data->prodesc = prodesc;
2651  increment_prodesc_refcount(prodesc);
2652 
2653  /* Set a callback for error reporting */
2654  pl_error_context.callback = plperl_exec_callback;
2655  pl_error_context.previous = error_context_stack;
2656  pl_error_context.arg = prodesc->proname;
2657  error_context_stack = &pl_error_context;
2658 
2659  activate_interpreter(prodesc->interp);
2660 
2661  svTD = plperl_event_trigger_build_args(fcinfo);
2662  plperl_call_perl_event_trigger_func(prodesc, fcinfo, svTD);
2663 
2664  if (SPI_finish() != SPI_OK_FINISH)
2665  elog(ERROR, "SPI_finish() failed");
2666 
2667  /* Restore the previous error callback */
2668  error_context_stack = pl_error_context.previous;
2669 
2670  SvREFCNT_dec_current(svTD);
2671 }
#define SPI_OK_CONNECT
Definition: spi.h:53
int SPI_connect(void)
Definition: spi.c:89
int SPI_finish(void)
Definition: spi.c:176
void(* callback)(void *arg)
Definition: elog.h:254
struct ErrorContextCallback * previous
Definition: elog.h:253
static void plperl_call_perl_event_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, SV *td)
Definition: plperl.c:2346
ErrorContextCallback * error_context_stack
Definition: elog.c:88
#define ERROR
Definition: elog.h:43
static plperl_proc_desc * compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
Definition: plperl.c:2722
static void activate_interpreter(plperl_interp_desc *interp_desc)
Definition: plperl.c:688
static void plperl_exec_callback(void *arg)
Definition: plperl.c:4127
#define increment_prodesc_refcount(prodesc)
Definition: plperl.c:130
static void SvREFCNT_dec_current(SV *sv)
Definition: plperl.c:313
#define SPI_OK_FINISH
Definition: spi.h:54
static SV * plperl_event_trigger_build_args(FunctionCallInfo fcinfo)
Definition: plperl.c:1733
#define elog(elevel,...)
Definition: elog.h:226
char * proname
Definition: plperl.c:105
plperl_proc_desc * prodesc
Definition: plperl.c:176
plperl_interp_desc * interp
Definition: plperl.c:111
static plperl_call_data * current_call_data
Definition: plperl.c:244

◆ plperl_exec_callback()

static void plperl_exec_callback ( void *  arg)
static

Definition at line 4127 of file plperl.c.

References errcontext.

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

4128 {
4129  char *procname = (char *) arg;
4130 
4131  if (procname)
4132  errcontext("PL/Perl function \"%s\"", procname);
4133 }
#define errcontext
Definition: elog.h:183
void * arg

◆ plperl_fini()

static void plperl_fini ( int  code,
Datum  arg 
)
static

Definition at line 512 of file plperl.c.

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

Referenced by select_perl_context().

513 {
514  HASH_SEQ_STATUS hash_seq;
515  plperl_interp_desc *interp_desc;
516 
517  elog(DEBUG3, "plperl_fini");
518 
519  /*
520  * Indicate that perl is terminating. Disables use of spi_* functions when
521  * running END/DESTROY code. See check_spi_usage_allowed(). Could be
522  * enabled in future, with care, using a transaction
523  * http://archives.postgresql.org/pgsql-hackers/2010-01/msg02743.php
524  */
525  plperl_ending = true;
526 
527  /* Only perform perl cleanup if we're exiting cleanly */
528  if (code)
529  {
530  elog(DEBUG3, "plperl_fini: skipped");
531  return;
532  }
533 
534  /* Zap the "held" interpreter, if we still have it */
536 
537  /* Zap any fully-initialized interpreters */
538  hash_seq_init(&hash_seq, plperl_interp_hash);
539  while ((interp_desc = hash_seq_search(&hash_seq)) != NULL)
540  {
541  if (interp_desc->interp)
542  {
543  activate_interpreter(interp_desc);
544  plperl_destroy_interp(&interp_desc->interp);
545  }
546  }
547 
548  elog(DEBUG3, "plperl_fini: done");
549 }
static bool plperl_ending
Definition: plperl.c:239
#define DEBUG3
Definition: elog.h:23
PerlInterpreter * interp
Definition: plperl.c:89
static void activate_interpreter(plperl_interp_desc *interp_desc)
Definition: plperl.c:688
static void plperl_destroy_interp(PerlInterpreter **)
Definition: plperl.c:922
void * hash_seq_search(HASH_SEQ_STATUS *status)
Definition: dynahash.c:1389
void hash_seq_init(HASH_SEQ_STATUS *status, HTAB *hashp)
Definition: dynahash.c:1379
static PerlInterpreter * plperl_held_interp
Definition: plperl.c:231
static HTAB * plperl_interp_hash
Definition: plperl.c:226
#define elog(elevel,...)
Definition: elog.h:226

◆ plperl_func_handler()

static Datum plperl_func_handler ( PG_FUNCTION_ARGS  )
static

Definition at line 2409 of file plperl.c.

References activate_interpreter(), ReturnSetInfo::allowedModes, ErrorContextCallback::arg, ErrorContextCallback::callback, castNode, compile_plperl_function(), dTHX, elog, ereport, errcode(), errmsg(), ERROR, error_context_stack, ExprEndResult, FALSE, plperl_proc_desc::fn_retisset, get_perl_array_ref(), i, 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_CONNECT, SPI_OK_FINISH, SPI_OPT_NONATOMIC, SvREFCNT_dec_current(), and plperl_call_data::tuple_store.

Referenced by plperl_call_handler().

2410 {
2411  bool nonatomic;
2412  plperl_proc_desc *prodesc;
2413  SV *perlret;
2414  Datum retval = 0;
2415  ReturnSetInfo *rsi;
2416  ErrorContextCallback pl_error_context;
2417 
2418  nonatomic = fcinfo->context &&
2419  IsA(fcinfo->context, CallContext) &&
2420  !castNode(CallContext, fcinfo->context)->atomic;
2421 
2422  if (SPI_connect_ext(nonatomic ? SPI_OPT_NONATOMIC : 0) != SPI_OK_CONNECT)
2423  elog(ERROR, "could not connect to SPI manager");
2424 
2425  prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false, false);
2426  current_call_data->prodesc = prodesc;
2427  increment_prodesc_refcount(prodesc);
2428 
2429  /* Set a callback for error reporting */
2430  pl_error_context.callback = plperl_exec_callback;
2431  pl_error_context.previous = error_context_stack;
2432  pl_error_context.arg = prodesc->proname;
2433  error_context_stack = &pl_error_context;
2434 
2435  rsi = (ReturnSetInfo *) fcinfo->resultinfo;
2436 
2437  if (prodesc->fn_retisset)
2438  {
2439  /* Check context before allowing the call to go through */
2440  if (!rsi || !IsA(rsi, ReturnSetInfo) ||
2441  (rsi->allowedModes & SFRM_Materialize) == 0)
2442  ereport(ERROR,
2443  (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
2444  errmsg("set-valued function called in context that "
2445  "cannot accept a set")));
2446  }
2447 
2448  activate_interpreter(prodesc->interp);
2449 
2450  perlret = plperl_call_perl_func(prodesc, fcinfo);
2451 
2452  /************************************************************
2453  * Disconnect from SPI manager and then create the return
2454  * values datum (if the input function does a palloc for it
2455  * this must not be allocated in the SPI memory context
2456  * because SPI_finish would free it).
2457  ************************************************************/
2458  if (SPI_finish() != SPI_OK_FINISH)
2459  elog(ERROR, "SPI_finish() failed");
2460 
2461  if (prodesc->fn_retisset)
2462  {
2463  SV *sav;
2464 
2465  /*
2466  * If the Perl function returned an arrayref, we pretend that it
2467  * called return_next() for each element of the array, to handle old
2468  * SRFs that didn't know about return_next(). Any other sort of return
2469  * value is an error, except undef which means return an empty set.
2470  */
2471  sav = get_perl_array_ref(perlret);
2472  if (sav)
2473  {
2474  dTHX;
2475  int i = 0;
2476  SV **svp = 0;
2477  AV *rav = (AV *) SvRV(sav);
2478 
2479  while ((svp = av_fetch(rav, i, FALSE)) != NULL)
2480  {
2482  i++;
2483  }
2484  }
2485  else if (SvOK(perlret))
2486  {
2487  ereport(ERROR,
2488  (errcode(ERRCODE_DATATYPE_MISMATCH),
2489  errmsg("set-returning PL/Perl function must return "
2490  "reference to array or use return_next")));
2491  }
2492 
2495  {
2498  }
2499  retval = (Datum) 0;
2500  }
2501  else if (prodesc->result_oid)
2502  {
2503  retval = plperl_sv_to_datum(perlret,
2504  prodesc->result_oid,
2505  -1,
2506  fcinfo,
2507  &prodesc->result_in_func,
2508  prodesc->result_typioparam,
2509  &fcinfo->isnull);
2510 
2511  if (fcinfo->isnull && rsi && IsA(rsi, ReturnSetInfo))
2512  rsi->isDone = ExprEndResult;
2513  }
2514 
2515  /* Restore the previous error callback */
2516  error_context_stack = pl_error_context.previous;
2517 
2518  SvREFCNT_dec_current(perlret);
2519 
2520  return retval;
2521 }
#define SPI_OK_CONNECT
Definition: spi.h:53
#define IsA(nodeptr, _type_)
Definition: nodes.h:575
static SV * get_perl_array_ref(SV *sv)
Definition: plperl.c:1142
static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod, FunctionCallInfo fcinfo, FmgrInfo *finfo, Oid typioparam, bool *isnull)
Definition: plperl.c:1311
#define dTHX
Definition: ppport.h:3208
int SPI_connect_ext(int options)
Definition: spi.c:95
#define castNode(_type_, nodeptr)
Definition: nodes.h:593
#define FALSE
Definition: ecpglib.h:39
int SPI_finish(void)
Definition: spi.c:176
int errcode(int sqlerrcode)
Definition: elog.c:570
void(* callback)(void *arg)
Definition: elog.h:254
struct ErrorContextCallback * previous
Definition: elog.h:253
ErrorContextCallback * error_context_stack
Definition: elog.c:88
bool fn_retisset
Definition: plperl.c:117
#define ERROR
Definition: elog.h:43
#define SPI_OPT_NONATOMIC
Definition: spi.h:71
FmgrInfo result_in_func
Definition: plperl.c:121
static plperl_proc_desc * compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
Definition: plperl.c:2722
static void activate_interpreter(plperl_interp_desc *interp_desc)
Definition: plperl.c:688
static void plperl_exec_callback(void *arg)
Definition: plperl.c:4127
#define increment_prodesc_refcount(prodesc)
Definition: plperl.c:130
Oid result_typioparam
Definition: plperl.c:122
#define ereport(elevel, rest)
Definition: elog.h:141
static void plperl_return_next_internal(SV *sv)
Definition: plperl.c:3266
uintptr_t Datum
Definition: postgres.h:367
Tuplestorestate * tuple_store
Definition: plperl.c:179
static void SvREFCNT_dec_current(SV *sv)
Definition: plperl.c:313
int allowedModes
Definition: execnodes.h:303
TupleDesc ret_tdesc
Definition: plperl.c:180
SetFunctionReturnMode returnMode
Definition: execnodes.h:305
#define SPI_OK_FINISH
Definition: spi.h:54
Tuplestorestate * setResult
Definition: execnodes.h:308
TupleDesc setDesc
Definition: execnodes.h:309
int errmsg(const char *fmt,...)
Definition: elog.c:784
#define elog(elevel,...)
Definition: elog.h:226
int i
char * proname
Definition: plperl.c:105
plperl_proc_desc * prodesc
Definition: plperl.c:176
ExprDoneCond isDone
Definition: execnodes.h:306
plperl_interp_desc * interp
Definition: plperl.c:111
static plperl_call_data * current_call_data
Definition: plperl.c:244
static SV * plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
Definition: plperl.c:2185

◆ plperl_hash_from_datum()

static SV * plperl_hash_from_datum ( Datum  attr)
static

Definition at line 3006 of file plperl.c.

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().

3007 {
3008  HeapTupleHeader td;
3009  Oid tupType;
3010  int32 tupTypmod;
3011  TupleDesc tupdesc;
3012  HeapTupleData tmptup;
3013  SV *sv;
3014 
3015  td = DatumGetHeapTupleHeader(attr);
3016 
3017  /* Extract rowtype info and find a tupdesc */
3018  tupType = HeapTupleHeaderGetTypeId(td);
3019  tupTypmod = HeapTupleHeaderGetTypMod(td);
3020  tupdesc = lookup_rowtype_tupdesc(tupType, tupTypmod);
3021 
3022  /* Build a temporary HeapTuple control structure */
3023  tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
3024  tmptup.t_data = td;
3025 
3026  sv = plperl_hash_from_tuple(&tmptup, tupdesc, true);
3027  ReleaseTupleDesc(tupdesc);
3028 
3029  return sv;
3030 }
TupleDesc lookup_rowtype_tupdesc(Oid type_id, int32 typmod)
Definition: typcache.c:1652
unsigned int Oid
Definition: postgres_ext.h:31
#define DatumGetHeapTupleHeader(X)
Definition: fmgr.h:289
signed int int32
Definition: c.h:346
HeapTupleHeader t_data
Definition: htup.h:68
#define HeapTupleHeaderGetTypMod(tup)
Definition: htup_details.h:468
uint32 t_len
Definition: htup.h:64
#define HeapTupleHeaderGetTypeId(tup)
Definition: htup_details.h:458
static SV * plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc, bool include_generated)
Definition: plperl.c:3034
#define ReleaseTupleDesc(tupdesc)
Definition: tupdesc.h:122
#define HeapTupleHeaderGetDatumLength(tup)
Definition: htup_details.h:452

◆ plperl_hash_from_tuple()

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

Definition at line 3034 of file plperl.c.

References attname, check_stack_depth(), cstr2sv(), 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().

3035 {
3036  dTHX;
3037  HV *hv;
3038  int i;
3039 
3040  /* since this function recurses, it could be driven to stack overflow */
3042 
3043  hv = newHV();
3044  hv_ksplit(hv, tupdesc->natts); /* pre-grow the hash */
3045 
3046  for (i = 0; i < tupdesc->natts; i++)
3047  {
3048  Datum attr;
3049  bool isnull,
3050  typisvarlena;
3051  char *attname;
3052  Oid typoutput;
3053  Form_pg_attribute att = TupleDescAttr(tupdesc, i);
3054 
3055  if (att->attisdropped)
3056  continue;
3057 
3058  if (att->attgenerated)
3059  {
3060  /* don't include unless requested */
3061  if (!include_generated)
3062  continue;
3063  }
3064 
3065  attname = NameStr(att->attname);
3066  attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
3067 
3068  if (isnull)
3069  {
3070  /*
3071  * Store (attname => undef) and move on. Note we can't use
3072  * &PL_sv_undef here; see "AVs, HVs and undefined values" in
3073  * perlguts for an explanation.
3074  */
3075  hv_store_string(hv, attname, newSV(0));
3076  continue;
3077  }
3078 
3079  if (type_is_rowtype(att->atttypid))
3080  {
3081  SV *sv = plperl_hash_from_datum(attr);
3082 
3083  hv_store_string(hv, attname, sv);
3084  }
3085  else
3086  {
3087  SV *sv;
3088  Oid funcid;
3089 
3090  if (OidIsValid(get_base_element_type(att->atttypid)))
3091  sv = plperl_ref_from_pg_array(attr, att->atttypid);
3093  sv = (SV *) DatumGetPointer(OidFunctionCall1(funcid, attr));
3094  else
3095  {
3096  char *outputstr;
3097 
3098  /* XXX should have a way to cache these lookups */
3099  getTypeOutputInfo(att->atttypid, &typoutput, &typisvarlena);
3100 
3101  outputstr = OidOutputFunctionCall(typoutput, attr);
3102  sv = cstr2sv(outputstr);
3103  pfree(outputstr);
3104  }
3105 
3106  hv_store_string(hv, attname, sv);
3107  }
3108  }
3109  return newRV_noinc((SV *) hv);
3110 }
static SV * plperl_ref_from_pg_array(Datum arg, Oid typid)
Definition: plperl.c:1466
Oid get_transform_fromsql(Oid typid, Oid langid, List *trftypes)
Definition: lsyscache.c:1900
List * trftypes
Definition: plperl.c:114
void getTypeOutputInfo(Oid type, Oid *typOutput, bool *typIsVarlena)
Definition: lsyscache.c:2674
#define dTHX
Definition: ppport.h:3208
#define TupleDescAttr(tupdesc, i)
Definition: tupdesc.h:92
static SV * plperl_hash_from_datum(Datum attr)
Definition: plperl.c:3006
static SV ** hv_store_string(HV *hv, const char *key, SV *val)
Definition: plperl.c:4077
unsigned int Oid
Definition: postgres_ext.h:31
#define OidIsValid(objectId)
Definition: c.h:638
void pfree(void *pointer)
Definition: mcxt.c:1031
NameData attname
Definition: pg_attribute.h:40
#define OidFunctionCall1(functionId, arg1)
Definition: fmgr.h:654
void check_stack_depth(void)
Definition: postgres.c:3262
FormData_pg_attribute * Form_pg_attribute
Definition: pg_attribute.h:200
bool type_is_rowtype(Oid typid)
Definition: lsyscache.c:2433
#define heap_getattr(tup, attnum, tupleDesc, isnull)
Definition: htup_details.h:762
#define newRV_noinc(a)
Definition: ppport.h:4456
uintptr_t Datum
Definition: postgres.h:367
static SV * cstr2sv(const char *str)
#define DatumGetPointer(X)
Definition: postgres.h:549
Oid get_base_element_type(Oid typid)
Definition: lsyscache.c:2599
char * OidOutputFunctionCall(Oid functionId, Datum val)
Definition: fmgr.c:1655
int i
#define NameStr(name)
Definition: c.h:609
plperl_proc_desc * prodesc
Definition: plperl.c:176
static plperl_call_data * current_call_data
Definition: plperl.c:244

◆ plperl_hash_to_datum()

static Datum plperl_hash_to_datum ( SV *  src,
TupleDesc  td 
)
static

Definition at line 1130 of file plperl.c.

References HeapTupleGetDatum, and plperl_build_tuple_result().

Referenced by plperl_sv_to_datum().

1131 {
1132  HeapTuple tup = plperl_build_tuple_result((HV *) SvRV(src), td);
1133 
1134  return HeapTupleGetDatum(tup);
1135 }
#define HeapTupleGetDatum(tuple)
Definition: funcapi.h:221
static HeapTuple plperl_build_tuple_result(HV *perlhash, TupleDesc td)
Definition: plperl.c:1079

◆ plperl_init_interp()

static PerlInterpreter * plperl_init_interp ( void  )
static

Definition at line 709 of file plperl.c.

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().

710 {
711  PerlInterpreter *plperl;
712 
713  static char *embedding[3 + 2] = {
714  "", "-e", PLC_PERLBOOT
715  };
716  int nargs = 3;
717 
718 #ifdef WIN32
719 
720  /*
721  * The perl library on startup does horrible things like call
722  * setlocale(LC_ALL,""). We have protected against that on most platforms
723  * by setting the environment appropriately. However, on Windows,
724  * setlocale() does not consult the environment, so we need to save the
725  * existing locale settings before perl has a chance to mangle them and
726  * restore them after its dirty deeds are done.
727  *
728  * MSDN ref:
729  * http://msdn.microsoft.com/library/en-us/vclib/html/_crt_locale.asp
730  *
731  * It appears that we only need to do this on interpreter startup, and
732  * subsequent calls to the interpreter don't mess with the locale
733  * settings.
734  *
735  * We restore them using setlocale_perl(), defined below, so that Perl
736  * doesn't have a different idea of the locale from Postgres.
737  *
738  */
739 
740  char *loc;
741  char *save_collate,
742  *save_ctype,
743  *save_monetary,
744  *save_numeric,
745  *save_time;
746 
747  loc = setlocale(LC_COLLATE, NULL);
748  save_collate = loc ? pstrdup(loc) : NULL;
749  loc = setlocale(LC_CTYPE, NULL);
750  save_ctype = loc ? pstrdup(loc) : NULL;
751  loc = setlocale(LC_MONETARY, NULL);
752  save_monetary = loc ? pstrdup(loc) : NULL;
753  loc = setlocale(LC_NUMERIC, NULL);
754  save_numeric = loc ? pstrdup(loc) : NULL;
755  loc = setlocale(LC_TIME, NULL);
756  save_time = loc ? pstrdup(loc) : NULL;
757 
758 #define PLPERL_RESTORE_LOCALE(name, saved) \
759  STMT_START { \
760  if (saved != NULL) { setlocale_perl(name, saved); pfree(saved); } \
761  } STMT_END
762 #endif /* WIN32 */
763 
765  {
766  embedding[nargs++] = "-e";
767  embedding[nargs++] = plperl_on_init;
768  }
769 
770  /*
771  * The perl API docs state that PERL_SYS_INIT3 should be called before
772  * allocating interpreters. Unfortunately, on some platforms this fails in
773  * the Perl_do_taint() routine, which is called when the platform is using
774  * the system's malloc() instead of perl's own. Other platforms, notably
775  * Windows, fail if PERL_SYS_INIT3 is not called. So we call it if it's
776  * available, unless perl is using the system malloc(), which is true when
777  * MYMALLOC is set.
778  */
779 #if defined(PERL_SYS_INIT3) && !defined(MYMALLOC)
780  {
781  static int perl_sys_init_done;
782 
783  /* only call this the first time through, as per perlembed man page */
784  if (!perl_sys_init_done)
785  {
786  char *dummy_env[1] = {NULL};
787 
788  PERL_SYS_INIT3(&nargs, (char ***) &embedding, (char ***) &dummy_env);
789 
790  /*
791  * For unclear reasons, PERL_SYS_INIT3 sets the SIGFPE handler to
792  * SIG_IGN. Aside from being extremely unfriendly behavior for a
793  * library, this is dumb on the grounds that the results of a
794  * SIGFPE in this state are undefined according to POSIX, and in
795  * fact you get a forced process kill at least on Linux. Hence,
796  * restore the SIGFPE handler to the backend's standard setting.
797  * (See Perl bug 114574 for more information.)
798  */
800 
801  perl_sys_init_done = 1;
802  /* quiet warning if PERL_SYS_INIT3 doesn't use the third argument */
803  dummy_env[0] = NULL;
804  }
805  }
806 #endif
807 
808  plperl = perl_alloc();
809  if (!plperl)
810  elog(ERROR, "could not allocate Perl interpreter");
811 
812  PERL_SET_CONTEXT(plperl);
813  perl_construct(plperl);
814 
815  /*
816  * Run END blocks in perl_destruct instead of perl_run. Note that dTHX
817  * loads up a pointer to the current interpreter, so we have to postpone
818  * it to here rather than put it at the function head.
819  */
820  {
821  dTHX;
822 
823  PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
824 
825  /*
826  * Record the original function for the 'require' and 'dofile'
827  * opcodes. (They share the same implementation.) Ensure it's used
828  * for new interpreters.
829  */
830  if (!pp_require_orig)
831  pp_require_orig = PL_ppaddr[OP_REQUIRE];
832  else
833  {
834  PL_ppaddr[OP_REQUIRE] = pp_require_orig;
835  PL_ppaddr[OP_DOFILE] = pp_require_orig;
836  }
837 
838 #ifdef PLPERL_ENABLE_OPMASK_EARLY
839 
840  /*
841  * For regression testing to prove that the PLC_PERLBOOT and
842  * PLC_TRUSTED code doesn't even compile any unsafe ops. In future
843  * there may be a valid need for them to do so, in which case this
844  * could be softened (perhaps moved to plperl_trusted_init()) or
845  * removed.
846  */
847  PL_op_mask = plperl_opmask;
848 #endif
849 
850  if (perl_parse(plperl, plperl_init_shared_libs,
851  nargs, embedding, NULL) != 0)
852  ereport(ERROR,
853  (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
855  errcontext("while parsing Perl initialization")));
856 
857  if (perl_run(plperl) != 0)
858  ereport(ERROR,
859  (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
861  errcontext("while running Perl initialization")));
862 
863 #ifdef PLPERL_RESTORE_LOCALE
864  PLPERL_RESTORE_LOCALE(LC_COLLATE, save_collate);
865  PLPERL_RESTORE_LOCALE(LC_CTYPE, save_ctype);
866  PLPERL_RESTORE_LOCALE(LC_MONETARY, save_monetary);
867  PLPERL_RESTORE_LOCALE(LC_NUMERIC, save_numeric);
868  PLPERL_RESTORE_LOCALE(LC_TIME, save_time);
869 #endif
870  }
871 
872  return plperl;
873 }
static char plperl_opmask[MAXO]
Definition: plperl.c:241
#define PL_ppaddr
Definition: ppport.h:4085
static char * plperl_on_init
Definition: plperl.c:235
static void plperl_init_shared_libs(pTHX)
Definition: plperl.c:2173
#define setlocale(a, b)
Definition: win32_port.h:417
#define dTHX
Definition: ppport.h:3208
char * pstrdup(const char *in)
Definition: mcxt.c:1161
int errcode(int sqlerrcode)
Definition: elog.c:570
#define ERRSV
Definition: ppport.h:3859
static OP *(* pp_require_orig)(pTHX)
Definition: plperl.c:240
#define ERROR
Definition: elog.h:43
#define ereport(elevel, rest)
Definition: elog.h:141
pqsigfunc pqsignal(int signum, pqsigfunc handler)
Definition: signal.c:170
static char * strip_trailing_ws(const char *msg)
Definition: plperl.c:1065
int errmsg(const char *fmt,...)
Definition: elog.c:784
#define elog(elevel,...)
Definition: elog.h:226
void FloatExceptionHandler(SIGNAL_ARGS)
Definition: postgres.c:2813
#define errcontext
Definition: elog.h:183
static char * sv2cstr(SV *sv)

◆ plperl_init_shared_libs()

static void plperl_init_shared_libs ( pTHX  )
static

Definition at line 2173 of file plperl.c.

References boot_DynaLoader(), and boot_PostgreSQL__InServer__Util().

Referenced by plperl_init_interp().

2174 {
2175  char *file = __FILE__;
2176 
2177  newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
2178  newXS("PostgreSQL::InServer::Util::bootstrap",
2180  /* newXS for...::SPI::bootstrap is in select_perl_context() */
2181 }
EXTERN_C void boot_DynaLoader(pTHX_ CV *cv)
EXTERN_C void boot_PostgreSQL__InServer__Util(pTHX_ CV *cv)

◆ plperl_inline_callback()

static void plperl_inline_callback ( void *  arg)
static

Definition at line 4151 of file plperl.c.

References dTHX, errcontext, locale, and setlocale.

Referenced by plperl_inline_handler().

4152 {
4153  errcontext("PL/Perl anonymous code block");
4154 }
#define errcontext
Definition: elog.h:183

◆ plperl_inline_handler()

Datum plperl_inline_handler ( PG_FUNCTION_ARGS  )

Definition at line 1888 of file plperl.c.

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_CATCH, PG_END_TRY, PG_FUNCTION_INFO_V1(), PG_GETARG_POINTER, PG_RE_THROW, PG_RETURN_VOID, PG_TRY, plperl_active_interp, plperl_call_perl_func(), plperl_create_sub(), plperl_inline_callback(), plperl_validator(), 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_CONNECT, SPI_OK_FINISH, SPI_OPT_NONATOMIC, SvREFCNT_dec_current(), and plperl_proc_desc::trftypes.

Referenced by plperl_call_handler(), and plperlu_inline_handler().

1889 {
1890  LOCAL_FCINFO(fake_fcinfo, 0);
1892  FmgrInfo flinfo;
1893  plperl_proc_desc desc;
1894  plperl_call_data *volatile save_call_data = current_call_data;
1895  plperl_interp_desc *volatile oldinterp = plperl_active_interp;
1896  plperl_call_data this_call_data;
1897  ErrorContextCallback pl_error_context;
1898 
1899  /* Initialize current-call status record */
1900  MemSet(&this_call_data, 0, sizeof(this_call_data));
1901 
1902  /* Set up a callback for error reporting */
1903  pl_error_context.callback = plperl_inline_callback;
1904  pl_error_context.previous = error_context_stack;
1905  pl_error_context.arg = NULL;
1906  error_context_stack = &pl_error_context;
1907 
1908  /*
1909  * Set up a fake fcinfo and descriptor with just enough info to satisfy
1910  * plperl_call_perl_func(). In particular note that this sets things up
1911  * with no arguments passed, and a result type of VOID.
1912  */
1913  MemSet(fake_fcinfo, 0, SizeForFunctionCallInfo(0));
1914  MemSet(&flinfo, 0, sizeof(flinfo));
1915  MemSet(&desc, 0, sizeof(desc));
1916  fake_fcinfo->flinfo = &flinfo;
1917  flinfo.fn_oid = InvalidOid;
1918  flinfo.fn_mcxt = CurrentMemoryContext;
1919 
1920  desc.proname = "inline_code_block";
1921  desc.fn_readonly = false;
1922 
1923  desc.lang_oid = codeblock->langOid;
1924  desc.trftypes = NIL;
1925  desc.lanpltrusted = codeblock->langIsTrusted;
1926 
1927  desc.fn_retistuple = false;
1928  desc.fn_retisset = false;
1929  desc.fn_retisarray = false;
1930  desc.result_oid = InvalidOid;
1931  desc.nargs = 0;
1932  desc.reference = NULL;
1933 
1934  this_call_data.fcinfo = fake_fcinfo;
1935  this_call_data.prodesc = &desc;
1936  /* we do not bother with refcounting the fake prodesc */
1937 
1938  PG_TRY();
1939  {
1940  SV *perlret;
1941 
1942  current_call_data = &this_call_data;
1943 
1944  if (SPI_connect_ext(codeblock->atomic ? 0 : SPI_OPT_NONATOMIC) != SPI_OK_CONNECT)
1945  elog(ERROR, "could not connect to SPI manager");
1946 
1948 
1949  plperl_create_sub(&desc, codeblock->source_text, 0);
1950 
1951  if (!desc.reference) /* can this happen? */
1952  elog(ERROR, "could not create internal procedure for anonymous code block");
1953 
1954  perlret = plperl_call_perl_func(&desc, fake_fcinfo);
1955 
1956  SvREFCNT_dec_current(perlret);
1957 
1958  if (SPI_finish() != SPI_OK_FINISH)
1959  elog(ERROR, "SPI_finish() failed");
1960  }
1961  PG_CATCH();
1962  {
1963  if (desc.reference)
1965  current_call_data = save_call_data;
1966  activate_interpreter(oldinterp);
1967  PG_RE_THROW();
1968  }
1969  PG_END_TRY();
1970 
1971  if (desc.reference)
1973 
1974  current_call_data = save_call_data;
1975  activate_interpreter(oldinterp);
1976 
1977  error_context_stack = pl_error_context.previous;
1978 
1979  PG_RETURN_VOID();
1980 }
#define NIL
Definition: pg_list.h:65
#define SPI_OK_CONNECT
Definition: spi.h:53
Definition: fmgr.h:56
List * trftypes
Definition: plperl.c:114
MemoryContext fn_mcxt
Definition: fmgr.h:65
FunctionCallInfo fcinfo
Definition: plperl.c:177
static void select_perl_context(bool trusted)
Definition: plperl.c:556
int SPI_connect_ext(int options)
Definition: spi.c:95
#define SizeForFunctionCallInfo(nargs)
Definition: fmgr.h:102
int SPI_finish(void)
Definition: spi.c:176
#define MemSet(start, val, len)
Definition: c.h:955
static plperl_interp_desc * plperl_active_interp
Definition: plperl.c:228
#define PG_GETARG_POINTER(n)
Definition: fmgr.h:271
void(* callback)(void *arg)
Definition: elog.h:254
struct ErrorContextCallback * previous
Definition: elog.h:253
ErrorContextCallback * error_context_stack
Definition: elog.c:88
bool fn_retisset
Definition: plperl.c:117
#define ERROR
Definition: elog.h:43
#define SPI_OPT_NONATOMIC
Definition: spi.h:71
static void activate_interpreter(plperl_interp_desc *interp_desc)
Definition: plperl.c:688
MemoryContext CurrentMemoryContext
Definition: mcxt.c:38
static void SvREFCNT_dec_current(SV *sv)
Definition: plperl.c:313
#define InvalidOid
Definition: postgres_ext.h:36
Oid fn_oid
Definition: fmgr.h:59
bool fn_readonly
Definition: plperl.c:112
static void plperl_inline_callback(void *arg)
Definition: plperl.c:4151
#define PG_RETURN_VOID()
Definition: fmgr.h:339
#define LOCAL_FCINFO(name, nargs)
Definition: fmgr.h:110
#define PG_CATCH()
Definition: elog.h:310
SV * reference
Definition: plperl.c:110
#define SPI_OK_FINISH
Definition: spi.h:54
#define PG_RE_THROW()
Definition: elog.h:331
bool fn_retistuple
Definition: plperl.c:116
#define elog(elevel,...)
Definition: elog.h:226
static void plperl_create_sub(plperl_proc_desc *desc, const char *s, Oid fn_oid)
Definition: plperl.c:2098
char * proname
Definition: plperl.c:105
char * source_text
Definition: parsenodes.h:2849
plperl_proc_desc * prodesc
Definition: plperl.c:176
#define PG_TRY()
Definition: elog.h:301
static plperl_call_data * current_call_data
Definition: plperl.c:244
#define PG_END_TRY()
Definition: elog.h:317
bool lanpltrusted
Definition: plperl.c:115
static SV * plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
Definition: plperl.c:2185
bool fn_retisarray
Definition: plperl.c:118

◆ plperl_modify_tuple()

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

Definition at line 1751 of file plperl.c.

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

Referenced by plperl_trigger_handler().

1752 {
1753  dTHX;
1754  SV **svp;
1755  HV *hvNew;
1756  HE *he;
1757  HeapTuple rtup;
1758  TupleDesc tupdesc;
1759  int natts;
1760  Datum *modvalues;
1761  bool *modnulls;
1762  bool *modrepls;
1763 
1764  svp = hv_fetch_string(hvTD, "new");
1765  if (!svp)
1766  ereport(ERROR,
1767  (errcode(ERRCODE_UNDEFINED_COLUMN),
1768  errmsg("$_TD->{new} does not exist")));
1769  if (!SvOK(*svp) || !SvROK(*svp) || SvTYPE(SvRV(*svp)) != SVt_PVHV)
1770  ereport(ERROR,
1771  (errcode(ERRCODE_DATATYPE_MISMATCH),
1772  errmsg("$_TD->{new} is not a hash reference")));
1773  hvNew = (HV *) SvRV(*svp);
1774 
1775  tupdesc = tdata->tg_relation->rd_att;
1776  natts = tupdesc->natts;
1777 
1778  modvalues = (Datum *) palloc0(natts * sizeof(Datum));
1779  modnulls = (bool *) palloc0(natts * sizeof(bool));
1780  modrepls = (bool *) palloc0(natts * sizeof(bool));
1781 
1782  hv_iterinit(hvNew);
1783  while ((he = hv_iternext(hvNew)))
1784  {
1785  char *key = hek2cstr(he);
1786  SV *val = HeVAL(he);
1787  int attn = SPI_fnumber(tupdesc, key);
1788  Form_pg_attribute attr = TupleDescAttr(tupdesc, attn - 1);
1789 
1790  if (attn == SPI_ERROR_NOATTRIBUTE)
1791  ereport(ERROR,
1792  (errcode(ERRCODE_UNDEFINED_COLUMN),
1793  errmsg("Perl hash contains nonexistent column \"%s\"",
1794  key)));
1795  if (attn <= 0)
1796  ereport(ERROR,
1797  (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1798  errmsg("cannot set system attribute \"%s\"",
1799  key)));
1800  if (attr->attgenerated)
1801  ereport(ERROR,
1802  (errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
1803  errmsg("cannot set generated column \"%s\"",
1804  key)));
1805 
1806  modvalues[attn - 1] = plperl_sv_to_datum(val,
1807  attr->atttypid,
1808  attr->atttypmod,
1809  NULL,
1810  NULL,
1811  InvalidOid,
1812  &modnulls[attn - 1]);
1813  modrepls[attn - 1] = true;
1814 
1815  pfree(key);
1816  }
1817  hv_iterinit(hvNew);
1818 
1819  rtup = heap_modify_tuple(otup, tupdesc, modvalues, modnulls, modrepls);
1820 
1821  pfree(modvalues);
1822  pfree(modnulls);
1823  pfree(modrepls);
1824 
1825  return rtup;
1826 }
int SPI_fnumber(TupleDesc tupdesc, const char *fname)
Definition: spi.c:951
static char * hek2cstr(HE *he)
Definition: plperl.c:324
static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod, FunctionCallInfo fcinfo, FmgrInfo *finfo, Oid typioparam, bool *isnull)
Definition: plperl.c:1311
#define dTHX
Definition: ppport.h:3208
#define TupleDescAttr(tupdesc, i)
Definition: tupdesc.h:92
int errcode(int sqlerrcode)
Definition: elog.c:570
static SV ** hv_fetch_string(HV *hv, const char *key)
Definition: plperl.c:4104
void pfree(void *pointer)
Definition: mcxt.c:1031
#define ERROR
Definition: elog.h:43
#define SPI_ERROR_NOATTRIBUTE
Definition: spi.h:47
FormData_pg_attribute * Form_pg_attribute
Definition: pg_attribute.h:200
#define ereport(elevel, rest)
Definition: elog.h:141
void * palloc0(Size size)
Definition: mcxt.c:955
uintptr_t Datum
Definition: postgres.h:367
TupleDesc rd_att
Definition: rel.h:84
#define InvalidOid
Definition: postgres_ext.h:36
int errmsg(const char *fmt,...)
Definition: elog.c:784
HeapTuple heap_modify_tuple(HeapTuple tuple, TupleDesc tupleDesc, Datum *replValues, bool *replIsnull, bool *doReplace)
Definition: heaptuple.c:1113
long val
Definition: informix.c:684
Relation tg_relation
Definition: trigger.h:34

◆ plperl_ref_from_pg_array()

static SV * plperl_ref_from_pg_array ( Datum  arg,
Oid  typid 
)
static

Definition at line 1466 of file plperl.c.

References ARR_DIMS, ARR_ELEMTYPE, ARR_NDIM, av, 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, 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().

1467 {
1468  dTHX;
1470  Oid elementtype = ARR_ELEMTYPE(ar);
1471  int16 typlen;
1472  bool typbyval;
1473  char typalign,
1474  typdelim;
1475  Oid typioparam;
1476  Oid typoutputfunc;
1477  Oid transform_funcid;
1478  int i,
1479  nitems,
1480  *dims;
1481  plperl_array_info *info;
1482  SV *av;
1483  HV *hv;
1484 
1485  /*
1486  * Currently we make no effort to cache any of the stuff we look up here,
1487  * which is bad.
1488  */
1489  info = palloc0(sizeof(plperl_array_info));
1490 
1491  /* get element type information, including output conversion function */
1492  get_type_io_data(elementtype, IOFunc_output,
1493  &typlen, &typbyval, &typalign,
1494  &typdelim, &typioparam, &typoutputfunc);
1495 
1496  /* Check for a transform function */
1497  transform_funcid = get_transform_fromsql(elementtype,
1500 
1501  /* Look up transform or output function as appropriate */
1502  if (OidIsValid(transform_funcid))
1503  fmgr_info(transform_funcid, &info->transform_proc);
1504  else
1505  fmgr_info(typoutputfunc, &info->proc);
1506 
1507  info->elem_is_rowtype = type_is_rowtype(elementtype);
1508 
1509  /* Get the number and bounds of array dimensions */
1510  info->ndims = ARR_NDIM(ar);
1511  dims = ARR_DIMS(ar);
1512 
1513  /* No dimensions? Return an empty array */
1514  if (info->ndims == 0)
1515  {
1516  av = newRV_noinc((SV *) newAV());
1517  }
1518  else
1519  {
1520  deconstruct_array(ar, elementtype, typlen, typbyval,
1521  typalign, &info->elements, &info->nulls,
1522  &nitems);
1523 
1524  /* Get total number of elements in each dimension */
1525  info->nelems = palloc(sizeof(int) * info->ndims);
1526  info->nelems[0] = nitems;
1527  for (i = 1; i < info->ndims; i++)
1528  info->nelems[i] = info->nelems[i - 1] / dims[i - 1];
1529 
1530  av = split_array(info, 0, nitems, 0);
1531  }
1532 
1533  hv = newHV();
1534  (void) hv_store(hv, "array", 5, av, 0);
1535  (void) hv_store(hv, "typeoid", 7, newSVuv(typid), 0);
1536 
1537  return sv_bless(newRV_noinc((SV *) hv),
1538  gv_stashpv("PostgreSQL::InServer::ARRAY", 0));
1539 }
signed short int16
Definition: c.h:345
FmgrInfo transform_proc
Definition: plperl.c:219
Oid get_transform_fromsql(Oid typid, Oid langid, List *trftypes)
Definition: lsyscache.c:1900
List * trftypes
Definition: plperl.c:114
#define dTHX
Definition: ppport.h:3208
unsigned int Oid
Definition: postgres_ext.h:31
#define OidIsValid(objectId)
Definition: c.h:638
static SV * split_array(plperl_array_info *info, int first, int last, int nest)
Definition: plperl.c:1545
char typalign
Definition: pg_type.h:170
#define newSVuv(uv)
Definition: ppport.h:3596
#define ARR_DIMS(a)
Definition: array.h:282
void fmgr_info(Oid functionId, FmgrInfo *finfo)
Definition: fmgr.c:124
bool type_is_rowtype(Oid typid)
Definition: lsyscache.c:2433
#define newRV_noinc(a)
Definition: ppport.h:4456
struct @18::@19 av[32]
void * palloc0(Size size)
Definition: mcxt.c:955
bool elem_is_rowtype
Definition: plperl.c:214
#define ARR_NDIM(a)
Definition: array.h:278
FmgrInfo proc
Definition: plperl.c:218
void deconstruct_array(ArrayType *array, Oid elmtype, int elmlen, bool elmbyval, char elmalign, Datum **elemsp, bool **nullsp, int *nelemsp)
Definition: arrayfuncs.c:3461
bool * nulls
Definition: plperl.c:216
void * palloc(Size size)
Definition: mcxt.c:924
int i
Datum * elements
Definition: plperl.c:215
void * arg
plperl_proc_desc * prodesc
Definition: plperl.c:176
static plperl_call_data * current_call_data
Definition: plperl.c:244
#define ARR_ELEMTYPE(a)
Definition: array.h:280
#define DatumGetArrayTypeP(X)
Definition: array.h:249
void get_type_io_data(Oid typid, IOFuncSelector which_func, int16 *typlen, bool *typbyval, char *typalign, char *typdelim, Oid *typioparam, Oid *func)
Definition: lsyscache.c:2103

◆ plperl_return_next()

void plperl_return_next ( SV *  sv)

Definition at line 3238 of file plperl.c.

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

3239 {
3240  MemoryContext oldcontext = CurrentMemoryContext;
3241 
3242  PG_TRY();
3243  {
3245  }
3246  PG_CATCH();
3247  {
3248  ErrorData *edata;
3249 
3250  /* Must reset elog.c's state */
3251  MemoryContextSwitchTo(oldcontext);
3252  edata = CopyErrorData();
3253  FlushErrorState();
3254 
3255  /* Punt the error to Perl */
3256  croak_cstr(edata->message);
3257  }
3258  PG_END_TRY();
3259 }
ErrorData * CopyErrorData(void)
Definition: elog.c:1484
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Definition: palloc.h:109
void FlushErrorState(void)
Definition: elog.c:1574
MemoryContext CurrentMemoryContext
Definition: mcxt.c:38
static void plperl_return_next_internal(SV *sv)
Definition: plperl.c:3266
static void croak_cstr(const char *str)
#define PG_CATCH()
Definition: elog.h:310
#define PG_TRY()
Definition: elog.h:301
#define PG_END_TRY()
Definition: elog.h:317
char * message
Definition: elog.h:360

◆ plperl_return_next_internal()

static void plperl_return_next_internal ( SV *  sv)
static

Definition at line 3266 of file plperl.c.

References ALLOCSET_DEFAULT_SIZES, AllocSetContextCreate, ReturnSetInfo::allowedModes, Assert, plperl_call_data::cdomain_info, plperl_call_data::cdomain_oid, CreateTupleDescCopy(), 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, 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().

3267 {
3268  plperl_proc_desc *prodesc;
3269  FunctionCallInfo fcinfo;
3270  ReturnSetInfo *rsi;
3271  MemoryContext old_cxt;
3272 
3273  if (!sv)
3274  return;
3275 
3276  prodesc = current_call_data->prodesc;
3277  fcinfo = current_call_data->fcinfo;
3278  rsi = (ReturnSetInfo *) fcinfo->resultinfo;
3279 
3280  if (!prodesc->fn_retisset)
3281  ereport(ERROR,
3282  (errcode(ERRCODE_SYNTAX_ERROR),
3283  errmsg("cannot use return_next in a non-SETOF function")));
3284 
3286  {
3287  TupleDesc tupdesc;
3288 
3290 
3291  /*
3292  * This is the first call to return_next in the current PL/Perl
3293  * function call, so identify the output tuple type and create a
3294  * tuplestore to hold the result rows.
3295  */
3296  if (prodesc->fn_retistuple)
3297  {
3298  TypeFuncClass funcclass;
3299  Oid typid;
3300 
3301  funcclass = get_call_result_type(fcinfo, &typid, &tupdesc);
3302  if (funcclass != TYPEFUNC_COMPOSITE &&
3303  funcclass != TYPEFUNC_COMPOSITE_DOMAIN)
3304  ereport(ERROR,
3305  (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
3306  errmsg("function returning record called in context "
3307  "that cannot accept type record")));
3308  /* if domain-over-composite, remember the domain's type OID */
3309  if (funcclass == TYPEFUNC_COMPOSITE_DOMAIN)
3310  current_call_data->cdomain_oid = typid;
3311  }
3312  else
3313  {
3314  tupdesc = rsi->expectedDesc;
3315  /* Protect assumption below that we return exactly one column */
3316  if (tupdesc == NULL || tupdesc->natts != 1)
3317  elog(ERROR, "expected single-column result descriptor for non-composite SETOF result");
3318  }
3319 
3320  /*
3321  * Make sure the tuple_store and ret_tdesc are sufficiently
3322  * long-lived.
3323  */
3325 
3329  false, work_mem);
3330 
3331  MemoryContextSwitchTo(old_cxt);
3332  }
3333 
3334  /*
3335  * Producing the tuple we want to return requires making plenty of
3336  * palloc() allocations that are not cleaned up. Since this function can
3337  * be called many times before the current memory context is reset, we
3338  * need to do those allocations in a temporary context.
3339  */
3340  if (!current_call_data->tmp_cxt)
3341  {
3344  "PL/Perl return_next temporary cxt",
3346  }
3347 
3349 
3350  if (prodesc->fn_retistuple)
3351  {
3352  HeapTuple tuple;
3353 
3354  if (!(SvOK(sv) && SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV))
3355  ereport(ERROR,
3356  (errcode(ERRCODE_DATATYPE_MISMATCH),
3357  errmsg("SETOF-composite-returning PL/Perl function "
3358  "must call return_next with reference to hash")));
3359 
3360  tuple = plperl_build_tuple_result((HV *) SvRV(sv),
3362 
3364  domain_check(HeapTupleGetDatum(tuple), false,
3368 
3370  }
3371  else if (prodesc->result_oid)
3372  {
3373  Datum ret[1];
3374  bool isNull[1];
3375 
3376  ret[0] = plperl_sv_to_datum(sv,
3377  prodesc->result_oid,
3378  -1,
3379  fcinfo,
3380  &prodesc->result_in_func,
3381  prodesc->result_typioparam,
3382  &isNull[0]);
3383 
3386  ret, isNull);
3387  }
3388 
3389  MemoryContextSwitchTo(old_cxt);
3391 }
void tuplestore_putvalues(Tuplestorestate *state, TupleDesc tdesc, Datum *values, bool *isnull)
Definition: tuplestore.c:750
TupleDesc CreateTupleDescCopy(TupleDesc tupdesc)
Definition: tupdesc.c:110
#define AllocSetContextCreate
Definition: memutils.h:169
TypeFuncClass get_call_result_type(FunctionCallInfo fcinfo, Oid *resultTypeId, TupleDesc *resultTupleDesc)
Definition: funcapi.c:196
static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod, FunctionCallInfo fcinfo, FmgrInfo *finfo, Oid typioparam, bool *isnull)
Definition: plperl.c:1311
FunctionCallInfo fcinfo
Definition: plperl.c:177
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Definition: palloc.h:109
int errcode(int sqlerrcode)
Definition: elog.c:570
void MemoryContextReset(MemoryContext context)
Definition: mcxt.c:136
unsigned int Oid
Definition: postgres_ext.h:31
#define OidIsValid(objectId)
Definition: c.h:638
void * cdomain_info
Definition: plperl.c:182
TupleDesc expectedDesc
Definition: execnodes.h:302
bool fn_retisset
Definition: plperl.c:117
#define ERROR
Definition: elog.h:43
fmNodePtr resultinfo
Definition: fmgr.h:89
FmgrInfo result_in_func
Definition: plperl.c:121
#define ALLOCSET_DEFAULT_SIZES
Definition: memutils.h:191
void tuplestore_puttuple(Tuplestorestate *state, HeapTuple tuple)
Definition: tuplestore.c:730
MemoryContext CurrentMemoryContext
Definition: mcxt.c:38
TypeFuncClass
Definition: funcapi.h:147
Oid result_typioparam
Definition: plperl.c:122
#define ereport(elevel, rest)
Definition: elog.h:141
Tuplestorestate * tuplestore_begin_heap(bool randomAccess, bool interXact, int maxKBytes)
Definition: tuplestore.c:318
uintptr_t Datum
Definition: postgres.h:367
int work_mem
Definition: globals.c:121
Tuplestorestate * tuple_store
Definition: plperl.c:179
void domain_check(Datum value, bool isnull, Oid domainType, void **extra, MemoryContext mcxt)
Definition: domains.c:327
int allowedModes
Definition: execnodes.h:303
TupleDesc ret_tdesc
Definition: plperl.c:180
MemoryContext tmp_cxt
Definition: plperl.c:183
#define Assert(condition)
Definition: c.h:732
#define HeapTupleGetDatum(tuple)
Definition: funcapi.h:221
MemoryContext ecxt_per_query_memory
Definition: execnodes.h:231
static HeapTuple plperl_build_tuple_result(HV *perlhash, TupleDesc td)
Definition: plperl.c:1079
ExprContext * econtext
Definition: execnodes.h:301
int errmsg(const char *fmt,...)
Definition: elog.c:784
bool fn_retistuple
Definition: plperl.c:116
#define elog(elevel,...)
Definition: elog.h:226
plperl_proc_desc * prodesc
Definition: plperl.c:176
static plperl_call_data * current_call_data
Definition: plperl.c:244

◆ plperl_spi_commit()

void plperl_spi_commit ( void  )

Definition at line 3982 of file plperl.c.

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

3983 {
3984  MemoryContext oldcontext = CurrentMemoryContext;
3985 
3986  PG_TRY();
3987  {
3988  SPI_commit();
3990  }
3991  PG_CATCH();
3992  {
3993  ErrorData *edata;
3994 
3995  /* Save error info */
3996  MemoryContextSwitchTo(oldcontext);
3997  edata = CopyErrorData();
3998  FlushErrorState();
3999 
4000  /* Punt the error to Perl */
4001  croak_cstr(edata->message);
4002  }
4003  PG_END_TRY();
4004 }
ErrorData * CopyErrorData(void)
Definition: elog.c:1484
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Definition: palloc.h:109
void FlushErrorState(void)
Definition: elog.c:1574
MemoryContext CurrentMemoryContext
Definition: mcxt.c:38
void SPI_commit(void)
Definition: spi.c:278
static void croak_cstr(const char *str)
#define PG_CATCH()
Definition: elog.h:310
void SPI_start_transaction(void)
Definition: spi.c:212
#define PG_TRY()
Definition: elog.h:301
#define PG_END_TRY()
Definition: elog.h:317
char * message
Definition: elog.h:360

◆ plperl_spi_cursor_close()

void plperl_spi_cursor_close ( char *  cursor)

Definition at line 3542 of file plperl.c.

References check_spi_usage_allowed(), SPI_cursor_close(), SPI_cursor_find(), and UnpinPortal().

3543 {
3544  Portal p;
3545 
3547 
3548  p = SPI_cursor_find(cursor);
3549 
3550  if (p)
3551  {
3552  UnpinPortal(p);
3553  SPI_cursor_close(p);
3554  }
3555 }
void UnpinPortal(Portal portal)
Definition: portalmem.c:377
Portal SPI_cursor_find(const char *name)
Definition: spi.c:1527
Definition: type.h:130
static void check_spi_usage_allowed(void)
Definition: plperl.c:3114
void SPI_cursor_close(Portal portal)
Definition: spi.c:1595

◆ plperl_spi_exec()

HV* plperl_spi_exec ( char *  query,
int  limit 
)

Definition at line 3126 of file plperl.c.

References BeginInternalSubTransaction(), check_spi_usage_allowed(), CopyErrorData(), croak_cstr(), 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.

3127 {
3128  HV *ret_hv;
3129 
3130  /*
3131  * Execute the query inside a sub-transaction, so we can cope with errors
3132  * sanely
3133  */
3134  MemoryContext oldcontext = CurrentMemoryContext;
3136 
3138 
3140  /* Want to run inside function's memory context */
3141  MemoryContextSwitchTo(oldcontext);
3142 
3143  PG_TRY();
3144  {
3145  int spi_rv;
3146 
3147  pg_verifymbstr(query, strlen(query), false);
3148 
3150  limit);
3152  spi_rv);
3153 
3154  /* Commit the inner transaction, return to outer xact context */
3156  MemoryContextSwitchTo(oldcontext);
3157  CurrentResourceOwner = oldowner;
3158  }
3159  PG_CATCH();
3160  {
3161  ErrorData *edata;
3162 
3163  /* Save error info */
3164  MemoryContextSwitchTo(oldcontext);
3165  edata = CopyErrorData();
3166  FlushErrorState();
3167 
3168  /* Abort the inner transaction */
3170  MemoryContextSwitchTo(oldcontext);
3171  CurrentResourceOwner = oldowner;
3172 
3173  /* Punt the error to Perl */
3174  croak_cstr(edata->message);
3175 
3176  /* Can't get here, but keep compiler quiet */
3177  return NULL;
3178  }
3179  PG_END_TRY();
3180 
3181  return ret_hv;
3182 }
ErrorData * CopyErrorData(void)
Definition: elog.c:1484
ResourceOwner CurrentResourceOwner
Definition: resowner.c:142
void ReleaseCurrentSubTransaction(void)
Definition: xact.c:4404
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Definition: palloc.h:109
SPITupleTable * SPI_tuptable
Definition: spi.c:46
void FlushErrorState(void)
Definition: elog.c:1574
uint64 SPI_processed
Definition: spi.c:45
void RollbackAndReleaseCurrentSubTransaction(void)
Definition: xact.c:4438
MemoryContext CurrentMemoryContext
Definition: mcxt.c:38
static void croak_cstr(const char *str)
bool fn_readonly
Definition: plperl.c:112
#define PG_CATCH()
Definition: elog.h:310
void BeginInternalSubTransaction(const char *name)
Definition: xact.c:4333
static void check_spi_usage_allowed(void)
Definition: plperl.c:3114
static HV * plperl_spi_execute_fetch_result(SPITupleTable *, uint64, int)
Definition: plperl.c:3186
bool pg_verifymbstr(const char *mbstr, int len, bool noError)
Definition: wchar.c:1914
plperl_proc_desc * prodesc
Definition: plperl.c:176
#define PG_TRY()
Definition: elog.h:301
static plperl_call_data * current_call_data
Definition: plperl.c:244
#define PG_END_TRY()
Definition: elog.h:317
char * message
Definition: elog.h:360
int SPI_execute(const char *src, bool read_only, long tcount)
Definition: spi.c:496

◆ plperl_spi_exec_prepared()

HV* plperl_spi_exec_prepared ( char *  query,
HV *  attr,
int  argc,
SV **  argv 
)

Definition at line 3706 of file plperl.c.

References plperl_query_desc::arginfuncs, plperl_query_desc::argtypes, plperl_query_desc::argtypioparams, BeginInternalSubTransaction(), check_spi_usage_allowed(), CopyErrorData(), croak_cstr(), 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_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.

3707 {
3708  HV *ret_hv;
3709  SV **sv;
3710  int i,
3711  limit,
3712  spi_rv;
3713  char *nulls;
3714  Datum *argvalues;
3715  plperl_query_desc *qdesc;
3716  plperl_query_entry *hash_entry;
3717 
3718  /*
3719  * Execute the query inside a sub-transaction, so we can cope with errors
3720  * sanely
3721  */
3722  MemoryContext oldcontext = CurrentMemoryContext;
3724 
3726 
3728  /* Want to run inside function's memory context */
3729  MemoryContextSwitchTo(oldcontext);
3730 
3731  PG_TRY();
3732  {
3733  dTHX;
3734 
3735  /************************************************************
3736  * Fetch the saved plan descriptor, see if it's o.k.
3737  ************************************************************/
3738  hash_entry = hash_search(plperl_active_interp->query_hash, query,
3739  HASH_FIND, NULL);
3740  if (hash_entry == NULL)
3741  elog(ERROR, "spi_exec_prepared: Invalid prepared query passed");
3742 
3743  qdesc = hash_entry->query_data;
3744  if (qdesc == NULL)
3745  elog(ERROR, "spi_exec_prepared: plperl query_hash value vanished");
3746 
3747  if (qdesc->nargs != argc)
3748  elog(ERROR, "spi_exec_prepared: expected %d argument(s), %d passed",
3749  qdesc->nargs, argc);
3750 
3751  /************************************************************
3752  * Parse eventual attributes
3753  ************************************************************/
3754  limit = 0;
3755  if (attr != NULL)
3756  {
3757  sv = hv_fetch_string(attr, "limit");
3758  if (sv && *sv && SvIOK(*sv))
3759  limit = SvIV(*sv);
3760  }
3761  /************************************************************
3762  * Set up arguments
3763  ************************************************************/
3764  if (argc > 0)
3765  {
3766  nulls = (char *) palloc(argc);
3767  argvalues = (Datum *) palloc(argc * sizeof(Datum));
3768  }
3769  else
3770  {
3771  nulls = NULL;
3772  argvalues = NULL;
3773  }
3774 
3775  for (i = 0; i < argc; i++)
3776  {
3777  bool isnull;
3778 
3779  argvalues[i] = plperl_sv_to_datum(argv[i],
3780  qdesc->argtypes[i],
3781  -1,
3782  NULL,
3783  &qdesc->arginfuncs[i],
3784  qdesc->argtypioparams[i],
3785  &isnull);
3786  nulls[i] = isnull ? 'n' : ' ';
3787  }
3788 
3789  /************************************************************
3790  * go
3791  ************************************************************/
3792  spi_rv = SPI_execute_plan(qdesc->plan, argvalues, nulls,
3795  spi_rv);
3796  if (argc > 0)
3797  {
3798  pfree(argvalues);
3799  pfree(nulls);
3800  }
3801 
3802  /* Commit the inner transaction, return to outer xact context */
3804  MemoryContextSwitchTo(oldcontext);
3805  CurrentResourceOwner = oldowner;
3806  }
3807  PG_CATCH();
3808  {
3809  ErrorData *edata;
3810 
3811  /* Save error info */
3812  MemoryContextSwitchTo(oldcontext);
3813  edata = CopyErrorData();
3814  FlushErrorState();
3815 
3816  /* Abort the inner transaction */
3818  MemoryContextSwitchTo(oldcontext);
3819  CurrentResourceOwner = oldowner;
3820 
3821  /* Punt the error to Perl */
3822  croak_cstr(edata->message);
3823 
3824  /* Can't get here, but keep compiler quiet */
3825  return NULL;
3826  }
3827  PG_END_TRY();
3828 
3829  return ret_hv;
3830 }
Definition: plperl.c:202
static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod, FunctionCallInfo fcinfo, FmgrInfo *finfo, Oid typioparam, bool *isnull)
Definition: plperl.c:1311
HTAB * query_hash
Definition: plperl.c:90
#define dTHX
Definition: ppport.h:3208
SPIPlanPtr plan
Definition: plperl.c:193
ErrorData * CopyErrorData(void)
Definition: elog.c:1484
Oid * argtypioparams
Definition: plperl.c:197
ResourceOwner CurrentResourceOwner
Definition: resowner.c:142
void ReleaseCurrentSubTransaction(void)
Definition: xact.c:4404
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Definition: palloc.h:109
SPITupleTable * SPI_tuptable
Definition: spi.c:46
static SV ** hv_fetch_string(HV *hv, const char *key)
Definition: plperl.c:4104
static plperl_interp_desc * plperl_active_interp
Definition: plperl.c:228
void * hash_search(HTAB *hashp, const void *keyPtr, HASHACTION action, bool *foundPtr)
Definition: dynahash.c:906
void FlushErrorState(void)
Definition: elog.c:1574
uint64 SPI_processed
Definition: spi.c:45
void pfree(void *pointer)
Definition: mcxt.c:1031
#define ERROR
Definition: elog.h:43
int SPI_execute_plan(SPIPlanPtr plan, Datum *Values, const char *Nulls, bool read_only, long tcount)
Definition: spi.c:531
void RollbackAndReleaseCurrentSubTransaction(void)
Definition: xact.c:4438
Oid * argtypes
Definition: plperl.c:195
MemoryContext CurrentMemoryContext
Definition: mcxt.c:38
uintptr_t Datum
Definition: postgres.h:367
FmgrInfo * arginfuncs
Definition: plperl.c:196
static void croak_cstr(const char *str)
bool fn_readonly
Definition: plperl.c:112
#define PG_CATCH()
Definition: elog.h:310
void BeginInternalSubTransaction(const char *name)
Definition: xact.c:4333
static void check_spi_usage_allowed(void)
Definition: plperl.c:3114
void * palloc(Size size)
Definition: mcxt.c:924
#define elog(elevel,...)
Definition: elog.h:226
int i
static HV * plperl_spi_execute_fetch_result(SPITupleTable *, uint64, int)
Definition: plperl.c:3186
plperl_proc_desc * prodesc
Definition: plperl.c:176
#define PG_TRY()
Definition: elog.h:301
static plperl_call_data * current_call_data
Definition: plperl.c:244
#define PG_END_TRY()
Definition: elog.h:317
char * message
Definition: elog.h:360
plperl_query_desc * query_data
Definition: plperl.c:205

◆ plperl_spi_execute_fetch_result()

static HV * plperl_spi_execute_fetch_result ( SPITupleTable tuptable,
uint64  processed,
int  status 
)
static

Definition at line 3186 of file plperl.c.

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().

3188 {
3189  dTHX;
3190  HV *result;
3191 
3193 
3194  result = newHV();
3195 
3196  hv_store_string(result, "status",
3198  hv_store_string(result, "processed",
3199  (processed > (uint64) UV_MAX) ?
3200  newSVnv((NV) processed) :
3201  newSVuv((UV) processed));
3202 
3203  if (status > 0 && tuptable)
3204  {
3205  AV *rows;
3206  SV *row;
3207  uint64 i;
3208 
3209  /* Prevent overflow in call to av_extend() */
3210  if (processed > (uint64) AV_SIZE_MAX)
3211  ereport(ERROR,
3212  (errcode(ERRCODE_PROGRAM_LIMIT_EXCEEDED),
3213  errmsg("query result has too many rows to fit in a Perl array")));
3214 
3215  rows = newAV();
3216  av_extend(rows, processed);
3217  for (i = 0; i < processed; i++)
3218  {
3219  row = plperl_hash_from_tuple(tuptable->vals[i], tuptable->tupdesc, true);
3220  av_push(rows, row);
3221  }
3222  hv_store_string(result, "rows",
3223  newRV_noinc((SV *) rows));
3224  }
3225 
3226  SPI_freetuptable(tuptable);
3227 
3228  return result;
3229 }
#define dTHX
Definition: ppport.h:3208
#define AV_SIZE_MAX
Definition: plperl.h:200
int errcode(int sqlerrcode)
Definition: elog.c:570
static SV ** hv_store_string(HV *hv, const char *key, SV *val)
Definition: plperl.c:4077
HeapTuple * vals
Definition: spi.h:26
NVTYPE NV
Definition: ppport.h:3754
#define ERROR
Definition: elog.h:43
#define newSVuv(uv)
Definition: ppport.h:3596
const char * SPI_result_code_string(int code)
Definition: spi.c:1705
#define ereport(elevel, rest)
Definition: elog.h:141
void SPI_freetuptable(SPITupleTable *tuptable)
Definition: spi.c:1162
#define newRV_noinc(a)
Definition: ppport.h:4456
TupleDesc tupdesc
Definition: spi.h:25
static SV * cstr2sv(const char *str)
#define UV_MAX
Definition: ppport.h:3566
static void check_spi_usage_allowed(void)
Definition: plperl.c:3114
int errmsg(const char *fmt,...)
Definition: elog.c:784
static SV * plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc, bool include_generated)
Definition: plperl.c:3034
int i
static void static void status(const char *fmt,...) pg_attribute_printf(1
Definition: pg_regress.c:227

◆ plperl_spi_fetchrow()

SV* plperl_spi_fetchrow ( char *  cursor)

Definition at line 3467 of file plperl.c.

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.

3468 {
3469  SV *row;
3470 
3471  /*
3472  * Execute the FETCH inside a sub-transaction, so we can cope with errors
3473  * sanely
3474  */
3475  MemoryContext oldcontext = CurrentMemoryContext;
3477 
3479 
3481  /* Want to run inside function's memory context */
3482  MemoryContextSwitchTo(oldcontext);
3483 
3484  PG_TRY();
3485  {
3486  dTHX;
3488 
3489  if (!p)
3490  {
3491  row = &PL_sv_undef;
3492  }
3493  else
3494  {
3495  SPI_cursor_fetch(p, true, 1);
3496  if (SPI_processed == 0)
3497  {
3498  UnpinPortal(p);
3499  SPI_cursor_close(p);
3500  row = &PL_sv_undef;
3501  }
3502  else
3503  {
3506  true);
3507  }
3509  }
3510 
3511  /* Commit the inner transaction, return to outer xact context */
3513  MemoryContextSwitchTo(oldcontext);
3514  CurrentResourceOwner = oldowner;
3515  }
3516  PG_CATCH();
3517  {
3518  ErrorData *edata;
3519 
3520  /* Save error info */
3521  MemoryContextSwitchTo(oldcontext);
3522  edata = CopyErrorData();
3523  FlushErrorState();
3524 
3525  /* Abort the inner transaction */
3527  MemoryContextSwitchTo(oldcontext);
3528  CurrentResourceOwner = oldowner;
3529 
3530  /* Punt the error to Perl */
3531  croak_cstr(edata->message);
3532 
3533  /* Can't get here, but keep compiler quiet */
3534  return NULL;
3535  }
3536  PG_END_TRY();
3537 
3538  return row;
3539 }
void UnpinPortal(Portal portal)
Definition: portalmem.c:377
#define dTHX
Definition: ppport.h:3208
ErrorData * CopyErrorData(void)
Definition: elog.c:1484
ResourceOwner CurrentResourceOwner
Definition: resowner.c:142
void ReleaseCurrentSubTransaction(void)
Definition: xact.c:4404
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Definition: palloc.h:109
SPITupleTable * SPI_tuptable
Definition: spi.c:46
#define PL_sv_undef
Definition: ppport.h:4129
HeapTuple * vals
Definition: spi.h:26
void FlushErrorState(void)
Definition: elog.c:1574
uint64 SPI_processed
Definition: spi.c:45
Portal SPI_cursor_find(const char *name)
Definition: spi.c:1527
void RollbackAndReleaseCurrentSubTransaction(void)
Definition: xact.c:4438
Definition: type.h:130
MemoryContext CurrentMemoryContext
Definition: mcxt.c:38
void SPI_freetuptable(SPITupleTable *tuptable)
Definition: spi.c:1162
static void croak_cstr(const char *str)
TupleDesc tupdesc
Definition: spi.h:25
#define PG_CATCH()
Definition: elog.h:310
void BeginInternalSubTransaction(const char *name)
Definition: xact.c:4333
static void check_spi_usage_allowed(void)
Definition: plperl.c:3114
void SPI_cursor_close(Portal portal)
Definition: spi.c:1595
static SV * plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc, bool include_generated)
Definition: plperl.c:3034
void SPI_cursor_fetch(Portal portal, bool forward, long count)
Definition: spi.c:1539
#define PG_TRY()
Definition: elog.h:301
#define PG_END_TRY()
Definition: elog.h:317
char * message
Definition: elog.h:360

◆ plperl_spi_freeplan()

void plperl_spi_freeplan ( char *  query)

Definition at line 3951 of file plperl.c.

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

3952 {
3953  SPIPlanPtr plan;
3954  plperl_query_desc *qdesc;
3955  plperl_query_entry *hash_entry;
3956 
3958 
3959  hash_entry = hash_search(plperl_active_interp->query_hash, query,
3960  HASH_FIND, NULL);
3961  if (hash_entry == NULL)
3962  elog(ERROR, "spi_freeplan: Invalid prepared query passed");
3963 
3964  qdesc = hash_entry->query_data;
3965  if (qdesc == NULL)
3966  elog(ERROR, "spi_freeplan: plperl query_hash value vanished");
3967  plan = qdesc->plan;
3968 
3969  /*
3970  * free all memory before SPI_freeplan, so if it dies, nothing will be
3971  * left over
3972  */
3974  HASH_REMOVE, NULL);
3975 
3976  MemoryContextDelete(qdesc->plan_cxt);
3977 
3978  SPI_freeplan(plan);
3979 }
Definition: plperl.c:202
void MemoryContextDelete(MemoryContext context)
Definition: mcxt.c:211
HTAB * query_hash
Definition: plperl.c:90
SPIPlanPtr plan
Definition: plperl.c:193
static plperl_interp_desc * plperl_active_interp
Definition: plperl.c:228
void * hash_search(HTAB *hashp, const void *keyPtr, HASHACTION action, bool *foundPtr)
Definition: dynahash.c:906
#define ERROR
Definition: elog.h:43
MemoryContext plan_cxt
Definition: plperl.c:192
static void check_spi_usage_allowed(void)
Definition: plperl.c:3114
int SPI_freeplan(SPIPlanPtr plan)
Definition: spi.c:801
#define elog(elevel,...)
Definition: elog.h:226
plperl_query_desc * query_data
Definition: plperl.c:205

◆ plperl_spi_prepare()

SV* plperl_spi_prepare ( char *  query,
int  argc,
SV **  argv 
)

Definition at line 3558 of file plperl.c.

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, plperl_query_desc::plan_cxt, 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.

3559 {
3560  volatile SPIPlanPtr plan = NULL;
3561  volatile MemoryContext plan_cxt = NULL;
3562  plperl_query_desc *volatile qdesc = NULL;
3563  plperl_query_entry *volatile hash_entry = NULL;
3564  MemoryContext oldcontext = CurrentMemoryContext;
3566  MemoryContext work_cxt;
3567  bool found;
3568  int i;
3569 
3571 
3573  MemoryContextSwitchTo(oldcontext);
3574 
3575  PG_TRY();
3576  {
3578 
3579  /************************************************************
3580  * Allocate the new querydesc structure
3581  *
3582  * The qdesc struct, as well as all its subsidiary data, lives in its
3583  * plan_cxt. But note that the SPIPlan does not.
3584  ************************************************************/
3586  "PL/Perl spi_prepare query",
3588  MemoryContextSwitchTo(plan_cxt);
3589  qdesc = (plperl_query_desc *) palloc0(sizeof(plperl_query_desc));
3590  snprintf(qdesc->qname, sizeof(qdesc->qname), "%p", qdesc);
3591  qdesc->plan_cxt = plan_cxt;
3592  qdesc->nargs = argc;
3593  qdesc->argtypes = (Oid *) palloc(argc * sizeof(Oid));
3594  qdesc->arginfuncs = (FmgrInfo *) palloc(argc * sizeof(FmgrInfo));
3595  qdesc->argtypioparams = (Oid *) palloc(argc * sizeof(Oid));
3596  MemoryContextSwitchTo(oldcontext);
3597 
3598  /************************************************************
3599  * Do the following work in a short-lived context so that we don't
3600  * leak a lot of memory in the PL/Perl function's SPI Proc context.
3601  ************************************************************/
3603  "PL/Perl spi_prepare workspace",
3605  MemoryContextSwitchTo(work_cxt);
3606 
3607  /************************************************************
3608  * Resolve argument type names and then look them up by oid
3609  * in the system cache, and remember the required information
3610  * for input conversion.
3611  ************************************************************/
3612  for (i = 0; i < argc; i++)
3613  {
3614  Oid typId,
3615  typInput,
3616  typIOParam;
3617  int32 typmod;
3618  char *typstr;
3619 
3620  typstr = sv2cstr(argv[i]);
3621  parseTypeString(typstr, &typId, &typmod, false);
3622  pfree(typstr);
3623 
3624  getTypeInputInfo(typId, &typInput, &typIOParam);
3625 
3626  qdesc->argtypes[i] = typId;
3627  fmgr_info_cxt(typInput, &(qdesc->arginfuncs[i]), plan_cxt);
3628  qdesc->argtypioparams[i] = typIOParam;
3629  }
3630 
3631  /* Make sure the query is validly encoded */
3632  pg_verifymbstr(query, strlen(query), false);
3633 
3634  /************************************************************
3635  * Prepare the plan and check for errors
3636  ************************************************************/
3637  plan = SPI_prepare(query, argc, qdesc->argtypes);
3638 
3639  if (plan == NULL)
3640  elog(ERROR, "SPI_prepare() failed:%s",
3642 
3643  /************************************************************
3644  * Save the plan into permanent memory (right now it's in the
3645  * SPI procCxt, which will go away at function end).
3646  ************************************************************/
3647  if (SPI_keepplan(plan))
3648  elog(ERROR, "SPI_keepplan() failed");
3649  qdesc->plan = plan;
3650 
3651  /************************************************************
3652  * Insert a hashtable entry for the plan.
3653  ************************************************************/
3655  qdesc->qname,
3656  HASH_ENTER, &found);
3657  hash_entry->query_data = qdesc;
3658 
3659  /* Get rid of workspace */
3660  MemoryContextDelete(work_cxt);
3661 
3662  /* Commit the inner transaction, return to outer xact context */
3664  MemoryContextSwitchTo(oldcontext);
3665  CurrentResourceOwner = oldowner;
3666  }
3667  PG_CATCH();
3668  {
3669  ErrorData *edata;
3670 
3671  /* Save error info */
3672  MemoryContextSwitchTo(oldcontext);
3673  edata = CopyErrorData();
3674  FlushErrorState();
3675 
3676  /* Drop anything we managed to allocate */
3677  if (hash_entry)
3679  qdesc->qname,
3680  HASH_REMOVE, NULL);
3681  if (plan_cxt)
3682  MemoryContextDelete(plan_cxt);
3683  if (plan)
3684  SPI_freeplan(plan);
3685 
3686  /* Abort the inner transaction */
3688  MemoryContextSwitchTo(oldcontext);
3689  CurrentResourceOwner = oldowner;
3690 
3691  /* Punt the error to Perl */
3692  croak_cstr(edata->message);
3693 
3694  /* Can't get here, but keep compiler quiet */
3695  return NULL;
3696  }
3697  PG_END_TRY();
3698 
3699  /************************************************************
3700  * Return the query's hash key to the caller.
3701  ************************************************************/
3702  return cstr2sv(qdesc->qname);
3703 }
Definition: fmgr.h:56
Definition: plperl.c:202
void MemoryContextDelete(MemoryContext context)
Definition: mcxt.c:211
#define AllocSetContextCreate
Definition: memutils.h:169
HTAB * query_hash
Definition: plperl.c:90
SPIPlanPtr plan
Definition: plperl.c:193
ErrorData * CopyErrorData(void)
Definition: elog.c:1484
Oid * argtypioparams
Definition: plperl.c:197
ResourceOwner CurrentResourceOwner
Definition: resowner.c:142
SPIPlanPtr SPI_prepare(const char *src, int nargs, Oid *argtypes)
Definition: spi.c:674
#define ALLOCSET_SMALL_SIZES
Definition: memutils.h:201
void ReleaseCurrentSubTransaction(void)
Definition: xact.c:4404
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Definition: palloc.h:109
static plperl_interp_desc * plperl_active_interp
Definition: plperl.c:228
void * hash_search(HTAB *hashp, const void *keyPtr, HASHACTION action, bool *foundPtr)
Definition: dynahash.c:906
unsigned int Oid
Definition: postgres_ext.h:31
void FlushErrorState(void)
Definition: elog.c:1574
signed int int32
Definition: c.h:346
int SPI_result
Definition: spi.c:47
void pfree(void *pointer)
Definition: mcxt.c:1031
#define ERROR
Definition: elog.h:43
const char * SPI_result_code_string(int code)
Definition: spi.c:1705
#define ALLOCSET_DEFAULT_SIZES
Definition: memutils.h:191
int SPI_keepplan(SPIPlanPtr plan)
Definition: spi.c:752
void RollbackAndReleaseCurrentSubTransaction(void)
Definition: xact.c:4438
Oid * argtypes
Definition: plperl.c:195
MemoryContext CurrentMemoryContext
Definition: mcxt.c:38
MemoryContext plan_cxt
Definition: plperl.c:192
void fmgr_info_cxt(Oid functionId, FmgrInfo *finfo, MemoryContext mcxt)
Definition: fmgr.c:134
void getTypeInputInfo(Oid type, Oid *typInput, Oid *typIOParam)
Definition: lsyscache.c:2641
MemoryContext TopMemoryContext
Definition: mcxt.c:44
void * palloc0(Size size)
Definition: mcxt.c:955
char qname[24]
Definition: plperl.c:191
FmgrInfo * arginfuncs
Definition: plperl.c:196
static void croak_cstr(const char *str)
static SV * cstr2sv(const char *str)
void parseTypeString(const char *str, Oid *typeid_p, int32 *typmod_p, bool missing_ok)
Definition: parse_type.c:833
#define PG_CATCH()
Definition: elog.h:310
void BeginInternalSubTransaction(const char *name)
Definition: xact.c:4333
static void check_spi_usage_allowed(void)
Definition: plperl.c:3114
int SPI_freeplan(SPIPlanPtr plan)
Definition: spi.c:801
void * palloc(Size size)
Definition: mcxt.c:924
#define elog(elevel,...)
Definition: elog.h:226
int i
bool pg_verifymbstr(const char *mbstr, int len, bool noError)
Definition: wchar.c:1914
#define CHECK_FOR_INTERRUPTS()
Definition: miscadmin.h:99
#define PG_TRY()
Definition: elog.h:301
#define snprintf
Definition: port.h:192
#define PG_END_TRY()
Definition: elog.h:317
char * message
Definition: elog.h:360
static char * sv2cstr(SV *sv)
plperl_query_desc * query_data
Definition: plperl.c:205

◆ plperl_spi_query()

SV* plperl_spi_query ( char *  query)

Definition at line 3395 of file plperl.c.

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(), ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), SPI_cursor_open(), SPI_freeplan(), SPI_prepare(), SPI_result, and SPI_result_code_string().

3396 {
3397  SV *cursor;
3398 
3399  /*
3400  * Execute the query inside a sub-transaction, so we can cope with errors
3401  * sanely
3402  */
3403  MemoryContext oldcontext = CurrentMemoryContext;
3405 
3407 
3409  /* Want to run inside function's memory context */
3410  MemoryContextSwitchTo(oldcontext);
3411 
3412  PG_TRY();
3413  {
3414  SPIPlanPtr plan;
3415  Portal portal;
3416 
3417  /* Make sure the query is validly encoded */
3418  pg_verifymbstr(query, strlen(query), false);
3419 
3420  /* Create a cursor for the query */
3421  plan = SPI_prepare(query, 0, NULL);
3422  if (plan == NULL)
3423  elog(ERROR, "SPI_prepare() failed:%s",
3425 
3426  portal = SPI_cursor_open(NULL, plan, NULL, NULL, false);
3427  SPI_freeplan(plan);
3428  if (portal == NULL)
3429  elog(ERROR, "SPI_cursor_open() failed:%s",
3431  cursor = cstr2sv(portal->name);
3432 
3433  PinPortal(portal);
3434 
3435  /* Commit the inner transaction, return to outer xact context */
3437  MemoryContextSwitchTo(oldcontext);
3438  CurrentResourceOwner = oldowner;
3439  }
3440  PG_CATCH();
3441  {
3442  ErrorData *edata;
3443 
3444  /* Save error info */
3445  MemoryContextSwitchTo(oldcontext);
3446  edata = CopyErrorData();
3447  FlushErrorState();
3448 
3449  /* Abort the inner transaction */
3451  MemoryContextSwitchTo(oldcontext);
3452  CurrentResourceOwner = oldowner;
3453 
3454  /* Punt the error to Perl */
3455  croak_cstr(edata->message);
3456 
3457  /* Can't get here, but keep compiler quiet */
3458  return NULL;
3459  }
3460  PG_END_TRY();
3461 
3462  return cursor;
3463 }
ErrorData * CopyErrorData(void)
Definition: elog.c:1484
ResourceOwner CurrentResourceOwner
Definition: resowner.c:142
SPIPlanPtr SPI_prepare(const char *src, int nargs, Oid *argtypes)
Definition: spi.c:674
void ReleaseCurrentSubTransaction(void)
Definition: xact.c:4404
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Definition: palloc.h:109
Portal SPI_cursor_open(const char *name, SPIPlanPtr plan, Datum *Values, const char *Nulls, bool read_only)
Definition: spi.c:1221
void FlushErrorState(void)
Definition: elog.c:1574
int SPI_result
Definition: spi.c:47
const char * name
Definition: portal.h:117
#define ERROR
Definition: elog.h:43
const char * SPI_result_code_string(int code)
Definition: spi.c:1705
void RollbackAndReleaseCurrentSubTransaction(void)
Definition: xact.c:4438
void PinPortal(Portal portal)
Definition: portalmem.c:368
Definition: type.h:130
MemoryContext CurrentMemoryContext
Definition: mcxt.c:38
static void croak_cstr(const char *str)
static SV * cstr2sv(const char *str)
#define PG_CATCH()
Definition: elog.h:310
void BeginInternalSubTransaction(const char *name)
Definition: xact.c:4333
static void check_spi_usage_allowed(void)
Definition: plperl.c:3114
int SPI_freeplan(SPIPlanPtr plan)
Definition: spi.c:801
#define elog(elevel,...)
Definition: elog.h:226
bool pg_verifymbstr(const char *mbstr, int len, bool noError)
Definition: wchar.c:1914
#define PG_TRY()
Definition: elog.h:301
#define PG_END_TRY()
Definition: elog.h:317
char * message
Definition: elog.h:360

◆ plperl_spi_query_prepared()

SV* plperl_spi_query_prepared ( char *  query,
int  argc,
SV **  argv 
)

Definition at line 3833 of file plperl.c.

References plperl_query_desc::arginfuncs, plperl_query_desc::argtypes, plperl_query_desc::argtypioparams, BeginInternalSubTransaction(), check_spi_usage_allowed(), CopyErrorData(), croak_cstr(), cstr2sv(), 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_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().

3834 {
3835  int i;
3836  char *nulls;
3837  Datum *argvalues;
3838  plperl_query_desc *qdesc;
3839  plperl_query_entry *hash_entry;
3840  SV *cursor;
3841  Portal portal = NULL;
3842 
3843  /*
3844  * Execute the query inside a sub-transaction, so we can cope with errors
3845  * sanely
3846  */
3847  MemoryContext oldcontext = CurrentMemoryContext;
3849 
3851 
3853  /* Want to run inside function's memory context */
3854  MemoryContextSwitchTo(oldcontext);
3855 
3856  PG_TRY();
3857  {
3858  /************************************************************
3859  * Fetch the saved plan descriptor, see if it's o.k.
3860  ************************************************************/
3861  hash_entry = hash_search(plperl_active_interp->query_hash, query,
3862  HASH_FIND, NULL);
3863  if (hash_entry == NULL)
3864  elog(ERROR, "spi_query_prepared: Invalid prepared query passed");
3865 
3866  qdesc = hash_entry->query_data;
3867  if (qdesc == NULL)
3868  elog(ERROR, "spi_query_prepared: plperl query_hash value vanished");
3869 
3870  if (qdesc->nargs != argc)
3871  elog(ERROR, "spi_query_prepared: expected %d argument(s), %d passed",
3872  qdesc->nargs, argc);
3873 
3874  /************************************************************
3875  * Set up arguments
3876  ************************************************************/
3877  if (argc > 0)
3878  {
3879  nulls = (char *) palloc(argc);
3880  argvalues = (Datum *) palloc(argc * sizeof(Datum));
3881  }
3882  else
3883  {
3884  nulls = NULL;
3885  argvalues = NULL;
3886  }
3887 
3888  for (i = 0; i < argc; i++)
3889  {
3890  bool isnull;
3891 
3892  argvalues[i] = plperl_sv_to_datum(argv[i],
3893  qdesc->argtypes[i],
3894  -1,
3895  NULL,
3896  &qdesc->arginfuncs[i],
3897  qdesc->argtypioparams[i],
3898  &isnull);
3899  nulls[i] = isnull ? 'n' : ' ';
3900  }
3901 
3902  /************************************************************
3903  * go
3904  ************************************************************/
3905  portal = SPI_cursor_open(NULL, qdesc->plan, argvalues, nulls,
3907  if (argc > 0)
3908  {
3909  pfree(argvalues);
3910  pfree(nulls);
3911  }
3912  if (portal == NULL)
3913  elog(ERROR, "SPI_cursor_open() failed:%s",
3915 
3916  cursor = cstr2sv(portal->name);
3917 
3918  PinPortal(portal);
3919 
3920  /* Commit the inner transaction, return to outer xact context */
3922  MemoryContextSwitchTo(oldcontext);
3923  CurrentResourceOwner = oldowner;
3924  }
3925  PG_CATCH();
3926  {
3927  ErrorData *edata;
3928 
3929  /* Save error info */
3930  MemoryContextSwitchTo(oldcontext);
3931  edata = CopyErrorData();
3932  FlushErrorState();
3933 
3934  /* Abort the inner transaction */
3936  MemoryContextSwitchTo(oldcontext);
3937  CurrentResourceOwner = oldowner;
3938 
3939  /* Punt the error to Perl */
3940  croak_cstr(edata->message);
3941 
3942  /* Can't get here, but keep compiler quiet */
3943  return NULL;
3944  }
3945  PG_END_TRY();
3946 
3947  return cursor;
3948 }
Definition: plperl.c:202
static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod, FunctionCallInfo fcinfo, FmgrInfo *finfo, Oid typioparam, bool *isnull)
Definition: plperl.c:1311
HTAB * query_hash
Definition: plperl.c:90
SPIPlanPtr plan
Definition: plperl.c:193
ErrorData * CopyErrorData(void)
Definition: elog.c:1484
Oid * argtypioparams
Definition: plperl.c:197
ResourceOwner CurrentResourceOwner
Definition: resowner.c:142
void ReleaseCurrentSubTransaction(void)
Definition: xact.c:4404
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Definition: palloc.h:109
static plperl_interp_desc * plperl_active_interp
Definition: plperl.c:228
Portal SPI_cursor_open(const char *name, SPIPlanPtr plan, Datum *Values, const char *Nulls, bool read_only)
Definition: spi.c:1221
void * hash_search(HTAB *hashp, const void *keyPtr, HASHACTION action, bool *foundPtr)
Definition: dynahash.c:906
void FlushErrorState(void)
Definition: elog.c:1574
int SPI_result
Definition: spi.c:47
void pfree(void *pointer)
Definition: mcxt.c:1031
const char * name
Definition: portal.h:117
#define ERROR
Definition: elog.h:43
const char * SPI_result_code_string(int code)
Definition: spi.c:1705
void RollbackAndReleaseCurrentSubTransaction(void)
Definition: xact.c:4438
void PinPortal(Portal portal)
Definition: portalmem.c:368
Definition: type.h:130
Oid * argtypes
Definition: plperl.c:195
MemoryContext CurrentMemoryContext
Definition: mcxt.c:38
uintptr_t Datum
Definition: postgres.h:367
FmgrInfo * arginfuncs
Definition: plperl.c:196
static void croak_cstr(const char *str)
static SV * cstr2sv(const char *str)
bool fn_readonly
Definition: plperl.c:112
#define PG_CATCH()
Definition: elog.h:310
void BeginInternalSubTransaction(const char *name)
Definition: xact.c:4333
static void check_spi_usage_allowed(void)
Definition: plperl.c:3114
void * palloc(Size size)
Definition: mcxt.c:924
#define elog(elevel,...)
Definition: elog.h:226
int i
plperl_proc_desc * prodesc
Definition: plperl.c:176
#define PG_TRY()
Definition: elog.h:301
static plperl_call_data * current_call_data
Definition: plperl.c:244
#define PG_END_TRY()
Definition: elog.h:317
char * message
Definition: elog.h:360
plperl_query_desc * query_data
Definition: plperl.c:205

◆ plperl_spi_rollback()

void plperl_spi_rollback ( void  )

Definition at line 4007 of file plperl.c.

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

4008 {
4009  MemoryContext oldcontext = CurrentMemoryContext;
4010 
4011  PG_TRY();
4012  {
4013  SPI_rollback();
4015  }
4016  PG_CATCH();
4017  {
4018  ErrorData *edata;
4019 
4020  /* Save error info */
4021  MemoryContextSwitchTo(oldcontext);
4022  edata = CopyErrorData();
4023  FlushErrorState();
4024 
4025  /* Punt the error to Perl */
4026  croak_cstr(edata->message);
4027  }
4028  PG_END_TRY();
4029 }
ErrorData * CopyErrorData(void)
Definition: elog.c:1484
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Definition: palloc.h:109
void SPI_rollback(void)
Definition: spi.c:333
void FlushErrorState(void)
Definition: elog.c:1574
MemoryContext CurrentMemoryContext
Definition: mcxt.c:38
static void croak_cstr(const char *str)
#define PG_CATCH()
Definition: elog.h:310
void SPI_start_transaction(void)
Definition: spi.c:212
#define PG_TRY()
Definition: elog.h:301
#define PG_END_TRY()
Definition: elog.h:317
char * message
Definition: elog.h:360

◆ plperl_sv_to_datum()

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

Definition at line 1311 of file plperl.c.

References _sv_to_datum_finfo(), Assert, check_stack_depth(), 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(), PointerGetDatum, plperl_call_data::prodesc, ReleaseTupleDesc, generate_unaccent_rules::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(), and plperl_sv_to_literal().

1315 {
1316  FmgrInfo tmp;
1317  Oid funcid;
1318 
1319  /* we might recurse */
1321 
1322  *isnull = false;
1323 
1324  /*
1325  * Return NULL if result is undef, or if we're in a function returning
1326  * VOID. In the latter case, we should pay no attention to the last Perl
1327  * statement's result, and this is a convenient means to ensure that.
1328  */
1329  if (!sv || !SvOK(sv) || typid == VOIDOID)
1330  {
1331  /* look up type info if they did not pass it */
1332  if (!finfo)
1333  {
1334  _sv_to_datum_finfo(typid, &tmp, &typioparam);
1335  finfo = &tmp;
1336  }
1337  *isnull = true;
1338  /* must call typinput in case it wants to reject NULL */
1339  return InputFunctionCall(finfo, NULL, typioparam, typmod);
1340  }
1342  return OidFunctionCall1(funcid, PointerGetDatum(sv));
1343  else if (SvROK(sv))
1344  {
1345  /* handle references */
1346  SV *sav = get_perl_array_ref(sv);
1347 
1348  if (sav)
1349  {
1350  /* handle an arrayref */
1351  return plperl_array_to_datum(sav, typid, typmod);
1352  }
1353  else if (SvTYPE(SvRV(sv)) == SVt_PVHV)
1354  {
1355  /* handle a hashref */
1356  Datum ret;
1357  TupleDesc td;
1358  bool isdomain;
1359 
1360  if (!type_is_rowtype(typid))
1361  ereport(ERROR,
1362  (errcode(ERRCODE_DATATYPE_MISMATCH),
1363  errmsg("cannot convert Perl hash to non-composite type %s",
1364  format_type_be(typid))));
1365 
1366  td = lookup_rowtype_tupdesc_domain(typid, typmod, true);
1367  if (td != NULL)
1368  {
1369  /* Did we look through a domain? */
1370  isdomain = (typid != td->tdtypeid);
1371  }
1372  else
1373  {
1374  /* Must be RECORD, try to resolve based on call info */
1375  TypeFuncClass funcclass;
1376 
1377  if (fcinfo)
1378  funcclass = get_call_result_type(fcinfo, &typid, &td);
1379  else
1380  funcclass = TYPEFUNC_OTHER;
1381  if (funcclass != TYPEFUNC_COMPOSITE &&
1382  funcclass != TYPEFUNC_COMPOSITE_DOMAIN)
1383  ereport(ERROR,
1384  (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1385  errmsg("function returning record called in context "
1386  "that cannot accept type record")));
1387  Assert(td);
1388  isdomain = (funcclass == TYPEFUNC_COMPOSITE_DOMAIN);
1389  }
1390 
1391  ret = plperl_hash_to_datum(sv, td);
1392 
1393  if (isdomain)
1394  domain_check(ret, false, typid, NULL, NULL);
1395 
1396  /* Release on the result of get_call_result_type is harmless */
1397  ReleaseTupleDesc(td);
1398 
1399  return ret;
1400  }
1401 
1402  /*
1403  * If it's a reference to something else, such as a scalar, just
1404  * recursively look through the reference.
1405  */
1406  return plperl_sv_to_datum(SvRV(sv), typid, typmod,
1407  fcinfo, finfo, typioparam,
1408  isnull);
1409  }
1410  else
1411  {
1412  /* handle a string/number */
1413  Datum ret;
1414  char *str = sv2cstr(sv);
1415 
1416  /* did not pass in any typeinfo? look it up */
1417  if (!finfo)
1418  {
1419  _sv_to_datum_finfo(typid, &tmp, &typioparam);
1420  finfo = &tmp;
1421  }
1422 
1423  ret = InputFunctionCall(finfo, str, typioparam, typmod);
1424  pfree(str);
1425 
1426  return ret;
1427  }
1428 }
Definition: fmgr.h:56
List * trftypes
Definition: plperl.c:114
TypeFuncClass get_call_result_type(FunctionCallInfo fcinfo, Oid *resultTypeId, TupleDesc *resultTupleDesc)
Definition: funcapi.c:196
static SV * get_perl_array_ref(SV *sv)
Definition: plperl.c:1142
static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod, FunctionCallInfo fcinfo, FmgrInfo *finfo, Oid typioparam, bool *isnull)
Definition: plperl.c:1311
static Datum plperl_array_to_datum(SV *src, Oid typid, int32 typmod)
Definition: plperl.c:1244
#define PointerGetDatum(X)
Definition: postgres.h:556
int errcode(int sqlerrcode)
Definition: elog.c:570
char * format_type_be(Oid type_oid)
Definition: format_type.c:326
unsigned int Oid
Definition: postgres_ext.h:31
TupleDesc lookup_rowtype_tupdesc_domain(Oid type_id, int32 typmod, bool noError)
Definition: typcache.c:1708
void pfree(void *pointer)
Definition: mcxt.c:1031
#define ERROR
Definition: elog.h:43
#define OidFunctionCall1(functionId, arg1)
Definition: fmgr.h:654
void check_stack_depth(void)
Definition: postgres.c:3262
static Datum plperl_hash_to_datum(SV *src, TupleDesc td)
Definition: plperl.c:1130
TypeFuncClass
Definition: funcapi.h:147
bool type_is_rowtype(Oid typid)
Definition: lsyscache.c:2433
#define ereport(elevel, rest)
Definition: elog.h:141
uintptr_t Datum
Definition: postgres.h:367
void domain_check(Datum value, bool isnull, Oid domainType, void **extra, MemoryContext mcxt)
Definition: domains.c:327
Datum InputFunctionCall(FmgrInfo *flinfo, char *str, Oid typioparam, int32 typmod)
Definition: fmgr.c:1531
#define Assert(condition)
Definition: c.h:732
Oid get_transform_tosql(Oid typid, Oid langid, List *trftypes)
Definition: lsyscache.c:1921
Oid tdtypeid
Definition: tupdesc.h:82
int errmsg(const char *fmt,...)
Definition: elog.c:784
plperl_proc_desc * prodesc
Definition: plperl.c:176
static void _sv_to_datum_finfo(Oid typid, FmgrInfo *finfo, Oid *typioparam)
Definition: plperl.c:1288
#define ReleaseTupleDesc(tupdesc)
Definition: tupdesc.h:122
static plperl_call_data * current_call_data
Definition: plperl.c:244
static char * sv2cstr(SV *sv)

◆ plperl_sv_to_literal()

char* plperl_sv_to_literal ( SV *  sv,
char *  fqtypename 
)

Definition at line 1432 of file plperl.c.

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

1433 {
1434  Datum str = CStringGetDatum(fqtypename);
1435  Oid typid = DirectFunctionCall1(regtypein, str);
1436  Oid typoutput;
1437  Datum datum;
1438  bool typisvarlena,
1439  isnull;
1440 
1441  if (!OidIsValid(typid))
1442  ereport(ERROR,
1443  (errcode(ERRCODE_UNDEFINED_OBJECT),
1444  errmsg("lookup failed for type %s", fqtypename)));
1445 
1446  datum = plperl_sv_to_datum(sv,
1447  typid, -1,
1448  NULL, NULL, InvalidOid,
1449  &isnull);
1450 
1451  if (isnull)
1452  return NULL;
1453 
1454  getTypeOutputInfo(typid,
1455  &typoutput, &typisvarlena);
1456 
1457  return OidOutputFunctionCall(typoutput, datum);
1458 }
void getTypeOutputInfo(Oid type, Oid *typOutput, bool *typIsVarlena)
Definition: lsyscache.c:2674
static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod, FunctionCallInfo fcinfo, FmgrInfo *finfo, Oid typioparam, bool *isnull)
Definition: plperl.c:1311
int errcode(int sqlerrcode)
Definition: elog.c:570
#define DirectFunctionCall1(func, arg1)
Definition: fmgr.h:616
unsigned int Oid
Definition: postgres_ext.h:31
#define OidIsValid(objectId)
Definition: c.h:638
#define ERROR
Definition: elog.h:43
#define CStringGetDatum(X)
Definition: postgres.h:578
#define ereport(elevel, rest)
Definition: elog.h:141
Datum regtypein(PG_FUNCTION_ARGS)
Definition: regproc.c:1061
uintptr_t Datum
Definition: postgres.h:367
#define InvalidOid
Definition: postgres_ext.h:36
char * OidOutputFunctionCall(Oid functionId, Datum val)
Definition: