The 7.5 release will include the new and improved plperl. The extensions to plperl in this release will include the ability to write trigger functions, make database queries, return sets and rows and sets of rows as well as store data local to the connection.

These abilities are already present in plpgsql, pltcl, plpythonu and most recently in plR. Now plperl has full procedure language functionality, too. Perl lovers will love this.

In this issue we cover plain perl functions, query executing functions and trigger functions. The other features, returning composites, returning sets (and sets of composites) and connection duration storage will be covered in the next issue of General Bits.

In creating these examples, I ran into a number of problems. These bugs were reported and have been reviewed by the plperl folks. We were all busy on #postgresql this long weekend.

• Is is required now that Safe.pm be greater than version 2.09. It is currently at 2.11 on CPAN.
• When an SQL error is encountered on a function which executes a query, then subsequent function calls will generate an error about the subroutine mksafefunc. The workaround is to close and reopen the connection.
• When returning a composite object, or a set, is is possible that the function will be executed twice.

Basic Perl Functions

   create or replace function strip_punc (text) 
   returns text as
   '
      $_[0] =~ s/\\W|\\s//g ;
      return $_[0];
   ' language 'plperl';

Queries in Perl Functions

The query function is: $rv = spi_exec_query( $qry ); If the query is a SELECT, you may have an optional integer argument limiting the number of rows returned.

The return values are all hashed relative to the return of the function. For SELECT you can access the row array and then the column values by hash. The number of rows is the size of the row array:

   $column_value    = $rv->{rows}[]->{column name} 
   $number_of_rows = @{$rv->{rows}};

In these functions I have used elog to show different values at runtime. In a production system these would be removed, of course.

This function calculates the minimum, maximum and average for a column in a table in one pass. The column and table names are arguments to the function. The return value is text.

   create or replace function mmav(text,text )
   returns text as
   '
   my $tble = $_[0];
   my $col  = $_[1];
   my $qry  = ''select ''.$col.'' from ''.$tble;
   my $min  = 0;
   my $max  = 0;
   my $sum  = 0;
   
   my $rv = spi_exec_query( $qry );
   elog NOTICE, $rv->{status};
   elog NOTICE, @{$rv->{rows}};
   if (@{$rv->{rows}} == 0 ) { return ''No Rows Found''};
   for ( my $i=0; $i < @{$rv->{rows}} ; $i++ ) {
      if ( $i == 0 ) {
         $sum = $max = $min = $rv->{rows}[$i]->{$col};
         next;
      }
      if ( $max < $rv->{rows}[$i]->{$col} )
         { $max = $rv->{rows}[$i]->{$col}; }
      if ( $min > $rv->{rows}[$i]->{$col} )
         { $min = $rv->{rows}[$i]->{$col}; }
      $sum += $rv->{rows}[$i]->{$col};
   }
   my $result = sprintf(''min=%d max=%d avg=%d'', $min, $max, $sum/@{$rv->{rows}});
   return $result;
   
   ' language 'plperl';

For INSERT, UPDATE and DELETE, the number of rows affected is in the processed hash and the status of the query is in the status hash.

   $number_of_rows = $rv->{processed};
   $exec_status    = $rv->{status};

   create or replace function upd_user( text )
   returns integer as
   '
   my $email = $_[0];
   my $qry = "update users set email=''".$email."'' where who = USER ; ";
   my $rv = spi_exec_query( $qry );
   elog NOTICE, $qry;
   elog NOTICE, $rv->{status};
   elog NOTICE, $rv->{rows};
   elog NOTICE, $rv;
   return $rv->{rows};
   ' language 'plperl';

PLPerl Trigger Functions

There are also other valuable parameters available in $_TD.

$_TD->{"new"}	A hash containing the values of the new table row for INSERT/UPDATE actions, or empty for DELETE. Fields that are NULL will be undefined!
$_TD->{"old"}	A hash containing the values of the old table row for UPDATE/DELETE actions, or empty for INSERT. Fields that are NULL will be undefined!
$_TD->{"name"}	the trigger name.
$_TD->{"event"}	the event as a string (INSERT, UPDATE, DELETE or UNKNOWN).
$_TD->{"when"}	one of BEFORE, AFTER or UNKNOWN.
$_TD->{"level"}	one of ROW, STATEMENT or UNKNOWN.
$_TD->{"relid"}	the relation ID of the table on which the trigger occurred.
$_TD->{"relname"}	the relation (table) name.
$_TD->{"argc"}	contains the arguments count.
$_TD->{"args"}[n]	the trigger arguments if any

This obsessive big brother function monitors inserts and updates to the users table by tracking the changes in a separate bigbro table. In this function many of the $_TD variables are used both for values and to determine the change data for logging.

   create table users (
   	email text,
   	who	text );
   create table bigbro (
      who   text,
      what  text,
      tab   text,
      wwhen timestamp,
      change   text);
   
   create or replace function bigbro ()
   returns TRIGGER as
   '
   my $changes = "";
   my $qry = "insert into bigbro (who, what, tab, wwhen, change) values (USER, ''";
   $qry .= $_TD->{"event"}."-".$_TD->{"when"}."'', ''".$_TD->{"relname"}."'', now(), ''";
   
   if ( $_TD->{"event"} eq "INSERT" ){
      $changes .= "who=".$_TD->{"new"}{"who"}.", new.email=".$_TD->{"new"}{"email"}." ";
   }
   if ( $_TD->{"event"} eq "UPDATE" ){
      if ( $_TD->{"new"}{"who"} ne $_TD->{"old"}{"who"})
      {
         $changes .= "old.who=".$_TD->{"old"}{"who"};
         $changes .= ", new.who=".$_TD->{"new"}{"who"}." ";
      }
      if ( $_TD->{"new"}{"email"} ne $_TD->{"old"}{"email"})
      {
         $changes .= "old.email=".$_TD->{"old"}{"email"};
   		$changes .= ", new.email=".$_TD->{"new"}{"email"}." ";
      }
   }
   if ( $changes eq "" ) {
      $changes = "No Changes.";
   };
   $qry .= $changes."'');";
   
   my $rv = spi_exec_query( $qry );
   return;
   ' language 'plperl'; 
   
   create trigger insbb before insert on users
   for each row execute procedure bigbro();
   create trigger updbb before update on users
   for each row execute procedure bigbro();

Editor: elein at varlena.com andrew at dunslane.net david at fetter.org