Add a validator function for plperl. Andrew Dunstan

diff --git a/src/bin/scripts/createlang.c b/src/bin/scripts/createlang.c
index e8015089c9a3461908eaf931c684891ecfc00e62..d088dad4f97a3901fbd15f7a43ed3121ab4c317a 100644 (file)
--- 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 36fc656ca976de4b4eb7238fa32a9f6b6ac56890..7d0e00effe18c9969b4c4f34b9fd228a5d34b773 100644 (file)
--- 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;