PostgreSQL Source Code  git master
plperl.h File Reference
#include "mb/pg_wchar.h"
#include "EXTERN.h"
#include "perl.h"
#include "ppport.h"
Include dependency graph for plperl.h:
This graph shows which files directly or indirectly include this file:

Go to the source code of this file.

Macros

#define PERL_UNUSED_DECL   pg_attribute_unused()
 
#define PERL_NO_GET_CONTEXT
 
#define vsnprintf   pg_vsnprintf
 
#define snprintf   pg_snprintf
 
#define vsprintf   pg_vsprintf
 
#define sprintf   pg_sprintf
 
#define vfprintf   pg_vfprintf
 
#define fprintf   pg_fprintf
 
#define vprintf   pg_vprintf
 
#define printf(...)   pg_printf(__VA_ARGS__)
 
#define _(x)   dgettext(TEXTDOMAIN, x)
 
#define HeUTF8(he)
 
#define GvCV_set(gv, cv)   (GvCV(gv) = cv)
 
#define AV_SIZE_MAX   I32_MAX
 

Functions

HV * plperl_spi_exec (char *, int)
 
void plperl_return_next (SV *)
 
SV * plperl_spi_query (char *)
 
SV * plperl_spi_fetchrow (char *)
 
SV * plperl_spi_prepare (char *, int, SV **)
 
HV * plperl_spi_exec_prepared (char *, HV *, int, SV **)
 
SV * plperl_spi_query_prepared (char *, int, SV **)
 
void plperl_spi_freeplan (char *)
 
void plperl_spi_cursor_close (char *)
 
void plperl_spi_commit (void)
 
void plperl_spi_rollback (void)
 
char * plperl_sv_to_literal (SV *, char *)
 
void plperl_util_elog (int level, SV *msg)
 
static char * utf_u2e (char *utf8_str, size_t len)
 
static char * utf_e2u (const char *str)
 
static char * sv2cstr (SV *sv)
 
static SV * cstr2sv (const char *str)
 
static void croak_cstr (const char *str)
 

Macro Definition Documentation

◆ _

#define _ (   x)    dgettext(TEXTDOMAIN, x)

Definition at line 172 of file plperl.h.

◆ AV_SIZE_MAX

#define AV_SIZE_MAX   I32_MAX

Definition at line 213 of file plperl.h.

◆ fprintf

#define fprintf   pg_fprintf

Definition at line 160 of file plperl.h.

◆ GvCV_set

#define GvCV_set (   gv,
  cv 
)    (GvCV(gv) = cv)

Definition at line 206 of file plperl.h.

◆ HeUTF8

#define HeUTF8 (   he)
Value:
((HeKLEN(he) == HEf_SVKEY) ? \
SvUTF8(HeKEY_sv(he)) : \
(U32)HeKUTF8(he))
#define HEf_SVKEY
Definition: ppport.h:12118
#define SvUTF8(sv)
Definition: ppport.h:17000

Definition at line 199 of file plperl.h.

◆ PERL_NO_GET_CONTEXT

#define PERL_NO_GET_CONTEXT

Definition at line 91 of file plperl.h.

◆ PERL_UNUSED_DECL

#define PERL_UNUSED_DECL   pg_attribute_unused()

Definition at line 30 of file plperl.h.

◆ printf

#define printf (   ...)    pg_printf(__VA_ARGS__)

Definition at line 162 of file plperl.h.

◆ snprintf

#define snprintf   pg_snprintf

Definition at line 156 of file plperl.h.

◆ sprintf

#define sprintf   pg_sprintf

Definition at line 158 of file plperl.h.

◆ vfprintf

#define vfprintf   pg_vfprintf

Definition at line 159 of file plperl.h.

◆ vprintf

#define vprintf   pg_vprintf

Definition at line 161 of file plperl.h.

◆ vsnprintf

#define vsnprintf   pg_vsnprintf

Definition at line 155 of file plperl.h.

◆ vsprintf

#define vsprintf   pg_vsprintf

Definition at line 157 of file plperl.h.

Function Documentation

◆ croak_cstr()

static void croak_cstr ( const char *  str)
inlinestatic

Definition at line 364 of file plperl.h.

365 {
366  dTHX;
367 
368 #ifdef croak_sv
369  /* Use sv_2mortal() to be sure the transient SV gets freed */
370  croak_sv(sv_2mortal(cstr2sv(str)));
371 #else
372 
373  /*
374  * The older way to do this is to assign a UTF8-marked value to ERRSV and
375  * then call croak(NULL). But if we leave it to croak() to append the
376  * error location, it does so too late (only after popping the stack) in
377  * some Perl versions. Hence, use mess() to create an SV with the error
378  * location info already appended.
379  */
380  SV *errsv = get_sv("@", GV_ADD);
381  char *utf8_str = utf_e2u(str);
382  SV *ssv;
383 
384  ssv = mess("%s", utf8_str);
385  SvUTF8_on(ssv);
386 
387  pfree(utf8_str);
388 
389  sv_setsv(errsv, ssv);
390 
391  croak(NULL);
392 #endif /* croak_sv */
393 }
void pfree(void *pointer)
Definition: mcxt.c:1436
static SV * cstr2sv(const char *str)
Definition: plperl.h:336
static char * utf_e2u(const char *str)
Definition: plperl.h:259
#define get_sv
Definition: ppport.h:12463
#define dTHX
Definition: ppport.h:11306
#define croak_sv(sv)
Definition: ppport.h:14714

