diff --git a/src/bin/scripts/createlang.c b/src/bin/scripts/createlang.c index e8015089c9..d088dad4f9 100644 --- a/src/bin/scripts/createlang.c +++ b/src/bin/scripts/createlang.c @@ -5,7 +5,7 @@ * Portions Copyright (c) 1996-2005, PostgreSQL Global Development Group * Portions Copyright (c) 1994, Regents of the University of California * - * $PostgreSQL: pgsql/src/bin/scripts/createlang.c,v 1.16 2005/06/14 02:57:45 momjian Exp $ + * $PostgreSQL: pgsql/src/bin/scripts/createlang.c,v 1.17 2005/06/22 16:45:50 tgl Exp $ * *------------------------------------------------------------------------- */ @@ -191,12 +191,14 @@ main(int argc, char *argv[]) { trusted = true; handler = "plperl_call_handler"; + validator = "plperl_validator"; object = "plperl"; } else if (strcmp(langname, "plperlu") == 0) { trusted = false; handler = "plperl_call_handler"; + validator = "plperl_validator"; object = "plperl"; } else if (strcmp(langname, "plpythonu") == 0) diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index 36fc656ca9..7d0e00effe 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -33,7 +33,7 @@ * ENHANCEMENTS, OR MODIFICATIONS. * * IDENTIFICATION - * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.77 2005/06/15 00:35:16 momjian Exp $ + * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.78 2005/06/22 16:45:51 tgl Exp $ * **********************************************************************/ @@ -114,6 +114,7 @@ static void plperl_init_all(void); static void plperl_init_interp(void); Datum plperl_call_handler(PG_FUNCTION_ARGS); +Datum plperl_validator(PG_FUNCTION_ARGS); void plperl_init(void); HV *plperl_spi_exec(char *query, int limit); @@ -506,10 +507,11 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) } -/* This is the only externally-visible part of the plperl interface. +/* + * This is the only externally-visible part of the plperl call interface. * The Postgres function and trigger managers call it to execute a - * perl function. */ - + * perl function. + */ PG_FUNCTION_INFO_V1(plperl_call_handler); Datum @@ -541,6 +543,44 @@ plperl_call_handler(PG_FUNCTION_ARGS) return retval; } +/* + * This is the other externally visible function - it is called when CREATE + * FUNCTION is issued to validate the function being created/replaced. + */ +PG_FUNCTION_INFO_V1(plperl_validator); + +Datum +plperl_validator(PG_FUNCTION_ARGS) +{ + Oid funcoid = PG_GETARG_OID(0); + HeapTuple tuple; + Form_pg_proc proc; + bool istrigger = false; + plperl_proc_desc *prodesc; + + plperl_init_all(); + + /* Get the new function's pg_proc entry */ + tuple = SearchSysCache(PROCOID, + ObjectIdGetDatum(funcoid), + 0, 0, 0); + if (!HeapTupleIsValid(tuple)) + elog(ERROR, "cache lookup failed for function %u", funcoid); + proc = (Form_pg_proc) GETSTRUCT(tuple); + + /* we assume OPAQUE with no arguments means a trigger */ + if (proc->prorettype == TRIGGEROID || + (proc->prorettype == OPAQUEOID && proc->pronargs == 0)) + istrigger = true; + + ReleaseSysCache(tuple); + + prodesc = compile_plperl_function(funcoid, istrigger); + + /* the result of a validator is ignored */ + PG_RETURN_VOID(); +} + /* Uses mksafefunc/mkunsafefunc to create an anonymous sub whose text is * supplied in s, and returns a reference to the closure. */ @@ -600,7 +640,7 @@ plperl_create_sub(char *s, bool trusted) */ subref = newSVsv(POPs); - if (!SvROK(subref)) + if (!SvROK(subref) || SvTYPE(SvRV(subref)) != SVt_PVCV) { PUTBACK; FREETMPS;