open-dsi
/
postgres
mirror of https://github.com/postgres/postgres
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

PL/Perl: Add event trigger support

Browse Source 
From: Dimitri Fontaine <dimitri@2ndQuadrant.fr>
pull/6/head
Peter Eisentraut 12 years ago
parent 6bea96dd49
commit e5dc4cc24d
4 changed files with 242 additions and 11 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 50
      doc/src/sgml/plperl.sgml
  2. 35
      src/pl/plperl/expected/plperl_trigger.out
  3. 148
      src/pl/plperl/plperl.c
  4. 20
      src/pl/plperl/sql/plperl_trigger.sql

50
doc/src/sgml/plperl.sgml
Unescape 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
Unescape 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
Unescape 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
Unescape 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;

Write Preview
Loading…
Cancel
Save