Fix declaration of $_TD in "strict" trigger functions

This was broken in commit ef19dc6d39dd2490ff61489da55d95d6941140bf by
the Bunce/Hunsaker/Dunstan team, which moved the declaration from
plperl_create_sub to plperl_call_perl_trigger_func.  This doesn't
actually work because the validator code would not find the variable
declared; and even if you manage to get past the validator, it still
doesn't work because get_sv("_TD", GV_ADD) doesn't have the expected
effect.  The only reason this got beyond testing is that it only fails
in strict mode.

We need to declare it as a global just like %_SHARED; it is simpler than
trying to actually do what the patch initially intended, and is said to
have the same performance benefit.

As a more serious issue, fix $_TD not being properly local()ized,
meaning nested trigger functions would clobber $_TD.

Alex Hunsaker, per test report from Greg Mullane

diff --git a/src/pl/plperl/expected/plperl_trigger.out b/src/pl/plperl/expected/plperl_trigger.out
index 238e1b73363b5b44874e2b0a02a04fadb8b3fb7d..181dcfa7aeb723a04d4b261c156af7fd138984c6 100644 (file)
--- 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 67c656086cbefeee1485981cf23cd0dad02b238f..e3e507722a81566ebee810122594cd16e5b79457 100644 (file)
--- 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 b5418074aee446fa09f7676e87c2c96a4a3c598c..d69d2327bb0c668f17292dca9144a5403a285f27 100644 (file)
--- 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 3b9bf89f8e68befe322c83fa7bd60f696fd45a85..c43b31ede0a91bded905daa25cb87995fd9d9fb0 100644 (file)
--- 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])
     {