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

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

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)

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)

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

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