Fix plperl validator to honor check_function_bodies: when that is OFF,

we want it to check the argument/result data types and no more.  In
particular, libperl shouldn't get initialized in this case.

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 5cd286bf547e03c8d7f01d5701a080195a70e0e2..70c0ce493a491197f9349d2b0efc6ac0a346b4b3 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.96 2005/11/22 18:17:33 momjian Exp $
+ *   $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.97 2005/12/28 18:34:16 tgl Exp $
  *
  **********************************************************************/
 
@@ -69,6 +69,8 @@
 #define pTHX void
 #endif
 
+extern DLLIMPORT bool check_function_bodies;
+
 
 /**********************************************************************
  * The information we cache about loaded procedures
@@ -622,10 +624,13 @@ plperl_validator(PG_FUNCTION_ARGS)
    Oid         funcoid = PG_GETARG_OID(0);
    HeapTuple   tuple;
    Form_pg_proc proc;
+   char        functyptype;
+   int         numargs;
+   Oid        *argtypes;
+   char      **argnames;
+   char       *argmodes;
    bool        istrigger = false;
-   plperl_proc_desc *prodesc;
-
-   plperl_init_all();
+   int         i;
 
    /* Get the new function's pg_proc entry */
    tuple = SearchSysCache(PROCOID,
@@ -635,14 +640,47 @@ plperl_validator(PG_FUNCTION_ARGS)
        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;
+   functyptype = get_typtype(proc->prorettype);
+
+   /* Disallow pseudotype result */
+   /* except for TRIGGER, RECORD, or VOID */
+   if (functyptype == 'p')
+   {
+       /* we assume OPAQUE with no arguments means a trigger */
+       if (proc->prorettype == TRIGGEROID ||
+           (proc->prorettype == OPAQUEOID && proc->pronargs == 0))
+           istrigger = true;
+       else if (proc->prorettype != RECORDOID &&
+                proc->prorettype != VOIDOID)
+           ereport(ERROR,
+                   (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+                    errmsg("plperl functions cannot return type %s",
+                           format_type_be(proc->prorettype))));
+   }
+
+   /* Disallow pseudotypes in arguments (either IN or OUT) */
+   numargs = get_func_arg_info(tuple,
+                               &argtypes, &argnames, &argmodes);
+   for (i = 0; i < numargs; i++)
+   {
+       if (get_typtype(argtypes[i]) == 'p')
+           ereport(ERROR,
+                   (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
+                    errmsg("plperl functions cannot take type %s",
+                           format_type_be(argtypes[i]))));
+   }
 
    ReleaseSysCache(tuple);
 
-   prodesc = compile_plperl_function(funcoid, istrigger);
+   /* Postpone body checks if !check_function_bodies */
+   if (check_function_bodies)
+   {
+       plperl_proc_desc *prodesc;
+
+       plperl_init_all();
+
+       prodesc = compile_plperl_function(funcoid, istrigger);
+   }
 
    /* the result of a validator is ignored */
    PG_RETURN_VOID();