References croak_sv, cstr2sv(), dTHX, get_sv, pfree(), generate_unaccent_rules::str, and utf_e2u().

Referenced by plperl_return_next(), plperl_spi_commit(), plperl_spi_exec(), plperl_spi_exec_prepared(), plperl_spi_fetchrow(), plperl_spi_prepare(), plperl_spi_query(), plperl_spi_query_prepared(), plperl_spi_rollback(), and plperl_util_elog().

◆ cstr2sv()

static SV* cstr2sv ( const char *  str)
inlinestatic

Definition at line 336 of file plperl.h.

337 {
338  dTHX;
339  SV *sv;
340  char *utf8_str;
341 
342  /* no conversion when SQL_ASCII */
344  return newSVpv(str, 0);
345 
346  utf8_str = utf_e2u(str);
347 
348  sv = newSVpv(utf8_str, 0);
349  SvUTF8_on(sv);
350  pfree(utf8_str);
351 
352  return sv;
353 }
int GetDatabaseEncoding(void)
Definition: mbutils.c:1268
@ PG_SQL_ASCII
Definition: pg_wchar.h:226

References dTHX, GetDatabaseEncoding(), pfree(), PG_SQL_ASCII, generate_unaccent_rules::str, and utf_e2u().

Referenced by croak_cstr(), hstore_to_plperl(), JsonbValue_to_SV(), make_array_ref(), plperl_call_perl_func(), plperl_call_perl_trigger_func(), plperl_create_sub(), plperl_event_trigger_build_args(), plperl_hash_from_tuple(), plperl_spi_execute_fetch_result(), plperl_spi_prepare(), plperl_spi_query(), plperl_spi_query_prepared(), and plperl_trigger_build_args().

◆ plperl_return_next()

void plperl_return_next ( SV *  sv)

Definition at line 3231 of file plperl.c.

3232 {
3233  MemoryContext oldcontext = CurrentMemoryContext;
3234 
3236 
3237  PG_TRY();
3238  {
3240  }
3241  PG_CATCH();
3242  {
3243  ErrorData *edata;
3244 
3245  /* Must reset elog.c's state */
3246  MemoryContextSwitchTo(oldcontext);
3247  edata = CopyErrorData();
3248  FlushErrorState();
3249 
3250  /* Punt the error to Perl */
3251  croak_cstr(edata->message);
3252  }
3253  PG_END_TRY();
3254 }
void FlushErrorState(void)
Definition: elog.c:1825
ErrorData * CopyErrorData(void)
Definition: elog.c:1720
#define PG_TRY(...)
Definition: elog.h:370
#define PG_END_TRY(...)
Definition: elog.h:395
#define PG_CATCH(...)
Definition: elog.h:380
MemoryContext CurrentMemoryContext
Definition: mcxt.c:135
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Definition: palloc.h:138
static void check_spi_usage_allowed(void)
Definition: plperl.c:3092
static void plperl_return_next_internal(SV *sv)
Definition: plperl.c:3261
static void croak_cstr(const char *str)
Definition: plperl.h:364
char * message
Definition: elog.h:439

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

◆ plperl_spi_commit()

void plperl_spi_commit ( void  )

Definition at line 3977 of file plperl.c.

3978 {
3979  MemoryContext oldcontext = CurrentMemoryContext;
3980 
3982 
3983  PG_TRY();
3984  {
3985  SPI_commit();
3986  }
3987  PG_CATCH();
3988  {
3989  ErrorData *edata;
3990 
3991  /* Save error info */
3992  MemoryContextSwitchTo(oldcontext);
3993  edata = CopyErrorData();
3994  FlushErrorState();
3995 
3996  /* Punt the error to Perl */
3997  croak_cstr(edata->message);
3998  }
3999  PG_END_TRY();
4000 }
void SPI_commit(void)
Definition: spi.c:321

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

◆ plperl_spi_cursor_close()

void plperl_spi_cursor_close ( char *  cursor)

Definition at line 3537 of file plperl.c.

3538 {
3539  Portal p;
3540 
3542 
3543  p = SPI_cursor_find(cursor);
3544 
3545  if (p)
3546  {
3547  UnpinPortal(p);
3548  SPI_cursor_close(p);
3549  }
3550 }
void UnpinPortal(Portal portal)
Definition: portalmem.c:381
Portal SPI_cursor_find(const char *name)
Definition: spi.c:1792
void SPI_cursor_close(Portal portal)
Definition: spi.c:1860
Definition: type.h:137

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

◆ plperl_spi_exec()

HV* plperl_spi_exec ( char *  query,
int  limit 
)

Definition at line 3119 of file plperl.c.

