Force strings passed to and from plperl to be in UTF8 encoding.

String are converted to UTF8 on the way into perl and to the
database encoding on the way back. This avoids a number of
observed anomalies, and ensures Perl a consistent view of the
world.

Some minor code cleanups are also accomplished.

Alex Hunsaker, reviewed by Andy Colson.

Author: adunstan

doc/src/sgml/plperl.sgml

@@ -125,6 +125,14 @@ $$ LANGUAGE plperl;
 </programlisting>
   </para>
 
+  <note>
+    <para>
+      Arguments will be converted from the database's encoding to UTF-8 
+      for use inside plperl, and then converted from UTF-8 back to the 
+      database encoding upon return. 
+    </para>
+  </note>
+
   <para>
    If an SQL null value<indexterm><primary>null value</><secondary
    sortas="PL/Perl">in PL/Perl</></indexterm> is passed to a function,

src/pl/plperl/SPI.xs

@@ -9,11 +9,14 @@
 
 /* this must be first: */
 #include "postgres.h"
+#include "mb/pg_wchar.h"       /* for GetDatabaseEncoding */
+
 /* Defined by Perl */
 #undef _
 
 /* perl stuff */
 #include "plperl.h"
+#include "plperl_helpers.h"
 
 
 /*
@@ -50,18 +53,21 @@ PROTOTYPES: ENABLE
 VERSIONCHECK: DISABLE
 
 SV*
-spi_spi_exec_query(query, ...)
-	char* query;
+spi_spi_exec_query(sv, ...)
+	SV* sv;
 	PREINIT:
 		HV *ret_hash;
 		int limit = 0;
+		char *query;
 	CODE:
 		if (items > 2)
 			croak("Usage: spi_exec_query(query, limit) "
 				  "or spi_exec_query(query)");
 		if (items == 2)
 			limit = SvIV(ST(1));
+		query = sv2cstr(sv);
 		ret_hash = plperl_spi_exec(query, limit);
+		pfree(query);
 		RETVAL = newRV_noinc((SV*) ret_hash);
 	OUTPUT:
 		RETVAL
@@ -73,46 +79,53 @@ spi_return_next(rv)
 		do_plperl_return_next(rv);
 
 SV *
-spi_spi_query(query)
-	char *query;
+spi_spi_query(sv)
+	SV *sv;
 	CODE:
+		char* query = sv2cstr(sv);
 		RETVAL = plperl_spi_query(query);
+		pfree(query);
 	OUTPUT:
 		RETVAL
 
 SV *
-spi_spi_fetchrow(cursor)
-	char *cursor;
+spi_spi_fetchrow(sv)
+	SV* sv;
 	CODE:
+		char* cursor = sv2cstr(sv);
 		RETVAL = plperl_spi_fetchrow(cursor);
+		pfree(cursor);
 	OUTPUT:
 		RETVAL
 
 SV*
-spi_spi_prepare(query, ...)
-	char* query;
+spi_spi_prepare(sv, ...)
+	SV* sv;
 	CODE:
 		int i;
 		SV** argv;
+		char* query = sv2cstr(sv);
 		if (items < 1)
 			Perl_croak(aTHX_ "Usage: spi_prepare(query, ...)");
 		argv = ( SV**) palloc(( items - 1) * sizeof(SV*));
 		for ( i = 1; i < items; i++)
 			argv[i - 1] = ST(i);
 		RETVAL = plperl_spi_prepare(query, items - 1, argv);
 		pfree( argv);
+		pfree(query);
 	OUTPUT:
 		RETVAL
 
 SV*
-spi_spi_exec_prepared(query, ...)
-	char * query;
+spi_spi_exec_prepared(sv, ...)
+	SV* sv;
 	PREINIT:
 		HV *ret_hash;
 	CODE:
 		HV *attr = NULL;
 		int i, offset = 1, argc;
 		SV ** argv;
+		char *query = sv2cstr(sv);
 		if ( items < 1)
 			Perl_croak(aTHX_ "Usage: spi_exec_prepared(query, [\\%%attr,] "
 					   "[\\@bind_values])");
@@ -128,15 +141,17 @@ spi_spi_exec_prepared(query, ...)
 		ret_hash = plperl_spi_exec_prepared(query, attr, argc, argv);
 		RETVAL = newRV_noinc((SV*)ret_hash);
 		pfree( argv);
+		pfree(query);
 	OUTPUT:
 		RETVAL
 
 SV*
-spi_spi_query_prepared(query, ...)
-	char * query;
+spi_spi_query_prepared(sv, ...)
+	SV * sv;
 	CODE:
 		int i;
 		SV ** argv;
+		char *query = sv2cstr(sv);
 		if ( items < 1)
 			Perl_croak(aTHX_ "Usage: spi_query_prepared(query, "
 					   "[\\@bind_values])");
@@ -145,20 +160,25 @@ spi_spi_query_prepared(query, ...)
 			argv[i - 1] = ST(i);
 		RETVAL = plperl_spi_query_prepared(query, items - 1, argv);
 		pfree( argv);
+		pfree(query);
 	OUTPUT:
 		RETVAL
 
 void
-spi_spi_freeplan(query)
-	char *query;
+spi_spi_freeplan(sv)
+	SV *sv;
 	CODE:
+		char *query = sv2cstr(sv);
 		plperl_spi_freeplan(query);
+		pfree(query);
 
 void
-spi_spi_cursor_close(cursor)
-	char *cursor;
+spi_spi_cursor_close(sv)
+	SV *sv;
 	CODE:
+		char *cursor = sv2cstr(sv);
 		plperl_spi_cursor_close(cursor);
+		pfree(cursor);
 
 
 BOOT:

src/pl/plperl/Util.xs

@@ -21,7 +21,7 @@
 
 /* perl stuff */
 #include "plperl.h"
