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:1521
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 3240 of file plperl.c.

3241{
3243
3245
3246 PG_TRY();
3247 {
3249 }
3250 PG_CATCH();
3251 {
3252 ErrorData *edata;
3253
3254 /* Must reset elog.c's state */
3255 MemoryContextSwitchTo(oldcontext);
3256 edata = CopyErrorData();
3258
3259 /* Punt the error to Perl */
3260 croak_cstr(edata->message);
3261 }
3262 PG_END_TRY();
3263}
ErrorData * CopyErrorData(void)
Definition: elog.c:1746
void FlushErrorState(void)
Definition: elog.c:1867
#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:143
static void check_spi_usage_allowed(void)
Definition: plperl.c:3101
static void plperl_return_next_internal(SV *sv)
Definition: plperl.c:3270
static void croak_cstr(const char *str)
Definition: plperl.h:175
MemoryContextSwitchTo(old_ctx)
char * message
Definition: elog.h:440

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

3987{
3989
3991
3992 PG_TRY();
3993 {
3994 SPI_commit();
3995 }
3996 PG_CATCH();
3997 {
3998 ErrorData *edata;
3999
4000 /* Save error info */
4001 MemoryContextSwitchTo(oldcontext);
4002 edata = CopyErrorData();
4004
4005 /* Punt the error to Perl */
4006 croak_cstr(edata->message);
4007 }
4008 PG_END_TRY();
4009}
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 3546 of file plperl.c.

3547{
3548 Portal p;
3549
3551
3553
3554 if (p)
3555 {
3556 UnpinPortal(p);
3558 }
3559}
void UnpinPortal(Portal portal)
Definition: portalmem.c:380
Portal SPI_cursor_find(const char *name)
Definition: spi.c:1794
void SPI_cursor_close(Portal portal)
Definition: spi.c:1862
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 3128 of file plperl.c.

3129{
3130 HV *ret_hv;
3131
3132 /*
3133 * Execute the query inside a sub-transaction, so we can cope with errors
3134 * sanely
3135 */
3138
3140
3142 /* Want to run inside function's memory context */
3143 MemoryContextSwitchTo(oldcontext);
3144
3145 PG_TRY();
3146 {
3147 int spi_rv;
3148
3149 pg_verifymbstr(query, strlen(query), false);
3150
3152 limit);
3154 spi_rv);
3155
3156 /* Commit the inner transaction, return to outer xact context */
3158 MemoryContextSwitchTo(oldcontext);
3159 CurrentResourceOwner = oldowner;
3160 }
3161 PG_CATCH();
3162 {
3163 ErrorData *edata;
3164
3165 /* Save error info */
3166 MemoryContextSwitchTo(oldcontext);
3167 edata = CopyErrorData();
3169
3170 /* Abort the inner transaction */
3172 MemoryContextSwitchTo(oldcontext);
3173 CurrentResourceOwner = oldowner;
3174
3175 /* Punt the error to Perl */
3176 croak_cstr(edata->message);
3177
3178 /* Can't get here, but keep compiler quiet */
3179 return NULL;
3180 }
3181 PG_END_TRY();
3182
3183 return ret_hv;
3184}
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:3188
static plperl_call_data * current_call_data
Definition: plperl.c:240
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:596
plperl_proc_desc * prodesc
Definition: plperl.c:172
bool fn_readonly
Definition: plperl.c:108
void BeginInternalSubTransaction(const char *name)
Definition: xact.c:4686
void RollbackAndReleaseCurrentSubTransaction(void)
Definition: xact.c:4788
void ReleaseCurrentSubTransaction(void)
Definition: xact.c:4760

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