3120 {
3121  HV *ret_hv;
3122 
3123  /*
3124  * Execute the query inside a sub-transaction, so we can cope with errors
3125  * sanely
3126  */
3127  MemoryContext oldcontext = CurrentMemoryContext;
3129 
3131 
3133  /* Want to run inside function's memory context */
3134  MemoryContextSwitchTo(oldcontext);
3135 
3136  PG_TRY();
3137  {
3138  int spi_rv;
3139 
3140  pg_verifymbstr(query, strlen(query), false);
3141 
3143  limit);
3145  spi_rv);
3146 
3147  /* Commit the inner transaction, return to outer xact context */
3149  MemoryContextSwitchTo(oldcontext);
3150  CurrentResourceOwner = oldowner;
3151  }
3152  PG_CATCH();
3153  {
3154  ErrorData *edata;
3155 
3156  /* Save error info */
3157  MemoryContextSwitchTo(oldcontext);
3158  edata = CopyErrorData();
3159  FlushErrorState();
3160 
3161  /* Abort the inner transaction */
3163  MemoryContextSwitchTo(oldcontext);
3164  CurrentResourceOwner = oldowner;
3165 
3166  /* Punt the error to Perl */
3167  croak_cstr(edata->message);
3168 
3169  /* Can't get here, but keep compiler quiet */
3170  return NULL;
3171  }
3172  PG_END_TRY();
3173 
3174  return ret_hv;
3175 }
bool pg_verifymbstr(const char *mbstr, int len, bool noError)
Definition: mbutils.c:1563
static HV * plperl_spi_execute_fetch_result(SPITupleTable *, uint64, int)
Definition: plperl.c:3179
static plperl_call_data * current_call_data
Definition: plperl.c:241
ResourceOwner CurrentResourceOwner
Definition: resowner.c:146
uint64 SPI_processed
Definition: spi.c:45
SPITupleTable * SPI_tuptable
Definition: spi.c:46
int SPI_execute(const char *src, bool read_only, long tcount)
Definition: spi.c:594
plperl_proc_desc * prodesc
Definition: plperl.c:173
bool fn_readonly
Definition: plperl.c:109
void BeginInternalSubTransaction(const char *name)
Definition: xact.c:4547
void RollbackAndReleaseCurrentSubTransaction(void)
Definition: xact.c:4652
void ReleaseCurrentSubTransaction(void)
Definition: xact.c:4618

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

◆ plperl_spi_exec_prepared()

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

Definition at line 3701 of file plperl.c.

3702 {
3703  HV *ret_hv;
3704  SV **sv;
3705  int i,
3706  limit,
3707  spi_rv;
3708  char *nulls;
3709  Datum *argvalues;
3710  plperl_query_desc *qdesc;
3711  plperl_query_entry *hash_entry;
3712 
3713  /*
3714  * Execute the query inside a sub-transaction, so we can cope with errors
3715  * sanely
3716  */
3717  MemoryContext oldcontext = CurrentMemoryContext;
3719 
3721 
3723  /* Want to run inside function's memory context */
3724  MemoryContextSwitchTo(oldcontext);
3725 
3726  PG_TRY();
3727  {
3728  dTHX;
3729 
3730  /************************************************************
3731  * Fetch the saved plan descriptor, see if it's o.k.
3732  ************************************************************/
3733  hash_entry = hash_search(plperl_active_interp->query_hash, query,
3734  HASH_FIND, NULL);
3735  if (hash_entry == NULL)
3736  elog(ERROR, "spi_exec_prepared: Invalid prepared query passed");
3737 
3738  qdesc = hash_entry->query_data;
3739  if (qdesc == NULL)
3740  elog(ERROR, "spi_exec_prepared: plperl query_hash value vanished");
3741 
3742  if (qdesc->nargs != argc)
3743  elog(ERROR, "spi_exec_prepared: expected %d argument(s), %d passed",
3744  qdesc->nargs, argc);
3745 
3746  /************************************************************
3747  * Parse eventual attributes
3748  ************************************************************/
3749  limit = 0;
3750  if (attr != NULL)
3751  {
3752  sv = hv_fetch_string(attr, "limit");
3753  if (sv && *sv && SvIOK(*sv))
3754  limit = SvIV(*sv);
3755  }
3756  /************************************************************
3757  * Set up arguments
3758  ************************************************************/
3759  if (argc > 0)
3760  {
3761  nulls = (char *) palloc(argc);
3762  argvalues = (Datum *) palloc(argc * sizeof(Datum));
3763  }
3764  else
3765  {
3766  nulls = NULL;
3767  argvalues = NULL;
3768  }
3769 
3770  for (i = 0; i < argc; i++)
3771  {
3772  bool isnull;
3773 
3774  argvalues[i] = plperl_sv_to_datum(argv[i],
3775  qdesc->argtypes[i],
3776  -1,
3777  NULL,
3778  &qdesc->arginfuncs[i],
3779  qdesc->argtypioparams[i],
3780  &isnull);
3781  nulls[i] = isnull ? 'n' : ' ';
3782  }
3783 
3784  /************************************************************
3785  * go
3786  ************************************************************/
3787  spi_rv = SPI_execute_plan(qdesc->plan, argvalues, nulls,
3790  spi_rv);
3791  if (argc > 0)
3792  {
3793  pfree(argvalues);
3794  pfree(nulls);
3795  }
3796 
3797  /* Commit the inner transaction, return to outer xact context */
3799  MemoryContextSwitchTo(oldcontext);
3800  CurrentResourceOwner = oldowner;
3801  }
3802  PG_CATCH();
3803  {
3804  ErrorData *edata;
3805 
3806  /* Save error info */
3807  MemoryContextSwitchTo(oldcontext);
3808  edata = CopyErrorData();
3809  FlushErrorState();
3810 
3811  /* Abort the inner transaction */
3813  MemoryContextSwitchTo(oldcontext);
3814  CurrentResourceOwner = oldowner;
3815 
3816  /* Punt the error to Perl */
3817  croak_cstr(edata->message);
3818 
3819  /* Can't get here, but keep compiler quiet */
3820  return NULL;
3821  }
3822  PG_END_TRY();
3823 
3824  return ret_hv;
3825 }
void * hash_search(HTAB *hashp, const void *keyPtr, HASHACTION action, bool *foundPtr)
Definition: dynahash.c:953
#define ERROR
Definition: elog.h:39
@ HASH_FIND
Definition: hsearch.h:113
int i
Definition: isn.c:73
void * palloc(Size size)
Definition: mcxt.c:1210
static plperl_interp_desc * plperl_active_interp
Definition: plperl.c:225
static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod, FunctionCallInfo fcinfo, FmgrInfo *finfo, Oid typioparam, bool *isnull)
Definition: plperl.c:1307
static SV ** hv_fetch_string(HV *hv, const char *key)
Definition: plperl.c:4106
uintptr_t Datum
Definition: postgres.h:64
int SPI_execute_plan(SPIPlanPtr plan, Datum *Values, const char *Nulls, bool read_only, long tcount)
Definition: spi.c:670
HTAB * query_hash
Definition: plperl.c:87
FmgrInfo * arginfuncs
Definition: plperl.c:193
Oid * argtypes
Definition: plperl.c:192
SPIPlanPtr plan
Definition: plperl.c:190
Oid * argtypioparams
Definition: plperl.c:194
Definition: plperl.c:200
plperl_query_desc * query_data
Definition: plperl.c:202

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

