PostgreSQL Source Code  git master
plperl.h File Reference
#include "mb/pg_wchar.h"
#include "plperl_system.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.

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)
 

Function Documentation

◆ croak_cstr()

static void croak_cstr ( const char *  str)
inlinestatic

Definition at line 175 of file plperl.h.

176 {
177  dTHX;
178 
179 #ifdef croak_sv
180  /* Use sv_2mortal() to be sure the transient SV gets freed */
181  croak_sv(sv_2mortal(cstr2sv(str)));
182 #else
183 
184  /*
185  * The older way to do this is to assign a UTF8-marked value to ERRSV and
186  * then call croak(NULL). But if we leave it to croak() to append the
187  * error location, it does so too late (only after popping the stack) in
188  * some Perl versions. Hence, use mess() to create an SV with the error
189  * location info already appended.
190  */
191  SV *errsv = get_sv("@", GV_ADD);
192  char *utf8_str = utf_e2u(str);
193  SV *ssv;
194 
195  ssv = mess("%s", utf8_str);
196  SvUTF8_on(ssv);
197 
198  pfree(utf8_str);
199 
200  sv_setsv(errsv, ssv);
201 
202  croak(NULL);
203 #endif /* croak_sv */
204 }
const char * str
void pfree(void *pointer)
Definition: mcxt.c:1520
static SV * cstr2sv(const char *str)
Definition: plperl.h:147
static char * utf_e2u(const char *str)
Definition: plperl.h:70
#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(), 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 147 of file plperl.h.

148 {
149  dTHX;
150  SV *sv;
151  char *utf8_str;
152 
153  /* no conversion when SQL_ASCII */
155  return newSVpv(str, 0);
156 
157  utf8_str = utf_e2u(str);
158 
159  sv = newSVpv(utf8_str, 0);
160  SvUTF8_on(sv);
161  pfree(utf8_str);
162 
163  return sv;
164 }
int GetDatabaseEncoding(void)
Definition: mbutils.c:1261
@ PG_SQL_ASCII
Definition: pg_wchar.h:226

References dTHX, GetDatabaseEncoding(), pfree(), PG_SQL_ASCII, 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 3245 of file plperl.c.

3246 {
3247  MemoryContext oldcontext = CurrentMemoryContext;
3248 
3250 
3251  PG_TRY();
3252  {
3254  }
3255  PG_CATCH();
3256  {
3257  ErrorData *edata;
3258 
3259  /* Must reset elog.c's state */
3260  MemoryContextSwitchTo(oldcontext);
3261  edata = CopyErrorData();
3262  FlushErrorState();
3263 
3264  /* Punt the error to Perl */
3265  croak_cstr(edata->message);
3266  }
3267  PG_END_TRY();
3268 }
void FlushErrorState(void)
Definition: elog.c:1836
ErrorData * CopyErrorData(void)
Definition: elog.c:1731
#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:143
static void check_spi_usage_allowed(void)
Definition: plperl.c:3106
static void plperl_return_next_internal(SV *sv)
Definition: plperl.c:3275
static void croak_cstr(const char *str)
Definition: plperl.h:175
MemoryContextSwitchTo(old_ctx)
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 3991 of file plperl.c.

3992 {
3993  MemoryContext oldcontext = CurrentMemoryContext;
3994 
3996 
3997  PG_TRY();
3998  {
3999  SPI_commit();
4000  }
4001  PG_CATCH();
4002  {
4003  ErrorData *edata;
4004 
4005  /* Save error info */
4006  MemoryContextSwitchTo(oldcontext);
4007  edata = CopyErrorData();
4008  FlushErrorState();
4009 
4010  /* Punt the error to Perl */
4011  croak_cstr(edata->message);
4012  }
4013  PG_END_TRY();
4014 }
void SPI_commit(void)
Definition: spi.c:320

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

3552 {
3553  Portal p;
3554 
3556 
3557  p = SPI_cursor_find(cursor);
3558 
3559  if (p)
3560  {
3561  UnpinPortal(p);
3562  SPI_cursor_close(p);
3563  }
3564 }
void UnpinPortal(Portal portal)
Definition: portalmem.c:380
Portal SPI_cursor_find(const char *name)
Definition: spi.c:1791
void SPI_cursor_close(Portal portal)
Definition: spi.c:1859
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 3133 of file plperl.c.

