From: Tom Lane Date: Fri, 28 Jul 2017 16:25:43 +0000 (-0400) Subject: PL/Perl portability fix: avoid including XSUB.h in plperl.c. X-Git-Tag: REL_10_BETA3~69 X-Git-Url: https://granicus.if.org/sourcecode?a=commitdiff_plain;h=bebe174bb4462ef079a1d7eeafb82ff969f160a4;p=postgresql PL/Perl portability fix: avoid including XSUB.h in plperl.c. In Perl builds that define PERL_IMPLICIT_SYS, XSUB.h defines macros that replace a whole lot of basic libc functions with Perl functions. We can't tolerate that in plperl.c; it breaks at least PG_TRY and probably other stuff. The core idea of this patch is to include XSUB.h only in the .xs files where it's really needed, and to move any code broken by PERL_IMPLICIT_SYS out of the .xs files and into plperl.c. The reason this hasn't been a problem before is that our build techniques did not result in PERL_IMPLICIT_SYS appearing as a #define in PL/Perl, even on some platforms where Perl thinks it is defined. That's about to change in order to fix a nasty portability issue, so we need this work to make the code safe for that. Rather unaccountably, the Perl people chose XSUB.h as the place to provide the versions of the aTHX/aTHX_ macros that are needed by code that's not explicitly aware of the MULTIPLICITY API conventions. Hence, just removing XSUB.h from plperl.c fails miserably. But we can work around that by defining PERL_NO_GET_CONTEXT (which would make the relevant stanza of XSUB.h a no-op anyway). As explained in perlguts.pod, that means we need to add a "dTHX" macro call in every C function that calls a Perl API function. In most of them we just add this at the top; but since the macro fetches the current Perl interpreter pointer, more care is needed in functions that switch the active interpreter. Lack of the macro is easily recognized since it results in bleats about "my_perl" not being defined. (A nice side benefit of this is that it significantly reduces the number of fetches of the current interpreter pointer. On my machine, plperl.so gets more than 10% smaller, and there's probably some performance win too. We could reduce the number of fetches still more by decorating the code with pTHX_/aTHX_ macros to pass the interpreter pointer around, as explained by perlguts.pod; but that's a task for another day.) Formatting note: pgindent seems happy to treat "dTHX;" as a declaration so long as it's the first thing after the left brace, as we'd already observed with respect to the similar macro "dSP;". If you try to put it later in a set of declarations, pgindent puts ugly extra space around it. Having removed XSUB.h from plperl.c, we need only move the support functions for spi_return_next and util_elog (both of which use PG_TRY) out of the .xs files and into plperl.c. This seems sufficient to avoid the known problems caused by PERL_IMPLICIT_SYS, although we could move more code if additional issues emerge. This will need to be back-patched, but first let's see what the buildfarm makes of it. Patch by me, with some help from Ashutosh Sharma Discussion: https://postgr.es/m/CANFyU97OVQ3+Mzfmt3MhuUm5NwPU=-FtbNH5Eb7nZL9ua8=rcA@mail.gmail.com --- diff --git a/contrib/hstore_plperl/hstore_plperl.c b/contrib/hstore_plperl/hstore_plperl.c index 480212f341..cc46a525f6 100644 --- a/contrib/hstore_plperl/hstore_plperl.c +++ b/contrib/hstore_plperl/hstore_plperl.c @@ -67,6 +67,7 @@ PG_FUNCTION_INFO_V1(hstore_to_plperl); Datum hstore_to_plperl(PG_FUNCTION_ARGS) { + dTHX; HStore *in = PG_GETARG_HS(0); int i; int count = HS_COUNT(in); @@ -99,7 +100,8 @@ PG_FUNCTION_INFO_V1(plperl_to_hstore); Datum plperl_to_hstore(PG_FUNCTION_ARGS) { - HV *hv; + dTHX; + HV *hv = (HV *) SvRV((SV *) PG_GETARG_POINTER(0)); HE *he; int32 buflen; int32 i; @@ -107,8 +109,6 @@ plperl_to_hstore(PG_FUNCTION_ARGS) HStore *out; Pairs *pairs; - hv = (HV *) SvRV((SV *) PG_GETARG_POINTER(0)); - pcount = hv_iterinit(hv); pairs = palloc(pcount * sizeof(Pairs)); diff --git a/src/pl/plperl/SPI.xs b/src/pl/plperl/SPI.xs index 0447c50df1..d9e6f579d4 100644 --- a/src/pl/plperl/SPI.xs +++ b/src/pl/plperl/SPI.xs @@ -9,44 +9,16 @@ /* this must be first: */ #include "postgres.h" -#include "mb/pg_wchar.h" /* for GetDatabaseEncoding */ /* Defined by Perl */ #undef _ /* perl stuff */ +#define PG_NEED_PERL_XSUB_H #include "plperl.h" #include "plperl_helpers.h" -/* - * Interface routine to catch ereports and punt them to Perl - */ -static void -do_plperl_return_next(SV *sv) -{ - MemoryContext oldcontext = CurrentMemoryContext; - - PG_TRY(); - { - plperl_return_next(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(); -} - - MODULE = PostgreSQL::InServer::SPI PREFIX = spi_ PROTOTYPES: ENABLE @@ -76,7 +48,7 @@ void spi_return_next(rv) SV *rv; CODE: - do_plperl_return_next(rv); + plperl_return_next(rv); SV * spi_spi_query(sv) diff --git a/src/pl/plperl/Util.xs b/src/pl/plperl/Util.xs index dbba0d7b87..686513d2e8 100644 --- a/src/pl/plperl/Util.xs +++ b/src/pl/plperl/Util.xs @@ -15,53 +15,15 @@ #include "fmgr.h" #include "utils/builtins.h" #include "utils/bytea.h" /* for byteain & byteaout */ -#include "mb/pg_wchar.h" /* for GetDatabaseEncoding */ + /* Defined by Perl */ #undef _ /* perl stuff */ +#define PG_NEED_PERL_XSUB_H #include "plperl.h" #include "plperl_helpers.h" -/* - * Implementation of plperl's elog() function - * - * If the error level is less than ERROR, we'll just emit the message and - * return. When it is ERROR, elog() will longjmp, which we catch and - * turn into a Perl croak(). Note we are assuming that elog() can't have - * any internal failures that are so bad as to require a transaction abort. - * - * This is out-of-line to suppress "might be clobbered by longjmp" warnings. - */ -static void -do_util_elog(int level, SV *msg) -{ - MemoryContext oldcontext = CurrentMemoryContext; - char * volatile cmsg = NULL; - - 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(); -} static text * sv2text(SV *sv) @@ -105,7 +67,7 @@ util_elog(level, msg) level = ERROR; if (level < DEBUG5) level = DEBUG5; - do_util_elog(level, msg); + plperl_util_elog(level, msg); SV * util_quote_literal(sv) diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index 5a45e3e0aa..b10b4434aa 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -6,6 +6,7 @@ **********************************************************************/ #include "postgres.h" + /* Defined by Perl */ #undef _ @@ -285,6 +286,7 @@ static void plperl_init_shared_libs(pTHX); static void plperl_trusted_init(void); static void plperl_untrusted_init(void); static HV *plperl_spi_execute_fetch_result(SPITupleTable *, uint64, int); +static void plperl_return_next_internal(SV *sv); static char *hek2cstr(HE *he); static SV **hv_store_string(HV *hv, const char *key, SV *val); static SV **hv_fetch_string(HV *hv, const char *key); @@ -302,12 +304,27 @@ static void activate_interpreter(plperl_interp_desc *interp_desc); static char *setlocale_perl(int category, char *locale); #endif +/* + * Decrement the refcount of the given SV within the active Perl interpreter + * + * This is handy because it reloads the active-interpreter pointer, saving + * some notation in callers that switch the active interpreter. + */ +static inline void +SvREFCNT_dec_current(SV *sv) +{ + dTHX; + + SvREFCNT_dec(sv); +} + /* * convert a HE (hash entry) key to a cstr in the current database encoding */ static char * hek2cstr(HE *he) { + dTHX; char *ret; SV *sv; @@ -641,15 +658,19 @@ select_perl_context(bool trusted) * to the database AFTER on_*_init code has run. See * http://archives.postgresql.org/pgsql-hackers/2010-01/msg02669.php */ - newXS("PostgreSQL::InServer::SPI::bootstrap", - boot_PostgreSQL__InServer__SPI, __FILE__); + { + dTHX; - eval_pv("PostgreSQL::InServer::SPI::bootstrap()", FALSE); - if (SvTRUE(ERRSV)) - ereport(ERROR, - (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), - errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))), - errcontext("while executing PostgreSQL::InServer::SPI::bootstrap"))); + newXS("PostgreSQL::InServer::SPI::bootstrap", + boot_PostgreSQL__InServer__SPI, __FILE__); + + eval_pv("PostgreSQL::InServer::SPI::bootstrap()", FALSE); + if (SvTRUE(ERRSV)) + ereport(ERROR, + (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), + errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))), + errcontext("while executing PostgreSQL::InServer::SPI::bootstrap"))); + } /* Fully initialized, so mark the hashtable entry valid */ interp_desc->interp = interp; @@ -792,53 +813,62 @@ plperl_init_interp(void) PERL_SET_CONTEXT(plperl); perl_construct(plperl); - /* run END blocks in perl_destruct instead of perl_run */ - PL_exit_flags |= PERL_EXIT_DESTRUCT_END; - /* - * Record the original function for the 'require' and 'dofile' opcodes. - * (They share the same implementation.) Ensure it's used for new - * interpreters. + * Run END blocks in perl_destruct instead of perl_run. Note that dTHX + * loads up a pointer to the current interpreter, so we have to postpone + * it to here rather than put it at the function head. */ - if (!pp_require_orig) - pp_require_orig = PL_ppaddr[OP_REQUIRE]; - else { - PL_ppaddr[OP_REQUIRE] = pp_require_orig; - PL_ppaddr[OP_DOFILE] = pp_require_orig; - } + dTHX; + + PL_exit_flags |= PERL_EXIT_DESTRUCT_END; + + /* + * Record the original function for the 'require' and 'dofile' + * opcodes. (They share the same implementation.) Ensure it's used + * for new interpreters. + */ + if (!pp_require_orig) + pp_require_orig = PL_ppaddr[OP_REQUIRE]; + else + { + PL_ppaddr[OP_REQUIRE] = pp_require_orig; + PL_ppaddr[OP_DOFILE] = pp_require_orig; + } #ifdef PLPERL_ENABLE_OPMASK_EARLY - /* - * For regression testing to prove that the PLC_PERLBOOT and PLC_TRUSTED - * code doesn't even compile any unsafe ops. In future there may be a - * valid need for them to do so, in which case this could be softened - * (perhaps moved to plperl_trusted_init()) or removed. - */ - PL_op_mask = plperl_opmask; + /* + * For regression testing to prove that the PLC_PERLBOOT and + * PLC_TRUSTED code doesn't even compile any unsafe ops. In future + * there may be a valid need for them to do so, in which case this + * could be softened (perhaps moved to plperl_trusted_init()) or + * removed. + */ + PL_op_mask = plperl_opmask; #endif - if (perl_parse(plperl, plperl_init_shared_libs, - nargs, embedding, NULL) != 0) - ereport(ERROR, - (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), - errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))), - errcontext("while parsing Perl initialization"))); + if (perl_parse(plperl, plperl_init_shared_libs, + nargs, embedding, NULL) != 0) + ereport(ERROR, + (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), + errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))), + errcontext("while parsing Perl initialization"))); - if (perl_run(plperl) != 0) - ereport(ERROR, - (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), - errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))), - errcontext("while running Perl initialization"))); + if (perl_run(plperl) != 0) + ereport(ERROR, + (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), + errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))), + errcontext("while running Perl initialization"))); #ifdef PLPERL_RESTORE_LOCALE - PLPERL_RESTORE_LOCALE(LC_COLLATE, save_collate); - PLPERL_RESTORE_LOCALE(LC_CTYPE, save_ctype); - PLPERL_RESTORE_LOCALE(LC_MONETARY, save_monetary); - PLPERL_RESTORE_LOCALE(LC_NUMERIC, save_numeric); - PLPERL_RESTORE_LOCALE(LC_TIME, save_time); + PLPERL_RESTORE_LOCALE(LC_COLLATE, save_collate); + PLPERL_RESTORE_LOCALE(LC_CTYPE, save_ctype); + PLPERL_RESTORE_LOCALE(LC_MONETARY, save_monetary); + PLPERL_RESTORE_LOCALE(LC_NUMERIC, save_numeric); + PLPERL_RESTORE_LOCALE(LC_TIME, save_time); #endif + } return plperl; } @@ -904,6 +934,7 @@ plperl_destroy_interp(PerlInterpreter **interp) * public API so isn't portably available.) Meanwhile END blocks can * be used to perform manual cleanup. */ + dTHX; /* Run END blocks - based on perl's perl_destruct() */ if (PL_exit_flags & PERL_EXIT_DESTRUCT_END) @@ -930,6 +961,7 @@ plperl_destroy_interp(PerlInterpreter **interp) static void plperl_trusted_init(void) { + dTHX; HV *stash; SV *sv; char *key; @@ -1010,6 +1042,8 @@ plperl_trusted_init(void) static void plperl_untrusted_init(void) { + dTHX; + /* * Nothing to do except execute plperl.on_plperlu_init */ @@ -1045,6 +1079,7 @@ strip_trailing_ws(const char *msg) static HeapTuple plperl_build_tuple_result(HV *perlhash, TupleDesc td) { + dTHX; Datum *values; bool *nulls; HE *he; @@ -1106,6 +1141,8 @@ plperl_hash_to_datum(SV *src, TupleDesc td) static SV * get_perl_array_ref(SV *sv) { + dTHX; + if (SvOK(sv) && SvROK(sv)) { if (SvTYPE(SvRV(sv)) == SVt_PVAV) @@ -1134,6 +1171,7 @@ array_to_datum_internal(AV *av, ArrayBuildState *astate, Oid arraytypid, Oid elemtypid, int32 typmod, FmgrInfo *finfo, Oid typioparam) { + dTHX; int i; int len = av_len(av) + 1; @@ -1205,6 +1243,7 @@ array_to_datum_internal(AV *av, ArrayBuildState *astate, static Datum plperl_array_to_datum(SV *src, Oid typid, int32 typmod) { + dTHX; ArrayBuildState *astate; Oid elemtypid; FmgrInfo finfo; @@ -1407,6 +1446,7 @@ plperl_sv_to_literal(SV *sv, char *fqtypename) static SV * plperl_ref_from_pg_array(Datum arg, Oid typid) { + dTHX; ArrayType *ar = DatumGetArrayTypeP(arg); Oid elementtype = ARR_ELEMTYPE(ar); int16 typlen; @@ -1485,6 +1525,7 @@ plperl_ref_from_pg_array(Datum arg, Oid typid) static SV * split_array(plperl_array_info *info, int first, int last, int nest) { + dTHX; int i; AV *result; @@ -1518,6 +1559,7 @@ split_array(plperl_array_info *info, int first, int last, int nest) static SV * make_array_ref(plperl_array_info *info, int first, int last) { + dTHX; int i; AV *result = newAV(); @@ -1555,6 +1597,7 @@ make_array_ref(plperl_array_info *info, int first, int last) static SV * plperl_trigger_build_args(FunctionCallInfo fcinfo) { + dTHX; TriggerData *tdata; TupleDesc tupdesc; int i; @@ -1661,6 +1704,7 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo) static SV * plperl_event_trigger_build_args(FunctionCallInfo fcinfo) { + dTHX; EventTriggerData *tdata; HV *hv; @@ -1678,6 +1722,7 @@ plperl_event_trigger_build_args(FunctionCallInfo fcinfo) static HeapTuple plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) { + dTHX; SV **svp; HV *hvNew; HE *he; @@ -1874,7 +1919,7 @@ plperl_inline_handler(PG_FUNCTION_ARGS) perlret = plperl_call_perl_func(&desc, &fake_fcinfo); - SvREFCNT_dec(perlret); + SvREFCNT_dec_current(perlret); if (SPI_finish() != SPI_OK_FINISH) elog(ERROR, "SPI_finish() failed"); @@ -1882,7 +1927,7 @@ plperl_inline_handler(PG_FUNCTION_ARGS) PG_CATCH(); { if (desc.reference) - SvREFCNT_dec(desc.reference); + SvREFCNT_dec_current(desc.reference); current_call_data = save_call_data; activate_interpreter(oldinterp); PG_RE_THROW(); @@ -1890,7 +1935,7 @@ plperl_inline_handler(PG_FUNCTION_ARGS) PG_END_TRY(); if (desc.reference) - SvREFCNT_dec(desc.reference); + SvREFCNT_dec_current(desc.reference); current_call_data = save_call_data; activate_interpreter(oldinterp); @@ -2018,6 +2063,7 @@ plperlu_validator(PG_FUNCTION_ARGS) static void plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid) { + dTHX; dSP; char subname[NAMEDATALEN + 40]; HV *pragma_hv = newHV(); @@ -2104,6 +2150,7 @@ plperl_init_shared_libs(pTHX) static SV * plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo) { + dTHX; dSP; SV *retval; int i; @@ -2197,6 +2244,7 @@ static SV * plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, SV *td) { + dTHX; dSP; SV *retval, *TDsv; @@ -2265,6 +2313,7 @@ plperl_call_perl_event_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, SV *td) { + dTHX; dSP; SV *retval, *TDsv; @@ -2384,13 +2433,14 @@ plperl_func_handler(PG_FUNCTION_ARGS) sav = get_perl_array_ref(perlret); if (sav) { + dTHX; int i = 0; SV **svp = 0; AV *rav = (AV *) SvRV(sav); while ((svp = av_fetch(rav, i, FALSE)) != NULL) { - plperl_return_next(*svp); + plperl_return_next_internal(*svp); i++; } } @@ -2427,7 +2477,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) /* Restore the previous error callback */ error_context_stack = pl_error_context.previous; - SvREFCNT_dec(perlret); + SvREFCNT_dec_current(perlret); return retval; } @@ -2538,9 +2588,9 @@ plperl_trigger_handler(PG_FUNCTION_ARGS) /* Restore the previous error callback */ error_context_stack = pl_error_context.previous; - SvREFCNT_dec(svTD); + SvREFCNT_dec_current(svTD); if (perlret) - SvREFCNT_dec(perlret); + SvREFCNT_dec_current(perlret); return retval; } @@ -2579,9 +2629,7 @@ plperl_event_trigger_handler(PG_FUNCTION_ARGS) /* Restore the previous error callback */ error_context_stack = pl_error_context.previous; - SvREFCNT_dec(svTD); - - return; + SvREFCNT_dec_current(svTD); } @@ -2624,7 +2672,7 @@ free_plperl_function(plperl_proc_desc *prodesc) plperl_interp_desc *oldinterp = plperl_active_interp; activate_interpreter(prodesc->interp); - SvREFCNT_dec(prodesc->reference); + SvREFCNT_dec_current(prodesc->reference); activate_interpreter(oldinterp); } /* Release all PG-owned data for this proc */ @@ -2949,6 +2997,7 @@ plperl_hash_from_datum(Datum attr) static SV * plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc) { + dTHX; HV *hv; int i; @@ -3094,6 +3143,7 @@ static HV * plperl_spi_execute_fetch_result(SPITupleTable *tuptable, uint64 processed, int status) { + dTHX; HV *result; check_spi_usage_allowed(); @@ -3137,15 +3187,40 @@ plperl_spi_execute_fetch_result(SPITupleTable *tuptable, uint64 processed, /* - * Note: plperl_return_next is called both in Postgres and Perl contexts. - * We report any errors in Postgres fashion (via ereport). If called in - * Perl context, it is SPI.xs's responsibility to catch the error and - * convert to a Perl error. We assume (perhaps without adequate justification) - * that we need not abort the current transaction if the Perl code traps the - * error. + * plperl_return_next catches any error and converts it to a Perl error. + * We assume (perhaps without adequate justification) that we need not abort + * the current transaction if the Perl code traps the error. */ void plperl_return_next(SV *sv) +{ + MemoryContext oldcontext = CurrentMemoryContext; + + 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(); +} + +/* + * plperl_return_next_internal reports any errors in Postgres fashion + * (via ereport). + */ +static void +plperl_return_next_internal(SV *sv) { plperl_proc_desc *prodesc; FunctionCallInfo fcinfo; @@ -3336,6 +3411,7 @@ plperl_spi_fetchrow(char *cursor) PG_TRY(); { + dTHX; Portal p = SPI_cursor_find(cursor); if (!p) @@ -3577,6 +3653,8 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv) PG_TRY(); { + dTHX; + /************************************************************ * Fetch the saved plan descriptor, see if it's o.k. ************************************************************/ @@ -3821,6 +3899,47 @@ plperl_spi_freeplan(char *query) SPI_freeplan(plan); } +/* + * Implementation of plperl's elog() function + * + * If the error level is less than ERROR, we'll just emit the message and + * return. When it is ERROR, elog() will longjmp, which we catch and + * turn into a Perl croak(). Note we are assuming that elog() can't have + * any internal failures that are so bad as to require a transaction abort. + * + * The main reason this is out-of-line is to avoid conflicts between XSUB.h + * and the PG_TRY macros. + */ +void +plperl_util_elog(int level, SV *msg) +{ + MemoryContext oldcontext = CurrentMemoryContext; + char *volatile cmsg = NULL; + + 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(); +} + /* * Store an SV into a hash table under a key that is a string assumed to be * in the current database's encoding. @@ -3828,6 +3947,7 @@ plperl_spi_freeplan(char *query) static SV ** hv_store_string(HV *hv, const char *key, SV *val) { + dTHX; int32 hlen; char *hkey; SV **ret; @@ -3854,6 +3974,7 @@ hv_store_string(HV *hv, const char *key, SV *val) static SV ** hv_fetch_string(HV *hv, const char *key) { + dTHX; int32 hlen; char *hkey; SV **ret; @@ -3912,6 +4033,7 @@ plperl_inline_callback(void *arg) static char * setlocale_perl(int category, char *locale) { + dTHX; char *RETVAL = setlocale(category, locale); if (RETVAL) @@ -3976,4 +4098,4 @@ setlocale_perl(int category, char *locale) return RETVAL; } -#endif +#endif /* WIN32 */ diff --git a/src/pl/plperl/plperl.h b/src/pl/plperl/plperl.h index eecd192802..c4e06d089f 100644 --- a/src/pl/plperl/plperl.h +++ b/src/pl/plperl/plperl.h @@ -24,7 +24,7 @@ #ifdef isnan #undef isnan #endif -#endif +#endif /* WIN32 */ /* * Supply a value of PERL_UNUSED_DECL that will satisfy gcc - the one @@ -43,10 +43,22 @@ #endif -/* required for perl API */ +/* + * Get the basic Perl API. We use PERL_NO_GET_CONTEXT mode so that our code + * can compile against MULTIPLICITY Perl builds without including XSUB.h. + */ +#define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" + +/* + * We want to include XSUB.h only within .xs files, because on some platforms + * it undesirably redefines a lot of libc functions. But it must appear + * before ppport.h, so use a #define flag to control inclusion here. + */ +#ifdef PG_NEED_PERL_XSUB_H #include "XSUB.h" +#endif /* put back our snprintf and vsnprintf */ #ifdef USE_REPL_SNPRINTF @@ -106,5 +118,6 @@ 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 *); +void plperl_util_elog(int level, SV *msg); #endif /* PL_PERL_H */ diff --git a/src/pl/plperl/plperl_helpers.h b/src/pl/plperl/plperl_helpers.h index 76124edc07..65b85a27ae 100644 --- a/src/pl/plperl/plperl_helpers.h +++ b/src/pl/plperl/plperl_helpers.h @@ -50,6 +50,7 @@ utf_e2u(const char *str) static inline char * sv2cstr(SV *sv) { + dTHX; char *val, *res; STRLEN len; @@ -107,6 +108,7 @@ sv2cstr(SV *sv) static inline SV * cstr2sv(const char *str) { + dTHX; SV *sv; char *utf8_str; @@ -134,6 +136,8 @@ cstr2sv(const char *str) static inline void croak_cstr(const char *str) { + dTHX; + #ifdef croak_sv /* Use sv_2mortal() to be sure the transient SV gets freed */ croak_sv(sv_2mortal(cstr2sv(str)));