◆ plperl_spi_fetchrow()

SV* plperl_spi_fetchrow ( char *  cursor)

Definition at line 3462 of file plperl.c.

3463 {
3464  SV *row;
3465 
3466  /*
3467  * Execute the FETCH inside a sub-transaction, so we can cope with errors
3468  * sanely
3469  */
3470  MemoryContext oldcontext = CurrentMemoryContext;
3472 
3474 
3476  /* Want to run inside function's memory context */
3477  MemoryContextSwitchTo(oldcontext);
3478 
3479  PG_TRY();
3480  {
3481  dTHX;
3483 
3484  if (!p)
3485  {
3486  row = &PL_sv_undef;
3487  }
3488  else
3489  {
3490  SPI_cursor_fetch(p, true, 1);
3491  if (SPI_processed == 0)
3492  {
3493  UnpinPortal(p);
3494  SPI_cursor_close(p);
3495  row = &PL_sv_undef;
3496  }
3497  else
3498  {
3501  true);
3502  }
3504  }
3505 
3506  /* Commit the inner transaction, return to outer xact context */
3508  MemoryContextSwitchTo(oldcontext);
3509  CurrentResourceOwner = oldowner;
3510  }
3511  PG_CATCH();
3512  {
3513  ErrorData *edata;
3514 
3515  /* Save error info */
3516  MemoryContextSwitchTo(oldcontext);
3517  edata = CopyErrorData();
3518  FlushErrorState();
3519 
3520  /* Abort the inner transaction */
3522  MemoryContextSwitchTo(oldcontext);
3523  CurrentResourceOwner = oldowner;
3524 
3525  /* Punt the error to Perl */
3526  croak_cstr(edata->message);
3527 
3528  /* Can't get here, but keep compiler quiet */
3529  return NULL;
3530  }
3531  PG_END_TRY();
3532 
3533  return row;
3534 }
static SV * plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc, bool include_generated)
Definition: plperl.c:3012
#define PL_sv_undef
Definition: ppport.h:11780
void SPI_cursor_fetch(Portal portal, bool forward, long count)
Definition: spi.c:1804
void SPI_freetuptable(SPITupleTable *tuptable)
Definition: spi.c:1384
TupleDesc tupdesc
Definition: spi.h:25
HeapTuple * vals
Definition: spi.h:26

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

◆ plperl_spi_freeplan()

void plperl_spi_freeplan ( char *  query)

Definition at line 3946 of file plperl.c.

3947 {
3948  SPIPlanPtr plan;
3949  plperl_query_desc *qdesc;
3950  plperl_query_entry *hash_entry;
3951 
3953 
3954  hash_entry = hash_search(plperl_active_interp->query_hash, query,
3955  HASH_FIND, NULL);
3956  if (hash_entry == NULL)
3957  elog(ERROR, "spi_freeplan: Invalid prepared query passed");
3958 
3959  qdesc = hash_entry->query_data;
3960  if (qdesc == NULL)
3961  elog(ERROR, "spi_freeplan: plperl query_hash value vanished");
3962  plan = qdesc->plan;
3963 
3964  /*
3965  * free all memory before SPI_freeplan, so if it dies, nothing will be
3966  * left over
3967  */
3969  HASH_REMOVE, NULL);
3970 
3971  MemoryContextDelete(qdesc->plan_cxt);
3972 
3973  SPI_freeplan(plan);
3974 }
@ HASH_REMOVE
Definition: hsearch.h:115
void MemoryContextDelete(MemoryContext context)
Definition: mcxt.c:387
int SPI_freeplan(SPIPlanPtr plan)
Definition: spi.c:1023
MemoryContext plan_cxt
Definition: plperl.c:189

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