3134 {
3135  HV *ret_hv;
3136 
3137  /*
3138  * Execute the query inside a sub-transaction, so we can cope with errors
3139  * sanely
3140  */
3141  MemoryContext oldcontext = CurrentMemoryContext;
3143 
3145 
3147  /* Want to run inside function's memory context */
3148  MemoryContextSwitchTo(oldcontext);
3149 
3150  PG_TRY();
3151  {
3152  int spi_rv;
3153 
3154  pg_verifymbstr(query, strlen(query), false);
3155 
3157  limit);
3159  spi_rv);
3160 
3161  /* Commit the inner transaction, return to outer xact context */
3163  MemoryContextSwitchTo(oldcontext);
3164  CurrentResourceOwner = oldowner;
3165  }
3166  PG_CATCH();
3167  {
3168  ErrorData *edata;
3169 
3170  /* Save error info */
3171  MemoryContextSwitchTo(oldcontext);
3172  edata = CopyErrorData();
3173  FlushErrorState();
3174 
3175  /* Abort the inner transaction */
3177  MemoryContextSwitchTo(oldcontext);
3178  CurrentResourceOwner = oldowner;
3179 
3180  /* Punt the error to Perl */
3181  croak_cstr(edata->message);
3182 
3183  /* Can't get here, but keep compiler quiet */
3184  return NULL;
3185  }
3186  PG_END_TRY();
3187 
3188  return ret_hv;
3189 }
bool pg_verifymbstr(const char *mbstr, int len, bool noError)
Definition: mbutils.c:1556
static HV * plperl_spi_execute_fetch_result(SPITupleTable *, uint64, int)
Definition: plperl.c:3193
static plperl_call_data * current_call_data
Definition: plperl.c:241
ResourceOwner CurrentResourceOwner
Definition: resowner.c:165
uint64 SPI_processed
Definition: spi.c:44
SPITupleTable * SPI_tuptable
Definition: spi.c:45
int SPI_execute(const char *src, bool read_only, long tcount)
Definition: spi.c:593
plperl_proc_desc * prodesc
Definition: plperl.c:173
bool fn_readonly
Definition: plperl.c:109
void BeginInternalSubTransaction(const char *name)
Definition: xact.c:4656
void RollbackAndReleaseCurrentSubTransaction(void)
Definition: xact.c:4758
void ReleaseCurrentSubTransaction(void)
Definition: xact.c:4730

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

