rdelaage
/
postgresql
mirror of https://git.postgresql.org/git/postgresql.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

PL/Perl: Add event trigger support 

From: Dimitri Fontaine <dimitri@2ndQuadrant.fr>
This commit is contained in:
Peter Eisentraut 2013-12-11 08:11:59 -05:00
parent 6bea96dd49
commit e5dc4cc24d
4 changed files with 242 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
doc/src/sgml/plperl.sgml
View File

@ -1211,6 +1211,56 @@ CREATE TRIGGER test_valid_id_trig
</para>
</sect1>
<sect1 id="plperl-event-triggers">
<title>PL/Perl Event Triggers</title>
<para>
PL/Perl can be used to write event trigger functions. In an event trigger
function, the hash reference <varname>$_TD</varname> contains information
about the current trigger event. <varname>$_TD</> is a global variable,
which gets a separate local value for each invocation of the trigger. The
fields of the <varname>$_TD</varname> hash reference are:
<variablelist>
<varlistentry>
<term><literal>$_TD-&gt;{event}</literal></term>
<listitem>
<para>
The name of the event the trigger is fired for.
</para>
</listitem>
</varlistentry>
<varlistentry>
<term><literal>$_TD-&gt;{tag}</literal></term>
<listitem>
<para>
The command tag for which the trigger is fired.
</para>
</listitem>
</varlistentry>
</variablelist>
</para>
<para>
The return value of the trigger procedure is ignored.
</para>
<para>
Here is an example of an event trigger function, illustrating some of the
above:
<programlisting>
CREATE OR REPLACE FUNCTION perlsnitch() RETURNS event_trigger AS $$
elog(NOTICE, "perlsnitch: " . $_TD->{event} . " " . $_TD->{tag} . " ");
$$ LANGUAGE plperl;
CREATE EVENT TRIGGER perl_a_snitch
ON ddl_command_start
EXECUTE PROCEDURE perlsnitch();
</programlisting>
</para>
</sect1>
<sect1 id="plperl-under-the-hood">
<title>PL/Perl Under the Hood</title>

35
src/pl/plperl/expected/plperl_trigger.out
View File

@ -309,3 +309,38 @@ $$ LANGUAGE plperl;
SELECT direct_trigger();
ERROR: trigger functions can only be called as triggers
CONTEXT: compilation of PL/Perl function "direct_trigger"
-- test plperl command triggers
create or replace function perlsnitch() returns event_trigger language plperl as $$
elog(NOTICE, "perlsnitch: " . $_TD->{event} . " " . $_TD->{tag} . " ");
$$;
create event trigger perl_a_snitch on ddl_command_start
execute procedure perlsnitch();
create event trigger perl_b_snitch on ddl_command_end
execute procedure perlsnitch();
create or replace function foobar() returns int language sql as $$select 1;$$;
NOTICE: perlsnitch: ddl_command_start CREATE FUNCTION
CONTEXT: PL/Perl function "perlsnitch"
NOTICE: perlsnitch: ddl_command_end CREATE FUNCTION
CONTEXT: PL/Perl function "perlsnitch"
alter function foobar() cost 77;
NOTICE: perlsnitch: ddl_command_start ALTER FUNCTION
CONTEXT: PL/Perl function "perlsnitch"
NOTICE: perlsnitch: ddl_command_end ALTER FUNCTION
CONTEXT: PL/Perl function "perlsnitch"
drop function foobar();
NOTICE: perlsnitch: ddl_command_start DROP FUNCTION
CONTEXT: PL/Perl function "perlsnitch"
NOTICE: perlsnitch: ddl_command_end DROP FUNCTION
CONTEXT: PL/Perl function "perlsnitch"
create table foo();
NOTICE: perlsnitch: ddl_command_start CREATE TABLE
CONTEXT: PL/Perl function "perlsnitch"
NOTICE: perlsnitch: ddl_command_end CREATE TABLE
CONTEXT: PL/Perl function "perlsnitch"
drop table foo;
NOTICE: perlsnitch: ddl_command_start DROP TABLE
CONTEXT: PL/Perl function "perlsnitch"
NOTICE: perlsnitch: ddl_command_end DROP TABLE
CONTEXT: PL/Perl function "perlsnitch"
drop event trigger perl_a_snitch;
drop event trigger perl_b_snitch;

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

