[caracas-pm] Re: l-desarrollo digest, Vol 1 #174 - 1 msg

[Alexis Arnal]

Saludos, gracias por el jalón de oreja, por decir que PERL no
soportaba llamado a procedimientos almacenados, en realidad fué un
manotazo de ahogado que lanzé el Martes en la mañana luego de 3
semanas de darme golpes sin resultados positivos desde el punto de
vista de producción pero altamente productivo en aprendizaje.

Si bien en la mañana del Martes estaba un poco desconcertado casi
resignado a dejarlo para otra ocasión en la cual tuviera tiempo, cerca
de las 6pm logramos hacer funcionar los procediemientos almacenados
desde una aplicación en perl utilizando el módulo DBIx::ProcedureCall,
no respondí inmediatamente a la lista debido a que nos hallabamos
desconcertados tratando de entender que fué lo que hicimos.

Este fué el código que utilizamos, aunque un poco arcaico pero era
superior en desempeño a la forma como lo estabamos haciendo.

#********************
#!/usr/bin/perl -w
use DBI;
use Benchmark ':hireswallclock';
use DBIx::ProcedureCall qw(tjubilados1:fetch[[]]);
$start = new Benchmark; 
	
$user="aarnal";
$password='1234';
$host = 'localhost';
$port= 5432;
$driver="dbi:Pg:dbname=dbsirehu;host=$host;port=$port";

unless ($dbh= DBI -> connect($driver,$user,$password)) {
	print "\n *** No se pudo contactar el servidor ***\n";
	}
	
	my $data = tjubilados1($dbh);
	$length = @$data;	
	
	$a=${$data}[0];
	$i=0;
	
until ($i==$length){
	$a=${$data}[$i];
        print "${$a}[0]|${$a}[1]|${$a}[2]|${$a}[3]|${$a}[4]|${$a}[5]|${$a}[6]|${$a}[7]|${$a}[8]|${$a}[9]|${$a}[10]|${$a}[11]|${$a}[12]|${$a}[13]\n";
	$i++;
	}
	
	
$end = new Benchmark;
$elapsed = timediff ($end,$start);
print "Tiempo de Ejecucion :", timestr ($elapsed),"\n";

#*******************************************

Quiero expresar que estoy full agradecido y contento por este logro (y
los que faltan) ya que estamos innovando aquí dentro de la
organización, y siento que estamos por buen camino en el momento en
que voy a cumplir mi primer año dentro del área de las TIC como
programador LAPP(Linux-Apache-PERL-Postgres).

Hemos tratado de aplicar con la mayor rigurosidad posible el paradigma
del MVC (Model-View-Controller), la granularidad del sistema, las
metodologías de Ingeniería del Software, junto con una buena dosis de
Gerencia del Cambio, Motivación, Gestión tecnológica, y mejora
continua entre otras, que han contribuido a que se fortalezca el
equipo de trabajo, aunque no ha sido fácil, gracias a un jefe (medio
loco) que confió en nosotros.

Gracias por la explicación y en lo que la terminemos de digerir vamos
ha hacer un tutorial completo acerca del desarrollo de sistemas
utilizando el LAPP.

Hacia donde vamos:
1.-Aprender ModPerl
2.-Integración con LDAP
3.-.........
4.-.........


