Add table_name and table_schema to plperl trigger data. relname is

kept but now deprecated. Patch from Adam Sjøgren. Add regression test to
show plperl trigger data (Andrew).
TBD: apply similar changes to plpgsql, plpython and pltcl.

diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml
index 9d262d8d70ac282f6748e3d2481b43bf6b8b37b0..02260d59a7c49b7bbdc89cd6df1924c6ec5c956c 100644 (file)
--- a/doc/src/sgml/plperl.sgml
+++ b/doc/src/sgml/plperl.sgml
@@ -1,4 +1,4 @@
-<!-- $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>
@@ -728,7 +728,7 @@ $$ LANGUAGE plperl;
     </varlistentry>
 
     <varlistentry>
-     <term><literal>$_TD-&gt;{relname}</literal></term>
+     <term><literal>$_TD-&gt;{table_name}</literal></term>
      <listitem>
       <para>
        Name of the table on which the trigger fired
@@ -736,6 +736,26 @@ $$ LANGUAGE plperl;
      </listitem>
     </varlistentry>
 
+    <varlistentry>
+     <term><literal>$_TD-&gt;{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-&gt;{table_name} instead.
+      </para>
+     </listitem>
+    </varlistentry>
+
+    <varlistentry>
+     <term><literal>$_TD-&gt;{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-&gt;{argc}</literal></term>
      <listitem>

diff --git a/src/pl/plperl/expected/plperl_trigger.out b/src/pl/plperl/expected/plperl_trigger.out
index 9c0bae9d36e66f5b90e4a4bbd16a9b6dd730c125..48a4853e214961f04c21bd5f34729382df1893a1 100644 (file)
--- a/src/pl/plperl/expected/plperl_trigger.out
+++ b/src/pl/plperl/expected/plperl_trigger.out
@@ -3,6 +3,95 @@ CREATE TABLE trigger_test (
         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))

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 310df025706e5f31714459bdc8fad7fb93d39468..b0ca84b1886b16605c7f22ae9f3e5f6844ef791e 100644 (file)
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -1,7 +1,7 @@
 /**********************************************************************
  * 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 $
  *
  **********************************************************************/
 
@@ -525,6 +525,12 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo)
        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))

diff --git a/src/pl/plperl/sql/plperl_trigger.sql b/src/pl/plperl/sql/plperl_trigger.sql
index 34ce9c484a23432ea0690d4c0b045ffa53d666fd..c8042d67ff5b3dacecf0b503055eb09f76ba7134 100644 (file)
--- a/src/pl/plperl/sql/plperl_trigger.sql
+++ b/src/pl/plperl/sql/plperl_trigger.sql
@@ -5,6 +5,64 @@ CREATE TABLE trigger_test (
         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))