mirrors/postgres
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

> Here's a patch I added against plperl, originally against beta5, now

Browse Source 
> 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
This commit is contained in:
Bruce Momjian 2005-06-15 00:35:16 +00:00
parent 0851a6fbc7
commit d092524418
1 changed files with 14 additions and 3 deletions

17
src/pl/plperl/plperl.c

@ -33,7 +33,7 @@
* ENHANCEMENTS, OR MODIFICATIONS. * ENHANCEMENTS, OR MODIFICATIONS.
* *
* IDENTIFICATION * 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/memutils.h"
#include "utils/typcache.h" #include "utils/typcache.h"
#include "miscadmin.h" #include "miscadmin.h"
#include "mb/pg_wchar.h"
/* perl stuff */ /* perl stuff */
#include "EXTERN.h" #include "EXTERN.h"
@ -649,6 +650,7 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
SV *retval; SV *retval;
int i; int i;
int count; int count;
SV *sv;
ENTER; ENTER;
SAVETMPS; SAVETMPS;
@ -688,7 +690,11 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
tmp = DatumGetCString(FunctionCall1(&(desc->arg_out_func[i]), tmp = DatumGetCString(FunctionCall1(&(desc->arg_out_func[i]),
fcinfo->arg[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); pfree(tmp);
} }
} }
@ -1261,6 +1267,7 @@ plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc)
Oid typoutput; Oid typoutput;
bool typisvarlena; bool typisvarlena;
int namelen; int namelen;
SV *sv;
if (tupdesc->attrs[i]->attisdropped) if (tupdesc->attrs[i]->attisdropped)
continue; continue;
@ -1283,7 +1290,11 @@ plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc)
outputstr = DatumGetCString(OidFunctionCall1(typoutput, outputstr = DatumGetCString(OidFunctionCall1(typoutput,
attr)); 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); return newRV_noinc((SV *) hv);