La estructura PGresult

Como mencionamos, la estructura PGresult contiene toda la información referente al resultado regresado por el servidor luego de una consulta. El método para obtener esta información es:

$result_status = $result->resultStatus

Regresa el estado del resultado. Para comparar el estado se usan las siguientes constantes, dependiendo de la instrucción enviada:

96#96

Pg proveé de algunos métodos para examinar la estructura resultante:

$ntuples = $result->ntuples

Regresa el número de tuplas resultantes de la consulta.

$nfields = $result->nfields

Regresa el número de campos.

$ret = $result->binaryTuples

Regresa 1 si las tuplas son binarias.

$fname = $result->fname($field_num)

Regresa el nombre del campo asociado al número de campo $field_num.

$fnumber = $result->fnumber($field_name)

Regresa el número de campo asociado al nombre de campo $field_name.

$ftype = $result->ftype($field_num)

Regresa el OID del tipo asociado al número de campo dado.^14.3

$fsize = $result->fsize($field_num)

Regresa el tamaño en bytes del tipo asociado al número de campo dado. Si regresa -1 entonces el campo es de tamaño variable.

$fmod = $result->fmod($field_num)

Regresa los datos de modificación para el tipo específico asociado con el índice de campo dado. Los indices de campo comienzan en el 0.

$cmdStatus = $result->cmdStatus

Regresa el estado de la última instrucción dada. En el caso de DELETE también regresa el número de tuplas borradas. En el caso de INSERT regresa el OID de la tupla insertada, seguido de 1, el número de tuplas afectadas por la operación.

$oid = $result->oidStatus

En caso de que la última consulta haya sido un INSERT regresa el OID de la tupla insertada.

$oid = $result->cmdTuples

En caso de que la última instrucción haya sido un INSERT o DELETE regresa el número de tuplas afectadas.

$value = $result->getvalue($tup_num, $field_num)

Regresa el valor de la tupla y campo dados. Es una cadena terminada, como en C, con 0. Los cursores binarios no utilizan este método.

$length = $result->getlength($tup_num, $field_num)

Regresa la longitud del valor para un campo y una tupla dados.

$null_status = $result->getisnull($tup_num, $field_num)

Regresa el estado respecto a NULL para un campo y una tupla dados.

$res->fetchrow

Trae la siguiente tupla del servidor y regresa NULL cuando todas han sido procesadas. Los atributos que tengan valores NULL, serán fijados al valor undef de Perl.

$result->print($fout, $header, $align,

$standard, $html3, $expanded, $pager, $fieldSep, $tableOpt, $caption, ...) Esta es la función de impresión empleada por psql. Imprime todas las tuplas de una manera presentable. La explicación de los parámetros es como sigue:

97#97

Si se le pasan valores adicionales, serán tomados como nombres de las columnas.

El siguiente es un ejemplo que toma la salida de una consulta al servidor de CDDB y lo inserta en una base de datos.

#!/usr/bin/perl

use Pg;
use Getopt::Std;

getopts('ig:');

@args = @ARGV;

$ini    = (defined $opt_i) ? 1 : 0;
$genero = (defined $opt_g) ? $opt_g : 'Sin Clasificar';
$DBUG   = 10000;
$|      = 1;

&inicializa();
&inidb();
foreach $a (@ARGV) {
    &jalacddb($a);
}

