• Publicidad

Base de datos

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

Base de datos

Notapor primitivo » 2013-07-20 18:30 @812

Tengo un problema con esta base de datos.

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. if ( database( "nicks", "nicks.db", "$nickR" ) ) {
  2.  
  3.     screen(qq($BOTS{"nick"} P $UserDest :Ese nick ya se encuentra registrado, Por favor escoja otro.\n));
  4.     screen(qq($BOTS{"nick"} P $UserDest :Por ejemplo '$nickR$options' -> $aa[0]\n));
  5. }
  6. else { &make_nick( "$nickR", "nicks.db", "nicks" ); }
  7.  
  8. sub make_nick {
  9.     my ( $regadd, $data, $dir ) = ( shift, shift, shift );
  10.     my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time);
  11.     $year += 1900;
  12.     $mon++;
  13.     my $ipParse   = $IPS{$UserDest};
  14.     my $DateMonth = $mday || $mon || $year;
  15.     my $DateHours = $hour || $min || $sec;
  16.     my $email_log = $mail;
  17.     my $passwd    = $tea;
  18.     my $statereg  = "REGISTRADO";
  19.  
  20.     #Creando el registro del usuario.
  21.     &insert_data( "$regadd", "$data", "$dir", "$DateMonth", "$DateHours", "$email_log", "$statereg", "$ipParse" );
  22. }
  23.  
  24. sub database {
  25.     my ( $dir, $data, $valor ) = ( shift, shift, shift );
  26.     my $FILE_HANDLE = "system/database/$dir/$data";
  27.     my $co;
  28.     open( data, $FILE_HANDLE );
  29.     while (<data>) {
  30.         $co++;
  31.         my $a = $_;
  32.         chop($a);
  33.         my @aa = split( /:/, $a );
  34.         if ( $valor =~ $aa[0] ) {
  35.             return "$aa[0]";
  36.             print "$aa[0] -> $a";
  37.         }
  38.     }
  39.     close(data);
  40. }
  41.  
  42. sub insert_data {
  43.  
  44.     my ( $first, $second, $third, $Month, $Hour, $Mails, $State, $Ipc )
  45.         = ( shift, shift, shift, shift, shift, shift, shift );
  46.     open( datatt, ">>system/database/$third/$second" );
  47.     print datatt "$first:$Month:$Hour:$Mails:$State:$Ipc\r\n";
  48.     close(datatt);
  49. }
  50.  
Coloreado en 0.003 segundos, usando GeSHi 1.0.8.4

La función database me devuelve 1, en vez del valor que le mando a buscar en el archivo nicks.db. ¿Por qué, si le doy return() y le indico que debe devolver el valor que encuentra siempre y cuando se encuentre?

El archivo nicks.db tendría el contenido, por ejemplo:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
pepe:fecha:hora:correo:estado-registro:ip
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

Posteriormente, separo la cadena de los ':' y comparo, pero me da el error que les comenté antes.

¿Qué puedo hacer?
Última edición por explorer el 2013-07-20 19:44 @864, editado 1 vez en total
Razón: Formateado de código con Perltidy
primitivo
Perlero nuevo
Perlero nuevo
 
Mensajes: 80
Registrado: 2013-03-22 23:05 @004

Publicidad

Re: Base de datos

Notapor explorer » 2013-07-20 20:28 @894

El '1' que obtienes, es el del close() de la línea 39.

En Perl, el resultado de una función siempre es el de la última sentencia ejecutada dentro de esa función, salvo cuando usamos un return().

En tu caso, la condición de la línea 34 nunca se cumple: has intentado poner una expresión regular para comparar si el $valor que estamos buscando coincide con el primer campo de la línea, pero se te ha olvidado poner los delimitadores al patrón $aa[0]. Debería ser if ($valor =~ /$aa[0]/).

Pero... no es eso lo que necesitas. Estás queriendo buscando coincidencias plenas. Debes usar el operador de igualdad de cadenas de caracteres 'eq' para saber si el $valor es igual a $aa[0].

