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.

{
    dTHX;
 
#ifdef croak_sv
    /* Use sv_2mortal() to be sure the transient SV gets freed */
    croak_sv(sv_2mortal(cstr2sv(str)));
#else
 
    /*
     * The older way to do this is to assign a UTF8-marked value to ERRSV and
     * then call croak(NULL).  But if we leave it to croak() to append the
     * error location, it does so too late (only after popping the stack) in
     * some Perl versions.  Hence, use mess() to create an SV with the error
     * location info already appended.
     */
    SV         *errsv = get_sv("@", GV_ADD);
    char       *utf8_str = utf_e2u(str);
    SV         *ssv;
 
    ssv = mess("%s", utf8_str);
    SvUTF8_on(ssv);
 
    pfree(utf8_str);
 
    sv_setsv(errsv, ssv);
 
    croak(NULL);
#endif                          /* croak_sv */
}

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.

{
    dTHX;
    SV         *sv;
    char       *utf8_str;
 
    /* no conversion when SQL_ASCII */
    if (GetDatabaseEncoding() == PG_SQL_ASCII)
        return newSVpv(str, 0);
 
    utf8_str = utf_e2u(str);
 
    sv = newSVpv(utf8_str, 0);
    SvUTF8_on(sv);
    pfree(utf8_str);
 
    return sv;
}

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

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

plperl_return_next()

void plperl_return_next

(

SV *

sv

)

Definition at line 3245 of file plperl.c.

{
    MemoryContext oldcontext = CurrentMemoryContext;
 
    check_spi_usage_allowed();
 
    PG_TRY();
    {
        plperl_return_next_internal(sv);
    }
    PG_CATCH();
    {
        ErrorData  *edata;
 
        /* Must reset elog.c's state */
        MemoryContextSwitchTo(oldcontext);
        edata = CopyErrorData();
        FlushErrorState();
 
        /* Punt the error to Perl */
        croak_cstr(edata->message);
    }
    PG_END_TRY();
}

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

plperl_spi_commit()

void plperl_spi_commit

(

void

)

Definition at line 3991 of file plperl.c.

{
    MemoryContext oldcontext = CurrentMemoryContext;
 
    check_spi_usage_allowed();
 
    PG_TRY();
    {
        SPI_commit();
    }
    PG_CATCH();
    {
        ErrorData  *edata;
 
        /* Save error info */
        MemoryContextSwitchTo(oldcontext);
        edata = CopyErrorData();
        FlushErrorState();
 
        /* Punt the error to Perl */
        croak_cstr(edata->message);
    }
    PG_END_TRY();
}

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

plperl_spi_cursor_close()

void plperl_spi_cursor_close

(

char *

cursor

)

Definition at line 3551 of file plperl.c.

{
    Portal      p;
 
    check_spi_usage_allowed();
 
    p = SPI_cursor_find(cursor);
 
    if (p)
    {
        UnpinPortal(p);
        SPI_cursor_close(p);
    }
}

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

plperl_spi_exec()

HV* plperl_spi_exec	(	char *	query,
		int	limit
	)

Definition at line 3133 of file plperl.c.

{
    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;
    }
    PG_CATCH();
    {
        ErrorData  *edata;
 
        /* Save error info */
        MemoryContextSwitchTo(oldcontext);
        edata = CopyErrorData();
        FlushErrorState();
 
        /* Abort the inner transaction */
        RollbackAndReleaseCurrentSubTransaction();
        MemoryContextSwitchTo(oldcontext);
        CurrentResourceOwner = oldowner;
 
        /* Punt the error to Perl */
        croak_cstr(edata->message);
 
        /* Can't get here, but keep compiler quiet */
        return NULL;
    }
    PG_END_TRY();
 
    return ret_hv;
}

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

plperl_spi_exec_prepared()

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

Definition at line 3715 of file plperl.c.

{
    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();
    {
        dTHX;
 
        /************************************************************
         * 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;
    }
    PG_CATCH();
    {
        ErrorData  *edata;
 
        /* Save error info */
        MemoryContextSwitchTo(oldcontext);
        edata = CopyErrorData();
        FlushErrorState();
 
        /* Abort the inner transaction */
        RollbackAndReleaseCurrentSubTransaction();
        MemoryContextSwitchTo(oldcontext);
        CurrentResourceOwner = oldowner;
 
        /* Punt the error to Perl */
        croak_cstr(edata->message);
 
        /* Can't get here, but keep compiler quiet */
        return NULL;
    }
    PG_END_TRY();
 
    return ret_hv;
}

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

plperl_spi_fetchrow()

SV* plperl_spi_fetchrow

(

char *

cursor

)

Definition at line 3476 of file plperl.c.