3716 {
3717  HV *ret_hv;
3718  SV **sv;
3719  int i,
3720  limit,
3721  spi_rv;
3722  char *nulls;
3723  Datum *argvalues;
3724  plperl_query_desc *qdesc;
3725  plperl_query_entry *hash_entry;
3726 
3727  /*
3728  * Execute the query inside a sub-transaction, so we can cope with errors
3729  * sanely
3730  */
3731  MemoryContext oldcontext = CurrentMemoryContext;
3733 
3735 
3737  /* Want to run inside function's memory context */
3738  MemoryContextSwitchTo(oldcontext);
3739 
3740  PG_TRY();
3741  {
3742  dTHX;
3743 
3744  /************************************************************
3745  * Fetch the saved plan descriptor, see if it's o.k.
3746  ************************************************************/
3747  hash_entry = hash_search(plperl_active_interp->query_hash, query,
3748  HASH_FIND, NULL);
3749  if (hash_entry == NULL)
3750  elog(ERROR, "spi_exec_prepared: Invalid prepared query passed");
3751 
3752  qdesc = hash_entry->query_data;
3753  if (qdesc == NULL)
3754  elog(ERROR, "spi_exec_prepared: plperl query_hash value vanished");
3755 
3756  if (qdesc->nargs != argc)
3757  elog(ERROR, "spi_exec_prepared: expected %d argument(s), %d passed",
3758  qdesc->nargs, argc);
3759 
3760  /************************************************************
3761  * Parse eventual attributes
3762  ************************************************************/
3763  limit = 0;
3764  if (attr != NULL)
3765  {
3766  sv = hv_fetch_string(attr, "limit");
3767  if (sv && *sv && SvIOK(*sv))
3768  limit = SvIV(*sv);
3769  }
3770  /************************************************************
3771  * Set up arguments
3772  ************************************************************/
3773  if (argc > 0)
3774  {
3775  nulls = (char *) palloc(argc);
3776  argvalues = (Datum *) palloc(argc * sizeof(Datum));
3777  }
3778  else
3779  {
3780  nulls = NULL;
3781  argvalues = NULL;
3782  }
3783 
3784  for (i = 0; i < argc; i++)
3785  {
3786  bool isnull;
3787 
3788  argvalues[i] = plperl_sv_to_datum(argv[i],
3789  qdesc->argtypes[i],
3790  -1,
3791  NULL,
3792  &qdesc->arginfuncs[i],
3793  qdesc->argtypioparams[i],
3794  &isnull);
3795  nulls[i] = isnull ? 'n' : ' ';
3796  }
3797 
3798  /************************************************************
3799  * go
3800  ************************************************************/
3801  spi_rv = SPI_execute_plan(qdesc->plan, argvalues, nulls,
3804  spi_rv);
3805  if (argc > 0)
3806  {
3807  pfree(argvalues);
3808  pfree(nulls);
3809  }
3810 
3811  /* Commit the inner transaction, return to outer xact context */
3813  MemoryContextSwitchTo(oldcontext);
3814  CurrentResourceOwner = oldowner;
3815  }
3816  PG_CATCH();
3817  {
3818  ErrorData *edata;
3819 
3820  /* Save error info */
3821  MemoryContextSwitchTo(oldcontext);
3822  edata = CopyErrorData();
3823  FlushErrorState();
3824 
3825  /* Abort the inner transaction */
3827  MemoryContextSwitchTo(oldcontext);
3828  CurrentResourceOwner = oldowner;
3829 
3830  /* Punt the error to Perl */
3831  croak_cstr(edata->message);
3832 
3833  /* Can't get here, but keep compiler quiet */
3834  return NULL;
3835  }
3836  PG_END_TRY();
3837 
3838  return ret_hv;
3839 }
void * hash_search(HTAB *hashp, const void *keyPtr, HASHACTION action, bool *foundPtr)
Definition: dynahash.c:955
#define ERROR
Definition: elog.h:39
#define elog(elevel,...)
Definition: elog.h:224
@ HASH_FIND
Definition: hsearch.h:113
int i
Definition: isn.c:73
void * palloc(Size size)
Definition: mcxt.c:1316
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:1323
static SV ** hv_fetch_string(HV *hv, const char *key)
Definition: plperl.c:4120
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:669
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 3476 of file plperl.c.

3477 {
3478  SV *row;
3479 
3480  /*
3481  * Execute the FETCH inside a sub-transaction, so we can cope with errors
3482  * sanely
3483  */
3484  MemoryContext oldcontext = CurrentMemoryContext;
3486 
3488 
3490  /* Want to run inside function's memory context */
3491  MemoryContextSwitchTo(oldcontext);
3492 
3493  PG_TRY();
3494  {
3495  dTHX;
3497 
3498  if (!p)
3499  {
3500  row = &PL_sv_undef;
3501  }
3502  else
3503  {
3504  SPI_cursor_fetch(p, true, 1);
3505  if (SPI_processed == 0)
3506  {
3507  UnpinPortal(p);
3508  SPI_cursor_close(p);
3509  row = &PL_sv_undef;
3510  }
3511  else
3512  {
3515  true);
3516  }
3518  }
3519 
3520  /* Commit the inner transaction, return to outer xact context */
3522  MemoryContextSwitchTo(oldcontext);
3523  CurrentResourceOwner = oldowner;
3524  }
3525  PG_CATCH();
3526  {
3527  ErrorData *edata;
3528 
3529  /* Save error info */
3530  MemoryContextSwitchTo(oldcontext);
3531  edata = CopyErrorData();
3532  FlushErrorState();
3533 
3534  /* Abort the inner transaction */
3536  MemoryContextSwitchTo(oldcontext);
3537  CurrentResourceOwner = oldowner;
3538 
3539  /* Punt the error to Perl */
3540  croak_cstr(edata->message);
3541 
3542  /* Can't get here, but keep compiler quiet */
3543  return NULL;
3544  }
3545  PG_END_TRY();
3546 
3547  return row;
3548 }
static SV * plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc, bool include_generated)
Definition: plperl.c:3026
#define PL_sv_undef
Definition: ppport.h:11780
void SPI_cursor_fetch(Portal portal, bool forward, long count)
Definition: spi.c:1803
void SPI_freetuptable(SPITupleTable *tuptable)
Definition: spi.c:1383
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 3960 of file plperl.c.

