PostgreSQL Source Code git master
All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Pages
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:2150
static char * utf_e2u(const char *str)
Definition: plperl.h:70
static SV * cstr2sv(const char *str)
Definition: plperl.h:147
#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 3246 of file plperl.c.

3247{
3249
3251
3252 PG_TRY();
3253 {
3255 }
3256 PG_CATCH();
3257 {
3258 ErrorData *edata;
3259
3260 /* Must reset elog.c's state */
3261 MemoryContextSwitchTo(oldcontext);
3262 edata = CopyErrorData();
3264
3265 /* Punt the error to Perl */
3266 croak_cstr(edata->message);
3267 }
3268 PG_END_TRY();
3269}
ErrorData * CopyErrorData(void)
Definition: elog.c:1751
void FlushErrorState(void)
Definition: elog.c:1872
#define PG_TRY(...)
Definition: elog.h:371
#define PG_END_TRY(...)
Definition: elog.h:396
#define PG_CATCH(...)
Definition: elog.h:381
MemoryContext CurrentMemoryContext
Definition: mcxt.c:159
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Definition: palloc.h:124
static void check_spi_usage_allowed(void)
Definition: plperl.c:3107
static void plperl_return_next_internal(SV *sv)
Definition: plperl.c:3276
static void croak_cstr(const char *str)
Definition: plperl.h:175
char * message
Definition: elog.h:431

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

3993{
3995
3997
3998 PG_TRY();
3999 {
4000 SPI_commit();
4001 }
4002 PG_CATCH();
4003 {
4004 ErrorData *edata;
4005
4006 /* Save error info */
4007 MemoryContextSwitchTo(oldcontext);
4008 edata = CopyErrorData();
4010
4011 /* Punt the error to Perl */
4012 croak_cstr(edata->message);
4013 }
4014 PG_END_TRY();
4015}
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 3552 of file plperl.c.

3553{
3554 Portal p;
3555
3557
3559
3560 if (p)
3561 {
3562 UnpinPortal(p);
3564 }
3565}
void UnpinPortal(Portal portal)
Definition: portalmem.c:382
Portal SPI_cursor_find(const char *name)
Definition: spi.c:1796
void SPI_cursor_close(Portal portal)
Definition: spi.c:1864
Definition: type.h:138

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

3135{
3136 HV *ret_hv;
3137
3138 /*
3139 * Execute the query inside a sub-transaction, so we can cope with errors
3140 * sanely
3141 */
3144
3146
3148 /* Want to run inside function's memory context */
3149 MemoryContextSwitchTo(oldcontext);
3150
3151 PG_TRY();
3152 {
3153 int spi_rv;
3154
3155 pg_verifymbstr(query, strlen(query), false);
3156
3158 limit);
3160 spi_rv);
3161
3162 /* Commit the inner transaction, return to outer xact context */
3164 MemoryContextSwitchTo(oldcontext);
3165 CurrentResourceOwner = oldowner;
3166 }
3167 PG_CATCH();
3168 {
3169 ErrorData *edata;
3170
3171 /* Save error info */
3172 MemoryContextSwitchTo(oldcontext);
3173 edata = CopyErrorData();
3175
3176 /* Abort the inner transaction */
3178 MemoryContextSwitchTo(oldcontext);
3179 CurrentResourceOwner = oldowner;
3180
3181 /* Punt the error to Perl */
3182 croak_cstr(edata->message);
3183
3184 /* Can't get here, but keep compiler quiet */
3185 return NULL;
3186 }
3187 PG_END_TRY();
3188
3189 return ret_hv;
3190}
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:3194
static plperl_call_data * current_call_data
Definition: plperl.c:243
ResourceOwner CurrentResourceOwner
Definition: resowner.c:173
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:597
plperl_proc_desc * prodesc
Definition: plperl.c:175
bool fn_readonly
Definition: plperl.c:111
void BeginInternalSubTransaction(const char *name)
Definition: xact.c:4694
void RollbackAndReleaseCurrentSubTransaction(void)
Definition: xact.c:4796
void ReleaseCurrentSubTransaction(void)
Definition: xact.c:4768

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

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

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

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

3962{
3964 plperl_query_desc *qdesc;
3965 plperl_query_entry *hash_entry;
3966
3968
3969 hash_entry = hash_search(plperl_active_interp->query_hash, query,
3970 HASH_FIND, NULL);
3971 if (hash_entry == NULL)
3972 elog(ERROR, "spi_freeplan: Invalid prepared query passed");
3973
3974 qdesc = hash_entry->query_data;
3975 if (qdesc == NULL)
3976 elog(ERROR, "spi_freeplan: plperl query_hash value vanished");
3977 plan = qdesc->plan;
3978
3979 /*
3980 * free all memory before SPI_freeplan, so if it dies, nothing will be
3981 * left over
3982 */
3984 HASH_REMOVE, NULL);
3985
3987
3989}
@ HASH_REMOVE
Definition: hsearch.h:115
void MemoryContextDelete(MemoryContext context)
Definition: mcxt.c:485
#define plan(x)
Definition: pg_regress.c:161
int SPI_freeplan(SPIPlanPtr plan)
Definition: spi.c:1026
MemoryContext plan_cxt
Definition: plperl.c:191

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

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

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

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

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

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

◆ plperl_spi_rollback()

void plperl_spi_rollback ( void  )

Definition at line 4018 of file plperl.c.

4019{
4021
4023
4024 PG_TRY();
4025 {
4026 SPI_rollback();
4027 }
4028 PG_CATCH();
4029 {
4030 ErrorData *edata;
4031
4032 /* Save error info */
4033 MemoryContextSwitchTo(oldcontext);
4034 edata = CopyErrorData();
4036
4037 /* Punt the error to Perl */
4038 croak_cstr(edata->message);
4039 }
4040 PG_END_TRY();
4041}
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 1446 of file plperl.c.

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

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

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:689
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, 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:2325
@ 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().