Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commite5dc4cc

Browse files
committed
PL/Perl: Add event trigger support
From: Dimitri Fontaine <dimitri@2ndQuadrant.fr>
1 parent6bea96d commite5dc4cc

File tree

4 files changed

+242
-11
lines changed

4 files changed

+242
-11
lines changed

‎doc/src/sgml/plperl.sgml‎

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1211,6 +1211,56 @@ CREATE TRIGGER test_valid_id_trig
12111211
</para>
12121212
</sect1>
12131213

1214+
<sect1 id="plperl-event-triggers">
1215+
<title>PL/Perl Event Triggers</title>
1216+
1217+
<para>
1218+
PL/Perl can be used to write event trigger functions. In an event trigger
1219+
function, the hash reference <varname>$_TD</varname> contains information
1220+
about the current trigger event. <varname>$_TD</> is a global variable,
1221+
which gets a separate local value for each invocation of the trigger. The
1222+
fields of the <varname>$_TD</varname> hash reference are:
1223+
1224+
<variablelist>
1225+
<varlistentry>
1226+
<term><literal>$_TD-&gt;{event}</literal></term>
1227+
<listitem>
1228+
<para>
1229+
The name of the event the trigger is fired for.
1230+
</para>
1231+
</listitem>
1232+
</varlistentry>
1233+
1234+
<varlistentry>
1235+
<term><literal>$_TD-&gt;{tag}</literal></term>
1236+
<listitem>
1237+
<para>
1238+
The command tag for which the trigger is fired.
1239+
</para>
1240+
</listitem>
1241+
</varlistentry>
1242+
</variablelist>
1243+
</para>
1244+
1245+
<para>
1246+
The return value of the trigger procedure is ignored.
1247+
</para>
1248+
1249+
<para>
1250+
Here is an example of an event trigger function, illustrating some of the
1251+
above:
1252+
<programlisting>
1253+
CREATE OR REPLACE FUNCTION perlsnitch() RETURNS event_trigger AS $$
1254+
elog(NOTICE, "perlsnitch: " . $_TD->{event} . " " . $_TD->{tag} . " ");
1255+
$$ LANGUAGE plperl;
1256+
1257+
CREATE EVENT TRIGGER perl_a_snitch
1258+
ON ddl_command_start
1259+
EXECUTE PROCEDURE perlsnitch();
1260+
</programlisting>
1261+
</para>
1262+
</sect1>
1263+
12141264
<sect1 id="plperl-under-the-hood">
12151265
<title>PL/Perl Under the Hood</title>
12161266

‎src/pl/plperl/expected/plperl_trigger.out‎

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -309,3 +309,38 @@ $$ LANGUAGE plperl;
309309
SELECT direct_trigger();
310310
ERROR: trigger functions can only be called as triggers
311311
CONTEXT: compilation of PL/Perl function "direct_trigger"
312+
-- test plperl command triggers
313+
create or replace function perlsnitch() returns event_trigger language plperl as $$
314+
elog(NOTICE, "perlsnitch: " . $_TD->{event} . " " . $_TD->{tag} . " ");
315+
$$;
316+
create event trigger perl_a_snitch on ddl_command_start
317+
execute procedure perlsnitch();
318+
create event trigger perl_b_snitch on ddl_command_end
319+
execute procedure perlsnitch();
320+
create or replace function foobar() returns int language sql as $$select 1;$$;
321+
NOTICE: perlsnitch: ddl_command_start CREATE FUNCTION
322+
CONTEXT: PL/Perl function "perlsnitch"
323+
NOTICE: perlsnitch: ddl_command_end CREATE FUNCTION
324+
CONTEXT: PL/Perl function "perlsnitch"
325+
alter function foobar() cost 77;
326+
NOTICE: perlsnitch: ddl_command_start ALTER FUNCTION
327+
CONTEXT: PL/Perl function "perlsnitch"
328+
NOTICE: perlsnitch: ddl_command_end ALTER FUNCTION
329+
CONTEXT: PL/Perl function "perlsnitch"
330+
drop function foobar();
331+
NOTICE: perlsnitch: ddl_command_start DROP FUNCTION
332+
CONTEXT: PL/Perl function "perlsnitch"
333+
NOTICE: perlsnitch: ddl_command_end DROP FUNCTION
334+
CONTEXT: PL/Perl function "perlsnitch"
335+
create table foo();
336+
NOTICE: perlsnitch: ddl_command_start CREATE TABLE
337+
CONTEXT: PL/Perl function "perlsnitch"
338+
NOTICE: perlsnitch: ddl_command_end CREATE TABLE
339+
CONTEXT: PL/Perl function "perlsnitch"
340+
drop table foo;
341+
NOTICE: perlsnitch: ddl_command_start DROP TABLE
342+
CONTEXT: PL/Perl function "perlsnitch"
343+
NOTICE: perlsnitch: ddl_command_end DROP TABLE
344+
CONTEXT: PL/Perl function "perlsnitch"
345+
drop event trigger perl_a_snitch;
346+
drop event trigger perl_b_snitch;