3961 {
3962  SPIPlanPtr plan;
3963  plperl_query_desc *qdesc;
3964  plperl_query_entry *hash_entry;
3965 
3967 
3968  hash_entry = hash_search(plperl_active_interp->query_hash, query,
3969  HASH_FIND, NULL);
3970  if (hash_entry == NULL)
3971  elog(ERROR, "spi_freeplan: Invalid prepared query passed");
3972 
3973  qdesc = hash_entry->query_data;
3974  if (qdesc == NULL)
3975  elog(ERROR, "spi_freeplan: plperl query_hash value vanished");
3976  plan = qdesc->plan;
3977 
3978  /*
3979  * free all memory before SPI_freeplan, so if it dies, nothing will be
3980  * left over
3981  */
3983  HASH_REMOVE, NULL);
3984 
3985  MemoryContextDelete(qdesc->plan_cxt);
3986 
3987  SPI_freeplan(plan);
3988 }
@ HASH_REMOVE
Definition: hsearch.h:115
void MemoryContextDelete(MemoryContext context)
Definition: mcxt.c:454
#define plan(x)
Definition: pg_regress.c:162
int SPI_freeplan(SPIPlanPtr plan)
Definition: spi.c:1022
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, 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 3567 of file plperl.c.

3568 {
3569  volatile SPIPlanPtr plan = NULL;
3570  volatile MemoryContext plan_cxt = NULL;
3571  plperl_query_desc *volatile qdesc = NULL;
3572  plperl_query_entry *volatile hash_entry = NULL;
3573  MemoryContext oldcontext = CurrentMemoryContext;
3575  MemoryContext work_cxt;
3576  bool found;
3577  int i;
3578 
3580 
3582  MemoryContextSwitchTo(oldcontext);
3583 
3584  PG_TRY();
3585  {
3587 
3588  /************************************************************
3589  * Allocate the new querydesc structure
3590  *
3591  * The qdesc struct, as well as all its subsidiary data, lives in its
3592  * plan_cxt. But note that the SPIPlan does not.
3593  ************************************************************/
3595  "PL/Perl spi_prepare query",
3597  MemoryContextSwitchTo(plan_cxt);
3598  qdesc = (plperl_query_desc *) palloc0(sizeof(plperl_query_desc));
3599  snprintf(qdesc->qname, sizeof(qdesc->qname), "%p", qdesc);
3600  qdesc->plan_cxt = plan_cxt;
3601  qdesc->nargs = argc;
3602  qdesc->argtypes = (Oid *) palloc(argc * sizeof(Oid));
3603  qdesc->arginfuncs = (FmgrInfo *) palloc(argc * sizeof(FmgrInfo));
3604  qdesc->argtypioparams = (Oid *) palloc(argc * sizeof(Oid));
3605  MemoryContextSwitchTo(oldcontext);
3606 
3607  /************************************************************
3608  * Do the following work in a short-lived context so that we don't
3609  * leak a lot of memory in the PL/Perl function's SPI Proc context.
3610  ************************************************************/
3612  "PL/Perl spi_prepare workspace",
3614  MemoryContextSwitchTo(work_cxt);
3615 
3616  /************************************************************
3617  * Resolve argument type names and then look them up by oid
3618  * in the system cache, and remember the required information
3619  * for input conversion.
3620  ************************************************************/
3621  for (i = 0; i < argc; i++)
3622  {
3623  Oid typId,
3624  typInput,
3625  typIOParam;
3626  int32 typmod;
3627  char *typstr;
3628 
3629  typstr = sv2cstr(argv[i]);
3630  (void) parseTypeString(typstr, &typId, &typmod, NULL);
3631  pfree(typstr);
3632 
3633  getTypeInputInfo(typId, &typInput, &typIOParam);
3634 
3635  qdesc->argtypes[i] = typId;
3636  fmgr_info_cxt(typInput, &(qdesc->arginfuncs[i]), plan_cxt);
3637  qdesc->argtypioparams[i] = typIOParam;
3638  }
3639 
3640  /* Make sure the query is validly encoded */
3641  pg_verifymbstr(query, strlen(query), false);
3642 
3643  /************************************************************
3644  * Prepare the plan and check for errors
3645  ************************************************************/
3646  plan = SPI_prepare(query, argc, qdesc->argtypes);
3647 
3648  if (plan == NULL)
3649  elog(ERROR, "SPI_prepare() failed:%s",
3651 
3652  /************************************************************
3653  * Save the plan into permanent memory (right now it's in the
3654  * SPI procCxt, which will go away at function end).
3655  ************************************************************/
3656  if (SPI_keepplan(plan))
3657  elog(ERROR, "SPI_keepplan() failed");
3658  qdesc->plan = plan;
3659 
3660  /************************************************************
3661  * Insert a hashtable entry for the plan.
3662  ************************************************************/
3664  qdesc->qname,
3665  HASH_ENTER, &found);
3666  hash_entry->query_data = qdesc;
3667 
3668  /* Get rid of workspace */
3669  MemoryContextDelete(work_cxt);
3670 
3671  /* Commit the inner transaction, return to outer xact context */
3673  MemoryContextSwitchTo(oldcontext);
3674  CurrentResourceOwner = oldowner;
3675  }
3676  PG_CATCH();
3677  {
3678  ErrorData *edata;
3679 
3680  /* Save error info */
3681  MemoryContextSwitchTo(oldcontext);
3682  edata = CopyErrorData();
3683  FlushErrorState();
3684 
3685  /* Drop anything we managed to allocate */
3686  if (hash_entry)
3688  qdesc->qname,
3689  HASH_REMOVE, NULL);
3690  if (plan_cxt)
3691  MemoryContextDelete(plan_cxt);
3692  if (plan)
3693  SPI_freeplan(plan);
3694 
3695  /* Abort the inner transaction */
3697  MemoryContextSwitchTo(oldcontext);
3698  CurrentResourceOwner = oldowner;
3699 
3700  /* Punt the error to Perl */
3701  croak_cstr(edata->message);
3702 
3703  /* Can't get here, but keep compiler quiet */
3704  return NULL;
3705  }
3706  PG_END_TRY();
3707 
3708  /************************************************************
3709  * Return the query's hash key to the caller.
3710  ************************************************************/
3711  return cstr2sv(qdesc->qname);
3712 }
signed int int32
Definition: c.h:494
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:2852
MemoryContext TopMemoryContext
Definition: mcxt.c:149
void * palloc0(Size size)
Definition: mcxt.c:1346
#define AllocSetContextCreate
Definition: memutils.h:129
#define ALLOCSET_DEFAULT_SIZES
Definition: memutils.h:160
#define ALLOCSET_SMALL_SIZES
Definition: memutils.h:170
#define CHECK_FOR_INTERRUPTS()
Definition: miscadmin.h:122
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:89
#define snprintf
Definition: port.h:238
unsigned int Oid
Definition: postgres_ext.h:31
int SPI_result
Definition: spi.c:46
const char * SPI_result_code_string(int code)
Definition: spi.c:1969
SPIPlanPtr SPI_prepare(const char *src, int nargs, Oid *argtypes)
Definition: spi.c:857
int SPI_keepplan(SPIPlanPtr plan)
Definition: spi.c:973
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, 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 3404 of file plperl.c.