# # xmcd CD database file
# # Copyright (C) 1993-1998 CDDB, Inc.
# #
# # Track frame offsets:
# #     200
# #     36531
# #     55138
# #     98442
# #     112786
# #     165902
# #     185123
# #     235011
# #
# # Disc length: 3225 seconds
# #
# # Revision: 6
# # Processed by: cddbd v1.4.1b10PL0 Copyright (c) 1996-1998 CDDB Inc.
# # Submitted via: NotifyCDPlayer(CDDB) 1.51.3
# #
# DISCID=530c9708,540c9c08,560c9508,570c9508,590c9708,590c9c08
# DTITLE=Genesis / Selling England by the Pound
# TTITLE0=Dancing with the Moonlight Knight
# TTITLE1=I know what I like (in your Wardrobe)
# TTITLE2=Firth of Fifth
# TTITLE3=More fool Me
# TTITLE4=The Battle of Epping Forest
# TTITLE5=After the Ordeal
# TTITLE6=The Cinema Show
# TTITLE7=Aisle of Plenty
# EXTD=Phil Collins : Drums, Percussion, Vocal\nMichael Rutherford : 12-String
# EXTD=, Bass, Electric Sitar\nStephen Hackett : Elec Guitar, Nylon Guitar\nTo
# EXTD=ny Banks : Keyboards, 12-String\nPeter Gabriel : Vocals, Flute, Percuss
# EXTD=ion, Oboe\n\nProduced by John Burns & Genesis\nCASCD 1074 (P) 1973 Virg
# EXTD=in Records LTD (C) 1985 Charisma Records LTD\n\nSubmitted by Stephane G
# EXTD=rienenberger, 17/12/1998
# EXTT0=
# EXTT1=
# EXTT2=
# EXTT3=Vocals : Phil
# EXTT4=
# EXTT5=
# EXTT6=
# EXTT7=
# PLAYORDER=
# .

