That attached 2 patches implement a validator function for plperl, and
support for it in createlang.
This has somewhat less utility than do such functions for languages with
stricter compiletime as opposed to runtime requirements, but I still
think it's useful. If this is acceptable I'll provide a regression test
in due course - I don't think any documentation is required.
cheers
andrew
Index: createlang.c
===================================================================
RCS file: /projects/cvsroot/pgsql/src/bin/scripts/createlang.c,v
retrieving revision 1.15
diff -c -r1.15 createlang.c
*** createlang.c 31 Dec 2004 22:03:17 -0000 1.15
--- createlang.c 21 Jun 2005 23:49:59 -0000
***************
*** 191,202 ****
--- 191,204 ----
{
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)
Index: plperl.c
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/plperl.c,v
retrieving revision 1.76
diff -c -r1.76 plperl.c
*** plperl.c 5 Jun 2005 03:16:35 -0000 1.76
--- plperl.c 21 Jun 2005 23:09:48 -0000
***************
*** 113,118 ****
--- 114,120 ----
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);
***************
*** 505,511 ****
}
! /* This is the only externally-visible part of the plperl interface.
* The Postgres function and trigger managers call it to execute a
* perl function. */
--- 586,592 ----
}
! /* 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. */
***************
*** 540,545 ****
--- 621,676 ----
return retval;
}
+ /*
+ * This is the other externally visible function - it is called when CREATE OR
+ * REPLACE FUNCTION is issued to validate the function being created/replaced.
+ *
+ * Some code copied from plpgsql's validator, but in our case most of the
+ * checking is built into the compile routine, so we need to do less work here.
+ */
+
+ PG_FUNCTION_INFO_V1(plperl_validator);
+
+ Datum
+ plperl_validator(PG_FUNCTION_ARGS)
+ {
+
+ Oid funcoid;
+ HeapTuple tuple;
+ Form_pg_proc proc;
+ char functyptype;
+ bool istrigger = false;
+ plperl_proc_desc *prodesc;
+
+ plperl_init_all();
+
+ funcoid = PG_GETARG_OID(0);
+
+ /* 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);
+
+ functyptype = get_typtype(proc->prorettype);
+
+ if (functyptype == 'p')
+ {
+ /* we assume OPAQUE with no arguments means a trigger */
+ istrigger = (proc->prorettype == TRIGGEROID ||
+ (proc->prorettype == OPAQUEOID && proc->pronargs == 0));
+ }
+
+ prodesc = compile_plperl_function(funcoid,istrigger);
+
+ ReleaseSysCache(tuple);
+
+ /* 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. */
***************
*** 599,605 ****
*/
subref = newSVsv(POPs);
! if (!SvROK(subref))
{
PUTBACK;
FREETMPS;
--- 730,736 ----
*/
subref = newSVsv(POPs);
! if (!SvROK(subref) || SvTYPE(SvRV(subref)) != SVt_PVCV)
{
PUTBACK;
FREETMPS;
