|
33 | 33 | * ENHANCEMENTS, OR MODIFICATIONS. |
34 | 34 | * |
35 | 35 | * IDENTIFICATION |
36 | | - * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.77 2005/06/15 00:35:16 momjian Exp $ |
| 36 | + * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.78 2005/06/22 16:45:51 tgl Exp $ |
37 | 37 | * |
38 | 38 | **********************************************************************/ |
39 | 39 |
|
@@ -114,6 +114,7 @@ static void plperl_init_all(void); |
114 | 114 | staticvoidplperl_init_interp(void); |
115 | 115 |
|
116 | 116 | Datumplperl_call_handler(PG_FUNCTION_ARGS); |
| 117 | +Datumplperl_validator(PG_FUNCTION_ARGS); |
117 | 118 | voidplperl_init(void); |
118 | 119 |
|
119 | 120 | HV*plperl_spi_exec(char*query,intlimit); |
@@ -506,10 +507,11 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) |
506 | 507 | } |
507 | 508 |
|
508 | 509 |
|
509 | | -/* This is the only externally-visible part of the plperl interface. |
| 510 | +/* |
| 511 | + * This is the only externally-visible part of the plperl call interface. |
510 | 512 | * The Postgres function and trigger managers call it to execute a |
511 | | - * perl function. */ |
512 | | - |
| 513 | + * perl function. |
| 514 | + */ |
513 | 515 | PG_FUNCTION_INFO_V1(plperl_call_handler); |
514 | 516 |
|
515 | 517 | Datum |
@@ -541,6 +543,44 @@ plperl_call_handler(PG_FUNCTION_ARGS) |
541 | 543 | returnretval; |
542 | 544 | } |
543 | 545 |
|
| 546 | +/* |
| 547 | + * This is the other externally visible function - it is called when CREATE |
| 548 | + * FUNCTION is issued to validate the function being created/replaced. |
| 549 | + */ |
| 550 | +PG_FUNCTION_INFO_V1(plperl_validator); |
| 551 | + |
| 552 | +Datum |
| 553 | +plperl_validator(PG_FUNCTION_ARGS) |
| 554 | +{ |
| 555 | +Oidfuncoid=PG_GETARG_OID(0); |
| 556 | +HeapTupletuple; |
| 557 | +Form_pg_procproc; |
| 558 | +boolistrigger= false; |
| 559 | +plperl_proc_desc*prodesc; |
| 560 | + |
| 561 | +plperl_init_all(); |
| 562 | + |
| 563 | +/* Get the new function's pg_proc entry */ |
| 564 | +tuple=SearchSysCache(PROCOID, |
| 565 | +ObjectIdGetDatum(funcoid), |
| 566 | +0,0,0); |
| 567 | +if (!HeapTupleIsValid(tuple)) |
| 568 | +elog(ERROR,"cache lookup failed for function %u",funcoid); |
| 569 | +proc= (Form_pg_proc)GETSTRUCT(tuple); |
| 570 | + |
| 571 | +/* we assume OPAQUE with no arguments means a trigger */ |
| 572 | +if (proc->prorettype==TRIGGEROID|| |
| 573 | +(proc->prorettype==OPAQUEOID&&proc->pronargs==0)) |
| 574 | +istrigger= true; |
| 575 | + |
| 576 | +ReleaseSysCache(tuple); |
| 577 | + |
| 578 | +prodesc=compile_plperl_function(funcoid,istrigger); |
| 579 | + |
| 580 | +/* the result of a validator is ignored */ |
| 581 | +PG_RETURN_VOID(); |
| 582 | +} |
| 583 | + |
544 | 584 |
|
545 | 585 | /* Uses mksafefunc/mkunsafefunc to create an anonymous sub whose text is |
546 | 586 | * supplied in s, and returns a reference to the closure. */ |
@@ -600,7 +640,7 @@ plperl_create_sub(char *s, bool trusted) |
600 | 640 | */ |
601 | 641 | subref=newSVsv(POPs); |
602 | 642 |
|
603 | | -if (!SvROK(subref)) |
| 643 | +if (!SvROK(subref)||SvTYPE(SvRV(subref))!=SVt_PVCV) |
604 | 644 | { |
605 | 645 | PUTBACK; |
606 | 646 | FREETMPS; |
|