3711{
3712 HV *ret_hv;
3713 SV **sv;
3714 int i,
3715 limit,
3716 spi_rv;
3717 char *nulls;
3718 Datum *argvalues;
3719 plperl_query_desc *qdesc;
3720 plperl_query_entry *hash_entry;
3721
3722 /*
3723 * Execute the query inside a sub-transaction, so we can cope with errors
3724 * sanely
3725 */
3728
3730
3732 /* Want to run inside function's memory context */
3733 MemoryContextSwitchTo(oldcontext);
3734
3735 PG_TRY();
3736 {
3737 dTHX;
3738
3739 /************************************************************
3740 * Fetch the saved plan descriptor, see if it's o.k.
3741 ************************************************************/
3742 hash_entry = hash_search(plperl_active_interp->query_hash, query,
3743 HASH_FIND, NULL);
3744 if (hash_entry == NULL)
3745 elog(ERROR, "spi_exec_prepared: Invalid prepared query passed");
3746
3747 qdesc = hash_entry->query_data;
3748 if (qdesc == NULL)
3749 elog(ERROR, "spi_exec_prepared: plperl query_hash value vanished");
3750
3751 if (qdesc->nargs != argc)
3752 elog(ERROR, "spi_exec_prepared: expected %d argument(s), %d passed",
3753 qdesc->nargs, argc);
3754
3755 /************************************************************
3756 * Parse eventual attributes
3757 ************************************************************/
3758 limit = 0;
3759 if (attr != NULL)
3760 {
3761 sv = hv_fetch_string(attr, "limit");
3762 if (sv && *sv && SvIOK(*sv))
3763 limit = SvIV(*sv);
3764 }
3765 /************************************************************
3766 * Set up arguments
3767 ************************************************************/
3768 if (argc > 0)
3769 {
3770 nulls = (char *) palloc(argc);
3771 argvalues = (Datum *) palloc(argc * sizeof(Datum));
3772 }
3773 else
3774 {
3775 nulls = NULL;
3776 argvalues = NULL;
3777 }
3778
3779 for (i = 0; i < argc; i++)
3780 {
3781 bool isnull;
3782
3783 argvalues[i] = plperl_sv_to_datum(argv[i],
3784 qdesc->argtypes[i],
3785 -1,
3786 NULL,
3787 &qdesc->arginfuncs[i],
3788 qdesc->argtypioparams[i],
3789 &isnull);
3790 nulls[i] = isnull ? 'n' : ' ';
3791 }
3792
3793 /************************************************************
3794 * go
3795 ************************************************************/
3796 spi_rv = SPI_execute_plan(qdesc->plan, argvalues, nulls,
3799 spi_rv);
3800 if (argc > 0)
3801 {
3802 pfree(argvalues);
3803 pfree(nulls);
3804 }
3805
3806 /* Commit the inner transaction, return to outer xact context */
3808 MemoryContextSwitchTo(oldcontext);
3809 CurrentResourceOwner = oldowner;
3810 }
3811 PG_CATCH();
3812 {
3813 ErrorData *edata;
3814
3815 /* Save error info */
3816 MemoryContextSwitchTo(oldcontext);
3817 edata = CopyErrorData();
3819
3820 /* Abort the inner transaction */
3822 MemoryContextSwitchTo(oldcontext);
3823 CurrentResourceOwner = oldowner;
3824
3825 /* Punt the error to Perl */
3826 croak_cstr(edata->message);
3827
3828 /* Can't get here, but keep compiler quiet */
3829 return NULL;
3830 }
3831 PG_END_TRY();
3832
3833 return ret_hv;
3834}
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:225
@ HASH_FIND
Definition: hsearch.h:113
int i
Definition: isn.c:72
void * palloc(Size size)
Definition: mcxt.c:1317
static plperl_interp_desc * plperl_active_interp
Definition: plperl.c:224
static Datum plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod, FunctionCallInfo fcinfo, FmgrInfo *finfo, Oid typioparam, bool *isnull)
Definition: plperl.c:1322
static SV ** hv_fetch_string(HV *hv, const char *key)
Definition: plperl.c:4115
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:672
HTAB * query_hash
Definition: plperl.c:86
FmgrInfo * arginfuncs
Definition: plperl.c:192
Oid * argtypes
Definition: plperl.c:191
SPIPlanPtr plan
Definition: plperl.c:189
Oid * argtypioparams
Definition: plperl.c:193
Definition: plperl.c:199
plperl_query_desc * query_data
Definition: plperl.c:201

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