‎src/pl/plperl/plperl.c‎

Lines changed: 137 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@
2121
#include"catalog/pg_language.h"
2222
#include"catalog/pg_proc.h"
2323
#include"catalog/pg_type.h"
24+
#include"commands/event_trigger.h"
2425
#include"commands/trigger.h"
2526
#include"executor/spi.h"
2627
#include"funcapi.h"
@@ -254,10 +255,13 @@ static void set_interp_require(bool trusted);
254255

255256
staticDatumplperl_func_handler(PG_FUNCTION_ARGS);
256257
staticDatumplperl_trigger_handler(PG_FUNCTION_ARGS);
258+
staticvoidplperl_event_trigger_handler(PG_FUNCTION_ARGS);
257259

258260
staticvoidfree_plperl_function(plperl_proc_desc*prodesc);
259261

260-
staticplperl_proc_desc*compile_plperl_function(Oidfn_oid,boolis_trigger);
262+
staticplperl_proc_desc*compile_plperl_function(Oidfn_oid,
263+
boolis_trigger,
264+
boolis_event_trigger);
261265

262266
staticSV*plperl_hash_from_tuple(HeapTupletuple,TupleDesctupdesc);
263267
staticSV*plperl_hash_from_datum(Datumattr);
@@ -1610,6 +1614,23 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo)
16101614
}
16111615

16121616

1617+
/* Set up the arguments for an event trigger call. */
1618+
staticSV*
1619+
plperl_event_trigger_build_args(FunctionCallInfofcinfo)
1620+
{
1621+
EventTriggerData*tdata;
1622+
HV*hv;
1623+
1624+
hv=newHV();
1625+
1626+
tdata= (EventTriggerData*)fcinfo->context;
1627+
1628+
hv_store_string(hv,"event",cstr2sv(tdata->event));
1629+
hv_store_string(hv,"tag",cstr2sv(tdata->tag));
1630+
1631+
returnnewRV_noinc((SV*)hv);
1632+
}
1633+
16131634
/* Set up the new tuple returned from a trigger. */
16141635

16151636
staticHeapTuple
@@ -1717,6 +1738,11 @@ plperl_call_handler(PG_FUNCTION_ARGS)
17171738
current_call_data=&this_call_data;
17181739
if (CALLED_AS_TRIGGER(fcinfo))
17191740
retval=PointerGetDatum(plperl_trigger_handler(fcinfo));
1741+
elseif (CALLED_AS_EVENT_TRIGGER(fcinfo))
1742+
{
1743+
plperl_event_trigger_handler(fcinfo);
1744+
retval= (Datum)0;
1745+
}
17201746
else
17211747
retval=plperl_func_handler(fcinfo);
17221748
}
@@ -1853,7 +1879,8 @@ plperl_validator(PG_FUNCTION_ARGS)
18531879
Oid*argtypes;
18541880
char**argnames;
18551881
char*argmodes;
1856-
boolistrigger= false;
1882+
boolis_trigger= false;
1883+
boolis_event_trigger= false;
18571884
inti;
18581885

18591886
/* Get the new function's pg_proc entry */
@@ -1865,13 +1892,15 @@ plperl_validator(PG_FUNCTION_ARGS)
18651892
functyptype=get_typtype(proc->prorettype);
18661893