> Message: 1
> From: Ernesto =?ISO-8859-1?Q?Hern=E1ndez-Novich?= <emhn at telcel.net.ve>
> To: Perl Mongers Caracas - Venezuela <caracas-pm at pm.org>
> Cc: l-desarrollo at velug.org.ve
> Date: Wed, 13 Apr 2005 12:36:03 -0400
> Subject: [l-desarrollo] Re: [caracas-pm] Procedimientos Almacenados
> Reply-To: l-desarrollo at velug.org.ve
> 
> On Tue, 2005-04-12 at 18:39 +0200, Alexis Arnal wrote:
> > Estoy tratando de implementar procedimientos almacenados en postgres
> > desde una aplicación Perl que utiliza DBI
> >
> > He revisado la documentación de DBI y DBD::Pg y encuentro que no están
> > soportados los procedimientos almacenados,
> 
> Eso es falso. La documentación lo que dice es que no existe ningún
> método _específico_ para ejecutar procedimientos almacenados, y que
> debes determinar cómo lo hace el manejador particular. En el caso de
> PostgreSQL, usualmente se invoca el procedimiento almacenado en un
> SELECT y eso funciona perfecto.
> 
> En psql...
> 
> create or replace function test(integer) returns integer as '
> begin
>   return $1 + 41;
> end;' language 'plpgsql';
> 
> ...que luego pruebas haciendo...
> 
> select test(1);
>  test
> ------
>    42
> (1 row)
> 
> Eso te dice que para invocar el procedimiento almacenado hay que pedirle
> a DBI que ejecute "select test(1)", entonces, en Perl
> 
> #!/usr/bin/perl
> use strict;
> use warnings;
> use DBI;
> my $dbh = DBI->connect('dbi:Pg:dbname=test','emhn');
> my $sql = q{ select test(?) };
> my $sth = $dbh->prepare($sql);
> for (1..10) {
>   $sth->execute($_);
>   my ($val) = $sth->fetchrow_array;
>   print "$val ";
> }
> print "\n";
> $sth->finish;
> $dbh->disconnect;
> 
> Y aparecerá "42 43 ... 51". Como verás se puede ejecutar el
> procedimiento almacenado y hasta pasarle parámetros. Si el procedimiento
> retorna _una_ tupla, con el fetchrow_array tienes. Si el procedimiento
> retorna varias tuplas la cosa cambia, digamos tengo una tabla 'foo' uno
> de cuyos campos es booleano y quiero hacer una función que filtre según
> el campo sea cierto o falso, y me retorne _todos_ los registros que
> cumplan, entonces en psql
> 
> create or replace function dame ( boolean ) returns setof foo as '
> declare
>   registro foo%ROWTYPE;
> begin
>   for registro in select * from foo where flag = $1 loop
>     return next registro;
>   end loop;
>   return;
> end;' language 'plpgsql';
> 
> ...y la pruebo haciendo
> 
>  select * from dame ('T');
>  name | number | flag
> ------+--------+------
>  Foo  |      1 | t
>  Bar  |      1 | t
> (2 rows)
> 
> Obviamente, desde Perl la llamada cambiará, y el cuerpo del programa
> debería cambiarse por algo como
> 
> my $sql = q{ select * from dame(?) };
> my $sth = $dbh->prepare($sql);
> my ($text,$number,$flag);
> $sth->execute('T');
> $sth->bind_columns(\$text,\$number,\$flag);
> while ($sth->fetchrow_arrayref) {
>   print "$text $number $flag\n",
> }
> 
> Y aparecerán las líneas correspondientes a los registros.
> 
> Está forma además de rápida es ahorrativa en memoria (del lado Perl) y
> espeluznantemente clara porque no hay nada más limpio que usar las
> variables $text, $number y $flag dentro del ciclo y ya tendrán los
> valores que me interesan.
> 
> Ahora, desde el punto de vista de PostgreSQL no es lo más eficiente,
> porque funciones que retornan SETOF calculan _todo_ el query y luego van
> dando los resultados uno por uno. Pero esos resultados tienen que estar
> en alguna parte, y esa es la memoria en el servidor; si uno quiere
> moverse para arriba o para abajo en el conjunto de datos, o bien
> trabajar sólo con algunos, se desperdicia memoria y recursos. Pero si se
> les ocurre copiarlos al cliente (el programa Perl) para trabajar con
> ellos. Ahí es donde se quiere usar cursores, que son más complejos de
> aplicar, pero mucho más eficientes.
> 
> La misma función, pero usando un cursor que encima recibe un parámetro,
> sería
> 
> create or replace function damec ( boolean ) returns refcursor as '
> declare
>   resultados cursor(arg boolean) for select * from foo where flag = arg;
> begin
>   open resultados($1);
>   return resultados;
> end;' language 'plpgsql';
> 
> y para probarla desde psql es un poco más complejo (y lo que significa
> cada paso está explicado en el manual de PostgreSQL)
> 
> test=> begin;
> BEGIN
> test=> select damec('T');
>    damec
> ------------
>  resultados
> (1 row)
> 
> test=> fetch all in resultados;
>  name | number | flag
> ------+--------+------
>  Foo  |      1 | t
>  Bar  |      1 | t
> (2 rows)
> 
> test=> commit;
> COMMIT
> 
> De modo que si quiero hacer uso de éste procedimiento en Perl, me basta
> 
> my $sql  = q{
>                select damec(?);
>                fetch all in resultados;
>             };
> my $sth   = $dbh->prepare($sql);
> $sth->execute('T');
> my ($text,$number,$flag);
> $sth->bind_columns(\$text,\$number,\$flag);
> while ($sth->fetchrow_arrayref) {
>   print "$text $number $flag\n",
> }
> $sth->finish;
> 
> Y esto será no solamente rápido, sino económico en memoria en _ambos_
> lados. Más aún, utilizando FETCH manualmente (dentro del procedure,
> preferiblemente) uno se puede mover hacia "arriba" y "abajo" en el
> conjunto de datos retornados.
> 
> Y si lo que quieres es escribir un procedimiento en Perl, tirado de
> fácil. La siguiente función cambia la columna 'name' a l33tsp34k
> solamente si la columna 'flag' tiene el valor 't'.
> 
> create or replace function leet ( foo ) returns text as '
>   my ($foo) = @_;
>   if ($foo->{flag} eq "t") {
>     $foo->{name} =~ tr/oae/043/;
>   }
>   return $foo->{name};
> ' language 'plperl';
> 
> Y en psql la uso como
> 
> select name,flag,leet(foo) from foo;
>  name | flag | leet
> ------+------+------
>  Foo  | t    | F00
>  Bar  | t    | B4r
>  Baz  | f    | Baz
> (3 rows)
> 
> Todo ésto salió de revisar los manuales. No conozco ningún tutorial
> específico.
> --
> Ernesto Hernández-Novich - On Linux 2.6.11 i686 - Unix: Live free or die!
> Geek by nature, Linux by choice, Debian of course.
> If you can't apt-get it, it isn't useful or doesn't exist.
> GPG Key Fingerprint = 438C 49A2 A8C7 E7D7 1500 C507 96D6 A3D6 2F4C 85E3
> 

Atte.
Ing. Alexis Arnal
MED, Caracas-Venezuela
Linux user number 378161