src/pl/plperl/sql/plperl_trigger.sql

   1 -- test plperl triggers
   2
   3 CREATE TYPE rowcomp as (i int);
   4 CREATE TYPE rowcompnest as (rfoo rowcomp);
   5 CREATE TABLE trigger_test (
   6         i int,
   7         v varchar,
   8                 foo rowcompnest
   9 );
  10
  11 CREATE TABLE trigger_test_generated (
  12     i int,
  13     j int GENERATED ALWAYS AS (i * 2) STORED
  14 );
  15
  16 CREATE 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
  68 CREATE TRIGGER show_trigger_data_trig
  69 BEFORE INSERT OR UPDATE OR DELETE ON trigger_test
  70 FOR EACH ROW EXECUTE PROCEDURE trigger_data(23,'skidoo');
  71
  72 insert into trigger_test values(1,'insert', '("(1)")');
  73 update trigger_test set v = 'update' where i = 1;
  74 delete from trigger_test;
  75
  76 DROP TRIGGER show_trigger_data_trig on trigger_test;
  77
  78 CREATE TRIGGER show_trigger_data_trig_before
  79 BEFORE INSERT OR UPDATE OR DELETE ON trigger_test_generated
  80 FOR EACH ROW EXECUTE PROCEDURE trigger_data();
  81
  82 CREATE TRIGGER show_trigger_data_trig_after
  83 AFTER INSERT OR UPDATE OR DELETE ON trigger_test_generated
  84 FOR EACH ROW EXECUTE PROCEDURE trigger_data();
  85
  86 insert into trigger_test_generated (i) values (1);
  87 update trigger_test_generated set i = 11 where i = 1;
  88 delete from trigger_test_generated;
  89
  90 DROP TRIGGER show_trigger_data_trig_before ON trigger_test_generated;
  91 DROP TRIGGER show_trigger_data_trig_after ON trigger_test_generated;
  92
  93 insert into trigger_test values(1,'insert', '("(1)")');
  94 CREATE VIEW trigger_test_view AS SELECT * FROM trigger_test;
  95
  96 CREATE TRIGGER show_trigger_data_trig
  97 INSTEAD OF INSERT OR UPDATE OR DELETE ON trigger_test_view
  98 FOR EACH ROW EXECUTE PROCEDURE trigger_data(24,'skidoo view');
  99
 100 insert into trigger_test_view values(2,'insert', '("(2)")');
 101 update trigger_test_view set v = 'update', foo = '("(3)")' where i = 1;
 102 delete from trigger_test_view;
 103
 104 DROP VIEW trigger_test_view;
 105 delete from trigger_test;
 106
 107 DROP FUNCTION trigger_data();
 108
 109 CREATE 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
 127 CREATE TRIGGER "test_valid_id_trig" BEFORE INSERT OR UPDATE ON trigger_test
 128 FOR EACH ROW EXECUTE PROCEDURE "valid_id"();
 129
 130 INSERT INTO trigger_test (i, v, foo) VALUES (1,'first line', '("(1)")');
 131 INSERT INTO trigger_test (i, v, foo) VALUES (2,'second line', '("(2)")');
 132 INSERT INTO trigger_test (i, v, foo) VALUES (3,'third line', '("(3)")');
 133 INSERT INTO trigger_test (i, v, foo) VALUES (4,'immortal', '("(4)")');
 134
 135 INSERT INTO trigger_test (i, v) VALUES (101,'bad id');
 136
 137 SELECT * FROM trigger_test;
 138
 139 UPDATE trigger_test SET i = 5 where i=3;
 140
 141 UPDATE trigger_test SET i = 100 where i=1;
 142
 143 SELECT * FROM trigger_test;
 144
 145 DROP TRIGGER "test_valid_id_trig" ON trigger_test;
 146
 147 CREATE 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
 162 CREATE TRIGGER "test_trigger_recurse" BEFORE INSERT ON trigger_test
 163 FOR EACH ROW EXECUTE PROCEDURE "trigger_recurse"();
 164
 165 INSERT INTO trigger_test (i, v) values (10000, 'top');
 166
 167 SELECT * FROM trigger_test;
 168
 169 CREATE 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
 180 CREATE TRIGGER "immortal_trig" BEFORE DELETE ON trigger_test
 181 FOR EACH ROW EXECUTE PROCEDURE immortal('immortal');
 182
 183 DELETE FROM trigger_test;
 184
 185 SELECT * FROM trigger_test;
 186
 187 CREATE FUNCTION direct_trigger() RETURNS trigger AS $$
 188     return;
 189 $$ LANGUAGE plperl;
 190
 191 SELECT direct_trigger();
 192
 193 -- check that SQL run in trigger code can see transition tables
 194
 195 CREATE TABLE transition_table_test (id int, name text);
 196 INSERT INTO transition_table_test VALUES (1, 'a');
 197
 198 CREATE 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
 217 CREATE 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();
 220 UPDATE transition_table_test SET name = 'b';
 221
 222 DROP TABLE transition_table_test;
 223 DROP FUNCTION transition_table_test_f();
 224
 225 -- test plperl command triggers
 226 create or replace function perlsnitch() returns event_trigger language plperl as $$
 227   elog(NOTICE, "perlsnitch: " . $_TD->{event} . " " . $_TD->{tag} . " ");
 228 $$;
 229
 230 create event trigger perl_a_snitch on ddl_command_start
 231    execute procedure perlsnitch();
 232 create event trigger perl_b_snitch on ddl_command_end
 233    execute procedure perlsnitch();
 234
 235 create or replace function foobar() returns int language sql as $$select 1;$$;
 236 alter function foobar() cost 77;
 237 drop function foobar();
 238
 239 create table foo();
 240 drop table foo;
 241
 242 drop event trigger perl_a_snitch;
 243 drop event trigger perl_b_snitch;
 244
 245 -- dealing with generated columns
 246
 247 CREATE FUNCTION generated_test_func1() RETURNS trigger
 248 LANGUAGE plperl
 249 AS $$
 250 $_TD->{new}{j} = 5;  # not allowed
 251 return 'MODIFY';
 252 $$;
 253
 254 CREATE TRIGGER generated_test_trigger1 BEFORE INSERT ON trigger_test_generated
 255 FOR EACH ROW EXECUTE PROCEDURE generated_test_func1();
 256
 257 TRUNCATE trigger_test_generated;
 258 INSERT INTO trigger_test_generated (i) VALUES (1);
 259 SELECT * FROM trigger_test_generated;