sub jalacddb {
# Esta funcion es mas grande de lo que puedo tolerar. Y todavia falta
# aniadirle una tonelada de chequeos.
    local ($arc) = @_;
    print "Insertando $arc\n" if ($DBUG <= 2);
    open (DATA, $arc) or die "No puedo leer de $arc\n";
    while (<DATA>) {
        chomp;
        if (m/Track frame offsets:/) {
            foreach my $i (0..100) {
                $disc[$TROLA][$i] = "";
            }
            $ind         = 0;
            $max_ind     = 0;
            $extd        = "";
            $disc[$EXTD] = "";
            $auxtit      = "";
            print "Machea Track frame:[$_]\n" if ($DBUG <= 1);
            $nt = 0;
            while (<DATA>) {
                next if (m/^\#\s+$/);
                chomp;
                if (m/Disc length:/) {
                    print "Machea Disc length:[$_]\n" if ($DBUG <= 2);
                    $aux  = $_;
                    $aux =~ s/(Disc)(\s)(length:)(\s)([0-9]+)/$5/;
                    $disc[$DURS][$nt] = $5 + 0;
                    $disc[$NROL]      = $nt - 1;
                    print "Tenemos $disc[$NROL] rolas: " if ($DBUG <= 2);
                    foreach my $i (0..$disc[$NROL]) {
                        print "$disc[$DURS][$i]:" if ($DBUG <= 2);
                        $disc[$TREX][$i] = "";
                    }
                    print "$disc[$DURS][$disc[$NROL]+1]\n" if ($DBUG <= 2);
                    last;
                } else {
                    @a = split (' ', $_);
                    $disc[$DURS][$nt++] = $a[1] + 0;
                }
            }
        }
        if (m/^DISCID/) {
            print "Machea DISCID:[$_]\n" if ($DBUG <= 1);
            @a = split (/=/, $_);
            $disc[$DISCID][0] = $a[1];
        }
        if (m/^DTITLE/) {
            # Recuerda que a veces vienen en dos lineas:
            # DTITLE=Fischer-Dieskau/Moore / Schubert, Franz: Die schone Mull
            # DTITLE=erin, D795
            print "Machea DTITLE:[$_]\n" if ($DBUG <= 1);
            @a = split (/=/, $_);
            $auxtit .= $a[1];
        }
        if (m/^EXTD/) {
            print "Machea EXTD:[$_]\n" if ($DBUG <= 1);
            @a = split (/=/, $_);
            $disc[$EXTD] .= $a[1];
        }
        if (m/^TTITLE/) { # Hay que guardar tambien el numero de rola...
            print "Machea TTITLE:[$_]\n" if ($DBUG <= 1);
            $aux = $_;
            @a = split (/=/, $_);
            $a[0] =~ s/(TITLE)([0-9]+)/$2/;
            $ind  = $2 + 0;
            print "$aux->$ind\n" if ($DBUG <= 1);
            $disc[$TROLA][$ind] .= $a[1];
            $max_ind = $ind;
        }
        if (m/^EXTT/) {
            print "Machea EXTT:[$_]\n" if ($DBUG <= 1);
            $aux = $_;
            @a = split (/=/, $_);
            $a[0] =~ s/(EXTT)([0-9]+)/$2/;
            $ind  = $2 + 0;
            print "indice extension: $aux->$ind:[$a[1]]\n" if ($DBUG <= 10);
            $disc[$TREX][$ind] .= $a[1];
        }
        if (m/^PLAYORDER/) { # Usualmente el archivo termina con un `.',
                             # pero en la practica, muchos terminan con el PLAYORDER
            print "max_ind ==> $max_ind\n" if ($DBUG <= 3);
            if ($max_ind <= 0) {
                print ILOG "$arc: con ", $max_ind+1, " rolas\n";
            }
            foreach my $i (0..$max_ind) {
                if ($i == $max_ind) {
                    $frames = $disc[$DURS][$i+1] * 75 - $disc[$DURS][$i];
                } else {
                    $frames    = $disc[$DURS][$i+1] - $disc[$DURS][$i];
                }
                if ($frames >= 270000) {
                    print STDERR "\n\n\t\t!!!PELIGRO!!!\n\nframes:$frames\n";
                    print ILOG "$arc:frames absurdos $frames\n";
                }
                $framesres = $frames % 75;
                $j         = ($frames - $framesres) / 75;
                $segundos  = $j % 60;
                $j         = $j - $segundos;
                $minutos   = ($j / 60) % 60;
                $horas     = int (int ($j / 60) / 60);
                print ">$i:$disc[$DURS][$i+1]:$disc[$DURS][$i]:$frames=>"
                    ."f$framesres:s$segundos:m$minutos:h$horas<\n" if ($DBUG <= 3);
                $disc[$TTIM][$i][$TFRM] = $framesres;
                $disc[$TTIM][$i][$TSEG] = $segundos;
                $disc[$TTIM][$i][$TMIN] = $minutos;
                $disc[$TTIM][$i][$THOR] = $horas;
                $disc[$MSDURS][$i] = sprintf ("%02d:%02d:%02d.%02d",
                                              $horas, $minutos,
                                              $segundos, $framesres);
            }
            print "auxtit:$auxtit\n" if ($DBUG <= 3);
            $disc[$TTOT][$TFRM] = 0;
            $disc[$TTOT][$TSEG] = 0;
            $disc[$TTOT][$TMIN] = 0;
            $disc[$TTOT][$THOR] = 0;
            $tfrm               = 0;
            $tseg               = 0;
            $tmin               = 0;
            $thor               = 0;
            if ($auxtit =~ m/\//) {
                @a = split (/\//, $auxtit, 2);
            } elsif ($auxtit =~ m/\-/) {
                @a = split (/\-/, $auxtit, 2);
            } elsif ($auxtit =~ m/:/) {
                @a = split (/:/, $auxtit, 2);
            } else {
                $a[0] = $auxtit;
                $a[1] = $auxtit;
            }
            $a[0]               =~ s/^\s+//;
            $a[0]               =~ s/\s+$//;
            $a[1]               =~ s/^\s+//;
            $a[1]               =~ s/\s+$//;
            $disc[$AUTOR]       = $a[0];
            $disc[$TITULO]      = $a[1];
            print "ID:    $disc[$DISCID][0]\n" if ($DBUG <= 4);
            print "Autor: $disc[$AUTOR]\n" if ($DBUG <= 4);
            print "Titulo:$disc[$TITULO]\n" if ($DBUG <= 4);
            print "Ext.:  $disc[$EXTD]\n" if ($DBUG <= 4);
            print "Tracks:\n" if ($DBUG <= 4);
            foreach my $i (0..$max_ind) {
                print "\t$disc[$TROLA][$i]:$disc[$TREX][$i]:$disc[$DURS][$i]"
                    . "($disc[$MSDURS][$i])\n" if ($DBUG <= 4);
                $tfrm += $disc[$TTIM][$i][$TFRM];
                $tseg += $disc[$TTIM][$i][$TSEG];
                $tmin += $disc[$TTIM][$i][$TMIN];
                $thor += $disc[$TTIM][$i][$THOR];
                $disc[$TTOT][$TFRM] = $tfrm % 75;
                $carry = ($tfrm  - $disc[$TTOT][$TFRM]) / 75;
                $disc[$TTOT][$TSEG] = ($tseg + $carry) % 60;
                $carry = ($tseg + $carry - $disc[$TTOT][$TSEG]) / 60;
                $disc[$TTOT][$TMIN] = ($tmin + $carry) % 60;
                print "........................................."
                    . "tmin:$tmin:carry:$carry\n" if ($DBUG <= 4);
                $carry = ($tmin + $carry - $disc[$TTOT][$TMIN]) / 60;
                $disc[$TTOT][$THOR] = $thor + $carry;
            }
            $disc[$TTOT][$TTTO] = sprintf ("%02d:%02d:%02d.%02d",
                    $disc[$TTOT][$THOR], $disc[$TTOT][$TMIN],
                    $disc[$TTOT][$TSEG], $disc[$TTOT][$TFRM]);
            &mete_disco();
            print "=" x 78, "\n";
        }
    }
    close (DATA);
}

sub dame_seq {
    $manda = "select nextval(\'seqdis\')";
    $result = $conn->exec($manda);
    $stat   = $result->resultStatus;
    cmp_eq("jalando sequencia", PGRES_TUPLES_OK, $result->resultStatus);
    cmp_ne("OID status",0, $result->oidStatus);
    $leseq = $result->fetchrow;
    if ($GranError == 1) {
        $GranError = 0;
        print ELOG "$manda ($.)\n" if ($LOGGING);
        print ILOG "dame_seq:$manda --> [$leseq]\n";
    }
    return $leseq;
}

sub inserta_id {
    local ($id, $seq) = @_;
    print STDERR "Insertando: $id\n";
    $manda = "insert into ids values (\'$id\', $seq)";
    $result = $conn->exec($manda);
    $stat   = $result->resultStatus;
    # print LOG "$stat\n" if ($LOGGING);
    cmp_eq("insertando $id:$seq",PGRES_COMMAND_OK, $result->resultStatus);
    cmp_ne("OID status",0, $result->oidStatus);
    if ($GranError == 1) {
        $GranError = 0;
        print ELOG "$manda ($.)\n" if ($LOGGING);
        print ILOG "inserta_id:$manda\n";
    }
}

sub busca_id {
    local ($id) = @_;
    $manda = "select discid from ids where discid = '$id'";
    $result = $conn->exec($manda);
    $stat   = $result->resultStatus;
    cmp_eq("Buscando $id", PGRES_COMMAND_OK, $result->resultStatus);
    cmp_ne("OID status", 0, $result->oidStatus);
    if ($GranError == 1) {
        $GranError = 0;
        print ELOG "$manda ($.)\n" if ($LOGGING);
    }
    return $result->ntuples;
}

sub mete_disco {
    $seq = &dame_seq ();
    @dd = split /,/, $disc[$DISCID][0];
    foreach my $id (@dd) {
        &inserta_id ($id, $seq);
    }
    $numrolas = $max_ind + 1;
    $disc[$AUTOR]  =~ s/\'/\\\'/g;
    $disc[$AUTOR]  =~ s/\"/\\\"/g;
    $disc[$TITULO] =~ s/\'/\\\'/g;
    $disc[$TITULO] =~ s/\"/\\\"/g;
    $disc[$EXTD]   =~ s/\\/\\\\/g;
    $disc[$EXTD]   =~ s/\'/\\\'/g;
    $disc[$EXTD]   =~ s/\"/\\\"/g;
    foreach my $i (0..$max_ind) {
        $disc[$TROLA][$i] =~ s/\'/\\\'/g;
        $disc[$TROLA][$i] =~ s/\"/\\\"/g;
        $disc[$TREX][$i]  =~ s/\\/\\\\/g;
        $disc[$TREX][$i]  =~ s/\'/\\\'/g;
        $disc[$TREX][$i]  =~ s/\"/\\\"/g;
    }
    $values = "$seq, \'$disc[$TITULO]\', \'$disc[$AUTOR]\', \'$disc[$EXTD]\'"
        . ", $numrolas, \'$disc[$TTOT][$TTTO]\', $legenero";
    $manda = "insert into ndis values ($values)";
    $result = $conn->exec($manda);
    $stat   = $result->resultStatus;
    cmp_eq("insertando $disc[$AUTOR]:$disc[$TITULO]", PGRES_COMMAND_OK,
           $result->resultStatus);
    cmp_ne("OID status",0, $result->oidStatus);
    if ($GranError == 1) {
        $GranError = 0;
        print ELOG "$manda ($.)\n" if ($LOGGING);
        print ILOG "mete_disco:$manda\n";
    }
    foreach my $i (0..$max_ind) {
        &inserta_rola ($seq, ($i+1), $disc[$TROLA][$i], $disc[$MSDURS][$i],
                       $disc[$TREX][$i]);
    }
}

sub inserta_rola {
    local ($seq, $nrola, $tit, $dur, $ext) = @_;
    $values = "$seq, $nrola, \'$tit\', \'$dur\', \'$ext\'";
    $manda = "insert into rolas values ($values)";
    $result = $conn->exec($manda);
    $stat   = $result->resultStatus;
    cmp_eq("insertando $seq:$tit",PGRES_COMMAND_OK, $result->resultStatus);
    cmp_ne("OID status",0, $result->oidStatus);
    if ($GranError == 1) {
        $GranError = 0;
        print ELOG "$manda ($.)\n" if ($LOGGING);
        print ILOG "inserta_rola:$manda\n";
    }
}

sub inicializa {
    $dbmain    =  'mancha';
    $dbname    =  'pruebas';
    $tabname   =  'discos';
    $dbhost    =  'caserola';
    $trace     =  '/tmp/pgtrace.out';
    $cnt       =  2;
    $DEBUG     =  1; # set this to 1 for traces
    $errorlog  =  'log.inscddb.log';
    $ellog     =  '/tmp/inscddb.log';
    $logirrec  =  'irrecuperables.inscddb.log';
    $LOGGING   =  1;
    $GranError =  0;
    $DURS      =  0;
    $DISCID    =  1;
    $AUTOR     =  2;
    $TITULO    =  3;
    $NROL      =  4;
    $TROLA     =  5;
    $TREX      =  6;
    $EXTD      =  7;
    $MSDURS    =  8;
    $TTIM      =  9;
    $TTOT      = 10;
    $THOR      =  0;
    $TMIN      =  1;
    $TSEG      =  2;
    $TFRM      =  3;
    $TTTO      =  4;
    $SIG{PIPE} = sub { print "Se rompio la canieria\n!Llamen al plomero!\n\n" };
    open (LOG,  ">>$ellog")    || die "No puedo crear $ellog\n";
    open (ELOG, ">>$errorlog") || die "No puedo crear $errorlog\n";
    open (ILOG, ">>$logirrec") || die "No puedo crear $logirrec\n";
}

sub inidb {
    $conn = Pg::connectdb("dbname=$dbname host=$dbhost");
    cmp_eq("probando conexion", PGRES_CONNECTION_OK, ($estatus=$conn->status));
    if ($estatus != PGRES_CONNECTION_OK) {
        print STDERR "Error fatal en la conexion ($estatus), terminamos\n";
        exit (1);
    }
    if ($DEBUG) {
        open(TRACE, ">$trace") || die "can not open $trace: $!";
        $conn->trace(TRACE);
    }
    $db = $conn->db;
    cmp_eq("comparando bases", $dbname, $db);
    $user = $conn->user;
    cmp_ne("comparando usuarios", "", $user);
    $host = $conn->host;
    cmp_ne("comparando hosts", "", $host);
    $port = $conn->port;
    cmp_ne("comparando puertos", "", $port);
    $result = $conn->exec("SET DateStyle to 'ISO'");
    cmp_eq("fijando la fecha", $result->resultStatus, $result->resultStatus);
    if ($ini == 1) {
        &limpia_base ();
        &crea_base ();
    }
    $legenero = &busca_genero ($genero);
    print "El id para genero $genero es $legenero\n";
}

sub busca_genero {
    local $legenero;
    $manda = "select genid from genero where genero='$genero'";
    $result = $conn->exec($manda);
    $stat   = $result->resultStatus;
    cmp_eq("obteniendo $genero", PGRES_COMMAND_OK, $result->resultStatus);
    cmp_ne("OID status", 0, $result->oidStatus);
    if ($result->ntuples) { # ya existe, obtenlo
        $legenero = $result->fetchrow;
    } elsif ($GranError == 1) { # no existe, insertalo
        $GranError = 0;
        print ELOG "$manda ($.)\n" if ($LOGGING);
        print STDERR "Error al sacar el genero\n";
        $manda = "insert into genero (genero) values ('$genero')";
        $result = $conn->exec($manda);
        $stat   = $result->resultStatus;
        cmp_eq("insertando $genero",PGRES_COMMAND_OK, $result->resultStatus);
        cmp_ne("OID status",0, $result->oidStatus);
        $manda = "select genid from genero where genero='$genero'";
        $result = $conn->exec($manda);
        $stat   = $result->resultStatus;
        cmp_eq("obteniendo $genero",PGRES_COMMAND_OK, $result->resultStatus);
        cmp_ne("OID status",0, $result->oidStatus);
        $legenero = $result->fetchrow;
    }
    return $legenero;
}

sub cmp_eq {
    my $mns = shift;
    my $cmp = shift;
    my $ret = shift;
    my $msg;

    print ELOG "$mns: ";
    if ("$cmp" eq "$ret") {
        print ELOG "ok $cnt\n";
    } else {
        $msg = $conn->errorMessage;
        print ELOG "error $cnt: $cmp, $ret\n$msg\n";
        $GranError = 1;
    }
    $cnt++;
}

sub cmp_ne {
    my $mns = shift;
    my $cmp = shift;
    my $ret = shift;
    my $msg;

    print ELOG "$mns: ";
    if ("$cmp" ne "$ret") {
        print ELOG "ok $cnt\n";
    } else {
        $msg = $conn->errorMessage;
        print ELOG "error $cnt: $cmp, $ret\n$msg\n";
        $GranError = 1;
    }
    $cnt++;
}

sub limpia_base {
    $des[0]    = "DROP TABLE ids";
    $des[1]    = "DROP TABLE ndis";
    $des[2]    = "DROP TABLE rolas";
    $des[3]    = "DROP INDEX xautor";
    $des[4]    = "DROP INDEX xtitulo";
    $des[5]    = "DROP SEQUENCE seqdis";
    $des[6]    = "DROP SEQUENCE genero_genid_seq";
    $des[7]    = "DROP INDEX genero_genid_key";
    $des[8]    = "DROP TABLE genero";
    $Max_Tab   = 8;
    foreach my $i (0..$Max_Tab) {
        print "Actuando $i:";
        print "\tDestruir: $des[$i]\n";
            if (defined $des[$i]) {     
                $result = $conn->exec($des[$i]);
                cmp_eq("destruyendo la tabla",PGRES_COMMAND_OK, $result->resultStatus);
                cmp_eq("redestruyendo la tabla","DROP", $result->cmdStatus);
            }
    }
}

sub crea_base {
    $tab[0]    = "CREATE TABLE ids (discid CHAR(8) NOT NULL, discseq INT4 NOT NULL)";
    $tab[1]    = "CREATE TABLE ndis (discseq INT4 NOT NULL, titulo TEXT, "
        . "autor TEXT, extdisc TEXT, numrolas INT2, durdisc TIME, genid INT4 NOT NULL)";
    $tab[2]    = "CREATE TABLE rolas (discseq INT4 NOT NULL, nrola int4, "
        . "rolatit TEXT, roladur TIME, rolaext TEXT)";
    $tab[3]    = "CREATE INDEX xautor on ndis using btree (autor text_ops)";
    $tab[4]    = "CREATE INDEX xtitulo on ndis using btree (titulo text_ops)";
    $tab[5]    = "CREATE SEQUENCE seqdis";
    $tab[6]    = "CREATE TABLE genero (genid serial, genero varchar(32))";
    $Max_Tab   = 6;
    foreach my $i (0..$Max_Tab) {
        print "Actuando $i:";
        print "\tConstruir: $tab[$i]\n";
        if (defined $tab[$i]) {
            $result = $conn->exec("$tab[$i]");
            cmp_eq("creando la tabla",PGRES_COMMAND_OK, $result->resultStatus);
            cmp_eq("recreando la tabla","CREATE", $result->cmdStatus);
        }
    }
}

En este otro ejemplo, hacemos un CGI que realiza consultas sobre una base de datos en PostgreSQL.

#!/usr/bin/perl

use Pg;
use CGI;

$DBUG=1001;

$cgi = new CGI;
&inicializa ();
&forma ();
&consulta ();

sub forma {
    print $cgi->header, "\n";
    print $cgi->start_html(-title => 'Consulta a la base de discos',
                           -author => 'mancha@caserola.mancha.baras.net',
                           -base => 'true',
                           -expires => 'now'),"\n";
    print $cgi->h1('Consulta a la base de datos de discos');
    print $cgi->startform;
    print "Seleccione algún campo de la forma";
    print "<P>Artista: ";
    print $cgi->scrolling_list(-name => 'autor',
                               -values => ['Indiferente', @lesartistes],
                               -size => 5,
                               -default => 'Indiferente');
    print "<P>Título: ";
    print $cgi->scrolling_list(-name => 'titulo',
                               -values => ['Indiferente', @lestitres],
                               -size => 5,
                               -default => 'Indiferente');
    print "<P>";
    print $cgi->submit('Action','Consultar');
    print $cgi->end_form;
    print $cgi->hr, "\n";
    print $cgi->end_html;
}

sub by_number {
    $a <=> $b;
} 

sub consulta {
    foreach my $key ($cgi->param) {
        print "[[$key]=>" if ($DBUG == 23);
        @valores = $cgi->param($key);
        print "[", join(' ', @valores), "]]<BR>" if ($DBUG == 23);
        $cosa = join (' ', @valores);
        $consulta{$key} = $cosa
            if (length $cosa && $cosa ne 'Indiferente' && $key ne 'Action');
    }
    print "Buscaremos por:<BR>" if ($DBUG == 23);
    foreach my $k (keys %consulta) {
        print "$k ==> [$consulta{$k}]<BR>" if ($DBUG == 23);
        push (@cbus, "$k ~~ \'%$consulta{$k}%\'");
    }
    $manda  = 'SELECT *,oid FROM discos WHERE ' . join (' AND ', @cbus);
    $manda .=  ' order by autor,titulo';
    print STDERR "query: [$manda]\n";
    print "query: $manda<BR>" if ($DBUG == 23);
    print LOG "$manda\n";
    &presenta ($manda);
}

sub presenta {
    local ($query) = @_;
    print "en presenta enviaremos: $query<BR>" if ($DBUG == 23);
    $result = $conn->exec($query);
    cmp_eq("consultando $tabname", PGRES_COMMAND_OK, $result->resultStatus);
    cmp_eq("Status $tabname", PGRES_TUPLES_OK, $result->cmdStatus);
    my $i = 0;
    while (@renglon = $result->fetchrow) {
        @{$renglones[$i]} = @renglon;
        $i++;
    }
    $tot   = --$i;
    $total = $tot + 1;
    print $cgi->hr;
    print "<H1>Recibimos un total de $total registro",
        ($total == 1) ? "" : "s","</H1>";
    print $cgi->hr;
    print "Recibimos un total de $tot registros<BR>" if ($DBUG == 23);
    if ($forma1) {
        foreach my $i (0..$tot) {
            print "<TABLE BORDER=2>";
            print "<TR><TD><B>Autor</B></TD>";
            print "<TD>@{$renglones[$i]}[0]</TD></TR>\n";
            print "<TR><TD><B>Titulo</B></TD>";
            print "<TD>@{$renglones[$i]}[1]</TD></TR>\n";
            print "<TR><TD><B>NDis</B></TD>";
            print "<TD>@{$renglones[$i]}[2]</TD></TR>\n";
            print "<TR><TD><B>Medio</B></TD>";
            print "<TD>@{$renglones[$i]}[3]</TD></TR>\n";
            print "</TABLE>";
            print $cgi->hr;
        }
    } else {
        print "<TABLE BORDER=2><TR>";
        print "<TD><B>Autor</B></TD>";
        print "<TD><B>Título</B></TD>";
        print "<TD><B>NDis</B></TD>";
        print "<TD><B>Medio</B></TD></TR>";
        foreach my $i (0..$tot) {
            print "<TR><TD>@{$renglones[$i]}[0]</TD>";
            print "<TD>@{$renglones[$i]}[1]</TD>";
            print "<TD>@{$renglones[$i]}[2]</TD>";
            print "<TD>@{$renglones[$i]}[3]</TD></TR>";
        }
        print "</TABLE>";
    }
    close (LOG);
}

sub inicializa {
    $dbname  = 'discos';
    $dbhost  = 'caserola';
    $tabname = 'discos';
    $ellog   = '/tmp/consultas.discos';
    chomp ($soy = `whoami`);
    chomp ($estoy = `hostname`);
    $cnt     = 1;
    print "Yo soy: [$soy]\ny estoy en la maquina: [$estoy]<P>"
        if ($DBUG == 23);
    $conn = Pg::connectdb("dbname=$dbname host=$dbhost");
    cmp_eq("<P>probando conexion", PGRES_CONNECTION_OK, $conn->status);
    $db = $conn->db;
    cmp_eq("<P>comparando bases", $dbname, $db);
    $user = $conn->user;
    cmp_ne("<P>comparando usuarios", "", $user);
    $host = $conn->host;
    cmp_ne("<P>comparando hosts", "", $host);
    $port = $conn->port;
    cmp_ne("<P>comparando puertos", "", $port);
    $result = $conn->exec("SET DateStyle to \'Postgres\'");
    cmp_eq("<P>fijando la fecha", $result->resultStatus,
           $result->resultStatus);
    $manda = "select distinct on autor autor from discos";
    print "<P>enviaremos: $manda\n" if ($DBUG > 0);
    $result = $conn->exec($manda);
    cmp_eq("<P>consultando $tabname", PGRES_COMMAND_OK,
           $result->resultStatus);
    cmp_eq("<P>Status $tabname", PGRES_TUPLES_OK, $result->cmdStatus);
    $cuantos = $result->ntuples;
    print "<P>obtuvimos $cuantos autores\n" if ($DBUG > 0);
    while ($aux = $result->fetchrow) {
        print "<P>($aux)" if ($DBUG > 101);
        push (@autores, $aux);
    }
    @lesartistes = sort @autores;
    $manda = "select distinct on titulo titulo from discos";
    print "<P>enviaremos: $manda\n" if ($DBUG > 0);
    $result = $conn->exec($manda);
    cmp_eq("<P>consultando $tabname", PGRES_COMMAND_OK,
           $result->resultStatus);
    cmp_eq("<P>Status $tabname", PGRES_TUPLES_OK, $result->cmdStatus);
    $cuantos = $result->ntuples;
    print "<P>obtuvimos $cuantos titulos\n" if ($DBUG > 0);
    while ($aux = $result->fetchrow) {
        push (@titulos,$aux);
    }
    @lestitres = sort @titulos;
    open(LOG, ">>$ellog") || die "No puedo escribir en $ellog";
}

sub cmp_eq {
    my $mns = shift;
    my $cmp = shift;
    my $ret = shift;
    my $msg;

    print "<P>$mns: " if ($DBUG > 23);
    if ("$cmp" eq "$ret") {
        print "<P>ok $cnt\n" if ($DBUG > 23);
    } else {
        $msg = $conn->errorMessage;
        print "<P>error $cnt: $cmp, $ret\n$msg\n" if ($DBUG > 23);
        $GranError = 1;
    }
    $cnt++;
}

sub cmp_ne {
    my $mns = shift;
    my $cmp = shift;
    my $ret = shift;
    my $msg;

    print "<P>$mns: " if ($DBUG > 23);
    if ("$cmp" ne "$ret") {
        print "<P>ok $cnt\n" if ($DBUG > 23);
    } else {
        $msg = $conn->errorMessage;
        print "<P>error $cnt: $cmp, $ret\n$msg\n" if ($DBUG > 23);
        $GranError = 1;
    }
    $cnt++;
}