diff options
| -rw-r--r-- | src/pl/plperl/GNUmakefile | 3 | ||||
| -rw-r--r-- | src/pl/plperl/plperl.c | 51 |
2 files changed, 52 insertions, 2 deletions
diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile index 3e1e0487bb2..383d479218a 100644 --- a/src/pl/plperl/GNUmakefile +++ b/src/pl/plperl/GNUmakefile @@ -1,5 +1,5 @@ # Makefile for PL/Perl -# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.31 2007/07/25 10:17:46 mha Exp $ +# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.32 2007/12/01 15:20:34 adunstan Exp $ subdir = src/pl/plperl top_builddir = ../../.. @@ -27,6 +27,7 @@ override CFLAGS += -Wno-comment endif override CPPFLAGS := -I$(srcdir) $(CPPFLAGS) -I$(perl_archlibexp)/CORE +override CFLAGS += -fPIC rpathdir = $(perl_archlibexp)/CORE diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index 936bbcc0828..5f4677c360e 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -1,7 +1,7 @@ /********************************************************************** * plperl.c - perl as a procedural language for PostgreSQL * - * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.132 2007/11/15 22:25:17 momjian Exp $ + * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.133 2007/12/01 15:20:34 adunstan Exp $ * **********************************************************************/ @@ -149,6 +149,8 @@ static HV *plperl_spi_execute_fetch_result(SPITupleTable *, int, int); static SV *newSVstring(const char *str); static SV **hv_store_string(HV *hv, const char *key, SV *val); static SV **hv_fetch_string(HV *hv, const char *key); +static SV *plperl_create_sub(char *proname, char *s, bool trusted); +static SV *plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo); /* * This routine is a crock, and so is everyplace that calls it. The problem @@ -504,6 +506,53 @@ plperl_safe_init(void) else { eval_pv(SAFE_OK, FALSE); + if (GetDatabaseEncoding() == PG_UTF8) + { + + /* + * Fill in just enough information to set up this perl + * function in the safe container and call it. + * For some reason not entirely clear, it prevents errors that + * can arise from the regex code later trying to load + * utf8 modules. + */ + + plperl_proc_desc desc; + FunctionCallInfoData fcinfo; + FmgrInfo outfunc; + HeapTuple typeTup; + Form_pg_type typeStruct; + SV *ret; + SV *func; + + /* make sure we don't call ourselves recursively */ + plperl_safe_init_done = true; + + /* compile the function */ + func = plperl_create_sub( + "utf8fix", + "return shift =~ /\\xa9/i ? 'true' : 'false' ;", + true); + + + /* set up to call the function with a single text argument 'a' */ + desc.reference = func; + desc.nargs = 1; + desc.arg_is_rowtype[0] = false; + fcinfo.argnull[0] = false; + fcinfo.arg[0] = + DatumGetTextP(DirectFunctionCall1(textin, + CStringGetDatum("a"))); + typeTup = SearchSysCache(TYPEOID, + TEXTOID, + 0, 0, 0); + typeStruct = (Form_pg_type) GETSTRUCT(typeTup); + fmgr_info(typeStruct->typoutput,&(desc.arg_out_func[0])); + ReleaseSysCache(typeTup); + + /* and make the call */ + ret = plperl_call_perl_func(&desc,&fcinfo); + } } plperl_safe_init_done = true; |