rdelaage
/
postgresql
mirror of https://git.postgresql.org/git/postgresql.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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
This commit is contained in:
Tom Lane 2017-07-28 12:25:43 -04:00
parent 8d304072a2
commit bebe174bb4
6 changed files with 210 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
contrib/hstore_plperl/hstore_plperl.c
View File

@ -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));

32
src/pl/plperl/SPI.xs
View File

@ -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)

44
src/pl/plperl/Util.xs
View File

@ -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)

244
src/pl/plperl/plperl.c
View File

@ -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 */

17
src/pl/plperl/plperl.h
View File

@ -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 */

4
src/pl/plperl/plperl_helpers.h
View File

@ -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)));