3472{
3473 SV *row;
3474
3475 /*
3476 * Execute the FETCH inside a sub-transaction, so we can cope with errors
3477 * sanely
3478 */
3481
3483
3485 /* Want to run inside function's memory context */
3486 MemoryContextSwitchTo(oldcontext);
3487
3488 PG_TRY();
3489 {
3490 dTHX;
3492
3493 if (!p)
3494 {
3495 row = &PL_sv_undef;
3496 }
3497 else
3498 {
3499 SPI_cursor_fetch(p, true, 1);
3500 if (SPI_processed == 0)
3501 {
3502 UnpinPortal(p);
3504 row = &PL_sv_undef;
3505 }
3506 else
3507 {
3510 true);
3511 }
3513 }
3514
3515 /* Commit the inner transaction, return to outer xact context */
3517 MemoryContextSwitchTo(oldcontext);
3518 CurrentResourceOwner = oldowner;
3519 }
3520 PG_CATCH();
3521 {
3522 ErrorData *edata;
3523
3524 /* Save error info */
3525 MemoryContextSwitchTo(oldcontext);
3526 edata = CopyErrorData();
3528
3529 /* Abort the inner transaction */
3531 MemoryContextSwitchTo(oldcontext);
3532 CurrentResourceOwner = oldowner;
3533
3534 /* Punt the error to Perl */
3535 croak_cstr(edata->message);
3536
3537 /* Can't get here, but keep compiler quiet */
3538 return NULL;
3539 }
3540 PG_END_TRY();
3541
3542 return row;
3543}
static SV * plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc, bool include_generated)
Definition: plperl.c:3021
#define PL_sv_undef
Definition: ppport.h:11780
void SPI_cursor_fetch(Portal portal, bool forward, long count)
Definition: spi.c:1806
void SPI_freetuptable(SPITupleTable *tuptable)
Definition: spi.c:1386
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 3955 of file plperl.c.

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

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

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

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

3400{
3401 SV *cursor;
3402
3403 /*
3404 * Execute the query inside a sub-transaction, so we can cope with errors
3405 * sanely
3406 */
3409
3411
3413 /* Want to run inside function's memory context */
3414 MemoryContextSwitchTo(oldcontext);
3415
3416 PG_TRY();
3417 {
3419 Portal portal;
3420
3421 /* Make sure the query is validly encoded */
3422 pg_verifymbstr(query, strlen(query), false);
3423
3424 /* Create a cursor for the query */
3425 plan = SPI_prepare(query, 0, NULL);
3426 if (plan == NULL)
3427 elog(ERROR, "SPI_prepare() failed:%s",
3429
3430 portal = SPI_cursor_open(NULL, plan, NULL, NULL, false);
3432 if (portal == NULL)
3433 elog(ERROR, "SPI_cursor_open() failed:%s",
3435 cursor = cstr2sv(portal->name);
3436
3437 PinPortal(portal);
3438
3439 /* Commit the inner transaction, return to outer xact context */
3441 MemoryContextSwitchTo(oldcontext);
3442 CurrentResourceOwner = oldowner;
3443 }
3444 PG_CATCH();
3445 {
3446 ErrorData *edata;
3447
3448 /* Save error info */
3449 MemoryContextSwitchTo(oldcontext);
3450 edata = CopyErrorData();
3452
3453 /* Abort the inner transaction */
3455 MemoryContextSwitchTo(oldcontext);
3456 CurrentResourceOwner = oldowner;
3457
3458 /* Punt the error to Perl */
3459 croak_cstr(edata->message);
3460
3461 /* Can't get here, but keep compiler quiet */
3462 return NULL;
3463 }
3464 PG_END_TRY();
3465
3466 return cursor;
3467}
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:1445
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 3837 of file plperl.c.

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

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

4013{
4015
4017
4018 PG_TRY();
4019 {
4020 SPI_rollback();
4021 }
4022 PG_CATCH();
4023 {
4024 ErrorData *edata;
4025
4026 /* Save error info */
4027 MemoryContextSwitchTo(oldcontext);
4028 edata = CopyErrorData();
4030
4031 /* Punt the error to Perl */
4032 croak_cstr(edata->message);
4033 }
4034 PG_END_TRY();
4035}
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 1443 of file plperl.c.

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

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

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