|
1 | 1 | /********************************************************************** |
2 | 2 | * plperl.c - perl as a procedural language for PostgreSQL |
3 | 3 | * |
4 | | - * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.132 2007/11/15 22:25:17 momjian Exp $ |
| 4 | + * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.133 2007/12/01 15:20:34 adunstan Exp $ |
5 | 5 | * |
6 | 6 | **********************************************************************/ |
7 | 7 |
|
@@ -149,6 +149,8 @@ static HV *plperl_spi_execute_fetch_result(SPITupleTable *, int, int); |
149 | 149 | staticSV*newSVstring(constchar*str); |
150 | 150 | staticSV**hv_store_string(HV*hv,constchar*key,SV*val); |
151 | 151 | staticSV**hv_fetch_string(HV*hv,constchar*key); |
| 152 | +staticSV*plperl_create_sub(char*proname,char*s,booltrusted); |
| 153 | +staticSV*plperl_call_perl_func(plperl_proc_desc*desc,FunctionCallInfofcinfo); |
152 | 154 |
|
153 | 155 | /* |
154 | 156 | * This routine is a crock, and so is everyplace that calls it. The problem |
@@ -504,6 +506,53 @@ plperl_safe_init(void) |
504 | 506 | else |
505 | 507 | { |
506 | 508 | eval_pv(SAFE_OK, FALSE); |
| 509 | +if (GetDatabaseEncoding()==PG_UTF8) |
| 510 | +{ |
| 511 | + |
| 512 | +/* |
| 513 | + * Fill in just enough information to set up this perl |
| 514 | + * function in the safe container and call it. |
| 515 | + * For some reason not entirely clear, it prevents errors that |
| 516 | + * can arise from the regex code later trying to load |
| 517 | + * utf8 modules. |
| 518 | + */ |
| 519 | + |
| 520 | +plperl_proc_descdesc; |
| 521 | +FunctionCallInfoDatafcinfo; |
| 522 | +FmgrInfooutfunc; |
| 523 | +HeapTupletypeTup; |
| 524 | +Form_pg_typetypeStruct; |
| 525 | +SV*ret; |
| 526 | +SV*func; |
| 527 | + |
| 528 | +/* make sure we don't call ourselves recursively */ |
| 529 | +plperl_safe_init_done= true; |
| 530 | + |
| 531 | +/* compile the function */ |
| 532 | +func=plperl_create_sub( |
| 533 | +"utf8fix", |
| 534 | +"return shift =~ /\\xa9/i ? 'true' : 'false' ;", |
| 535 | +true); |
| 536 | + |
| 537 | + |
| 538 | +/* set up to call the function with a single text argument 'a' */ |
| 539 | +desc.reference=func; |
| 540 | +desc.nargs=1; |
| 541 | +desc.arg_is_rowtype[0]= false; |
| 542 | +fcinfo.argnull[0]= false; |
| 543 | +fcinfo.arg[0]= |
| 544 | +DatumGetTextP(DirectFunctionCall1(textin, |
| 545 | +CStringGetDatum("a"))); |
| 546 | +typeTup=SearchSysCache(TYPEOID, |
| 547 | +TEXTOID, |
| 548 | +0,0,0); |
| 549 | +typeStruct= (Form_pg_type)GETSTRUCT(typeTup); |
| 550 | +fmgr_info(typeStruct->typoutput,&(desc.arg_out_func[0])); |
| 551 | +ReleaseSysCache(typeTup); |
| 552 | + |
| 553 | +/* and make the call */ |
| 554 | +ret=plperl_call_perl_func(&desc,&fcinfo); |
| 555 | +} |
507 | 556 | } |
508 | 557 |
|
509 | 558 | plperl_safe_init_done= true; |
|