From d0925244189a9888d48a86b15e73ee8c4b3f82bb Mon Sep 17 00:00:00 2001
From: Bruce Momjian <bruce@momjian.us>
Date: Wed, 15 Jun 2005 00:35:16 +0000
Subject: [PATCH] > Here's a patch I added against plperl, originally against
 beta5, now > against rc1. It simply checks with GetDatabaseEncoding() if the
 current > database is in UTF-8, and if so, sets the UTF-8 flag on the
 arguments > that are passed to perl. This means that it isn't necessary to >
 utf8::upgrade() every string, as perl has no way of knowing offhand > that a
 string is UTF-8 -- but postgres does, because the database > encoding is
 specified, so it makes sense to turn the flag on. You > should also be able
 to properly manipulate UTF-8 strings now from > plperl as opposed to plperlu,
 because otherwise you'd have to use > encoding 'utf8' which was not allowed.
 It could also eliminate some > unexpected bugs if you assume that perl knows
 the string is unicode. It > is enabled only for perl 5.6 and higher, so
 earlier versions will not > be affected. > > I have been assured by crab that
 the patch is quite harmless and will > not break anything. It would be great
 to see it in 8 final! :-)

David Kamholz
---
 src/pl/plperl/plperl.c | 17 ++++++++++++++---
 1 file changed, 14 insertions(+), 3 deletions(-)

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 6cd3494fb9..36fc656ca9 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -33,7 +33,7 @@
  *	  ENHANCEMENTS, OR MODIFICATIONS.
  *
  * IDENTIFICATION
- *	  $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.76 2005/06/05 03:16:35 momjian Exp $
+ *	  $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.77 2005/06/15 00:35:16 momjian Exp $
  *
  **********************************************************************/
 
@@ -54,6 +54,7 @@
 #include "utils/memutils.h"
 #include "utils/typcache.h"
 #include "miscadmin.h"
+#include "mb/pg_wchar.h"
 
 /* perl stuff */
 #include "EXTERN.h"
@@ -649,6 +650,7 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
 	SV		   *retval;
 	int			i;
 	int			count;
+	SV			*sv;
 
 	ENTER;
 	SAVETMPS;
@@ -688,7 +690,11 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
 
 			tmp = DatumGetCString(FunctionCall1(&(desc->arg_out_func[i]),
 												fcinfo->arg[i]));
-			XPUSHs(sv_2mortal(newSVpv(tmp, 0)));
+			sv = newSVpv(tmp, 0);
+#if PERL_BCDVERSION >= 0x5006000L
+			if (GetDatabaseEncoding() == PG_UTF8) SvUTF8_on(sv);
+#endif
+			XPUSHs(sv_2mortal(sv));
 			pfree(tmp);
 		}
 	}
@@ -1261,6 +1267,7 @@ plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc)
 		Oid			typoutput;
 		bool		typisvarlena;
 		int			namelen;
+		SV			*sv;
 
 		if (tupdesc->attrs[i]->attisdropped)
 			continue;
@@ -1283,7 +1290,11 @@ plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc)
 		outputstr = DatumGetCString(OidFunctionCall1(typoutput,
 													 attr));
 
-		hv_store(hv, attname, namelen, newSVpv(outputstr, 0), 0);
+		sv = newSVpv(outputstr, 0);
+#if PERL_BCDVERSION >= 0x5006000L
+		if (GetDatabaseEncoding() == PG_UTF8) SvUTF8_on(sv);
+#endif
+		hv_store(hv, attname, namelen, sv, 0);
 	}
 
 	return newRV_noinc((SV *) hv);