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.

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,27 +79,32 @@ 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*));
@@ -101,18 +112,20 @@ spi_spi_prepare(query, ...)
 			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
 

src/pl/plperl/plperl_helpers.h

+#ifndef PL_PERL_HELPERS_H
+#define PL_PERL_HELPERS_H
+
+/*
+ * convert from utf8 to database encoding
+ */
+static inline char *
+utf_u2e(const char *utf8_str, size_t len)
+{
+	char *ret = (char*)pg_do_encoding_conversion((unsigned char*)utf8_str, len, PG_UTF8, GetDatabaseEncoding());
+	if (ret == utf8_str)
+		ret = pstrdup(ret);
+	return ret;
+}
+
+/*
+ * convert from database encoding to utf8
+ */
+static inline char *
+utf_e2u(const char *str)
+{
+	char *ret = (char*)pg_do_encoding_conversion((unsigned char*)str, strlen(str), GetDatabaseEncoding(), PG_UTF8);
+	if (ret == str)
+		ret = pstrdup(ret);
+	return ret;
+}
+
+
+/*
+ * Convert an SV to a char * in the current database encoding
+ */
+static inline char *
+sv2cstr(SV *sv)
+{
+	char *val;
+	STRLEN len;
+
+	/*
+	 * get a utf8 encoded char * out of perl. *note* it may not be valid utf8!
+	 */
+	val = SvPVutf8(sv, len);
+
+	/*
+	 * we use perls length in the event we had an embedded null byte to ensure
+	 * we error out properly
+	 */
+	return utf_u2e(val, len);
+}
+
+/*
+ * Create a new SV from a string assumed to be in the current database's
+ * encoding.
+ */
+
+static inline SV *
+cstr2sv(const char *str)
+{
+	SV *sv;
+	char *utf8_str = utf_e2u(str);
+
+	sv = newSVpv(utf8_str, 0);
+	SvUTF8_on(sv);
+
+	pfree(utf8_str);
+
+	return sv;
+}
+
+#endif   /* PL_PERL_HELPERS_H */