1-- test plperl triggers 2 3CREATE TYPE rowcomp as (i int); 4CREATE TYPE rowcompnest as (rfoo rowcomp); 5CREATE TABLE trigger_test ( 6 i int, 7 v varchar, 8 foo rowcompnest 9); 10 11CREATE TABLE trigger_test_generated ( 12 i int, 13 j int GENERATED ALWAYS AS (i * 2) STORED 14); 15 16CREATE OR REPLACE FUNCTION trigger_data() RETURNS trigger LANGUAGE plperl AS $$ 17 18 # make sure keys are sorted for consistent results - perl no longer 19 # hashes in repeatable fashion across runs 20 21 sub str { 22 my $val = shift; 23 24 if (!defined $val) 25 { 26 return 'NULL'; 27 } 28 elsif (ref $val eq 'HASH') 29 { 30 my $str = ''; 31 foreach my $rowkey (sort keys %$val) 32 { 33 $str .= ", " if $str; 34 my $rowval = str($val->{$rowkey}); 35 $str .= "'$rowkey' => $rowval"; 36 } 37 return '{'. $str .'}'; 38 } 39 elsif (ref $val eq 'ARRAY') 40 { 41 my $str = ''; 42 for my $argval (@$val) 43 { 44 $str .= ", " if $str; 45 $str .= str($argval); 46 } 47 return '['. $str .']'; 48 } 49 else 50 { 51 return "'$val'"; 52 } 53 } 54 55 foreach my $key (sort keys %$_TD) 56 { 57 58 my $val = $_TD->{$key}; 59 60 # relid is variable, so we can not use it repeatably 61 $val = "bogus:12345" if $key eq 'relid'; 62 63 elog(NOTICE, "\$_TD->\{$key\} = ". str($val)); 64 } 65 return undef; # allow statement to proceed; 66$$; 67 68CREATE TRIGGER show_trigger_data_trig 69BEFORE INSERT OR UPDATE OR DELETE ON trigger_test 70FOR EACH ROW EXECUTE PROCEDURE trigger_data(23,'skidoo'); 71 72insert into trigger_test values(1,'insert', '("(1)")'); 73update trigger_test set v = 'update' where i = 1; 74delete from trigger_test; 75 76DROP TRIGGER show_trigger_data_trig on trigger_test; 77 78CREATE TRIGGER show_trigger_data_trig_before 79BEFORE INSERT OR UPDATE OR DELETE ON trigger_test_generated 80FOR EACH ROW EXECUTE PROCEDURE trigger_data(); 81 82CREATE TRIGGER show_trigger_data_trig_after 83AFTER INSERT OR UPDATE OR DELETE ON trigger_test_generated 84FOR EACH ROW EXECUTE PROCEDURE trigger_data(); 85 86insert into trigger_test_generated (i) values (1); 87update trigger_test_generated set i = 11 where i = 1; 88delete from trigger_test_generated; 89 90DROP TRIGGER show_trigger_data_trig_before ON trigger_test_generated; 91DROP TRIGGER show_trigger_data_trig_after ON trigger_test_generated; 92 93insert into trigger_test values(1,'insert', '("(1)")'); 94CREATE VIEW trigger_test_view AS SELECT * FROM trigger_test; 95 96CREATE TRIGGER show_trigger_data_trig 97INSTEAD OF INSERT OR UPDATE OR DELETE ON trigger_test_view 98FOR EACH ROW EXECUTE PROCEDURE trigger_data(24,'skidoo view'); 99 100insert into trigger_test_view values(2,'insert', '("(2)")'); 101update trigger_test_view set v = 'update', foo = '("(3)")' where i = 1; 102delete from trigger_test_view; 103 104DROP VIEW trigger_test_view; 105delete from trigger_test; 106 107DROP FUNCTION trigger_data(); 108 109CREATE OR REPLACE FUNCTION valid_id() RETURNS trigger AS $$ 110 111 if (($_TD->{new}{i}>=100) || ($_TD->{new}{i}<=0)) 112 { 113 return "SKIP"; # Skip INSERT/UPDATE command 114 } 115 elsif ($_TD->{new}{v} ne "immortal") 116 { 117 $_TD->{new}{v} .= "(modified by trigger)"; 118 $_TD->{new}{foo}{rfoo}{i}++; 119 return "MODIFY"; # Modify tuple and proceed INSERT/UPDATE command 120 } 121 else 122 { 123 return; # Proceed INSERT/UPDATE command 124 } 125$$ LANGUAGE plperl; 126 127CREATE TRIGGER "test_valid_id_trig" BEFORE INSERT OR UPDATE ON trigger_test 128FOR EACH ROW EXECUTE PROCEDURE "valid_id"(); 129 130INSERT INTO trigger_test (i, v, foo) VALUES (1,'first line', '("(1)")'); 131INSERT INTO trigger_test (i, v, foo) VALUES (2,'second line', '("(2)")'); 132INSERT INTO trigger_test (i, v, foo) VALUES (3,'third line', '("(3)")'); 133INSERT INTO trigger_test (i, v, foo) VALUES (4,'immortal', '("(4)")'); 134 135INSERT INTO trigger_test (i, v) VALUES (101,'bad id'); 136 137SELECT * FROM trigger_test; 138 139UPDATE trigger_test SET i = 5 where i=3; 140 141UPDATE trigger_test SET i = 100 where i=1; 142 143SELECT * FROM trigger_test; 144 145DROP TRIGGER "test_valid_id_trig" ON trigger_test; 146 147CREATE OR REPLACE FUNCTION trigger_recurse() RETURNS trigger AS $$ 148 use strict; 149 150 if ($_TD->{new}{i} == 10000) 151 { 152 spi_exec_query("insert into trigger_test (i, v) values (20000, 'child');"); 153 154 if ($_TD->{new}{i} != 10000) 155 { 156 die "recursive trigger modified: ". $_TD->{new}{i}; 157 } 158 } 159 return; 160$$ LANGUAGE plperl; 161 162CREATE TRIGGER "test_trigger_recurse" BEFORE INSERT ON trigger_test 163FOR EACH ROW EXECUTE PROCEDURE "trigger_recurse"(); 164 165INSERT INTO trigger_test (i, v) values (10000, 'top'); 166 167SELECT * FROM trigger_test; 168 169CREATE OR REPLACE FUNCTION immortal() RETURNS trigger AS $$ 170 if ($_TD->{old}{v} eq $_TD->{args}[0]) 171 { 172 return "SKIP"; # Skip DELETE command 173 } 174 else 175 { 176 return; # Proceed DELETE command 177 }; 178$$ LANGUAGE plperl; 179 180CREATE TRIGGER "immortal_trig" BEFORE DELETE ON trigger_test 181FOR EACH ROW EXECUTE PROCEDURE immortal('immortal'); 182 183DELETE FROM trigger_test; 184 185SELECT * FROM trigger_test; 186 187CREATE FUNCTION direct_trigger() RETURNS trigger AS $$ 188 return; 189$$ LANGUAGE plperl; 190 191SELECT direct_trigger(); 192 193-- check that SQL run in trigger code can see transition tables 194 195CREATE TABLE transition_table_test (id int, name text); 196INSERT INTO transition_table_test VALUES (1, 'a'); 197 198CREATE FUNCTION transition_table_test_f() RETURNS trigger LANGUAGE plperl AS 199$$ 200 my $cursor = spi_query("SELECT * FROM old_table"); 201 my $row = spi_fetchrow($cursor); 202 defined($row) || die "expected a row"; 203 elog(INFO, "old: " . $row->{id} . " -> " . $row->{name}); 204 my $row = spi_fetchrow($cursor); 205 !defined($row) || die "expected no more rows"; 206 207 my $cursor = spi_query("SELECT * FROM new_table"); 208 my $row = spi_fetchrow($cursor); 209 defined($row) || die "expected a row"; 210 elog(INFO, "new: " . $row->{id} . " -> " . $row->{name}); 211 my $row = spi_fetchrow($cursor); 212 !defined($row) || die "expected no more rows"; 213 214 return undef; 215$$; 216 217CREATE TRIGGER a_t AFTER UPDATE ON transition_table_test 218 REFERENCING OLD TABLE AS old_table NEW TABLE AS new_table 219 FOR EACH STATEMENT EXECUTE PROCEDURE transition_table_test_f(); 220UPDATE transition_table_test SET name = 'b'; 221 222DROP TABLE transition_table_test; 223DROP FUNCTION transition_table_test_f(); 224 225-- test plperl command triggers 226create or replace function perlsnitch() returns event_trigger language plperl as $$ 227 elog(NOTICE, "perlsnitch: " . $_TD->{event} . " " . $_TD->{tag} . " "); 228$$; 229 230create event trigger perl_a_snitch on ddl_command_start 231 execute procedure perlsnitch(); 232create event trigger perl_b_snitch on ddl_command_end 233 execute procedure perlsnitch(); 234 235create or replace function foobar() returns int language sql as $$select 1;$$; 236alter function foobar() cost 77; 237drop function foobar(); 238 239create table foo(); 240drop table foo; 241 242drop event trigger perl_a_snitch; 243drop event trigger perl_b_snitch; 244 245-- dealing with generated columns 246 247CREATE FUNCTION generated_test_func1() RETURNS trigger 248LANGUAGE plperl 249AS $$ 250$_TD->{new}{j} = 5; # not allowed 251return 'MODIFY'; 252$$; 253 254CREATE TRIGGER generated_test_trigger1 BEFORE INSERT ON trigger_test_generated 255FOR EACH ROW EXECUTE PROCEDURE generated_test_func1(); 256 257TRUNCATE trigger_test_generated; 258INSERT INTO trigger_test_generated (i) VALUES (1); 259SELECT * FROM trigger_test_generated; 260