mirrors/postgres
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add a validator function for plperl. Andrew Dunstan

Browse Source
This commit is contained in:
Tom Lane 2005-06-22 16:45:51 +00:00
parent 676bb1ab06
commit 84d73a6dbc
2 changed files with 48 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/bin/scripts/createlang.c
View File

@ -5,7 +5,7 @@
* Portions Copyright (c) 1996-2005, PostgreSQL Global Development Group * Portions Copyright (c) 1996-2005, PostgreSQL Global Development Group
* Portions Copyright (c) 1994, Regents of the University of California * 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; trusted = true;
handler = "plperl_call_handler"; handler = "plperl_call_handler";
validator = "plperl_validator";
object = "plperl"; object = "plperl";
} }
else if (strcmp(langname, "plperlu") == 0) else if (strcmp(langname, "plperlu") == 0)
{ {
trusted = false; trusted = false;
handler = "plperl_call_handler"; handler = "plperl_call_handler";
validator = "plperl_validator";
object = "plperl"; object = "plperl";
} }
else if (strcmp(langname, "plpythonu") == 0) else if (strcmp(langname, "plpythonu") == 0)

50
src/pl/plperl/plperl.c
View File

@ -33,7 +33,7 @@
* ENHANCEMENTS, OR MODIFICATIONS. * ENHANCEMENTS, OR MODIFICATIONS.
* *
* IDENTIFICATION * 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); static void plperl_init_interp(void);
Datum plperl_call_handler(PG_FUNCTION_ARGS); Datum plperl_call_handler(PG_FUNCTION_ARGS);
Datum plperl_validator(PG_FUNCTION_ARGS);
void plperl_init(void); void plperl_init(void);
HV *plperl_spi_exec(char *query, int limit); 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 * The Postgres function and trigger managers call it to execute a
* perl function. */ * perl function.
*/
PG_FUNCTION_INFO_V1(plperl_call_handler); PG_FUNCTION_INFO_V1(plperl_call_handler);
Datum Datum
@ -541,6 +543,44 @@ plperl_call_handler(PG_FUNCTION_ARGS)
return retval; 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 /* Uses mksafefunc/mkunsafefunc to create an anonymous sub whose text is
* supplied in s, and returns a reference to the closure. */ * supplied in s, and returns a reference to the closure. */
@ -600,7 +640,7 @@ plperl_create_sub(char *s, bool trusted)
*/ */
subref = newSVsv(POPs); subref = newSVsv(POPs);
if (!SvROK(subref)) if (!SvROK(subref) || SvTYPE(SvRV(subref)) != SVt_PVCV)
{ {
PUTBACK; PUTBACK;
FREETMPS; FREETMPS;