Hay otros detalles en el código, que quiero comentarte. El código, más reducido, queda así:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. if (database('nicks', 'nicks.db', $nickR)) {
  2.     screen(qq($BOTS{"nick"} P $UserDest :Ese nick ya se encuentra registrado, Por favor escoja otro.\n));
  3.     screen(qq($BOTS{"nick"} P $UserDest :Por ejemplo '$nickR$options'\n));
  4. }
  5. else {
  6.     make_nick($nickR, 'nicks.db', 'nicks');
  7. }
  8.  
  9. sub make_nick {
  10.     my ($regadd, $data, $dir) = @_;
  11.  
  12.     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time);
  13.     $year += 1900;
  14.     $mon++;
  15.  
  16.     # Creando el registro del usuario
  17.     insert_data($regadd, $data, $dir, "$mday/$mon/$year", "$hour:$min:$sec", $mail, 'REGISTRADO', $IPS{$UserDest});
  18. }
  19.  
  20. sub database {
  21.     my ($dir, $data, $valor) = @_;
  22.  
  23.     open(my $DATA, "<system/database/$dir/$data");
  24.     while (my $a = <$DATA>) {
  25.         chomp $a;
  26.  
  27.         my @aa = split(/:/, $a);
  28.  
  29.         if ( $valor eq $aa[0] ) {
  30.             print "$aa[0] -> $a\n";
  31.             return 1;
  32.         }
  33.     }
  34.     close($DATA);
  35.    
  36.     return 0;
  37. }
  38.  
  39. sub insert_data {
  40.     my ( $first, $second, $third, $Month, $Hour, $Mails, $State, $Ipc ) = @_;
  41.  
  42.     open( datatt, ">>system/database/$third/$second" );
  43.     print datatt "$first:$Month:$Hour:$Mails:$State:$Ipc\r\n";
  44.     close(datatt);
  45. }
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4
Estos son los cambios fundamentales:
  • no es necesario poner una variable entre comillas dobles si entre las comillas dobles no hay nada más que esa variable. Por ejemplo, tu pones "$nickR" en la primera línea, cuando realmente no se necesitan las comillas. Ponerlas, hace tu programa más lento de ejecutar, y más largo de escribir
  • para recuperar los argumentos pasados a una función, usamos normalmente el shift(), que lo que hace es sacar los argumentos desde el array especial @_. El caso es que para uno o dos argumentos está bien, pero, para el caso de insert_data(), repetir shift ocho veces... pues es muy cansado. Mejor es asignar @_ a la lista de variables locales indicadas por my(), como ves en mi versión
  • no es necesario llamar a las subrutinas con el sigilo '&' delante de ellas. Por favor: nuestro lenguaje es lo suficientemente peludo como para encima ponerle más pelo (modismo inglés)
  • no entiendo por qué usas el operador or-lógico '||' para componer la fecha y la hora. He considerado que es más lógico usar comillas dobles para componer los dos valores
  • hay variables que sobran porque nunca son conocidas fuera de su contexto de definición: $co y $passwd. En la primera parte, en la línea 4, imprimes el valor de $aa[0], pero resulta que ese array es local a la función database(), así que cuando sales de la función, @aa ya ha desaparecido, por lo que no puedes saber el valor de $aa[0]. Estos errores te los puede avisar Perl, antes, si usases 'use strict;' al principio del programa
  • el gestor de archivo se transforma en $DATA, una variable local, por una razón: en caso de que la subrutina saliese por el return del interior del bucle, no se ejecutaría el close() del final, por lo que quedaría el archivo abierto. No es importante, pero si tu programa va a estar mucho tiempo funcionando, eso se transforma en un recurso ocupado en la memoria y del propio sistema operativo (cachés y búferes ocupados), y esos tienen un determinado límite. Si se llega al límite, el programa puede llegar a ser parado. Al ponerlo en forma de variable local, garantizamos que, al salir de la subrutina, el archivo siempre es cerrado. Otra forma más cómoda de hacerlo:
    Sintáxis: [ Descargar ] [ Ocultar ]
    Using perl Syntax Highlighting
    1.     my $encontrado = 0;
    2.     open(my $DATA, "<system/database/$dir/$data");
    3.     while (<$DATA>) {                   # la línea se guarda en $_
    4.                                         # no es necesario el chomp, porque solo nos interesa el primer campo
    5.         my $campo1 = (split /:/)[0];    # el split() nos devuelve una lista de elementos, y solo nos quedamos con el primero
    6.  
    7.         if ( $valor eq $campo1 ) {      # si es el que buscamos...
    8.             print "$_\n";               # informamos
    9.             $encontrado = 1;            # marcamos la bandera
    10.             last;                       # y terminamos el bucle
    11.         }
    12.     }
    13.     close($DATA);
    14.     return $encontrado;
    Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
  • en la línea 47 tienes puesto un "\r\n", lo cual... es curioso... ¿no querrás usar solo un "\n"? El usar "\r\n" es solo para el caso de que quieras guardar tu base de datos para formato MSDOS/Windows. Te podría dar problemas en otros sistemas. Recuerda que cuando pones "\n", Perl usará el carácter o caracteres de nueva línea del sistema operativo en que te encuentres.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Re: Base de datos

Notapor primitivo » 2013-07-21 22:11 @965

Muchas gracias, explorer.

Haré las correcciones sugeridas y te comento.
primitivo
Perlero nuevo
Perlero nuevo
 
Mensajes: 80
Registrado: 2013-03-22 23:05 @004


Volver a Básico

¿Quién está conectado?

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