@ -21,6 +21,7 @@
#include "catalog/pg_language.h"
#include "catalog/pg_proc.h"
#include "catalog/pg_type.h"
#include "commands/event_trigger.h"
#include "commands/trigger.h"
#include "executor/spi.h"
#include "funcapi.h"
@ -254,10 +255,13 @@ static void set_interp_require(bool trusted);
static Datum plperl_func_handler(PG_FUNCTION_ARGS);
static Datum plperl_trigger_handler(PG_FUNCTION_ARGS);
static void plperl_event_trigger_handler(PG_FUNCTION_ARGS);
static void free_plperl_function(plperl_proc_desc *prodesc);
static plperl_proc_desc *compile_plperl_function(Oid fn_oid, bool is_trigger);
static plperl_proc_desc *compile_plperl_function(Oid fn_oid,
bool is_trigger,
bool is_event_trigger);
static SV *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc);
static SV *plperl_hash_from_datum(Datum attr);
@ -1610,6 +1614,23 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo)
}
/* Set up the arguments for an event trigger call. */
static SV *
plperl_event_trigger_build_args(FunctionCallInfo fcinfo)
{
EventTriggerData *tdata;
HV *hv;
hv = newHV();
tdata = (EventTriggerData *) fcinfo->context;
hv_store_string(hv, "event", cstr2sv(tdata->event));
hv_store_string(hv, "tag", cstr2sv(tdata->tag));
return newRV_noinc((SV *) hv);
}
/* Set up the new tuple returned from a trigger. */
static HeapTuple
@ -1717,6 +1738,11 @@ plperl_call_handler(PG_FUNCTION_ARGS)
current_call_data = &this_call_data;
if (CALLED_AS_TRIGGER(fcinfo))
retval = PointerGetDatum(plperl_trigger_handler(fcinfo));
else if (CALLED_AS_EVENT_TRIGGER(fcinfo))
{
plperl_event_trigger_handler(fcinfo);
retval = (Datum) 0;
}
else
retval = plperl_func_handler(fcinfo);
}
@ -1853,7 +1879,8 @@ plperl_validator(PG_FUNCTION_ARGS)
Oid *argtypes;
char **argnames;
char *argmodes;
bool istrigger = false;
bool is_trigger = false;
bool is_event_trigger = false;
int i;
/* Get the new function's pg_proc entry */
@ -1865,13 +1892,15 @@ plperl_validator(PG_FUNCTION_ARGS)
functyptype = get_typtype(proc->prorettype);
/* Disallow pseudotype result */
/* except for TRIGGER, RECORD, or VOID */
/* except for TRIGGER, EVTTRIGGER, RECORD, or VOID */
if (functyptype == TYPTYPE_PSEUDO)
{
/* we assume OPAQUE with no arguments means a trigger */
if (proc->prorettype == TRIGGEROID ||
(proc->prorettype == OPAQUEOID && proc->pronargs == 0))
istrigger = true;
is_trigger = true;
else if (proc->prorettype == EVTTRIGGEROID)
is_event_trigger = true;
else if (proc->prorettype != RECORDOID &&
proc->prorettype != VOIDOID)
ereport(ERROR,
@ -1898,7 +1927,7 @@ plperl_validator(PG_FUNCTION_ARGS)
/* Postpone body checks if !check_function_bodies */
if (check_function_bodies)
{
(void) compile_plperl_function(funcoid, istrigger);
(void) compile_plperl_function(funcoid, is_trigger, is_event_trigger);
}
/* the result of a validator is ignored */
@ -2169,6 +2198,63 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
}
static void
plperl_call_perl_event_trigger_func(plperl_proc_desc *desc,
FunctionCallInfo fcinfo,
SV *td)
{
dSP;
SV *retval,
*TDsv;
int count;
ENTER;
SAVETMPS;
TDsv = get_sv("main::_TD", 0);
if (!TDsv)
elog(ERROR, "couldn't fetch $_TD");
save_item(TDsv); /* local $_TD */
sv_setsv(TDsv, td);
PUSHMARK(sp);
PUTBACK;
/* Do NOT use G_KEEPERR here */
count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL);
SPAGAIN;
if (count != 1)
{
PUTBACK;
FREETMPS;
LEAVE;
elog(ERROR, "didn't get a return item from trigger function");
}
if (SvTRUE(ERRSV))
{
(void) POPs;
PUTBACK;
FREETMPS;
LEAVE;
/* XXX need to find a way to assign an errcode here */
ereport(ERROR,
(errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV)))));
}
retval = newSVsv(POPs);
(void) retval; /* silence compiler warning */
PUTBACK;
FREETMPS;
LEAVE;
return;
}
static Datum
plperl_func_handler(PG_FUNCTION_ARGS)
{
@ -2181,7 +2267,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
if (SPI_connect() != SPI_OK_CONNECT)
elog(ERROR, "could not connect to SPI manager");
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false);
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false, false);
current_call_data->prodesc = prodesc;
increment_prodesc_refcount(prodesc);
@ -2295,7 +2381,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
elog(ERROR, "could not connect to SPI manager");
/* Find or compile the function */
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, true);
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, true, false);
current_call_data->prodesc = prodesc;
increment_prodesc_refcount(prodesc);
@ -2386,6 +2472,45 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
}
static void
plperl_event_trigger_handler(PG_FUNCTION_ARGS)
{
plperl_proc_desc *prodesc;
SV *svTD;
ErrorContextCallback pl_error_context;
/* Connect to SPI manager */
if (SPI_connect() != SPI_OK_CONNECT)
elog(ERROR, "could not connect to SPI manager");
/* Find or compile the function */
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false, true);
current_call_data->prodesc = prodesc;
increment_prodesc_refcount(prodesc);
/* Set a callback for error reporting */
pl_error_context.callback = plperl_exec_callback;
pl_error_context.previous = error_context_stack;
pl_error_context.arg = prodesc->proname;
error_context_stack = &pl_error_context;
activate_interpreter(prodesc->interp);
svTD = plperl_event_trigger_build_args(fcinfo);
plperl_call_perl_event_trigger_func(prodesc, fcinfo, svTD);
if (SPI_finish() != SPI_OK_FINISH)
elog(ERROR, "SPI_finish() failed");
/* Restore the previous error callback */
error_context_stack = pl_error_context.previous;
SvREFCNT_dec(svTD);
return;
}
static bool
validate_plperl_function(plperl_proc_ptr *proc_ptr, HeapTuple procTup)
{
@ -2437,7 +2562,7 @@ free_plperl_function(plperl_proc_desc *prodesc)
static plperl_proc_desc *
compile_plperl_function(Oid fn_oid, bool is_trigger)
compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
{
HeapTuple procTup;
Form_pg_proc procStruct;
@ -2543,7 +2668,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
* Get the required information for input conversion of the
* return value.
************************************************************/
if (!is_trigger)
if (!is_trigger && !is_event_trigger)
{
typeTup =
SearchSysCache1(TYPEOID,
@ -2562,7 +2687,8 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
if (procStruct->prorettype == VOIDOID ||
procStruct->prorettype == RECORDOID)
/* okay */ ;
else if (procStruct->prorettype == TRIGGEROID)
else if (procStruct->prorettype == TRIGGEROID ||
procStruct->prorettype == EVTTRIGGEROID)
{
free_plperl_function(prodesc);
ereport(ERROR,
@ -2598,7 +2724,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
* Get the required information for output conversion
* of all procedure arguments
************************************************************/
if (!is_trigger)
if (!is_trigger && !is_event_trigger)
{
prodesc->nargs = procStruct->pronargs;
for (i = 0; i < prodesc->nargs; i++)

20
src/pl/plperl/sql/plperl_trigger.sql
View File

@ -169,3 +169,23 @@ CREATE FUNCTION direct_trigger() RETURNS trigger AS $$
$$ LANGUAGE plperl;
SELECT direct_trigger();
-- test plperl command triggers
create or replace function perlsnitch() returns event_trigger language plperl as $$
elog(NOTICE, "perlsnitch: " . $_TD->{event} . " " . $_TD->{tag} . " ");
$$;
create event trigger perl_a_snitch on ddl_command_start
execute procedure perlsnitch();
create event trigger perl_b_snitch on ddl_command_end
execute procedure perlsnitch();
create or replace function foobar() returns int language sql as $$select 1;$$;
alter function foobar() cost 77;
drop function foobar();
create table foo();
drop table foo;
drop event trigger perl_a_snitch;
drop event trigger perl_b_snitch;