-<!-- $PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.52 2006/03/10 19:10:48 momjian Exp $ -->
+<!-- $PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.53 2006/05/26 17:34:16 adunstan Exp $ -->
<chapter id="plperl">
<title>PL/Perl - Perl Procedural Language</title>
</varlistentry>
<varlistentry>
- <term><literal>$_TD->{relname}</literal></term>
+ <term><literal>$_TD->{table_name}</literal></term>
<listitem>
<para>
Name of the table on which the trigger fired
</varlistentry>
<varlistentry>
+ <term><literal>$_TD->{relname}</literal></term>
+ <listitem>
+ <para>
+ Name of the table on which the trigger fired. This has been deprecated,
+ and could be removed in a future release.
+ Please use $_TD->{table_name} instead.
+ </para>
+ </listitem>
+ </varlistentry>
+
+ <varlistentry>
+ <term><literal>$_TD->{table_schema}</literal></term>
+ <listitem>
+ <para>
+ Name of the schema in which the table on which the trigger fired, is
+ </para>
+ </listitem>
+ </varlistentry>
+
+ <varlistentry>
<term><literal>$_TD->{argc}</literal></term>
<listitem>
<para>
i int,
v varchar
);
+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
+
+ 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';
+
+ if (! defined $val)
+ {
+ elog(NOTICE, "\$_TD->\{$key\} = NULL");
+ }
+ elsif (not ref $val)
+ {
+ elog(NOTICE, "\$_TD->\{$key\} = '$val'");
+ }
+ elsif (ref $val eq 'HASH')
+ {
+ my $str = "";
+ foreach my $rowkey (sort keys %$val)
+ {
+ $str .= ", " if $str;
+ my $rowval = $val->{$rowkey};
+ $str .= "'$rowkey' => '$rowval'";
+ }
+ elog(NOTICE, "\$_TD->\{$key\} = \{$str\}");
+ }
+ elsif (ref $val eq 'ARRAY')
+ {
+ my $str = "";
+ foreach my $argval (@$val)
+ {
+ $str .= ", " if $str;
+ $str .= "'$argval'";
+ }
+ elog(NOTICE, "\$_TD->\{$key\} = \[$str\]");
+ }
+ }
+ 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');
+NOTICE: $_TD->{argc} = '2'
+NOTICE: $_TD->{args} = ['23', 'skidoo']
+NOTICE: $_TD->{event} = 'INSERT'
+NOTICE: $_TD->{level} = 'ROW'
+NOTICE: $_TD->{name} = 'show_trigger_data_trig'
+NOTICE: $_TD->{new} = {'i' => '1', 'v' => 'insert'}
+NOTICE: $_TD->{relid} = 'bogus:12345'
+NOTICE: $_TD->{relname} = 'trigger_test'
+NOTICE: $_TD->{table_name} = 'trigger_test'
+NOTICE: $_TD->{table_schema} = 'public'
+NOTICE: $_TD->{when} = 'BEFORE'
+update trigger_test set v = 'update' where i = 1;
+NOTICE: $_TD->{argc} = '2'
+NOTICE: $_TD->{args} = ['23', 'skidoo']
+NOTICE: $_TD->{event} = 'UPDATE'
+NOTICE: $_TD->{level} = 'ROW'
+NOTICE: $_TD->{name} = 'show_trigger_data_trig'
+NOTICE: $_TD->{new} = {'i' => '1', 'v' => 'update'}
+NOTICE: $_TD->{old} = {'i' => '1', 'v' => 'insert'}
+NOTICE: $_TD->{relid} = 'bogus:12345'
+NOTICE: $_TD->{relname} = 'trigger_test'
+NOTICE: $_TD->{table_name} = 'trigger_test'
+NOTICE: $_TD->{table_schema} = 'public'
+NOTICE: $_TD->{when} = 'BEFORE'
+delete from trigger_test;
+NOTICE: $_TD->{argc} = '2'
+NOTICE: $_TD->{args} = ['23', 'skidoo']
+NOTICE: $_TD->{event} = 'DELETE'
+NOTICE: $_TD->{level} = 'ROW'
+NOTICE: $_TD->{name} = 'show_trigger_data_trig'
+NOTICE: $_TD->{old} = {'i' => '1', 'v' => 'update'}
+NOTICE: $_TD->{relid} = 'bogus:12345'
+NOTICE: $_TD->{relname} = 'trigger_test'
+NOTICE: $_TD->{table_name} = 'trigger_test'
+NOTICE: $_TD->{table_schema} = 'public'
+NOTICE: $_TD->{when} = 'BEFORE'
+
+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))
/**********************************************************************
* plperl.c - perl as a procedural language for PostgreSQL
*
- * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.108 2006/04/04 19:35:37 tgl Exp $
+ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.109 2006/05/26 17:34:16 adunstan Exp $
*
**********************************************************************/
hv_store(hv, "relname", 7,
newSVpv(SPI_getrelname(tdata->tg_relation), 0), 0);
+ hv_store(hv, "table_name", 10,
+ newSVpv(SPI_getrelname(tdata->tg_relation), 0), 0);
+
+ hv_store(hv, "table_schema", 12,
+ newSVpv(SPI_getnspname(tdata->tg_relation), 0), 0);
+
if (TRIGGER_FIRED_BEFORE(tdata->tg_event))
when = "BEFORE";
else if (TRIGGER_FIRED_AFTER(tdata->tg_event))
v varchar
);
+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
+
+ 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';
+
+ if (! defined $val)
+ {
+ elog(NOTICE, "\$_TD->\{$key\} = NULL");
+ }
+ elsif (not ref $val)
+ {
+ elog(NOTICE, "\$_TD->\{$key\} = '$val'");
+ }
+ elsif (ref $val eq 'HASH')
+ {
+ my $str = "";
+ foreach my $rowkey (sort keys %$val)
+ {
+ $str .= ", " if $str;
+ my $rowval = $val->{$rowkey};
+ $str .= "'$rowkey' => '$rowval'";
+ }
+ elog(NOTICE, "\$_TD->\{$key\} = \{$str\}");
+ }
+ elsif (ref $val eq 'ARRAY')
+ {
+ my $str = "";
+ foreach my $argval (@$val)
+ {
+ $str .= ", " if $str;
+ $str .= "'$argval'";
+ }
+ elog(NOTICE, "\$_TD->\{$key\} = \[$str\]");
+ }
+ }
+ 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');
+update trigger_test set v = 'update' where i = 1;
+delete from trigger_test;
+
+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))