18671894
/* Disallow pseudotype result */
1868-
/* except for TRIGGER, RECORD, or VOID */
1895+
/* except for TRIGGER,EVTTRIGGER,RECORD, or VOID */
18691896
if (functyptype==TYPTYPE_PSEUDO)
18701897
{
18711898
/* we assume OPAQUE with no arguments means a trigger */
18721899
if (proc->prorettype==TRIGGEROID||
18731900
(proc->prorettype==OPAQUEOID&&proc->pronargs==0))
1874-
istrigger= true;
1901+
is_trigger= true;
1902+
elseif (proc->prorettype==EVTTRIGGEROID)
1903+
is_event_trigger= true;
18751904
elseif (proc->prorettype!=RECORDOID&&
18761905
proc->prorettype!=VOIDOID)
18771906
ereport(ERROR,
@@ -1898,7 +1927,7 @@ plperl_validator(PG_FUNCTION_ARGS)
18981927
/* Postpone body checks if !check_function_bodies */
18991928
if (check_function_bodies)
19001929
{
1901-
(void)compile_plperl_function(funcoid,istrigger);
1930+
(void)compile_plperl_function(funcoid,is_trigger,is_event_trigger);
19021931
}
19031932

19041933
/* the result of a validator is ignored */
@@ -2169,6 +2198,63 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
21692198
}
21702199

21712200

2201+
staticvoid
2202+
plperl_call_perl_event_trigger_func(plperl_proc_desc*desc,
2203+
FunctionCallInfofcinfo,
2204+
SV*td)
2205+
{
2206+
dSP;
2207+
SV*retval,
2208+
*TDsv;
2209+
intcount;
2210+
2211+
ENTER;
2212+
SAVETMPS;
2213+
2214+
TDsv=get_sv("main::_TD",0);
2215+
if (!TDsv)
2216+
elog(ERROR,"couldn't fetch $_TD");
2217+
2218+
save_item(TDsv);/* local $_TD */
2219+
sv_setsv(TDsv,td);
2220+
2221+
PUSHMARK(sp);
2222+
PUTBACK;
2223+
2224+
/* Do NOT use G_KEEPERR here */
2225+
count=perl_call_sv(desc->reference,G_SCALAR |G_EVAL);
2226+
2227+
SPAGAIN;
2228+
2229+
if (count!=1)
2230+
{
2231+
PUTBACK;
2232+
FREETMPS;
2233+
LEAVE;
2234+
elog(ERROR,"didn't get a return item from trigger function");
2235+
}
2236+
2237+
if (SvTRUE(ERRSV))
2238+
{
2239+
(void)POPs;
2240+
PUTBACK;
2241+
FREETMPS;
2242+
LEAVE;
2243+
/* XXX need to find a way to assign an errcode here */
2244+
ereport(ERROR,
2245+
(errmsg("%s",strip_trailing_ws(sv2cstr(ERRSV)))));
2246+
}
2247+
2248+
retval=newSVsv(POPs);
2249+
(void)retval;/* silence compiler warning */
2250+
2251+
PUTBACK;
2252+
FREETMPS;
2253+
LEAVE;
2254+
2255+
return;
2256+
}
2257+
21722258
staticDatum
21732259
plperl_func_handler(PG_FUNCTION_ARGS)
21742260
{
@@ -2181,7 +2267,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
21812267
if (SPI_connect()!=SPI_OK_CONNECT)
21822268
elog(ERROR,"could not connect to SPI manager");
21832269

2184-
prodesc=compile_plperl_function(fcinfo->flinfo->fn_oid, false);
2270+
prodesc=compile_plperl_function(fcinfo->flinfo->fn_oid, false, false);
21852271
current_call_data->prodesc=prodesc;
21862272
increment_prodesc_refcount(prodesc);
21872273

@@ -2295,7 +2381,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
22952381
elog(ERROR,"could not connect to SPI manager");
22962382

22972383
/* Find or compile the function */
2298-
prodesc=compile_plperl_function(fcinfo->flinfo->fn_oid, true);
2384+
prodesc=compile_plperl_function(fcinfo->flinfo->fn_oid, true, false);
22992385
current_call_data->prodesc=prodesc;
23002386
increment_prodesc_refcount(prodesc);
23012387

@@ -2386,6 +2472,45 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
23862472
}
23872473

23882474

2475+
staticvoid
2476+
plperl_event_trigger_handler(PG_FUNCTION_ARGS)
2477+
{
2478+
plperl_proc_desc*prodesc;
2479+
SV*svTD;
2480+
ErrorContextCallbackpl_error_context;
2481+
2482+
/* Connect to SPI manager */
2483+
if (SPI_connect()!=SPI_OK_CONNECT)
2484+
elog(ERROR,"could not connect to SPI manager");
2485+
2486+
/* Find or compile the function */
2487+
prodesc=compile_plperl_function(fcinfo->flinfo->fn_oid, false, true);
2488+
current_call_data->prodesc=prodesc;
2489+
increment_prodesc_refcount(prodesc);
2490+
2491+
/* Set a callback for error reporting */
2492+
pl_error_context.callback=plperl_exec_callback;
2493+
pl_error_context.previous=error_context_stack;
2494+
pl_error_context.arg=prodesc->proname;
2495+
error_context_stack=&pl_error_context;
2496+
2497+
activate_interpreter(prodesc->interp);
2498+
2499+
svTD=plperl_event_trigger_build_args(fcinfo);
2500+
plperl_call_perl_event_trigger_func(prodesc,fcinfo,svTD);
2501+
2502+
if (SPI_finish()!=SPI_OK_FINISH)
2503+
elog(ERROR,"SPI_finish() failed");
2504+
2505+
/* Restore the previous error callback */
2506+
error_context_stack=pl_error_context.previous;
2507+
2508+
SvREFCNT_dec(svTD);
2509+
2510+
return;
2511+
}
2512+
2513+
23892514
staticbool
23902515
validate_plperl_function(plperl_proc_ptr*proc_ptr,HeapTupleprocTup)
23912516
{
@@ -2437,7 +2562,7 @@ free_plperl_function(plperl_proc_desc *prodesc)
24372562

24382563

24392564
staticplperl_proc_desc*
2440-
compile_plperl_function(Oidfn_oid,boolis_trigger)
2565+
compile_plperl_function(Oidfn_oid,boolis_trigger,boolis_event_trigger)
24412566
{
24422567
HeapTupleprocTup;
24432568
Form_pg_procprocStruct;
@@ -2543,7 +2668,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
25432668
* Get the required information for input conversion of the
25442669
* return value.
25452670
************************************************************/
2546-
if (!is_trigger)
2671+
if (!is_trigger&& !is_event_trigger)
25472672
{
25482673
typeTup=
25492674
SearchSysCache1(TYPEOID,
@@ -2562,7 +2687,8 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
25622687
if (procStruct->prorettype==VOIDOID||
25632688
procStruct->prorettype==RECORDOID)
25642689
/* okay */ ;
2565-
elseif (procStruct->prorettype==TRIGGEROID)
2690+
elseif (procStruct->prorettype==TRIGGEROID||
2691+
procStruct->prorettype==EVTTRIGGEROID)
25662692
{
25672693
free_plperl_function(prodesc);
25682694
ereport(ERROR,
@@ -2598,7 +2724,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
25982724
* Get the required information for output conversion
25992725
* of all procedure arguments
26002726
************************************************************/
2601-
if (!is_trigger)
2727+
if (!is_trigger&& !is_event_trigger)
26022728
{
26032729
prodesc->nargs=procStruct->pronargs;
26042730
for (i=0;i<prodesc->nargs;i++)

‎src/pl/plperl/sql/plperl_trigger.sql‎

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -169,3 +169,23 @@ CREATE FUNCTION direct_trigger() RETURNS trigger AS $$
169169
$$ LANGUAGE plperl;
170170

171171
SELECT direct_trigger();
172+
173+
-- test plperl command triggers
174+
create or replacefunctionperlsnitch() returns event_trigger language plperlas $$
175+
elog(NOTICE,"perlsnitch:" . $_TD->{event} ."" . $_TD->{tag} ."");
176+
$$;
177+
178+
create event trigger perl_a_snitchon ddl_command_start
179+
execute procedure perlsnitch();
180+
create event trigger perl_b_snitchon ddl_command_end
181+
execute procedure perlsnitch();
182+
183+
create or replacefunctionfoobar() returnsint language sqlas $$select1;$$;
184+
alterfunction foobar() cost77;
185+
dropfunction foobar();
186+
187+
createtablefoo();
188+
droptable foo;
189+
190+
drop event trigger perl_a_snitch;
191+
drop event trigger perl_b_snitch;

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp