src/pl/plperl/sql/plperl_trigger.sql

   1 -- test plperl triggers
   2
   3 CREATE TABLE trigger_test (
   4         i int,
   5         v varchar
   6 );
   7
   8 CREATE OR REPLACE FUNCTION trigger_data() RETURNS trigger LANGUAGE plperl AS $$
   9
  10   # make sure keys are sorted for consistent results - perl no longer
  11   # hashes in  repeatable fashion across runs
  12
  13   foreach my $key (sort keys %$_TD)
  14   {
  15
  16     my $val = $_TD->{$key};
  17
  18         # relid is variable, so we can not use it repeatably
  19         $val = "bogus:12345" if $key eq 'relid';
  20
  21         if (! defined $val)
  22         {
  23           elog(NOTICE, "\$_TD->\{$key\} = NULL");
  24         }
  25         elsif (not ref $val)
  26     {
  27           elog(NOTICE, "\$_TD->\{$key\} = '$val'");
  28         }
  29         elsif (ref $val eq 'HASH')
  30         {
  31           my $str = "";
  32           foreach my $rowkey (sort keys %$val)
  33           {
  34             $str .= ", " if $str;
  35             my $rowval = $val->{$rowkey};
  36             $str .= "'$rowkey' => '$rowval'";
  37       }
  38           elog(NOTICE, "\$_TD->\{$key\} = \{$str\}");
  39         }
  40         elsif (ref $val eq 'ARRAY')
  41         {
  42           my $str = "";
  43           foreach my $argval (@$val)
  44           {
  45             $str .= ", " if $str;
  46             $str .= "'$argval'";
  47       }
  48           elog(NOTICE, "\$_TD->\{$key\} = \[$str\]");
  49         }
  50   }
  51   return undef; # allow statement to proceed;
  52 $$;
  53
  54 CREATE TRIGGER show_trigger_data_trig
  55 BEFORE INSERT OR UPDATE OR DELETE ON trigger_test
  56 FOR EACH ROW EXECUTE PROCEDURE trigger_data(23,'skidoo');
  57
  58 insert into trigger_test values(1,'insert');
  59 update trigger_test set v = 'update' where i = 1;
  60 delete from trigger_test;
  61
  62 DROP TRIGGER show_trigger_data_trig on trigger_test;
  63
  64 DROP FUNCTION trigger_data();
  65
  66 CREATE OR REPLACE FUNCTION valid_id() RETURNS trigger AS $$
  67
  68     if (($_TD->{new}{i}>=100) || ($_TD->{new}{i}<=0))
  69     {
  70         return "SKIP";   # Skip INSERT/UPDATE command
  71     }
  72     elsif ($_TD->{new}{v} ne "immortal")
  73     {
  74         $_TD->{new}{v} .= "(modified by trigger)";
  75         return "MODIFY"; # Modify tuple and proceed INSERT/UPDATE command
  76     }
  77     else
  78     {
  79         return;          # Proceed INSERT/UPDATE command
  80     }
  81 $$ LANGUAGE plperl;
  82
  83 CREATE TRIGGER "test_valid_id_trig" BEFORE INSERT OR UPDATE ON trigger_test
  84 FOR EACH ROW EXECUTE PROCEDURE "valid_id"();
  85
  86 INSERT INTO trigger_test (i, v) VALUES (1,'first line');
  87 INSERT INTO trigger_test (i, v) VALUES (2,'second line');
  88 INSERT INTO trigger_test (i, v) VALUES (3,'third line');
  89 INSERT INTO trigger_test (i, v) VALUES (4,'immortal');
  90
  91 INSERT INTO trigger_test (i, v) VALUES (101,'bad id');
  92
  93 SELECT * FROM trigger_test;
  94
  95 UPDATE trigger_test SET i = 5 where i=3;
  96
  97 UPDATE trigger_test SET i = 100 where i=1;
  98
  99 SELECT * FROM trigger_test;
 100
 101 CREATE OR REPLACE FUNCTION immortal() RETURNS trigger AS $$
 102     if ($_TD->{old}{v} eq $_TD->{args}[0])
 103     {
 104         return "SKIP"; # Skip DELETE command
 105     }
 106     else
 107     {
 108         return;        # Proceed DELETE command
 109     };
 110 $$ LANGUAGE plperl;
 111
 112 CREATE TRIGGER "immortal_trig" BEFORE DELETE ON trigger_test
 113 FOR EACH ROW EXECUTE PROCEDURE immortal('immortal');
 114
 115 DELETE FROM trigger_test;
 116
 117
 118 SELECT * FROM trigger_test;
 119