Fix declaration of $_TD in "strict" trigger functions

alvherre · alvherre · commit 6b449d905165 · 2011-05-18T23:56:18.000-04:00
This was broken in commit ef19dc6 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
@@ -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
@@ -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
@@ -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
@@ -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])
     {