-
+#include "plperl_helpers.h"
 
 /*
  * Implementation of plperl's elog() function
@@ -34,13 +34,16 @@
  * This is out-of-line to suppress "might be clobbered by longjmp" warnings.
  */
 static void
-do_util_elog(int level, char *message)
+do_util_elog(int level, SV *msg)
 {
     MemoryContext oldcontext = CurrentMemoryContext;
+	char *cmsg = NULL;
 
     PG_TRY();
     {
-        elog(level, "%s", message);
+		cmsg = sv2cstr(msg);
+        elog(level, "%s", cmsg);
+		pfree(cmsg);
     }
     PG_CATCH();
     {
@@ -51,35 +54,20 @@ do_util_elog(int level, char *message)
         edata = CopyErrorData();
         FlushErrorState();
 
+		if (cmsg)
+			pfree(cmsg);
+
         /* Punt the error to Perl */
         croak("%s", edata->message);
     }
     PG_END_TRY();
 }
 
-static SV  *
-newSVstring_len(const char *str, STRLEN len)
-{
-    SV         *sv;
-
-    sv = newSVpvn(str, len);
-#if PERL_BCDVERSION >= 0x5006000L
-    if (GetDatabaseEncoding() == PG_UTF8)
-        SvUTF8_on(sv);
-#endif
-    return sv;
-}
-
 static text *
 sv2text(SV *sv)
 {
-    STRLEN    sv_len;
-    char     *sv_pv;
-
-    if (!sv)
-        sv = &PL_sv_undef;
-    sv_pv = SvPV(sv, sv_len);
-    return cstring_to_text_with_len(sv_pv, sv_len);
+	char *str = sv2cstr(sv);
+	return cstring_to_text(str);
 }
 
 MODULE = PostgreSQL::InServer::Util PREFIX = util_
@@ -105,15 +93,15 @@ _aliased_constants()
 
 
 void
-util_elog(level, message)
+util_elog(level, msg)
     int level
-    char* message
+    SV *msg
     CODE:
         if (level > ERROR)      /* no PANIC allowed thanks */
             level = ERROR;
         if (level < DEBUG5)
             level = DEBUG5;
-        do_util_elog(level, message);
+        do_util_elog(level, msg);
 
 SV *
 util_quote_literal(sv)
@@ -125,7 +113,9 @@ util_quote_literal(sv)
     else {
         text *arg = sv2text(sv);
         text *ret = DatumGetTextP(DirectFunctionCall1(quote_literal, PointerGetDatum(arg)));
-        RETVAL = newSVstring_len(VARDATA(ret), (VARSIZE(ret) - VARHDRSZ));
+		char *str = text_to_cstring(ret);
+		RETVAL = cstr2sv(str);
+		pfree(str);
     }
     OUTPUT:
     RETVAL
@@ -136,13 +126,15 @@ util_quote_nullable(sv)
     CODE:
     if (!sv || !SvOK(sv))
 	{
-        RETVAL = newSVstring_len("NULL", 4);
+        RETVAL = cstr2sv("NULL");
     }
     else
 	{
         text *arg = sv2text(sv);
         text *ret = DatumGetTextP(DirectFunctionCall1(quote_nullable, PointerGetDatum(arg)));
-        RETVAL = newSVstring_len(VARDATA(ret), (VARSIZE(ret) - VARHDRSZ));
+		char *str = text_to_cstring(ret);
+		RETVAL = cstr2sv(str);
+		pfree(str);
     }
     OUTPUT:
     RETVAL
@@ -153,10 +145,13 @@ util_quote_ident(sv)
     PREINIT:
         text *arg;
         text *ret;
+		char *str;
     CODE:
         arg = sv2text(sv);
         ret = DatumGetTextP(DirectFunctionCall1(quote_ident, PointerGetDatum(arg)));
-        RETVAL = newSVstring_len(VARDATA(ret), (VARSIZE(ret) - VARHDRSZ));
+		str = text_to_cstring(ret);
+		RETVAL = cstr2sv(str);
+		pfree(str);
     OUTPUT:
     RETVAL
 
@@ -167,9 +162,9 @@ util_decode_bytea(sv)
         char *arg;
         text *ret;
     CODE:
-        arg = SvPV_nolen(sv);
+        arg = SvPVbyte_nolen(sv);
         ret = DatumGetTextP(DirectFunctionCall1(byteain, PointerGetDatum(arg)));
-        /* not newSVstring_len because this is raw bytes not utf8'able */
+        /* not cstr2sv because this is raw bytes not utf8'able */
         RETVAL = newSVpvn(VARDATA(ret), (VARSIZE(ret) - VARHDRSZ));
     OUTPUT:
     RETVAL
@@ -180,10 +175,13 @@ util_encode_bytea(sv)
     PREINIT:
         text *arg;
         char *ret;
+		STRLEN len;
     CODE:
-        arg = sv2text(sv);
+        /* not sv2text because this is raw bytes not utf8'able */
+        ret = SvPVbyte(sv, len);
+		arg = cstring_to_text_with_len(ret, len);
         ret = DatumGetCString(DirectFunctionCall1(byteaout, PointerGetDatum(arg)));
-        RETVAL = newSVstring_len(ret, strlen(ret));
+        RETVAL = cstr2sv(ret);
     OUTPUT:
     RETVAL