src/pl/plperl/expected/plperl_trigger.out

-- test plperl triggers
CREATE TYPE rowcomp as (i int);
CREATE TYPE rowcompnest as (rfoo rowcomp);
CREATE TABLE trigger_test (
        i int,
        v varchar,
		foo rowcompnest
) distributed by (i);
CREATE OR REPLACE FUNCTION trigger_data() RETURNS trigger LANGUAGE plperl AS $$

  # make sure keys are sorted for consistent results - perl no longer
  # hashes in  repeatable fashion across runs

  sub str {
	  my $val = shift;

	  if (!defined $val)
	  {
		  return 'NULL';
	  }
	  elsif (ref $val eq 'HASH')
	  {
		my $str = '';
		foreach my $rowkey (sort keys %$val)
		{
		  $str .= ", " if $str;
		  my $rowval = str($val->{$rowkey});
		  $str .= "'$rowkey' => $rowval";
		}
		return '{'. $str .'}';
	  }
	  elsif (ref $val eq 'ARRAY')
	  {
		  my $str = '';
		  for my $argval (@$val)
		  {
			  $str .= ", " if $str;
			  $str .= str($argval);
		  }
		  return '['. $str .']';
	  }
	  else
	  {
		  return "'$val'";
	  }
  }

  foreach my $key (sort keys %$_TD)
  {

    my $val = $_TD->{$key};

	# relid is variable, so we can not use it repeatably
	$val = "bogus:12345" if $key eq 'relid';

	elog(NOTICE, "\$_TD->\{$key\} = ". str($val));
  }
  return undef; # allow statement to proceed;
$$;
CREATE TRIGGER show_trigger_data_trig
BEFORE INSERT OR UPDATE OR DELETE ON trigger_test
FOR EACH ROW EXECUTE PROCEDURE trigger_data(23,'skidoo');
insert into trigger_test values(1,'insert', '("(1)")');
NOTICE:  $_TD->{argc} = '2'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{args} = ['23', 'skidoo']
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{event} = 'INSERT'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{level} = 'ROW'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{name} = 'show_trigger_data_trig'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{new} = {'foo' => {'rfoo' => {'i' => '1'}}, 'i' => '1', 'v' => 'insert'}
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{relid} = 'bogus:12345'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{relname} = 'trigger_test'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{table_name} = 'trigger_test'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{table_schema} = 'public'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{when} = 'BEFORE'
CONTEXT:  PL/Perl function "trigger_data"
update trigger_test set v = 'update' where i = 1;
NOTICE:  $_TD->{argc} = '2'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{args} = ['23', 'skidoo']
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{event} = 'UPDATE'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{level} = 'ROW'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{name} = 'show_trigger_data_trig'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{new} = {'foo' => {'rfoo' => {'i' => '1'}}, 'i' => '1', 'v' => 'update'}
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{old} = {'foo' => {'rfoo' => {'i' => '1'}}, 'i' => '1', 'v' => 'insert'}
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{relid} = 'bogus:12345'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{relname} = 'trigger_test'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{table_name} = 'trigger_test'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{table_schema} = 'public'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{when} = 'BEFORE'
CONTEXT:  PL/Perl function "trigger_data"
delete from trigger_test;
NOTICE:  $_TD->{argc} = '2'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{args} = ['23', 'skidoo']
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{event} = 'DELETE'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{level} = 'ROW'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{name} = 'show_trigger_data_trig'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{old} = {'foo' => {'rfoo' => {'i' => '1'}}, 'i' => '1', 'v' => 'update'}
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{relid} = 'bogus:12345'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{relname} = 'trigger_test'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{table_name} = 'trigger_test'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{table_schema} = 'public'
CONTEXT:  PL/Perl function "trigger_data"
NOTICE:  $_TD->{when} = 'BEFORE'
CONTEXT:  PL/Perl function "trigger_data"
DROP TRIGGER show_trigger_data_trig on trigger_test;
DROP FUNCTION trigger_data();
CREATE OR REPLACE FUNCTION valid_id() RETURNS trigger AS $$

    if (($_TD->{new}{i}>=100) || ($_TD->{new}{i}<=0))
    {
        return "SKIP";   # Skip INSERT/UPDATE command
    }
    elsif ($_TD->{new}{v} ne "immortal")
    {
        $_TD->{new}{v} .= "(modified by trigger)";
		$_TD->{new}{foo}{rfoo}{i}++;
        return "MODIFY"; # Modify tuple and proceed INSERT/UPDATE command
    }
    else
    {
        return;          # Proceed INSERT/UPDATE command
    }
$$ LANGUAGE plperl;
CREATE TRIGGER "test_valid_id_trig" BEFORE INSERT OR UPDATE ON trigger_test
FOR EACH ROW EXECUTE PROCEDURE "valid_id"();
INSERT INTO trigger_test (i, v, foo) VALUES (1,'first line', '("(1)")');
INSERT INTO trigger_test (i, v, foo) VALUES (2,'second line', '("(2)")');
INSERT INTO trigger_test (i, v, foo) VALUES (3,'third line', '("(3)")');
INSERT INTO trigger_test (i, v, foo) VALUES (4,'immortal', '("(4)")');
INSERT INTO trigger_test (i, v) VALUES (101,'bad id');
SELECT * FROM trigger_test;
 i |                v                 |   foo   
---+----------------------------------+---------
 1 | first line(modified by trigger)  | ("(2)")
 2 | second line(modified by trigger) | ("(3)")
 3 | third line(modified by trigger)  | ("(4)")
 4 | immortal                         | ("(4)")
(4 rows)

UPDATE trigger_test SET i = 5 where i=3;
ERROR:  Cannot parallelize an UPDATE statement that updates the distribution columns
UPDATE trigger_test SET i = 100 where i=1;
ERROR:  Cannot parallelize an UPDATE statement that updates the distribution columns
SELECT * FROM trigger_test;
 i |                v                 |   foo   
---+----------------------------------+---------
 2 | second line(modified by trigger) | ("(3)")
 4 | immortal                         | ("(4)")
 1 | first line(modified by trigger)  | ("(2)")
 3 | third line(modified by trigger)  | ("(4)")
(4 rows)

CREATE OR REPLACE FUNCTION immortal() RETURNS trigger AS $$
    if ($_TD->{old}{v} eq $_TD->{args}[0])
    {
        return "SKIP"; # Skip DELETE command
    }
    else
    {
        return;        # Proceed DELETE command
    };
$$ LANGUAGE plperl;
CREATE TRIGGER "immortal_trig" BEFORE DELETE ON trigger_test
FOR EACH ROW EXECUTE PROCEDURE immortal('immortal');
DELETE FROM trigger_test;
SELECT * FROM trigger_test;
 i |    v     |   foo   
---+----------+---------
 4 | immortal | ("(4)")
(1 row)

CREATE FUNCTION direct_trigger() RETURNS trigger AS $$
    return;
$$ LANGUAGE plperl;
SELECT direct_trigger();
ERROR:  trigger functions can only be called as triggers
CONTEXT:  compilation of PL/Perl function "direct_trigger"