plperl validator function - Mailing list pgsql-patches

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;