{
    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();
    {
        dTHX;
        Portal      p = SPI_cursor_find(cursor);
 
        if (!p)
        {
            row = &PL_sv_undef;
        }
        else
        {
            SPI_cursor_fetch(p, true, 1);
            if (SPI_processed == 0)
            {
                UnpinPortal(p);
                SPI_cursor_close(p);
                row = &PL_sv_undef;
            }
            else
            {
                row = plperl_hash_from_tuple(SPI_tuptable->vals[0],
                                             SPI_tuptable->tupdesc,
                                             true);
            }
            SPI_freetuptable(SPI_tuptable);
        }
 
        /* Commit the inner transaction, return to outer xact context */
        ReleaseCurrentSubTransaction();
        MemoryContextSwitchTo(oldcontext);
        CurrentResourceOwner = oldowner;
    }
    PG_CATCH();
    {
        ErrorData  *edata;
 
        /* Save error info */
        MemoryContextSwitchTo(oldcontext);
        edata = CopyErrorData();
        FlushErrorState();
 
        /* Abort the inner transaction */
        RollbackAndReleaseCurrentSubTransaction();
        MemoryContextSwitchTo(oldcontext);
        CurrentResourceOwner = oldowner;
 
        /* Punt the error to Perl */
        croak_cstr(edata->message);
 
        /* Can't get here, but keep compiler quiet */
        return NULL;
    }
    PG_END_TRY();
 
    return row;
}

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

plperl_spi_freeplan()

void plperl_spi_freeplan

(

char *

query

)

Definition at line 3960 of file plperl.c.

{
    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);
}

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

plperl_spi_prepare()

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

Definition at line 3567 of file plperl.c.

{
    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_SIZES);
        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_SIZES);
        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]);
            (void) parseTypeString(typstr, &typId, &typmod, NULL);
            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;
    }
    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;
 
        /* Punt the error to Perl */
        croak_cstr(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);
}

References ALLOCSET_DEFAULT_SIZES, ALLOCSET_SMALL_SIZES, AllocSetContextCreate, plperl_query_desc::arginfuncs, plperl_query_desc::argtypes, plperl_query_desc::argtypioparams, BeginInternalSubTransaction(), CHECK_FOR_INTERRUPTS, check_spi_usage_allowed(), CopyErrorData(), croak_cstr(), cstr2sv(), CurrentMemoryContext, CurrentResourceOwner, elog, ERROR, FlushErrorState(), fmgr_info_cxt(), getTypeInputInfo(), HASH_ENTER, HASH_REMOVE, hash_search(), i, MemoryContextDelete(), MemoryContextSwitchTo(), ErrorData::message, plperl_query_desc::nargs, palloc(), palloc0(), parseTypeString(), pfree(), PG_CATCH, PG_END_TRY, PG_TRY, pg_verifymbstr(), plperl_query_desc::plan, plan, plperl_query_desc::plan_cxt, plperl_active_interp, plperl_query_desc::qname, plperl_query_entry::query_data, plperl_interp_desc::query_hash, ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), snprintf, SPI_freeplan(), SPI_keepplan(), SPI_prepare(), SPI_result, SPI_result_code_string(), sv2cstr(), and TopMemoryContext.

plperl_spi_query()

SV* plperl_spi_query

(

char *

query

)

Definition at line 3404 of file plperl.c.

{
    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);
 
        PinPortal(portal);
 
        /* Commit the inner transaction, return to outer xact context */
        ReleaseCurrentSubTransaction();
        MemoryContextSwitchTo(oldcontext);
        CurrentResourceOwner = oldowner;
    }
    PG_CATCH();
    {
        ErrorData  *edata;
 
        /* Save error info */
        MemoryContextSwitchTo(oldcontext);
        edata = CopyErrorData();
        FlushErrorState();
 
        /* Abort the inner transaction */
        RollbackAndReleaseCurrentSubTransaction();
        MemoryContextSwitchTo(oldcontext);
        CurrentResourceOwner = oldowner;
 
        /* Punt the error to Perl */
        croak_cstr(edata->message);
 
        /* Can't get here, but keep compiler quiet */
        return NULL;
    }
    PG_END_TRY();
 
    return cursor;
}

References BeginInternalSubTransaction(), check_spi_usage_allowed(), CopyErrorData(), croak_cstr(), cstr2sv(), CurrentMemoryContext, CurrentResourceOwner, elog, ERROR, FlushErrorState(), MemoryContextSwitchTo(), ErrorData::message, PortalData::name, PG_CATCH, PG_END_TRY, PG_TRY, pg_verifymbstr(), PinPortal(), plan, ReleaseCurrentSubTransaction(), RollbackAndReleaseCurrentSubTransaction(), SPI_cursor_open(), SPI_freeplan(), SPI_prepare(), SPI_result, and SPI_result_code_string().

plperl_spi_query_prepared()

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

Definition at line 3842 of file plperl.c.

