• Publicidad

Problema de bucle RESUELTO

¿Apenas comienzas con Perl? En este foro podrás encontrar y hacer preguntas básicas de Perl con respuestas aptas a tu nivel.

Problema de bucle RESUELTO

Notapor Antala » 2010-08-03 04:08 @214

Hola, buenos días:

Este es mi primer post, llevo una semana con Perl y ando un poco perdidillo, a ver si podéis ayudarme con este script que estoy haciendo.

En él tengo que recorrer las tablas tpersonas y tproyectos y que me busque los nombres que sean iguales en dichas tablas, y que los id me los guarde en otra llamada tproyper.

El problema que tengo es el siguiente: el bucle me saca siempre la misma persona siendo que hay bastantes más.

Os pongo aquí el script.

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/perl
  2. use Pg;
  3. #Conexión a la base de dato local
  4. $conn=Pg::connectdb("dbname=dbproy");
  5. if ($conn->status!=PGRES_CONNECTION_OK){
  6.         print  "Conexion erronea al conertar con base de datos.\n";
  7.         print  "No se ha podido establecer conexion con base de datos, intentelo de nuevo.";
  8.         exit;
  9.                                         }
  10. #Selección de la tabla de datos a modificar
  11. $result=$conn->exec("select id, nombre_
  12.                     from tpersonas order by id");
  13. $n_personas=$result->ntuples;
  14. for($a=0;$a<$n_personas;$a++){
  15.         $id_personas[$a]=trunca_final($result->getvalue($a,0));
  16.         $nombre_personas[$a]=trunca_final($result->getvalue($a,1));
  17.                                 }
  18.  
  19. $result1=$conn->exec("select id, investigadorpral
  20.                     from  tproyectos order by id");
  21. $n_tproyectos=$result1->ntuples;
  22. for($a=0;$a<$n_tproyectos;$a++){
  23.         $id_id[$a]=trunca_final($result1->getvalue($a,0));
  24.         $nombre_investigadorpral[$a]=trunca_final($result1->getvalue($a,1));
  25.                                 }
  26.         #Hay que relacionar las tablas tpersonas y tproyectos en la tabla tproyper
  27.  
  28. while(){
  29.         for($a=0;$a<$n_personas;$a++){
  30.  
  31.         if($nombre_personas[$a] eq $nombre_investigadorpral[$a1]){
  32.  
  33.         print "Nombre $nombre_personas[$a]\t Nombre $nombre_investigadorpral[$a1]\n";  
  34.         print "Id $id_personas[$a] \t Id $id_id[$a1]\n";
  35.        
  36.         $orden="INSERT INTO tproyper (idproy, idper) VALUES ($id_id[$a1], $id_personas[$a])";
  37.         $result = $conn->exec($orden);
  38.  
  39.         stop(); #Esto esta mal es solo para salir del bucle infinito                                   
  40.                                                                  }#cerrar for
  41.                                         }#cerrar if
  42.         }#cerrar while
  43.  
  44. sub trunca_final ($)
  45. {
  46.     my ($p) = @_;
  47.     $p =~ /(.+?)(\ *)$/;
  48.     return $1;
  49. }
  50.  
Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4


Un saludo y muchas gracias.
Sintáxis: [ Descargar ] [ Ocultar ]
Using html4strict Syntax Highlighting
  1. [syntax lang=html4strict lines=geshi-n]<span style="font-weight: bold">[b]</span>[/b][/syntax]
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
Última edición por Antala el 2010-08-03 04:52 @245, editado 1 vez en total
Antala
Perlero nuevo
Perlero nuevo
 
Mensajes: 3
Registrado: 2010-08-02 02:13 @134
Ubicación: Zaragoza

Publicidad

Re: Problema de bucle

Notapor explorer » 2010-08-03 04:33 @231

Bienvenido a los foros de Perl en Español, Antala.

Yo veo varios problemas...

* ¿dónde se inicializa e incrementa la variable $a1? necesitas hacer un doble bucle for() para hacer la comparación, no un while()

* stop() no es ninguna función de Perl.


Te aconsejo que, mientras estés aprendiendo Perl (y más tarde, también), inicies todos tus programas con las líneas

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
use strict;
use warnings;
use diagnostics;
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


La primera línea te obligará a escribir un programa de forma estricta: todas las variables que vayas a usar deberán haber sido declaradas con my() u our(). Perl te hubiera avisado de la existencia de una variable $a1 sin declarar.

La segunda línea sirve para que Perl te avise de cualquier cosa rara que vea, en el código. Te hubiera avisado de que la variable $a1 no se inicializado nunca.

La tercera es opcional. Sirve para dar aún más información en las advertencias y errores que tenga tu programa.

Sería algo así (no probado):
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use diagnostics;
  5.  
  6. use Pg;
  7.  
  8. #Conexión a la base de datos local
  9. my $conn = Pg::connectdb('dbname=dbproy');
  10.  
  11. if ($conn->status != PGRES_CONNECTION_OK) {
  12.     print "Conexión errónea al conectar con base de datos.\n";
  13.     print "No se ha podido establecer conexión con base de datos, inténtelo de nuevo.";
  14.     exit 1;
  15. }
  16.  
  17. #Selección de la tabla de datos a modificar
  18. my $result = $conn->exec("select id, nombre_ from tpersonas order by id");
  19. my $n_personas = $result->ntuples;
  20.  
  21. my @id_personas;
  22. my @nombre_personas;
  23.  
  24. for(my $a = 0; $a < $n_personas; $a++) {
  25.     $id_personas[$a]     = trunca_final($result->getvalue($a,0));
  26.     $nombre_personas[$a] = trunca_final($result->getvalue($a,1));
  27. }
  28.  
  29. my $result1 = $conn->exec("select id, investigadorpral from  tproyectos order by id");
  30. my $n_tproyectos = $result1->ntuples;
  31.  
  32. my @id_id;
  33. my @nombre_investigadorpral;
  34.  
  35. for(my $b = 0; $b < $n_tproyectos; $b++) {
  36.     $id_id[$b]                   = trunca_final($result1->getvalue($b,0));
  37.     $nombre_investigadorpral[$b] = trunca_final($result1->getvalue($b,1));
  38. }
  39.  
  40. #Hay que relacionar las tablas tpersonas y tproyectos en la tabla tproyper
  41. for(my $a = 0; $a < $n_personas;   $a++) {
  42. for(my $b = 0; $b < $n_tproyectos; $b++) {
  43.  
  44.     if ($nombre_personas[$a] eq $nombre_investigadorpral[$b]) {
  45.  
  46.         print "Nombre $nombre_personas[$a]\t Nombre $nombre_investigadorpral[$b]\n";
  47.         print "Id $id_personas[$a] \t Id $id_id[$b]\n";
  48.  
  49.         my $orden  = "INSERT INTO tproyper (idproy, idper) VALUES ($id_id[$b], $id_personas[$a])";
  50.         my $result = $conn->exec($orden);
  51.     }
  52.  
  53. }#cerrar for
  54. }#cerrar for
  55.  
  56. sub trunca_final {
  57.     my($p) = shift;
  58.     $p =~ /(.+?) *$/;
  59.     return $1;
  60. }
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4

Este, también, es un buen ejemplo de aplicación de los hash de Perl.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14486
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Re: Problema de bucle

Notapor Antala » 2010-08-03 04:51 @243

Muchas gracias, explorer. Funcionando 100%.

Te estoy agradecido. Seguiré ese consejo de utilizar los use, y si tengo alguna duda me dejaré caer por aquí.

Un saludo.
Antala
Perlero nuevo
Perlero nuevo
 
Mensajes: 3
Registrado: 2010-08-02 02:13 @134
Ubicación: Zaragoza

Re: Problema de bucle RESUELTO

Notapor explorer » 2010-08-03 05:51 @285

Esta es otra versión, usando hash:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use diagnostics;
  5.  
  6. use Pg;
  7.  
  8. #Conexión a la base de datos local
  9. my $conn = Pg::connectdb('dbname=dbproy');
  10.  
  11. if ($conn->status != PGRES_CONNECTION_OK) {
  12.     print "Conexión errónea al conectar con base de datos.\n";
  13.     print "No se ha podido establecer conexión con base de datos, inténtelo de nuevo.";
  14.     exit 1;
  15. }
  16.  
  17. #Selección de la tabla de datos a modificar
  18. my $result = $conn->exec("select id, nombre_ from tpersonas order by id");
  19. my $n_personas = $result->ntuples;
  20.  
  21. my %id_personas;
  22.  
  23. for(my $a = 0; $a < $n_personas; $a++) {
  24.     my $id     = trunca_final($result->getvalue($a,0));
  25.     my $nombre = trunca_final($result->getvalue($a,1));
  26.  
  27.     $id_personas{nombre} = $id;                 # guardamos id de la persona
  28. }
  29.  
  30. my $result1 = $conn->exec("select id, investigadorpral from  tproyectos order by id");
  31. my $n_tproyectos = $result1->ntuples;
  32.  
  33. my %id_investigadores;
  34.  
  35. for(my $b = 0; $b < $n_tproyectos; $b++) {
  36.     my $id     = trunca_final($result1->getvalue($b,0));
  37.     my $nombre = trunca_final($result1->getvalue($b,1));
  38.  
  39.     $id_investigadores{$nombre} = $id;          # guardamos id del investigador
  40. }
  41.  
  42. # Fichero de registro
  43. open my $REGISTRO, q[>>], 'actividad.log'
  44.     or  die "ERROR: No puedo escribir en el log: $!\n";
  45.  
  46. #Hay que relacionar las tablas tpersonas y tproyectos en la tabla tproyper
  47. for my $persona (keys %id_personas) {
  48.  
  49.     if ($id_investigadores{$persona}) {  # Sí que hay una persona que es a la vez investigador
  50.  
  51.         print "Nombre: [$persona]\n";
  52.         print "Id Persona: $id_personas{$persona}\tId Proyecto: $id_investigadores{$persona}\n";
  53.  
  54.         my $orden  = "INSERT INTO tproyper (idproy, idper) VALUES ($id_investigadores{$persona}, $id_personas{$persona})";
  55.         my $result = $conn->exec($orden);
  56.     }
  57.     else {
  58.         print $REGISTRO "[$persona] no está en ningún proyecto de investigación\n";
  59.     }
  60. }
  61.  
  62. close $REGISTRO;
  63.  
  64. sub trunca_final {
  65.     $_[0] =~ s/ *$//;   # quitamos los espacios en blanco del final, del primer argumento
  66. }
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14486
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Re: Problema de bucle RESUELTO

Notapor Antala » 2010-08-04 02:48 @158

Buenos días, hoy me ha surgido otra dudilla: en el programa que ya funciona bien, necesito hacer que los que no sean igual me los redireccione a un archivo.log y eso no lo he hecho nunca.

Imagino que para los que no son iguales es otro if() más o menos así:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
 if ($nombre_personas[$a] != $nombre_investigadorpral[$b]) {
              print "Nombre $nombre_personas[$a]\t Nombre $nombre_investigadorpral[$b]\n";
              print "Id $id_personas[$a] \t Id $id_id[$b]\n";
          }
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


E iría después del otro if(), ¿no? La cuestión es: ¿cómo hago para que sacarlo en un archivo.log?

Un saludo.
Antala
Perlero nuevo
Perlero nuevo
 
Mensajes: 3
Registrado: 2010-08-02 02:13 @134
Ubicación: Zaragoza

Re: Problema de bucle RESUELTO

Notapor explorer » 2010-08-04 05:21 @264

Un fichero log podría ser tan sencillo como un fichero de texto, así que solo tienes que hacer un open() antes del bucle principal, luego, los print() que quieras hacer, dentro del bucle, y finalmente, un close().

Y para diferenciar entre los que son distintos, te vale con usar un else{}.

Solo puedes usar != si estás seguro de que los ID son siempre numéricos. Mejor, en este caso, usar el else{}.

El código anterior ya está modificado con estos cambios.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14486
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España


Volver a Básico

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 2 invitados

cron