Re: [GENERAL] plperl and regexps with accented characters - incompatible? - Mailing list pgsql-hackers

Andrew Dunstan wrote:
>
>
> Andrew Dunstan wrote:
>>
>>
>> Greg Sabino Mullane wrote:
>>> Just as a followup, I reported this as a bug and it is being looked
>>> at and discussed:
>>>
>>> http://rt.perl.org/rt3//Public/Bug/Display.html?id=47576
>>>
>>> Appears there is no easy resolution yet.
>>>
>>>
>>>
>>
>> We might be able to do something with the suggested workaround. I
>> will see what I can do, unless you have already tried.
>>
>>
>
> OK, I have a fairly ugly manual workaround, that I don't yet
> understand, but seems to work for me.
>
> In your session, run the following code before you do anything else:
>
> CREATE OR REPLACE FUNCTION test(text) RETURNS bool LANGUAGE plperl as $$
> return shift =~ /\xa9/i ? 'true' : 'false';
> $$;
> SELECT test('a');
> DROP FUNCTION test(text);
>
> After that we seem to be good to go with any old UTF8 chars.
>
> I'm looking at automating this so the workaround can be hidden, but
> I'd rather understand it first.
>
> (Core guys: If we can hold RC1 for a bit while I get this fixed that
> would be good.)
>
>

The attached patch works for me to eliminate the errors. Please test ASAP.

cheers

andrew
Index: src/pl/plperl/plperl.c
===================================================================
RCS file: /cvsroot/pgsql/src/pl/plperl/plperl.c,v
retrieving revision 1.132
diff -c -r1.132 plperl.c
*** src/pl/plperl/plperl.c    15 Nov 2007 22:25:17 -0000    1.132
--- src/pl/plperl/plperl.c    29 Nov 2007 05:32:22 -0000
***************
*** 149,154 ****
--- 149,156 ----
  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,509 ****
--- 506,558 ----
      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;