diff options
| -rw-r--r-- | src/pl/plperl/expected/plperl_trigger.out | 29 | ||||
| -rw-r--r-- | src/pl/plperl/plc_perlboot.pl | 2 | ||||
| -rw-r--r-- | src/pl/plperl/plperl.c | 7 | ||||
| -rw-r--r-- | src/pl/plperl/sql/plperl_trigger.sql | 24 |
4 files changed, 59 insertions, 3 deletions
diff --git a/src/pl/plperl/expected/plperl_trigger.out b/src/pl/plperl/expected/plperl_trigger.out index 238e1b73363..181dcfa7aeb 100644 --- a/src/pl/plperl/expected/plperl_trigger.out +++ b/src/pl/plperl/expected/plperl_trigger.out @@ -255,6 +255,35 @@ SELECT * FROM trigger_test; 5 | third line(modified by trigger)(modified by trigger) | ("(5)") (4 rows) +DROP TRIGGER "test_valid_id_trig" ON trigger_test; +CREATE OR REPLACE FUNCTION trigger_recurse() RETURNS trigger AS $$ + use strict; + + if ($_TD->{new}{i} == 10000) + { + spi_exec_query("insert into trigger_test (i, v) values (20000, 'child');"); + + if ($_TD->{new}{i} != 10000) + { + die "recursive trigger modified: ". $_TD->{new}{i}; + } + } + return; +$$ LANGUAGE plperl; +CREATE TRIGGER "test_trigger_recurse" BEFORE INSERT ON trigger_test +FOR EACH ROW EXECUTE PROCEDURE "trigger_recurse"(); +INSERT INTO trigger_test (i, v) values (10000, 'top'); +SELECT * FROM trigger_test; + i | v | foo +-------+------------------------------------------------------+--------- + 1 | first line(modified by trigger) | ("(2)") + 2 | second line(modified by trigger) | ("(3)") + 4 | immortal | ("(4)") + 5 | third line(modified by trigger)(modified by trigger) | ("(5)") + 20000 | child | + 10000 | top | +(6 rows) + CREATE OR REPLACE FUNCTION immortal() RETURNS trigger AS $$ if ($_TD->{old}{v} eq $_TD->{args}[0]) { diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl index 67c656086cb..e3e507722a8 100644 --- a/src/pl/plperl/plc_perlboot.pl +++ b/src/pl/plperl/plc_perlboot.pl @@ -1,7 +1,7 @@ # src/pl/plperl/plc_perlboot.pl use 5.008001; -use vars qw(%_SHARED); +use vars qw(%_SHARED $_TD); PostgreSQL::InServer::Util::bootstrap(); diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index b5418074aee..d69d2327bb0 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -1976,8 +1976,11 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, ENTER; SAVETMPS; - TDsv = get_sv("_TD", GV_ADD); - SAVESPTR(TDsv); /* local $_TD */ + TDsv = get_sv("_TD", 0); + if (!TDsv) + elog(ERROR, "couldn't fetch $_TD"); + + save_item(TDsv); /* local $_TD */ sv_setsv(TDsv, td); PUSHMARK(sp); diff --git a/src/pl/plperl/sql/plperl_trigger.sql b/src/pl/plperl/sql/plperl_trigger.sql index 3b9bf89f8e6..c43b31ede0a 100644 --- a/src/pl/plperl/sql/plperl_trigger.sql +++ b/src/pl/plperl/sql/plperl_trigger.sql @@ -122,6 +122,30 @@ UPDATE trigger_test SET i = 100 where i=1; SELECT * FROM trigger_test; +DROP TRIGGER "test_valid_id_trig" ON trigger_test; + +CREATE OR REPLACE FUNCTION trigger_recurse() RETURNS trigger AS $$ + use strict; + + if ($_TD->{new}{i} == 10000) + { + spi_exec_query("insert into trigger_test (i, v) values (20000, 'child');"); + + if ($_TD->{new}{i} != 10000) + { + die "recursive trigger modified: ". $_TD->{new}{i}; + } + } + return; +$$ LANGUAGE plperl; + +CREATE TRIGGER "test_trigger_recurse" BEFORE INSERT ON trigger_test +FOR EACH ROW EXECUTE PROCEDURE "trigger_recurse"(); + +INSERT INTO trigger_test (i, v) values (10000, 'top'); + +SELECT * FROM trigger_test; + CREATE OR REPLACE FUNCTION immortal() RETURNS trigger AS $$ if ($_TD->{old}{v} eq $_TD->{args}[0]) { |