◆ plperl_spi_prepare()

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

Definition at line 3553 of file plperl.c.

3554 {
3555  volatile SPIPlanPtr plan = NULL;
3556  volatile MemoryContext plan_cxt = NULL;
3557  plperl_query_desc *volatile qdesc = NULL;
3558  plperl_query_entry *volatile hash_entry = NULL;
3559  MemoryContext oldcontext = CurrentMemoryContext;
3561  MemoryContext work_cxt;
3562  bool found;
3563  int i;
3564 
3566 
3568  MemoryContextSwitchTo(oldcontext);
3569 
3570  PG_TRY();
3571  {
3573 
3574  /************************************************************
3575  * Allocate the new querydesc structure
3576  *
3577  * The qdesc struct, as well as all its subsidiary data, lives in its
3578  * plan_cxt. But note that the SPIPlan does not.
3579  ************************************************************/
3581  "PL/Perl spi_prepare query",
3583  MemoryContextSwitchTo(plan_cxt);
3584  qdesc = (plperl_query_desc *) palloc0(sizeof(plperl_query_desc));
3585  snprintf(qdesc->qname, sizeof(qdesc->qname), "%p", qdesc);
3586  qdesc->plan_cxt = plan_cxt;
3587  qdesc->nargs = argc;
3588  qdesc->argtypes = (Oid *) palloc(argc * sizeof(Oid));
3589  qdesc->arginfuncs = (FmgrInfo *) palloc(argc * sizeof(FmgrInfo));
3590  qdesc->argtypioparams = (Oid *) palloc(argc * sizeof(Oid));
3591  MemoryContextSwitchTo(oldcontext);
3592 
3593  /************************************************************
3594  * Do the following work in a short-lived context so that we don't
3595  * leak a lot of memory in the PL/Perl function's SPI Proc context.
3596  ************************************************************/
3598  "PL/Perl spi_prepare workspace",
3600  MemoryContextSwitchTo(work_cxt);
3601 
3602  /************************************************************
3603  * Resolve argument type names and then look them up by oid
3604  * in the system cache, and remember the required information
3605  * for input conversion.
3606  ************************************************************/
3607  for (i = 0; i < argc; i++)
3608  {
3609  Oid typId,
3610  typInput,
3611  typIOParam;
3612  int32 typmod;
3613  char *typstr;
3614 
3615  typstr = sv2cstr(argv[i]);
3616  (void) parseTypeString(typstr, &typId, &typmod, NULL);
3617  pfree(typstr);
3618 
3619  getTypeInputInfo(typId, &typInput, &typIOParam);
3620 
3621  qdesc->argtypes[i] = typId;
3622  fmgr_info_cxt(typInput, &(qdesc->arginfuncs[i]), plan_cxt);
3623  qdesc->argtypioparams[i] = typIOParam;
3624  }
3625 
3626  /* Make sure the query is validly encoded */
3627  pg_verifymbstr(query, strlen(query), false);
3628 
3629  /************************************************************
3630  * Prepare the plan and check for errors
3631  ************************************************************/
3632  plan = SPI_prepare(query, argc, qdesc->argtypes);
3633 
3634  if (plan == NULL)
3635  elog(ERROR, "SPI_prepare() failed:%s",
3637 
3638  /************************************************************
3639  * Save the plan into permanent memory (right now it's in the
3640  * SPI procCxt, which will go away at function end).
3641  ************************************************************/
3642  if (SPI_keepplan(plan))
3643  elog(ERROR, "SPI_keepplan() failed");
3644  qdesc->plan = plan;
3645 
3646  /************************************************************
3647  * Insert a hashtable entry for the plan.
3648  ************************************************************/
3650  qdesc->qname,
3651  HASH_ENTER, &found);
3652  hash_entry->query_data = qdesc;
3653 
3654  /* Get rid of workspace */
3655  MemoryContextDelete(work_cxt);
3656 
3657  /* Commit the inner transaction, return to outer xact context */
3659  MemoryContextSwitchTo(oldcontext);
3660  CurrentResourceOwner = oldowner;
3661  }
3662  PG_CATCH();
3663  {
3664  ErrorData *edata;
3665 
3666  /* Save error info */
3667  MemoryContextSwitchTo(oldcontext);
3668  edata = CopyErrorData();
3669  FlushErrorState();
3670 
3671  /* Drop anything we managed to allocate */
3672  if (hash_entry)
3674  qdesc->qname,
3675  HASH_REMOVE, NULL);
3676  if (plan_cxt)
3677  MemoryContextDelete(plan_cxt);
3678  if (plan)
3679  SPI_freeplan(plan);
3680 
3681  /* Abort the inner transaction */
3683  MemoryContextSwitchTo(oldcontext);
3684  CurrentResourceOwner = oldowner;
3685 
3686  /* Punt the error to Perl */
3687  croak_cstr(edata->message);
3688 
3689  /* Can't get here, but keep compiler quiet */
3690  return NULL;
3691  }
3692  PG_END_TRY();
3693 
3694  /************************************************************
3695  * Return the query's hash key to the caller.
3696  ************************************************************/
3697  return cstr2sv(qdesc->qname);
3698 }
signed int int32
Definition: c.h:478
void fmgr_info_cxt(Oid functionId, FmgrInfo *finfo, MemoryContext mcxt)
Definition: fmgr.c:137
@ HASH_ENTER
Definition: hsearch.h:114
void getTypeInputInfo(Oid type, Oid *typInput, Oid *typIOParam)
Definition: lsyscache.c:2832
MemoryContext TopMemoryContext
Definition: mcxt.c:141
void * palloc0(Size size)
Definition: mcxt.c:1241
#define AllocSetContextCreate
Definition: memutils.h:129
#define ALLOCSET_DEFAULT_SIZES
Definition: memutils.h:153
#define ALLOCSET_SMALL_SIZES
Definition: memutils.h:163
#define CHECK_FOR_INTERRUPTS()
Definition: miscadmin.h:121
bool parseTypeString(const char *str, Oid *typeid_p, int32 *typmod_p, Node *escontext)
Definition: parse_type.c:785
static char * sv2cstr(SV *sv)
Definition: plperl.h:278
#define snprintf
Definition: port.h:238
unsigned int Oid
Definition: postgres_ext.h:31
int SPI_result
Definition: spi.c:47
const char * SPI_result_code_string(int code)
Definition: spi.c:1970
SPIPlanPtr SPI_prepare(const char *src, int nargs, Oid *argtypes)
Definition: spi.c:858
int SPI_keepplan(SPIPlanPtr plan)
Definition: spi.c:974
Definition: fmgr.h:57
char qname[24]
Definition: plperl.c:188

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_active_interp, plperl_query_desc::qname, plperl_query_entry::query_data, plperl_interp_desc::query_hash, ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), snprintf, SPI_freeplan(), SPI_keepplan(), SPI_prepare(), SPI_result, SPI_result_code_string(), sv2cstr(), and TopMemoryContext.

◆ plperl_spi_query()

SV* plperl_spi_query ( char *  query)

Definition at line 3390 of file plperl.c.

3391 {
3392  SV *cursor;
3393 
3394  /*
3395  * Execute the query inside a sub-transaction, so we can cope with errors
3396  * sanely
3397  */
3398  MemoryContext oldcontext = CurrentMemoryContext;
3400 
3402 
3404  /* Want to run inside function's memory context */
3405  MemoryContextSwitchTo(oldcontext);
3406 
3407  PG_TRY();
3408  {
3409  SPIPlanPtr plan;
3410  Portal portal;
3411 
3412  /* Make sure the query is validly encoded */
3413  pg_verifymbstr(query, strlen(query), false);
3414 
3415  /* Create a cursor for the query */
3416  plan = SPI_prepare(query, 0, NULL);
3417  if (plan == NULL)
3418  elog(ERROR, "SPI_prepare() failed:%s",
3420 
3421  portal = SPI_cursor_open(NULL, plan, NULL, NULL, false);
3422  SPI_freeplan(plan);
3423  if (portal == NULL)
3424  elog(ERROR, "SPI_cursor_open() failed:%s",
3426  cursor = cstr2sv(portal->name);
3427 
3428  PinPortal(portal);
3429 
3430  /* Commit the inner transaction, return to outer xact context */
3432  MemoryContextSwitchTo(oldcontext);
3433  CurrentResourceOwner = oldowner;
3434  }
3435  PG_CATCH();
3436  {
3437  ErrorData *edata;
3438 
3439  /* Save error info */
3440  MemoryContextSwitchTo(oldcontext);
3441  edata = CopyErrorData();
3442  FlushErrorState();
3443 
3444  /* Abort the inner transaction */
3446  MemoryContextSwitchTo(oldcontext);
3447  CurrentResourceOwner = oldowner;
3448 
3449  /* Punt the error to Perl */
3450  croak_cstr(edata->message);
3451 
3452  /* Can't get here, but keep compiler quiet */
3453  return NULL;
3454  }
3455  PG_END_TRY();
3456 
3457  return cursor;
3458 }
void PinPortal(Portal portal)
Definition: portalmem.c:372
Portal SPI_cursor_open(const char *name, SPIPlanPtr plan, Datum *Values, const char *Nulls, bool read_only)
Definition: spi.c:1443
const char * name
Definition: portal.h:118

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

◆ plperl_spi_query_prepared()

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

Definition at line 3828 of file plperl.c.

3829 {
3830  int i;
3831  char *nulls;
3832  Datum *argvalues;
3833  plperl_query_desc *qdesc;
3834  plperl_query_entry *hash_entry;
3835  SV *cursor;
3836  Portal portal = NULL;
3837 
3838  /*
3839  * Execute the query inside a sub-transaction, so we can cope with errors
3840  * sanely
3841  */
3842  MemoryContext oldcontext = CurrentMemoryContext;
3844 
3846 
3848  /* Want to run inside function's memory context */
3849  MemoryContextSwitchTo(oldcontext);
3850 
3851  PG_TRY();
3852  {
3853  /************************************************************
3854  * Fetch the saved plan descriptor, see if it's o.k.
3855  ************************************************************/
3856  hash_entry = hash_search(plperl_active_interp->query_hash, query,
3857  HASH_FIND, NULL);
3858  if (hash_entry == NULL)
3859  elog(ERROR, "spi_query_prepared: Invalid prepared query passed");
3860 
3861  qdesc = hash_entry->query_data;
3862  if (qdesc == NULL)
3863  elog(ERROR, "spi_query_prepared: plperl query_hash value vanished");
3864 
3865  if (qdesc->nargs != argc)
3866  elog(ERROR, "spi_query_prepared: expected %d argument(s), %d passed",
3867  qdesc->nargs, argc);
3868 
3869  /************************************************************
3870  * Set up arguments
3871  ************************************************************/
3872  if (argc > 0)
3873  {
3874  nulls = (char *) palloc(argc);
3875  argvalues = (Datum *) palloc(argc * sizeof(Datum));
3876  }
3877  else
3878  {
3879  nulls = NULL;
3880  argvalues = NULL;
3881  }
3882 
3883  for (i = 0; i < argc; i++)
3884  {
3885  bool isnull;
3886 
3887  argvalues[i] = plperl_sv_to_datum(argv[i],
3888  qdesc->argtypes[i],
3889  -1,
3890  NULL,
3891  &qdesc->arginfuncs[i],
3892  qdesc->argtypioparams[i],
3893  &isnull);
3894  nulls[i] = isnull ? 'n' : ' ';
3895  }
3896 
3897  /************************************************************
3898  * go
3899  ************************************************************/
3900  portal = SPI_cursor_open(NULL, qdesc->plan, argvalues, nulls,
3902  if (argc > 0)
3903  {
3904  pfree(argvalues);
3905  pfree(nulls);
3906  }
3907  if (portal == NULL)
3908  elog(ERROR, "SPI_cursor_open() failed:%s",
3910 
3911  cursor = cstr2sv(portal->name);
3912 
3913  PinPortal(portal);
3914 
3915  /* Commit the inner transaction, return to outer xact context */
3917  MemoryContextSwitchTo(oldcontext);
3918  CurrentResourceOwner = oldowner;
3919  }
3920  PG_CATCH();
3921  {
3922  ErrorData *edata;
3923 
3924  /* Save error info */
3925  MemoryContextSwitchTo(oldcontext);
3926  edata = CopyErrorData();
3927  FlushErrorState();
3928 
3929  /* Abort the inner transaction */
3931  MemoryContextSwitchTo(oldcontext);
3932  CurrentResourceOwner = oldowner;
3933 
3934  /* Punt the error to Perl */
3935  croak_cstr(edata->message);
3936 
3937  /* Can't get here, but keep compiler quiet */
3938  return NULL;
3939  }
3940  PG_END_TRY();
3941 
3942  return cursor;
3943 }

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

◆ plperl_spi_rollback()

void plperl_spi_rollback ( void  )

Definition at line 4003 of file plperl.c.

4004 {
4005  MemoryContext oldcontext = CurrentMemoryContext;
4006 
4008 
4009  PG_TRY();
4010  {
4011  SPI_rollback();
4012  }
4013  PG_CATCH();
4014  {
4015  ErrorData *edata;
4016 
4017  /* Save error info */
4018  MemoryContextSwitchTo(oldcontext);
4019  edata = CopyErrorData();
4020  FlushErrorState();
4021 
4022  /* Punt the error to Perl */
4023  croak_cstr(edata->message);
4024  }
4025  PG_END_TRY();
4026 }
void SPI_rollback(void)
Definition: spi.c:414

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

◆ plperl_sv_to_literal()

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

Definition at line 1428 of file plperl.c.

1429 {
1430  Oid typid;
1431  Oid typoutput;
1432  Datum datum;
1433  bool typisvarlena,
1434  isnull;
1435 
1437 
1438  typid = DirectFunctionCall1(regtypein, CStringGetDatum(fqtypename));
1439  if (!OidIsValid(typid))
1440  ereport(ERROR,
1441  (errcode(ERRCODE_UNDEFINED_OBJECT),
1442  errmsg("lookup failed for type %s", fqtypename)));
1443 
1444  datum = plperl_sv_to_datum(sv,
1445  typid, -1,
1446  NULL, NULL, InvalidOid,
1447  &isnull);
1448 
1449  if (isnull)
1450  return NULL;
1451 
1452  getTypeOutputInfo(typid,
1453  &typoutput, &typisvarlena);
1454 
1455  return OidOutputFunctionCall(typoutput, datum);
1456 }
#define OidIsValid(objectId)
Definition: c.h:759
int errcode(int sqlerrcode)
Definition: elog.c:858
int errmsg(const char *fmt,...)
Definition: elog.c:1069
#define ereport(elevel,...)
Definition: elog.h:149
char * OidOutputFunctionCall(Oid functionId, Datum val)
Definition: fmgr.c:1750
#define DirectFunctionCall1(func, arg1)
Definition: fmgr.h:642
void getTypeOutputInfo(Oid type, Oid *typOutput, bool *typIsVarlena)
Definition: lsyscache.c:2865
static Datum CStringGetDatum(const char *X)
Definition: postgres.h:350
#define InvalidOid
Definition: postgres_ext.h:36
Datum regtypein(PG_FUNCTION_ARGS)
Definition: regproc.c:1176

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

◆ plperl_util_elog()

void plperl_util_elog ( int  level,
SV *  msg 
)

Definition at line 4040 of file plperl.c.

4041 {
4042  MemoryContext oldcontext = CurrentMemoryContext;
4043  char *volatile cmsg = NULL;
4044 
4045  /*
4046  * We intentionally omit check_spi_usage_allowed() here, as this seems
4047  * safe to allow even in the contexts that that function rejects.
4048  */
4049 
4050  PG_TRY();
4051  {
4052  cmsg = sv2cstr(msg);
4053  elog(level, "%s", cmsg);
4054  pfree(cmsg);
4055  }
4056  PG_CATCH();
4057  {
4058  ErrorData *edata;
4059 
4060  /* Must reset elog.c's state */
4061  MemoryContextSwitchTo(oldcontext);
4062  edata = CopyErrorData();
4063  FlushErrorState();
4064 
4065  if (cmsg)
4066  pfree(cmsg);
4067 
4068  /* Punt the error to Perl */
4069  croak_cstr(edata->message);
4070  }
4071  PG_END_TRY();
4072 }

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

◆ sv2cstr()

static char* sv2cstr ( SV *  sv)
inlinestatic

Definition at line 278 of file plperl.h.

279 {
280  dTHX;
281  char *val,
282  *res;
283  STRLEN len;
284 
285  /*
286  * get a utf8 encoded char * out of perl. *note* it may not be valid utf8!
287  */
288 
289  /*
290  * SvPVutf8() croaks nastily on certain things, like typeglobs and
291  * readonly objects such as $^V. That's a perl bug - it's not supposed to
292  * happen. To avoid crashing the backend, we make a copy of the sv before
293  * passing it to SvPVutf8(). The copy is garbage collected when we're done
294  * with it.
295  */
296  if (SvREADONLY(sv) ||
297  isGV_with_GP(sv) ||
298  (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM))
299  sv = newSVsv(sv);
300  else
301  {
302  /*
303  * increase the reference count so we can just SvREFCNT_dec() it when
304  * we are done
305  */
307  }
308 
309  /*
310  * Request the string from Perl, in UTF-8 encoding; but if we're in a
311  * SQL_ASCII database, just request the byte soup without trying to make
312  * it UTF8, because that might fail.
313  */
315  val = SvPV(sv, len);
316  else
317  val = SvPVutf8(sv, len);
318 
319  /*
320  * Now convert to database encoding. We use perl's length in the event we
321  * had an embedded null byte to ensure we error out properly.
322  */
323  res = utf_u2e(val, len);
324 
325  /* safe now to garbage collect the new SV */
326  SvREFCNT_dec(sv);
327 
328  return res;
329 }
long val
Definition: informix.c:664
const void size_t len
static char * utf_u2e(char *utf8_str, size_t len)
Definition: plperl.h:240
#define SvREFCNT_inc_simple_void(sv)
Definition: ppport.h:15412
#define isGV_with_GP(gv)
Definition: ppport.h:15703

References dTHX, GetDatabaseEncoding(), isGV_with_GP, len, PG_SQL_ASCII, res, SvREFCNT_inc_simple_void, utf_u2e(), and val.

Referenced by hek2cstr(), plperl_call_perl_event_trigger_func(), plperl_call_perl_func(), plperl_call_perl_trigger_func(), plperl_create_sub(), plperl_init_interp(), plperl_spi_prepare(), plperl_sv_to_datum(), plperl_to_hstore(), plperl_trigger_handler(), plperl_trusted_init(), plperl_untrusted_init(), plperl_util_elog(), select_perl_context(), and SV_to_JsonbValue().

◆ utf_e2u()

static char* utf_e2u ( const char *  str)
inlinestatic

Definition at line 259 of file plperl.h.

260 {
261  char *ret;
262 
263  ret = pg_server_to_any(str, strlen(str), PG_UTF8);
264 
265  /* ensure we have a copy even if no conversion happened */
266  if (ret == str)
267  ret = pstrdup(ret);
268 
269  return ret;
270 }
char * pg_server_to_any(const char *s, int len, int encoding)
Definition: mbutils.c:750
char * pstrdup(const char *in)
Definition: mcxt.c:1624
@ PG_UTF8
Definition: pg_wchar.h:232

References pg_server_to_any(), PG_UTF8, pstrdup(), and generate_unaccent_rules::str.

Referenced by croak_cstr(), and cstr2sv().

◆ utf_u2e()

static char* utf_u2e ( char *  utf8_str,
size_t  len 
)
inlinestatic

Definition at line 240 of file plperl.h.

241 {
242  char *ret;
243 
244  ret = pg_any_to_server(utf8_str, len, PG_UTF8);
245 
246  /* ensure we have a copy even if no conversion happened */
247  if (ret == utf8_str)
248  ret = pstrdup(ret);
249 
250  return ret;
251 }
char * pg_any_to_server(const char *s, int len, int encoding)
Definition: mbutils.c:677

References len, pg_any_to_server(), PG_UTF8, and pstrdup().

Referenced by sv2cstr().