Header And Logo
|
#include "EXTERN.h"#include "perl.h"#include "XSUB.h"#include "ppport.h"
Go to the source code of this file.
Defines | |
| #define | NEED_eval_pv |
| #define | NEED_newRV_noinc |
| #define | NEED_sv_2pv_flags |
| #define | HeUTF8(he) |
| #define | GvCV_set(gv, cv) (GvCV(gv) = cv) |
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 *) |
| char * | plperl_sv_to_literal (SV *, char *) |
| #define GvCV_set | ( | gv, | ||
| cv | ||||
| ) | (GvCV(gv) = cv) |
Definition at line 90 of file plperl.h.
Referenced by plperl_trusted_init().
| #define HeUTF8 | ( | he | ) |
((HeKLEN(he) == HEf_SVKEY) ? \
SvUTF8(HeKEY_sv(he)) : \
(U32)HeKUTF8(he))
Definition at line 83 of file plperl.h.
Referenced by hek2cstr().
| void plperl_return_next | ( | SV * | ) |
Definition at line 2925 of file plperl.c.
References ALLOCSET_DEFAULT_INITSIZE, ALLOCSET_DEFAULT_MAXSIZE, ALLOCSET_DEFAULT_MINSIZE, AllocSetContextCreate(), ReturnSetInfo::allowedModes, Assert, CreateTupleDescCopy(), CurrentMemoryContext, ReturnSetInfo::econtext, ExprContext::ecxt_per_query_memory, ereport, errcode(), errmsg(), ERROR, ReturnSetInfo::expectedDesc, plperl_call_data::fcinfo, plperl_proc_desc::fn_retisset, plperl_proc_desc::fn_retistuple, get_call_result_type(), MemoryContextReset(), MemoryContextSwitchTo(), NULL, plperl_build_tuple_result(), plperl_sv_to_datum(), plperl_call_data::prodesc, plperl_proc_desc::result_in_func, plperl_proc_desc::result_oid, plperl_proc_desc::result_typioparam, FunctionCallInfoData::resultinfo, plperl_call_data::ret_tdesc, SFRM_Materialize_Random, plperl_call_data::tmp_cxt, plperl_call_data::tuple_store, tuplestore_begin_heap(), tuplestore_puttuple(), tuplestore_putvalues(), and work_mem.
Referenced by plperl_func_handler().
{
plperl_proc_desc *prodesc;
FunctionCallInfo fcinfo;
ReturnSetInfo *rsi;
MemoryContext old_cxt;
if (!sv)
return;
prodesc = current_call_data->prodesc;
fcinfo = current_call_data->fcinfo;
rsi = (ReturnSetInfo *) fcinfo->resultinfo;
if (!prodesc->fn_retisset)
ereport(ERROR,
(errcode(ERRCODE_SYNTAX_ERROR),
errmsg("cannot use return_next in a non-SETOF function")));
if (!current_call_data->ret_tdesc)
{
TupleDesc tupdesc;
Assert(!current_call_data->tuple_store);
/*
* This is the first call to return_next in the current PL/Perl
* function call, so memoize some lookups
*/
if (prodesc->fn_retistuple)
(void) get_call_result_type(fcinfo, NULL, &tupdesc);
else
tupdesc = rsi->expectedDesc;
/*
* Make sure the tuple_store and ret_tdesc are sufficiently
* long-lived.
*/
old_cxt = MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory);
current_call_data->ret_tdesc = CreateTupleDescCopy(tupdesc);
current_call_data->tuple_store =
tuplestore_begin_heap(rsi->allowedModes & SFRM_Materialize_Random,
false, work_mem);
MemoryContextSwitchTo(old_cxt);
}
/*
* Producing the tuple we want to return requires making plenty of
* palloc() allocations that are not cleaned up. Since this function can
* be called many times before the current memory context is reset, we
* need to do those allocations in a temporary context.
*/
if (!current_call_data->tmp_cxt)
{
current_call_data->tmp_cxt =
AllocSetContextCreate(CurrentMemoryContext,
"PL/Perl return_next temporary cxt",
ALLOCSET_DEFAULT_MINSIZE,
ALLOCSET_DEFAULT_INITSIZE,
ALLOCSET_DEFAULT_MAXSIZE);
}
old_cxt = MemoryContextSwitchTo(current_call_data->tmp_cxt);
if (prodesc->fn_retistuple)
{
HeapTuple tuple;
if (!(SvOK(sv) && SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV))
ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("SETOF-composite-returning PL/Perl function "
"must call return_next with reference to hash")));
tuple = plperl_build_tuple_result((HV *) SvRV(sv),
current_call_data->ret_tdesc);
tuplestore_puttuple(current_call_data->tuple_store, tuple);
}
else
{
Datum ret;
bool isNull;
ret = plperl_sv_to_datum(sv,
prodesc->result_oid,
-1,
fcinfo,
&prodesc->result_in_func,
prodesc->result_typioparam,
&isNull);
tuplestore_putvalues(current_call_data->tuple_store,
current_call_data->ret_tdesc,
&ret, &isNull);
}
MemoryContextSwitchTo(old_cxt);
MemoryContextReset(current_call_data->tmp_cxt);
}
| void plperl_spi_cursor_close | ( | char * | ) |
Definition at line 3197 of file plperl.c.
References check_spi_usage_allowed(), SPI_cursor_close(), and SPI_cursor_find().
{
Portal p;
check_spi_usage_allowed();
p = SPI_cursor_find(cursor);
if (p)
SPI_cursor_close(p);
}
| HV* plperl_spi_exec | ( | char * | , | |
| int | ||||
| ) |
Definition at line 2806 of file plperl.c.
References BeginInternalSubTransaction(), check_spi_usage_allowed(), CopyErrorData(), CurrentMemoryContext, CurrentResourceOwner, FlushErrorState(), plperl_proc_desc::fn_readonly, MemoryContextSwitchTo(), ErrorData::message, NULL, PG_CATCH, PG_END_TRY, PG_TRY, pg_verifymbstr(), plperl_spi_execute_fetch_result(), plperl_call_data::prodesc, ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), SPI_execute(), SPI_processed, SPI_restore_connection(), and SPI_tuptable.
{
HV *ret_hv;
/*
* Execute the query inside a sub-transaction, so we can cope with errors
* sanely
*/
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
check_spi_usage_allowed();
BeginInternalSubTransaction(NULL);
/* Want to run inside function's memory context */
MemoryContextSwitchTo(oldcontext);
PG_TRY();
{
int spi_rv;
pg_verifymbstr(query, strlen(query), false);
spi_rv = SPI_execute(query, current_call_data->prodesc->fn_readonly,
limit);
ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed,
spi_rv);
/* Commit the inner transaction, return to outer xact context */
ReleaseCurrentSubTransaction();
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
/*
* AtEOSubXact_SPI() should not have popped any SPI context, but just
* in case it did, make sure we remain connected.
*/
SPI_restore_connection();
}
PG_CATCH();
{
ErrorData *edata;
/* Save error info */
MemoryContextSwitchTo(oldcontext);
edata = CopyErrorData();
FlushErrorState();
/* Abort the inner transaction */
RollbackAndReleaseCurrentSubTransaction();
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
/*
* If AtEOSubXact_SPI() popped any SPI context of the subxact, it will
* have left us in a disconnected state. We need this hack to return
* to connected state.
*/
SPI_restore_connection();
/* Punt the error to Perl */
croak("%s", edata->message);
/* Can't get here, but keep compiler quiet */
return NULL;
}
PG_END_TRY();
return ret_hv;
}
| HV* plperl_spi_exec_prepared | ( | char * | , | |
| HV * | , | |||
| int | , | |||
| SV ** | ||||
| ) |
Definition at line 3375 of file plperl.c.
References plperl_query_desc::arginfuncs, plperl_query_desc::argtypes, plperl_query_desc::argtypioparams, BeginInternalSubTransaction(), check_spi_usage_allowed(), CopyErrorData(), CurrentMemoryContext, CurrentResourceOwner, elog, ERROR, FlushErrorState(), plperl_proc_desc::fn_readonly, HASH_FIND, hash_search(), hv_fetch_string(), i, MemoryContextSwitchTo(), ErrorData::message, plperl_query_desc::nargs, NULL, palloc(), pfree(), PG_CATCH, PG_END_TRY, PG_TRY, plperl_query_desc::plan, plperl_spi_execute_fetch_result(), plperl_sv_to_datum(), plperl_call_data::prodesc, plperl_query_entry::query_data, plperl_interp_desc::query_hash, ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), SPI_execute_plan(), SPI_processed, SPI_restore_connection(), and SPI_tuptable.
{
HV *ret_hv;
SV **sv;
int i,
limit,
spi_rv;
char *nulls;
Datum *argvalues;
plperl_query_desc *qdesc;
plperl_query_entry *hash_entry;
/*
* Execute the query inside a sub-transaction, so we can cope with errors
* sanely
*/
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
check_spi_usage_allowed();
BeginInternalSubTransaction(NULL);
/* Want to run inside function's memory context */
MemoryContextSwitchTo(oldcontext);
PG_TRY();
{
/************************************************************
* Fetch the saved plan descriptor, see if it's o.k.
************************************************************/
hash_entry = hash_search(plperl_active_interp->query_hash, query,
HASH_FIND, NULL);
if (hash_entry == NULL)
elog(ERROR, "spi_exec_prepared: Invalid prepared query passed");
qdesc = hash_entry->query_data;
if (qdesc == NULL)
elog(ERROR, "spi_exec_prepared: plperl query_hash value vanished");
if (qdesc->nargs != argc)
elog(ERROR, "spi_exec_prepared: expected %d argument(s), %d passed",
qdesc->nargs, argc);
/************************************************************
* Parse eventual attributes
************************************************************/
limit = 0;
if (attr != NULL)
{
sv = hv_fetch_string(attr, "limit");
if (sv && *sv && SvIOK(*sv))
limit = SvIV(*sv);
}
/************************************************************
* Set up arguments
************************************************************/
if (argc > 0)
{
nulls = (char *) palloc(argc);
argvalues = (Datum *) palloc(argc * sizeof(Datum));
}
else
{
nulls = NULL;
argvalues = NULL;
}
for (i = 0; i < argc; i++)
{
bool isnull;
argvalues[i] = plperl_sv_to_datum(argv[i],
qdesc->argtypes[i],
-1,
NULL,
&qdesc->arginfuncs[i],
qdesc->argtypioparams[i],
&isnull);
nulls[i] = isnull ? 'n' : ' ';
}
/************************************************************
* go
************************************************************/
spi_rv = SPI_execute_plan(qdesc->plan, argvalues, nulls,
current_call_data->prodesc->fn_readonly, limit);
ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed,
spi_rv);
if (argc > 0)
{
pfree(argvalues);
pfree(nulls);
}
/* Commit the inner transaction, return to outer xact context */
ReleaseCurrentSubTransaction();
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
/*
* AtEOSubXact_SPI() should not have popped any SPI context, but just
* in case it did, make sure we remain connected.
*/
SPI_restore_connection();
}
PG_CATCH();
{
ErrorData *edata;
/* Save error info */
MemoryContextSwitchTo(oldcontext);
edata = CopyErrorData();
FlushErrorState();
/* Abort the inner transaction */
RollbackAndReleaseCurrentSubTransaction();
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
/*
* If AtEOSubXact_SPI() popped any SPI context of the subxact, it will
* have left us in a disconnected state. We need this hack to return
* to connected state.
*/
SPI_restore_connection();
/* Punt the error to Perl */
croak("%s", edata->message);
/* Can't get here, but keep compiler quiet */
return NULL;
}
PG_END_TRY();
return ret_hv;
}
| SV* plperl_spi_fetchrow | ( | char * | ) |
Definition at line 3112 of file plperl.c.
References BeginInternalSubTransaction(), check_spi_usage_allowed(), CopyErrorData(), CurrentMemoryContext, CurrentResourceOwner, FlushErrorState(), MemoryContextSwitchTo(), ErrorData::message, NULL, PG_CATCH, PG_END_TRY, PG_TRY, plperl_hash_from_tuple(), ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), SPI_cursor_close(), SPI_cursor_fetch(), SPI_cursor_find(), SPI_freetuptable(), SPI_processed, SPI_restore_connection(), SPI_tuptable, SPITupleTable::tupdesc, and SPITupleTable::vals.
{
SV *row;
/*
* Execute the FETCH inside a sub-transaction, so we can cope with errors
* sanely
*/
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
check_spi_usage_allowed();
BeginInternalSubTransaction(NULL);
/* Want to run inside function's memory context */
MemoryContextSwitchTo(oldcontext);
PG_TRY();
{
Portal p = SPI_cursor_find(cursor);
if (!p)
{
row = &PL_sv_undef;
}
else
{
SPI_cursor_fetch(p, true, 1);
if (SPI_processed == 0)
{
SPI_cursor_close(p);
row = &PL_sv_undef;
}
else
{
row = plperl_hash_from_tuple(SPI_tuptable->vals[0],
SPI_tuptable->tupdesc);
}
SPI_freetuptable(SPI_tuptable);
}
/* Commit the inner transaction, return to outer xact context */
ReleaseCurrentSubTransaction();
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
/*
* AtEOSubXact_SPI() should not have popped any SPI context, but just
* in case it did, make sure we remain connected.
*/
SPI_restore_connection();
}
PG_CATCH();
{
ErrorData *edata;
/* Save error info */
MemoryContextSwitchTo(oldcontext);
edata = CopyErrorData();
FlushErrorState();
/* Abort the inner transaction */
RollbackAndReleaseCurrentSubTransaction();
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
/*
* If AtEOSubXact_SPI() popped any SPI context of the subxact, it will
* have left us in a disconnected state. We need this hack to return
* to connected state.
*/
SPI_restore_connection();
/* Punt the error to Perl */
croak("%s", edata->message);
/* Can't get here, but keep compiler quiet */
return NULL;
}
PG_END_TRY();
return row;
}
| void plperl_spi_freeplan | ( | char * | ) |
Definition at line 3642 of file plperl.c.
References check_spi_usage_allowed(), elog, ERROR, HASH_FIND, HASH_REMOVE, hash_search(), MemoryContextDelete(), NULL, plperl_query_desc::plan, plperl_query_desc::plan_cxt, plperl_query_entry::query_data, plperl_interp_desc::query_hash, and SPI_freeplan().
{
SPIPlanPtr plan;
plperl_query_desc *qdesc;
plperl_query_entry *hash_entry;
check_spi_usage_allowed();
hash_entry = hash_search(plperl_active_interp->query_hash, query,
HASH_FIND, NULL);
if (hash_entry == NULL)
elog(ERROR, "spi_freeplan: Invalid prepared query passed");
qdesc = hash_entry->query_data;
if (qdesc == NULL)
elog(ERROR, "spi_freeplan: plperl query_hash value vanished");
plan = qdesc->plan;
/*
* free all memory before SPI_freeplan, so if it dies, nothing will be
* left over
*/
hash_search(plperl_active_interp->query_hash, query,
HASH_REMOVE, NULL);
MemoryContextDelete(qdesc->plan_cxt);
SPI_freeplan(plan);
}
| SV* plperl_spi_prepare | ( | char * | , | |
| int | , | |||
| SV ** | ||||
| ) |
Definition at line 3210 of file plperl.c.
References ALLOCSET_DEFAULT_INITSIZE, ALLOCSET_DEFAULT_MAXSIZE, ALLOCSET_DEFAULT_MINSIZE, ALLOCSET_SMALL_INITSIZE, ALLOCSET_SMALL_MAXSIZE, ALLOCSET_SMALL_MINSIZE, AllocSetContextCreate(), plperl_query_desc::arginfuncs, plperl_query_desc::argtypes, plperl_query_desc::argtypioparams, BeginInternalSubTransaction(), CHECK_FOR_INTERRUPTS, check_spi_usage_allowed(), CopyErrorData(), 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, NULL, palloc(), palloc0(), parseTypeString(), pfree(), PG_CATCH, PG_END_TRY, PG_TRY, pg_verifymbstr(), plperl_query_desc::plan, plperl_query_desc::plan_cxt, plperl_query_desc::qname, plperl_query_entry::query_data, plperl_interp_desc::query_hash, ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), snprintf(), SPI_freeplan(), SPI_keepplan(), SPI_prepare(), SPI_restore_connection(), SPI_result, SPI_result_code_string(), sv2cstr(), and TopMemoryContext.
{
volatile SPIPlanPtr plan = NULL;
volatile MemoryContext plan_cxt = NULL;
plperl_query_desc *volatile qdesc = NULL;
plperl_query_entry *volatile hash_entry = NULL;
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
MemoryContext work_cxt;
bool found;
int i;
check_spi_usage_allowed();
BeginInternalSubTransaction(NULL);
MemoryContextSwitchTo(oldcontext);
PG_TRY();
{
CHECK_FOR_INTERRUPTS();
/************************************************************
* Allocate the new querydesc structure
*
* The qdesc struct, as well as all its subsidiary data, lives in its
* plan_cxt. But note that the SPIPlan does not.
************************************************************/
plan_cxt = AllocSetContextCreate(TopMemoryContext,
"PL/Perl spi_prepare query",
ALLOCSET_SMALL_MINSIZE,
ALLOCSET_SMALL_INITSIZE,
ALLOCSET_SMALL_MAXSIZE);
MemoryContextSwitchTo(plan_cxt);
qdesc = (plperl_query_desc *) palloc0(sizeof(plperl_query_desc));
snprintf(qdesc->qname, sizeof(qdesc->qname), "%p", qdesc);
qdesc->plan_cxt = plan_cxt;
qdesc->nargs = argc;
qdesc->argtypes = (Oid *) palloc(argc * sizeof(Oid));
qdesc->arginfuncs = (FmgrInfo *) palloc(argc * sizeof(FmgrInfo));
qdesc->argtypioparams = (Oid *) palloc(argc * sizeof(Oid));
MemoryContextSwitchTo(oldcontext);
/************************************************************
* Do the following work in a short-lived context so that we don't
* leak a lot of memory in the PL/Perl function's SPI Proc context.
************************************************************/
work_cxt = AllocSetContextCreate(CurrentMemoryContext,
"PL/Perl spi_prepare workspace",
ALLOCSET_DEFAULT_MINSIZE,
ALLOCSET_DEFAULT_INITSIZE,
ALLOCSET_DEFAULT_MAXSIZE);
MemoryContextSwitchTo(work_cxt);
/************************************************************
* Resolve argument type names and then look them up by oid
* in the system cache, and remember the required information
* for input conversion.
************************************************************/
for (i = 0; i < argc; i++)
{
Oid typId,
typInput,
typIOParam;
int32 typmod;
char *typstr;
typstr = sv2cstr(argv[i]);
parseTypeString(typstr, &typId, &typmod);
pfree(typstr);
getTypeInputInfo(typId, &typInput, &typIOParam);
qdesc->argtypes[i] = typId;
fmgr_info_cxt(typInput, &(qdesc->arginfuncs[i]), plan_cxt);
qdesc->argtypioparams[i] = typIOParam;
}
/* Make sure the query is validly encoded */
pg_verifymbstr(query, strlen(query), false);
/************************************************************
* Prepare the plan and check for errors
************************************************************/
plan = SPI_prepare(query, argc, qdesc->argtypes);
if (plan == NULL)
elog(ERROR, "SPI_prepare() failed:%s",
SPI_result_code_string(SPI_result));
/************************************************************
* Save the plan into permanent memory (right now it's in the
* SPI procCxt, which will go away at function end).
************************************************************/
if (SPI_keepplan(plan))
elog(ERROR, "SPI_keepplan() failed");
qdesc->plan = plan;
/************************************************************
* Insert a hashtable entry for the plan.
************************************************************/
hash_entry = hash_search(plperl_active_interp->query_hash,
qdesc->qname,
HASH_ENTER, &found);
hash_entry->query_data = qdesc;
/* Get rid of workspace */
MemoryContextDelete(work_cxt);
/* Commit the inner transaction, return to outer xact context */
ReleaseCurrentSubTransaction();
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
/*
* AtEOSubXact_SPI() should not have popped any SPI context, but just
* in case it did, make sure we remain connected.
*/
SPI_restore_connection();
}
PG_CATCH();
{
ErrorData *edata;
/* Save error info */
MemoryContextSwitchTo(oldcontext);
edata = CopyErrorData();
FlushErrorState();
/* Drop anything we managed to allocate */
if (hash_entry)
hash_search(plperl_active_interp->query_hash,
qdesc->qname,
HASH_REMOVE, NULL);
if (plan_cxt)
MemoryContextDelete(plan_cxt);
if (plan)
SPI_freeplan(plan);
/* Abort the inner transaction */
RollbackAndReleaseCurrentSubTransaction();
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
/*
* If AtEOSubXact_SPI() popped any SPI context of the subxact, it will
* have left us in a disconnected state. We need this hack to return
* to connected state.
*/
SPI_restore_connection();
/* Punt the error to Perl */
croak("%s", edata->message);
/* Can't get here, but keep compiler quiet */
return NULL;
}
PG_END_TRY();
/************************************************************
* Return the query's hash key to the caller.
************************************************************/
return cstr2sv(qdesc->qname);
}
| SV* plperl_spi_query | ( | char * | ) |
Definition at line 3029 of file plperl.c.
References BeginInternalSubTransaction(), check_spi_usage_allowed(), CopyErrorData(), cstr2sv(), CurrentMemoryContext, CurrentResourceOwner, elog, ERROR, FlushErrorState(), MemoryContextSwitchTo(), ErrorData::message, PortalData::name, NULL, PG_CATCH, PG_END_TRY, PG_TRY, pg_verifymbstr(), ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), SPI_cursor_open(), SPI_freeplan(), SPI_prepare(), SPI_restore_connection(), SPI_result, and SPI_result_code_string().
{
SV *cursor;
/*
* Execute the query inside a sub-transaction, so we can cope with errors
* sanely
*/
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
check_spi_usage_allowed();
BeginInternalSubTransaction(NULL);
/* Want to run inside function's memory context */
MemoryContextSwitchTo(oldcontext);
PG_TRY();
{
SPIPlanPtr plan;
Portal portal;
/* Make sure the query is validly encoded */
pg_verifymbstr(query, strlen(query), false);
/* Create a cursor for the query */
plan = SPI_prepare(query, 0, NULL);
if (plan == NULL)
elog(ERROR, "SPI_prepare() failed:%s",
SPI_result_code_string(SPI_result));
portal = SPI_cursor_open(NULL, plan, NULL, NULL, false);
SPI_freeplan(plan);
if (portal == NULL)
elog(ERROR, "SPI_cursor_open() failed:%s",
SPI_result_code_string(SPI_result));
cursor = cstr2sv(portal->name);
/* Commit the inner transaction, return to outer xact context */
ReleaseCurrentSubTransaction();
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
/*
* AtEOSubXact_SPI() should not have popped any SPI context, but just
* in case it did, make sure we remain connected.
*/
SPI_restore_connection();
}
PG_CATCH();
{
ErrorData *edata;
/* Save error info */
MemoryContextSwitchTo(oldcontext);
edata = CopyErrorData();
FlushErrorState();
/* Abort the inner transaction */
RollbackAndReleaseCurrentSubTransaction();
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
/*
* If AtEOSubXact_SPI() popped any SPI context of the subxact, it will
* have left us in a disconnected state. We need this hack to return
* to connected state.
*/
SPI_restore_connection();
/* Punt the error to Perl */
croak("%s", edata->message);
/* Can't get here, but keep compiler quiet */
return NULL;
}
PG_END_TRY();
return cursor;
}
| SV* plperl_spi_query_prepared | ( | char * | , | |
| int | , | |||
| SV ** | ||||
| ) |
Definition at line 3513 of file plperl.c.
References plperl_query_desc::arginfuncs, plperl_query_desc::argtypes, plperl_query_desc::argtypioparams, BeginInternalSubTransaction(), check_spi_usage_allowed(), CopyErrorData(), cstr2sv(), CurrentMemoryContext, CurrentResourceOwner, elog, ERROR, FlushErrorState(), plperl_proc_desc::fn_readonly, HASH_FIND, hash_search(), i, MemoryContextSwitchTo(), ErrorData::message, PortalData::name, plperl_query_desc::nargs, NULL, palloc(), pfree(), PG_CATCH, PG_END_TRY, PG_TRY, plperl_query_desc::plan, plperl_sv_to_datum(), plperl_call_data::prodesc, plperl_query_entry::query_data, plperl_interp_desc::query_hash, ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), SPI_cursor_open(), SPI_restore_connection(), SPI_result, and SPI_result_code_string().
{
int i;
char *nulls;
Datum *argvalues;
plperl_query_desc *qdesc;
plperl_query_entry *hash_entry;
SV *cursor;
Portal portal = NULL;
/*
* Execute the query inside a sub-transaction, so we can cope with errors
* sanely
*/
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
check_spi_usage_allowed();
BeginInternalSubTransaction(NULL);
/* Want to run inside function's memory context */
MemoryContextSwitchTo(oldcontext);
PG_TRY();
{
/************************************************************
* Fetch the saved plan descriptor, see if it's o.k.
************************************************************/
hash_entry = hash_search(plperl_active_interp->query_hash, query,
HASH_FIND, NULL);
if (hash_entry == NULL)
elog(ERROR, "spi_query_prepared: Invalid prepared query passed");
qdesc = hash_entry->query_data;
if (qdesc == NULL)
elog(ERROR, "spi_query_prepared: plperl query_hash value vanished");
if (qdesc->nargs != argc)
elog(ERROR, "spi_query_prepared: expected %d argument(s), %d passed",
qdesc->nargs, argc);
/************************************************************
* Set up arguments
************************************************************/
if (argc > 0)
{
nulls = (char *) palloc(argc);
argvalues = (Datum *) palloc(argc * sizeof(Datum));
}
else
{
nulls = NULL;
argvalues = NULL;
}
for (i = 0; i < argc; i++)
{
bool isnull;
argvalues[i] = plperl_sv_to_datum(argv[i],
qdesc->argtypes[i],
-1,
NULL,
&qdesc->arginfuncs[i],
qdesc->argtypioparams[i],
&isnull);
nulls[i] = isnull ? 'n' : ' ';
}
/************************************************************
* go
************************************************************/
portal = SPI_cursor_open(NULL, qdesc->plan, argvalues, nulls,
current_call_data->prodesc->fn_readonly);
if (argc > 0)
{
pfree(argvalues);
pfree(nulls);
}
if (portal == NULL)
elog(ERROR, "SPI_cursor_open() failed:%s",
SPI_result_code_string(SPI_result));
cursor = cstr2sv(portal->name);
/* Commit the inner transaction, return to outer xact context */
ReleaseCurrentSubTransaction();
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
/*
* AtEOSubXact_SPI() should not have popped any SPI context, but just
* in case it did, make sure we remain connected.
*/
SPI_restore_connection();
}
PG_CATCH();
{
ErrorData *edata;
/* Save error info */
MemoryContextSwitchTo(oldcontext);
edata = CopyErrorData();
FlushErrorState();
/* Abort the inner transaction */
RollbackAndReleaseCurrentSubTransaction();
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
/*
* If AtEOSubXact_SPI() popped any SPI context of the subxact, it will
* have left us in a disconnected state. We need this hack to return
* to connected state.
*/
SPI_restore_connection();
/* Punt the error to Perl */
croak("%s", edata->message);
/* Can't get here, but keep compiler quiet */
return NULL;
}
PG_END_TRY();
return cursor;
}
| char* plperl_sv_to_literal | ( | SV * | , | |
| char * | ||||
| ) |
Definition at line 1355 of file plperl.c.
References CStringGetDatum, DirectFunctionCall1, elog, ERROR, getTypeOutputInfo(), InvalidOid, NULL, OidIsValid, OidOutputFunctionCall(), plperl_sv_to_datum(), and regtypein().
{
Datum str = CStringGetDatum(fqtypename);
Oid typid = DirectFunctionCall1(regtypein, str);
Oid typoutput;
Datum datum;
bool typisvarlena,
isnull;
if (!OidIsValid(typid))
elog(ERROR, "lookup failed for type %s", fqtypename);
datum = plperl_sv_to_datum(sv,
typid, -1,
NULL, NULL, InvalidOid,
&isnull);
if (isnull)
return NULL;
getTypeOutputInfo(typid,
&typoutput, &typisvarlena);
return OidOutputFunctionCall(typoutput, datum);
}
1.7.1