{
    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);
 
        PinPortal(portal);
 
        /* Commit the inner transaction, return to outer xact context */
        ReleaseCurrentSubTransaction();
        MemoryContextSwitchTo(oldcontext);
        CurrentResourceOwner = oldowner;
    }
    PG_CATCH();
    {
        ErrorData  *edata;
 
        /* Save error info */
        MemoryContextSwitchTo(oldcontext);
        edata = CopyErrorData();
        FlushErrorState();
 
        /* Abort the inner transaction */
        RollbackAndReleaseCurrentSubTransaction();
        MemoryContextSwitchTo(oldcontext);
        CurrentResourceOwner = oldowner;
 
        /* Punt the error to Perl */
        croak_cstr(edata->message);
 
        /* Can't get here, but keep compiler quiet */
        return NULL;
    }
    PG_END_TRY();
 
    return cursor;
}

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

plperl_spi_rollback()

void plperl_spi_rollback

(

void

)

Definition at line 4017 of file plperl.c.

{
    MemoryContext oldcontext = CurrentMemoryContext;
 
    check_spi_usage_allowed();
 
    PG_TRY();
    {
        SPI_rollback();
    }
    PG_CATCH();
    {
        ErrorData  *edata;
 
        /* Save error info */
        MemoryContextSwitchTo(oldcontext);
        edata = CopyErrorData();
        FlushErrorState();
 
        /* Punt the error to Perl */
        croak_cstr(edata->message);
    }
    PG_END_TRY();
}

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

plperl_sv_to_literal()

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

Definition at line 1444 of file plperl.c.

{
    Oid         typid;
    Oid         typoutput;
    Datum       datum;
    bool        typisvarlena,
                isnull;
 
    check_spi_usage_allowed();
 
    typid = DirectFunctionCall1(regtypein, CStringGetDatum(fqtypename));
    if (!OidIsValid(typid))
        ereport(ERROR,
                (errcode(ERRCODE_UNDEFINED_OBJECT),
                 errmsg("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);
}

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

plperl_util_elog()

void plperl_util_elog	(	int	level,
		SV *	msg
	)

Definition at line 4054 of file plperl.c.

{
    MemoryContext oldcontext = CurrentMemoryContext;
    char       *volatile cmsg = NULL;
 
    /*
     * We intentionally omit check_spi_usage_allowed() here, as this seems
     * safe to allow even in the contexts that that function rejects.
     */
 
    PG_TRY();
    {
        cmsg = sv2cstr(msg);
        elog(level, "%s", cmsg);
        pfree(cmsg);
    }
    PG_CATCH();
    {
        ErrorData  *edata;
 
        /* Must reset elog.c's state */
        MemoryContextSwitchTo(oldcontext);
        edata = CopyErrorData();
        FlushErrorState();
 
        if (cmsg)
            pfree(cmsg);
 
        /* Punt the error to Perl */
        croak_cstr(edata->message);
    }
    PG_END_TRY();
}

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.

{
    dTHX;
    char       *val,
               *res;
    STRLEN      len;
 
    /*
     * get a utf8 encoded char * out of perl. *note* it may not be valid utf8!
     */
 
    /*
     * SvPVutf8() croaks nastily on certain things, like typeglobs and
     * readonly objects such as $^V. That's a perl bug - it's not supposed to
     * happen. To avoid crashing the backend, we make a copy of the sv before
     * passing it to SvPVutf8(). The copy is garbage collected when we're done
     * with it.
     */
    if (SvREADONLY(sv) ||
        isGV_with_GP(sv) ||
        (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM))
        sv = newSVsv(sv);
    else
    {
        /*
         * increase the reference count so we can just SvREFCNT_dec() it when
         * we are done
         */
        SvREFCNT_inc_simple_void(sv);
    }
 
    /*
     * Request the string from Perl, in UTF-8 encoding; but if we're in a
     * SQL_ASCII database, just request the byte soup without trying to make
     * it UTF8, because that might fail.
     */
    if (GetDatabaseEncoding() == PG_SQL_ASCII)
        val = SvPV(sv, len);
    else
        val = SvPVutf8(sv, len);
 
    /*
     * Now convert to database encoding.  We use perl's length in the event we
     * had an embedded null byte to ensure we error out properly.
     */
    res = utf_u2e(val, len);
 
    /* safe now to garbage collect the new SV */
    SvREFCNT_dec(sv);
 
    return res;
}

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.

{
    char       *ret;
 
    ret = pg_server_to_any(str, strlen(str), PG_UTF8);
 
    /* ensure we have a copy even if no conversion happened */
    if (ret == str)
        ret = pstrdup(ret);
 
    return ret;
}

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.

{
    char       *ret;
 
    ret = pg_any_to_server(utf8_str, len, PG_UTF8);
 
    /* ensure we have a copy even if no conversion happened */
    if (ret == utf8_str)
        ret = pstrdup(ret);
 
    return ret;
}

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

Referenced by sv2cstr().