A versão 7.5 incluirá o novo e melhorado plperl. As extensões de plperl nesta versão irão incluir a possibilidade de escrever funcões de trigger, fazer queries à base de dados, retornar sets e linhas assim como guardar valores locais à conecção.

Estas funcionalidades estavam já presentes em plpgsql, pltcl, plpythonu e mais recentemente em plR. Agora o plperl tem também uma completa funcionalidade de linguagem de procedimentos. Amantes de Perl irão adorar.

Nesta edição iremos rever funções básicas de perl, executar funções de query e funções de trigger. As outras funcionalidades, como retornar compostos, retornar sets (e sets de compostos) e guardar durações da conecção serão revistas na próxima edição de General Bits.

Ao criar estes exemplos, deparei-me com alguns problemas. Estes bugs foram reportados e foram revistos pelo pessoal do plperl. Estivemos todos ocupados no #postgresql neste longo fim-de-semana.

• é agora requerido que Safe.pm seja maior que a versão 2.09. A versão actual é a 2.11 na CPAN.
• Quando um erro de SQL é encontrado numa função que executa uma query, então chamadas subsequentes irão gerar um erro sobre a subrotina mksafefunc. A solução é fechar e reabrir a conecção.
• Aquando do retorno de um objecto composto, ou de um set, é possível que a função seja executada duas vezes.

Funções Básicas de Perl

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

Queries em funções Perl

A função de query é: $rv = spi_exec_query( $qry ); Se a query é um SELECT, poderá ter um argumento opcional integer que limitará o numero de linhas retornado.

Os valores de retorno estão hashed relativamente ao retorno da função. Para um SELECT poderá aceder ao array da linha e depois aos valores de coluna por hash. O numero de linhas é o tamanho do array de linhas:

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

Nestas funções usei elog para mostrar diferentes valores em runtime. Num sistema de produção estas seriam removidas, obviamente.

Esta função calcula os valores mínimo, máximo e médios para uma coluna numa tabela só num passo. Os nomes da coluna e da tabela são argumentos da função. O valor retornado é texto.

   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';

Para INSERT, UPDATE e DELETE, o numero de linhas afectadas está no hash processado e o status do query no hash de status .

   $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';

Funçõs de Trigger PLPerl

Existem ainda outros valiosos parâmetros disponíveis em $_TD.

$_TD->{"new"}	Um hash que contém os valores na nova linha da tabela para acções de INSERT/UPDATE , ou vazias para DELETE. Campos que contenham NULL ficarão indefinidos!
$_TD->{"old"}	Um hash que contém os valores da antiga linha da tabela para acções de UPDATE/DELETE , ou vazias para INSERT. Campos que contenham NULL ficarão indefinidos!
$_TD->{"name"}	o nome do trigger.
$_TD->{"event"}	o evento como string (INSERT, UPDATE, DELETE ou UNKNOWN).
$_TD->{"when"}	um dos seguintes: BEFORE, AFTER ou UNKNOWN.
$_TD->{"level"}	um dos seguintes: ROW, STATEMENT ou UNKNOWN.
$_TD->{"relid"}	a relação de ID da tabela na qual o trigger ocorreu.
$_TD->{"relname"}	o nome da relação (tabela).
$_TD->{"argc"}	contém os argumentos count.
$_TD->{"args"}[n]	os argumentos do trigger, caso existam

Esta obsessiva função big brother monitoriza inserts e updates à tabela de utilizadores controlando as mudanças numa tabela bigbro à parte. Nesta função muitas das variáveis $_TD são usadas nao só para valores, mas também para determinar as mudanças a serem logadas.

   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