3333 * ENHANCEMENTS, OR MODIFICATIONS.
3434 *
3535 * IDENTIFICATION
36- * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.96 2005/11/22 18:17:33 momjian Exp $
36+ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.97 2005/12/28 18:34:16 tgl Exp $
3737 *
3838 **********************************************************************/
3939
6969#define pTHX void
7070#endif
7171
72+ extern DLLIMPORT bool check_function_bodies ;
73+
7274
7375/**********************************************************************
7476 * The information we cache about loaded procedures
@@ -622,10 +624,13 @@ plperl_validator(PG_FUNCTION_ARGS)
622624Oid funcoid = PG_GETARG_OID (0 );
623625HeapTuple tuple ;
624626Form_pg_proc proc ;
627+ char functyptype ;
628+ int numargs ;
629+ Oid * argtypes ;
630+ char * * argnames ;
631+ char * argmodes ;
625632bool istrigger = false;
626- plperl_proc_desc * prodesc ;
627-
628- plperl_init_all ();
633+ int i ;
629634
630635/* Get the new function's pg_proc entry */
631636tuple = SearchSysCache (PROCOID ,
@@ -635,14 +640,47 @@ plperl_validator(PG_FUNCTION_ARGS)
635640elog (ERROR ,"cache lookup failed for function %u" ,funcoid );
636641proc = (Form_pg_proc )GETSTRUCT (tuple );
637642
638- /* we assume OPAQUE with no arguments means a trigger */
639- if (proc -> prorettype == TRIGGEROID ||
640- (proc -> prorettype == OPAQUEOID && proc -> pronargs == 0 ))
641- istrigger = true;
643+ functyptype = get_typtype (proc -> prorettype );
644+
645+ /* Disallow pseudotype result */
646+ /* except for TRIGGER, RECORD, or VOID */
647+ if (functyptype == 'p' )
648+ {
649+ /* we assume OPAQUE with no arguments means a trigger */
650+ if (proc -> prorettype == TRIGGEROID ||
651+ (proc -> prorettype == OPAQUEOID && proc -> pronargs == 0 ))
652+ istrigger = true;
653+ else if (proc -> prorettype != RECORDOID &&
654+ proc -> prorettype != VOIDOID )
655+ ereport (ERROR ,
656+ (errcode (ERRCODE_FEATURE_NOT_SUPPORTED ),
657+ errmsg ("plperl functions cannot return type %s" ,
658+ format_type_be (proc -> prorettype ))));
659+ }
660+
661+ /* Disallow pseudotypes in arguments (either IN or OUT) */
662+ numargs = get_func_arg_info (tuple ,
663+ & argtypes ,& argnames ,& argmodes );
664+ for (i = 0 ;i < numargs ;i ++ )
665+ {
666+ if (get_typtype (argtypes [i ])== 'p' )
667+ ereport (ERROR ,
668+ (errcode (ERRCODE_FEATURE_NOT_SUPPORTED ),
669+ errmsg ("plperl functions cannot take type %s" ,
670+ format_type_be (argtypes [i ]))));
671+ }
642672
643673ReleaseSysCache (tuple );
644674
645- prodesc = compile_plperl_function (funcoid ,istrigger );
675+ /* Postpone body checks if !check_function_bodies */
676+ if (check_function_bodies )
677+ {
678+ plperl_proc_desc * prodesc ;
679+
680+ plperl_init_all ();
681+
682+ prodesc = compile_plperl_function (funcoid ,istrigger );
683+ }
646684
647685/* the result of a validator is ignored */
648686PG_RETURN_VOID ();