3405 {
3406  SV *cursor;
3407 
3408  /*
3409  * Execute the query inside a sub-transaction, so we can cope with errors
3410  * sanely
3411  */
3412  MemoryContext oldcontext = CurrentMemoryContext;
3414 
3416 
3418  /* Want to run inside function's memory context */
3419  MemoryContextSwitchTo(oldcontext);
3420 
3421  PG_TRY();
3422  {
3423  SPIPlanPtr plan;
3424  Portal portal;
3425 
3426  /* Make sure the query is validly encoded */
3427  pg_verifymbstr(query, strlen(query), false);
3428 
3429  /* Create a cursor for the query */
3430  plan = SPI_prepare(query, 0, NULL);
3431  if (plan == NULL)
3432  elog(ERROR, "SPI_prepare() failed:%s",
3434 
3435  portal = SPI_cursor_open(NULL, plan, NULL, NULL, false);
3436  SPI_freeplan(plan);
3437  if (portal == NULL)
3438  elog(ERROR, "SPI_cursor_open() failed:%s",
3440  cursor = cstr2sv(portal->name);
3441 
3442  PinPortal(portal);
3443 
3444  /* Commit the inner transaction, return to outer xact context */
3446  MemoryContextSwitchTo(oldcontext);
3447  CurrentResourceOwner = oldowner;
3448  }
3449  PG_CATCH();
3450  {
3451  ErrorData *edata;
3452 
3453  /* Save error info */
3454  MemoryContextSwitchTo(oldcontext);
3455  edata = CopyErrorData();
3456  FlushErrorState();
3457 
3458  /* Abort the inner transaction */
3460  MemoryContextSwitchTo(oldcontext);
3461  CurrentResourceOwner = oldowner;
3462 
3463  /* Punt the error to Perl */
3464  croak_cstr(edata->message);
3465 
3466  /* Can't get here, but keep compiler quiet */
3467  return NULL;
3468  }
3469  PG_END_TRY();
3470 
3471  return cursor;
3472 }
void PinPortal(Portal portal)
Definition: portalmem.c:371
Portal SPI_cursor_open(const char *name, SPIPlanPtr plan, Datum *Values, const char *Nulls, bool read_only)
Definition: spi.c:1442
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(), plan, 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 3842 of file plperl.c.

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

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

4018 {
4019  MemoryContext oldcontext = CurrentMemoryContext;
4020 
4022 
4023  PG_TRY();
4024  {
4025  SPI_rollback();
4026  }
4027  PG_CATCH();
4028  {
4029  ErrorData *edata;
4030 
4031  /* Save error info */
4032  MemoryContextSwitchTo(oldcontext);
4033  edata = CopyErrorData();
4034  FlushErrorState();
4035 
4036  /* Punt the error to Perl */
4037  croak_cstr(edata->message);
4038  }
4039  PG_END_TRY();
4040 }
void SPI_rollback(void)
Definition: spi.c:413

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

1445 {
1446  Oid typid;
1447  Oid typoutput;
1448  Datum datum;
1449  bool typisvarlena,
1450  isnull;
1451 
1453 
1454  typid = DirectFunctionCall1(regtypein, CStringGetDatum(fqtypename));
1455  if (!OidIsValid(typid))
1456  ereport(ERROR,
1457  (errcode(ERRCODE_UNDEFINED_OBJECT),
1458  errmsg("lookup failed for type %s", fqtypename)));
1459 
1460  datum = plperl_sv_to_datum(sv,
1461  typid, -1,
1462  NULL, NULL, InvalidOid,
1463  &isnull);
1464 
1465  if (isnull)
1466  return NULL;
1467 
1468  getTypeOutputInfo(typid,
1469  &typoutput, &typisvarlena);
1470 
1471  return OidOutputFunctionCall(typoutput, datum);
1472 }
#define OidIsValid(objectId)
Definition: c.h:775
int errcode(int sqlerrcode)
Definition: elog.c:859
int errmsg(const char *fmt,...)
Definition: elog.c:1072
#define ereport(elevel,...)
Definition: elog.h:149
char * OidOutputFunctionCall(Oid functionId, Datum val)
Definition: fmgr.c:1763
#define DirectFunctionCall1(func, arg1)
Definition: fmgr.h:642
void getTypeOutputInfo(Oid type, Oid *typOutput, bool *typIsVarlena)
Definition: lsyscache.c:2885
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 4054 of file plperl.c.

4055 {
4056  MemoryContext oldcontext = CurrentMemoryContext;
4057  char *volatile cmsg = NULL;
4058 
4059  /*
4060  * We intentionally omit check_spi_usage_allowed() here, as this seems
4061  * safe to allow even in the contexts that that function rejects.
4062  */
4063 
4064  PG_TRY();
4065  {
4066  cmsg = sv2cstr(msg);
4067  elog(level, "%s", cmsg);
4068  pfree(cmsg);
4069  }
4070  PG_CATCH();
4071  {
4072  ErrorData *edata;
4073 
4074  /* Must reset elog.c's state */
4075  MemoryContextSwitchTo(oldcontext);
4076  edata = CopyErrorData();
4077  FlushErrorState();
4078 
4079  if (cmsg)
4080  pfree(cmsg);
4081 
4082  /* Punt the error to Perl */
4083  croak_cstr(edata->message);
4084  }
4085  PG_END_TRY();
4086 }

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 89 of file plperl.h.

90 {
91  dTHX;
92  char *val,
93  *res;
94  STRLEN len;
95 
96  /*
97  * get a utf8 encoded char * out of perl. *note* it may not be valid utf8!
98  */
99 
100  /*
101  * SvPVutf8() croaks nastily on certain things, like typeglobs and
102  * readonly objects such as $^V. That's a perl bug - it's not supposed to
103  * happen. To avoid crashing the backend, we make a copy of the sv before
104  * passing it to SvPVutf8(). The copy is garbage collected when we're done
105  * with it.
106  */
107  if (SvREADONLY(sv) ||
108  isGV_with_GP(sv) ||
109  (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM))
110  sv = newSVsv(sv);
111  else
112  {
113  /*
114  * increase the reference count so we can just SvREFCNT_dec() it when
115  * we are done
116  */
118  }
119 
120  /*
121  * Request the string from Perl, in UTF-8 encoding; but if we're in a
122  * SQL_ASCII database, just request the byte soup without trying to make
123  * it UTF8, because that might fail.
124  */
126  val = SvPV(sv, len);
127  else
128  val = SvPVutf8(sv, len);
129 
130  /*
131  * Now convert to database encoding. We use perl's length in the event we
132  * had an embedded null byte to ensure we error out properly.
133  */
134  res = utf_u2e(val, len);
135 
136  /* safe now to garbage collect the new SV */
137  SvREFCNT_dec(sv);
138 
139  return res;
140 }
long val
Definition: informix.c:670
const void size_t len
static char * utf_u2e(char *utf8_str, size_t len)
Definition: plperl.h:51
#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 70 of file plperl.h.

71 {
72  char *ret;
73 
74  ret = pg_server_to_any(str, strlen(str), PG_UTF8);
75 
76  /* ensure we have a copy even if no conversion happened */
77  if (ret == str)
78  ret = pstrdup(ret);
79 
80  return ret;
81 }
char * pg_server_to_any(const char *s, int len, int encoding)
Definition: mbutils.c:749
char * pstrdup(const char *in)
Definition: mcxt.c:1695
@ PG_UTF8
Definition: pg_wchar.h:232

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

Referenced by croak_cstr(), and cstr2sv().

◆ utf_u2e()

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

Definition at line 51 of file plperl.h.

52 {
53  char *ret;
54 
55  ret = pg_any_to_server(utf8_str, len, PG_UTF8);
56 
57  /* ensure we have a copy even if no conversion happened */
58  if (ret == utf8_str)
59  ret = pstrdup(ret);
60 
61  return ret;
62 }
char * pg_any_to_server(const char *s, int len, int encoding)
Definition: mbutils.c:676

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

Referenced by sv2cstr().