• Publicidad

Archivos binarios: lectura, escritura

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

Archivos binarios: lectura, escritura

Notapor primitivo » 2017-09-23 22:27 @977

Tengo el siguiente script. Lee un archivo llamado 'log.log' y extrae datos según se cumpla la regex.

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. use Fcntl;
  2. use bytes;
  3.  
  4. my $ruta = qw(/home/USER/);
  5.  
  6. my $archivo = "log.log";
  7.  
  8. my $regex_joinfile = '^\\[(.*)\\](\\s+)\\[(.*)\\](\\s+)Join(\\s+)(.*)(\\s+)\\((.*)@(.*)\\)(.*)$';
  9.  
  10. my $match = 0;
  11.  
  12. my $regs = 0;
  13.  
  14. open my $p, sprintf("<%s/%s", $ruta, $archivo);
  15.  
  16. open my $q, sprintf(">%s/%s", $ruta, "index.bin");
  17.  
  18. binmode $q;
  19.  
  20. my %hash_ips;
  21.  
  22.  
  23. while (<$p>)
  24. {
  25.         chomp $p;
  26.  
  27.         if ($_ =~ $regex_joinfile)
  28.         {
  29.                 my $seekpoint = toId($9);
  30.  
  31.                 seek $q, ($seekpoint * 32), SEEK_SET;
  32.  
  33.                 if (defined($hash_ips{$9}))
  34.                 {
  35.                         $hash_ips{$9} = $hash_ips{$9} + 1;
  36.                 } else {
  37.                         $hash_ips{$9} = 1;
  38.                         $regs++;
  39.                 }
  40.  
  41.                 print $q $9;
  42.  
  43.                 $match++;
  44.         }
  45. }
  46.  
  47. close($p);
  48. close($q);
  49.  
  50. sub toId {
  51.         my($v) = (shift);
  52.  
  53.         my @toks = split(//, $v);
  54.  
  55.         my $id;
  56.  
  57.         for(my $chr = 0; $chr < scalar(@toks); $chr++)
  58.         {
  59.  
  60.                 $id += ord($toks[$chr]);
  61.        
  62.         }
  63.  
  64.         return $id
  65. }
  66.  
  67. my $diff = $match - $regs;
  68.  
  69. print "Fin del archivo $ruta, coincidencias $match veces. registros $regs adicionados, ignorados $diff ips\n";
  70.  
Coloreado en 0.003 segundos, usando GeSHi 1.0.8.4


Luego, este otro para buscar un registro específico en el archivo 'index.bin' ya generado:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. use Fcntl;
  2. use bytes;
  3. my $ruta = qw(/home/USER/);
  4.  
  5. my $archivo = "log.log";
  6.  
  7. my $regex_joinfile = '^\\[(.*)\\](\\s+)\\[(.*)\\](\\s+)Join(\\s+)(.*)(\\s+)\\((.*)@(.*)\\)(.*)$';
  8.  
  9. open my $p, sprintf("<%s/%s", $ruta, $archivo);
  10.  
  11. open my $q, sprintf("<%s/%s", $ruta, "index.bin");
  12.  
  13. binmode $q;
  14.  
  15. while (<$p>)
  16. {
  17.         chomp $p;
  18.  
  19.  
  20.         if ($_ =~ $regex_joinfile)
  21.         {
  22.  
  23.                 my $point = (toId($9) * 32);
  24.  
  25.                 seek $q, $point, SEEK_SET;
  26.  
  27.                 my $lectura;
  28.  
  29.                 read($q, $lectura, 32);
  30.  
  31.  
  32.                 my $i = toId($lectura);
  33.                 my $j = toId($9);
  34.  
  35.  
  36.                 print "--> $lectura - $9 -- $i - $j \n";
  37.  
  38.                 sleep(5);
  39.         }
  40. }
  41.  
  42. close($p);
  43. close($q);
  44.  
  45.  
  46. sub toId {
  47.         my($v) = (shift);
  48.  
  49.         my @toks = split(//, $v);
  50.  
  51.         my $id;
  52.  
  53.         for(my $chr = 0; $chr < scalar(@toks); $chr++)
  54.         {
  55.  
  56.                 $id += ord($toks[$chr]);
  57.                
  58.         }
  59.  
  60.         return $id
  61. }
  62.  
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

La regex compara si existe en el archivo 'log.log' alguna línea como:


[Tuesday, May 2, 2017] [1:21:46 AM PDT] Join Invitado-5392 ([email protected]) has joined this channel.


La 'subrutina' llamada toId() lo que hace es generar un 'id' que me sirve para mover el cursor a un punto del archivo, primero para escribir, luego para leer la posición específica.

El punto es... que no funciona: me da registros en una posición del archivo que no corresponde, siendo el que el valor que recibe para escribir es diferente del que tiene que leer.

El 'id' determina si existe un registro o no. He intentado de muchas formas antes de venir a preguntar (un valor de bytes constante en la funciona seek y read, usar length, etc.) pero nada funciona, en lenguaje C usando el mismo método (o al menos parecido) funciona, es decir, fseek(*FILE,(cursor * sizeof(struct), SEEK_SET);

¿Alguno sabría cómo ayudarme?
primitivo
Perlero nuevo
Perlero nuevo
 
Mensajes: 80
Registrado: 2013-03-22 23:05 @004

Publicidad

Re: Archivos binarios: lectura, escritura

Notapor explorer » 2017-09-24 09:20 @431

El problema puede estar en el cálculo del toID().

Como es una simple suma, hay muchas combinaciones que dan el mismo resultado. Por ejemplo:

3 + 2 + 6 == 5 + 6 == 11 + 0 == 1 + 1 + 1 + 4 + 4 == 9 + 2 == ...

Esto es lo que se llama "colisiones". En el primer ejemplo lo resuelves sumando 1 al %hash_ips, pero... no haces uso de esa variable en ningún sitio.

Hummm... algo anda mal...
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14476
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Re: Archivos binarios: lectura, escritura

Notapor primitivo » 2017-09-24 10:19 @471

Basado en tu comentario acerca del hash, estoy intentando otra forma. Ya te confirmo si me ha dado resultado.
primitivo
Perlero nuevo
Perlero nuevo
 
Mensajes: 80
Registrado: 2013-03-22 23:05 @004

Re: Archivos binarios: lectura, escritura

Notapor primitivo » 2017-09-24 12:21 @556

Intenté, usando los valores del hash y usando un valor constante para seek().

Sigue sin funcionar...

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. use Fcntl;
  2. use bytes;
  3.  
  4. my $ruta = qw(/home/USER/);
  5.  
  6. my $archivo = "log.log";
  7.  
  8. my $regex_joinfile = '^\\[(.*)\\](\\s+)\\[(.*)\\](\\s+)Join(\\s+)(.*)(\\s+)\\((.*)@(.*)\\)(.*)$';
  9.  
  10. my $match = 0;
  11.  
  12. my $regs = 0;
  13.  
  14. open my $p, sprintf("<%s/%s", $ruta, $archivo);
  15.  
  16. my %hash_ips;
  17.  
  18.  
  19. while (<$p>)
  20. {
  21.         chomp $p;
  22.  
  23.        
  24.  
  25.  
  26.         if ($_ =~ $regex_joinfile)
  27.         {
  28.                 my $r = $9;
  29.  
  30.                 if (defined($hash_ips{lc($r)}))
  31.                 {
  32.                         $hash_ips{lc($r)} = $hash_ips{lc($r)} + 1;
  33.                 } else {
  34.                         $hash_ips{lc($r)} = 1;
  35.                         $regs++;
  36.                 }
  37.                
  38.  
  39.  
  40.  
  41.                 $match++;
  42.         }
  43. }
  44.  
  45. close($p);
  46.  
  47.  
  48.  
  49.  
  50. sub toId {
  51.         my($v) = (shift);
  52.  
  53.         my $regex = '^chat-(.*)\\.ip$';
  54.  
  55.         my $id;
  56.  
  57.         if ($v =~ $regex)
  58.         {
  59.                 my $data = $1;
  60.  
  61.  
  62.                 my @parts = split(/\./, $data);
  63.  
  64.                 foreach my $octeto (@parts)
  65.                 {
  66.                         $id .= $octeto;
  67.                 }
  68.  
  69.         } else {
  70.  
  71.                 my @parts = split(/\./, $v);
  72.                
  73.                 foreach my $octeto (@parts)
  74.                 {
  75.  
  76.                         $id .= $octeto;
  77.                 }
  78.         }
  79.  
  80.         my @toks = split(//, $id);
  81.  
  82.         my $_id;
  83.  
  84.  
  85.         foreach my $chr (@toks)
  86.         {
  87.                 $_id += (ord($chr) ^ 0x05f);
  88.         }
  89.  
  90.         return $_id
  91. }
  92.  
  93. my $diff = $match - $regs;
  94.  
  95. print "Fin del archivo $ruta, coincidencias $match veces. registros $regs adicionados, ignorados $diff ips, escribiendo datos...\n";
  96.  
  97. sleep(2);
  98.  
  99. open my $q, sprintf("+>%s/%s", $ruta, "index.bin");
  100.  
  101. binmode $q;
  102.  
  103.  
  104. foreach my $key (keys %hash_ips)
  105. {
  106.         my $id = toId(lc($key));
  107.  
  108.         print "Grabando $key, Id: $id\n";
  109.  
  110.         #sleep(1);
  111.        
  112.         my $seekpoint = (70 * $id);
  113.                        
  114.         seek $q, $seekpoint, SEEK_SET;
  115.  
  116.         print $q $key;
  117. }
  118.  
  119. close $q;
  120.  
  121.  
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. use Fcntl;
  2. use bytes;
  3. my $ruta = qw(/home/USER/);
  4.  
  5. my $archivo = "log.log";
  6.  
  7. my $regex_joinfile = '^\\[(.*)\\](\\s+)\\[(.*)\\](\\s+)Join(\\s+)(.*)(\\s+)\\((.*)@(.*)\\)(.*)$';
  8.  
  9. open my $p, sprintf("<%s/%s", $ruta, $archivo);
  10.  
  11. open my $q, sprintf("<%s/%s", $ruta, "index.bin");
  12.  
  13. binmode $q;
  14.  
  15. while (<$p>)
  16. {
  17.         chomp $p;
  18.  
  19.         if ($_ =~ $regex_joinfile)
  20.         {
  21.                 my $r = $9;
  22.  
  23.                 my $point = toId(lc($r));
  24.                
  25.  
  26.                 seek $q, (70 * $point), SEEK_SET;
  27.  
  28.                 my $lectura;
  29.  
  30.                 read($q, $lectura, 70, 0);
  31.  
  32.                 my $i = toId(lc($r));
  33.                 my $j = toId(lc($lectura));
  34.  
  35.                 print "--> $lectura - $r / $j - $i\n";
  36.  
  37.                 sleep(1);
  38.         }
  39. }
  40.  
  41. close($p);
  42. close($q);
  43.  
  44.  
  45. sub toId {
  46.         my($v) = (shift);
  47.  
  48.         my $regex = '^chat-(.*)\\.ip$';
  49.  
  50.         my $id;
  51.  
  52.         if ($v =~ $regex)
  53.         {
  54.                 my $data = $1;
  55.  
  56.  
  57.                 my @parts = split(/\./, $data);
  58.  
  59.                 foreach my $octeto (@parts)
  60.                 {
  61.                         $id .= $octeto;
  62.                 }
  63.  
  64.         } else {
  65.  
  66.                 my @parts = split(/\./, $v);
  67.                
  68.                 foreach my $octeto (@parts)
  69.                 {
  70.  
  71.                         $id .= $octeto;
  72.                 }
  73.         }
  74.  
  75.         my @toks = split(//, $id);
  76.  
  77.         my $_id;
  78.  
  79.  
  80.         foreach my $chr (@toks)
  81.         {
  82.                 $_id += (ord($chr) ^ 0x05f);
  83.         }
  84.  
  85.         return $_id
  86. }
  87.  
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4
primitivo
Perlero nuevo
Perlero nuevo
 
Mensajes: 80
Registrado: 2013-03-22 23:05 @004

Re: Archivos binarios: lectura, escritura

Notapor explorer » 2017-09-24 19:45 @864

A ver... quizás no me entero muy bien...

¿Qué es lo que quieres guardar en los archivos binarios? Porque, lo que yo veo en los listados, es que estás guardando la clave ($key) que es lo mismo que usas para calcular el desplazamiento para el seek().

¿No deberías guardar la entrada del log? La clave calcula la posición.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14476
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Re: Archivos binarios: lectura, escritura

Notapor primitivo » 2017-09-24 23:55 @038

Tienes razón, explorer, el problema está cuando se calcula el desplazamiento.

Tendré que buscar otra forma... Muchas gracias.
primitivo
Perlero nuevo
Perlero nuevo
 
Mensajes: 80
Registrado: 2013-03-22 23:05 @004

Re: Archivos binarios: lectura, escritura

Notapor explorer » 2017-09-27 15:13 @675

A ver... por partes.

Yo veo que estás usando el nombre del dominio extraído de la dirección de correo electrónica para calcular la posición del fichero donde quieres escribir.

Las cuestiones son:
  1. ¿Qué quieres escribir? Lo que yo veo es que quieres guardar el propio dominio. ¿Es así?
  2. ¿Puedes darnos alguna pista de lo que intentas hacer? Es decir, ¿Quieres llevar una estadística de los dominios, las veces que aparecen en un log? Ya sabes que eso lo puedes ir guardando en un hash a medida de que vas leyendo los registros, y al final sacas el resultado (las claves y valores del hash).
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14476
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Re: Archivos binarios: lectura, escritura

Notapor primitivo » 2017-10-01 14:35 @649

Hola, explorer, gracias por responder.

Lo que intentaba es obtener una posición de archivo para seek() según el registro que recibía, por ejemplo:

Pseudocódigo
seek registro1 = crear_seek registro1;

crear_seek lo que haría sería calcular un número único (el algoritmo para calcularlo es lo que no me funciona) intenté inicialmente sumar el valor de cada carácter de la cadena que pudiese contener registro1 pero como tu comentas antes, puede haber varias combinaciones que de como resultado el mismo número, por lo que no funciona.

Pero bueno, ya usé un archivo temporal donde guardo una posición de n=n+100 para cada registro, en otro archivo que lo abro en modo binario, guardo los datos completos.

Ahora tengo otro problema, usando el módulo Perl6::Classes, IO::Async::Loop y IO::Async::Timer::Periodic y es el siguiente.

Con los dos últimos creo un 'proceso asíncrono' para poner el valor de un scalar a 0. A medida que se ejecuta IO::Async::Timer::Periodic no cambia a 0 el valor de la variable, me da undefined.

Es de aclarar que uso un fork() como 'temporizador'. Puede que tenga que ver con el ámbito aunque yo declaro el scalar como my y por no estar en el ámbito de la clase ¿Qué opinas tú? Te dejaré parte del código.

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #Desde un *.pm llamo a la clase 'Parse' así:
  2. my $p = new Parse;
  3.  
  4. $p->parse($buf, $s, $config, $p);
  5.  
  6. #Esta sería la clase 'Parse'
  7.  
  8. my %mychan = {
  9.    entries => 0,
  10. };
  11.  
  12. class Parse
  13. {
  14.         method update
  15.         {
  16.                 $mychan{entries} = 0;
  17.         }
  18.         method getn
  19.         {
  20.                 return $NICK;
  21.         }
  22.         method getu
  23.         {
  24.                 return $USER;
  25.         }
  26.         method clean
  27.         {
  28.                 my($m) = (shift);
  29.  
  30.                 $m =~ s/(\n|\r|\t)//g;
  31.                
  32.                 return $m;
  33.  
  34.         }
  35.         method parse
  36.         {
  37.                         my($buffer, $socket, $c, $p) = (shift, shift, shift, shift);
  38.                         $mychan{entries} +=1;
  39.                         if (!$pendingLoop)
  40.                         {
  41.                                 $pendingLoop = 1;
  42.                                 if (($pid = fork()))
  43.                                 {
  44.                                                 #exit;
  45.                                                 local $loop = IO::Async::Loop->new;
  46.                                                          
  47.                                                 local $timer = IO::Async::Timer::Periodic->new(
  48.                                                            interval => 3,
  49.                                                          
  50.                                                            on_tick => sub {
  51.                                                                         $p->update();
  52.                                                            },
  53.                                                 );
  54.                                                          
  55.                                                 $timer->start;
  56.                                                          
  57.                                                 $loop->add( $timer );
  58.                                                                  
  59.                                                 $loop->run;
  60.                                 }
  61.                         }
  62.  
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
primitivo
Perlero nuevo
Perlero nuevo
 
Mensajes: 80
Registrado: 2013-03-22 23:05 @004

Re: Archivos binarios: lectura, escritura

Notapor explorer » 2017-10-02 06:52 @327

De la parte de producción de un ID único, yo el único problema que le veo es que aún no sé hasta qué nivel de especificidad quieres llegar.

Me explico: el Id lo formas a partir de cadenas así: [email protected], de donde te quedas con la parte cqa.oo9.c5uoel.

La cuestión es: ¿ese dato es único para todo el archivo de registro (log)? Yo me temo que no, y por eso hay colisiones de claves.

Ya que se trata de un archivo de registro con una fecha, ¿por qué no usar la fecha junto con la cadena capturada? La transformación a un puntero numérico, para seek() puede ser más peliagudo... Si un registro debe aparecer en la posición 0, al principio del documento, ¿cómo hacemos esa cuenta?

De todas maneras, ¿para qué queremos hacer todo esto? ¿Para guardar la información del archivo de registro en otro formato?

Tampoco sabemos si se trata de algo temporal o definitivo. Quiero decir que si se trata de algo temporal para que otra parte del programa haga, por ejemplo, estadísticas, no necesitamos nada de esto. Basta simplemente con almacenar la información en una estructura hash o array. Por estos foros hay muchos ejemplos de ese procesamiento: leemos algo, lo preprocesamos, lo guardamos de forma indexada en un hash, y la segunda parte del programa va extrayendo estadísticas o lo confronta con otra información o archivo.

Si se trata de algo definitivo, para futuras ejecuciones del programa, ¿por qué no usar una base de datos? Es más sencillo acceder a los registros, no hay que crear un sistema para seek(), y la información se guarda por campos.

En cuanto a la segunda parte, pues no sé qué responderte. No conozco esos módulos.

Si necesitas temporizar una operación para evitar que pase por un límite de tiempo, puedes usar alarm() junto con una señal de tiempo agotado: como te comentan en perldoc -f alarm:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
    alarm SEGUNDOS
    alarm   Ordena mandar una señal SIGALRM al proceso actual después de que
            haya pasado el número de segundos especificados. Si no se ha
            especificado SEGUNDOS, se usará el valor almacenado en $_. (En
            algunas máquinas, desafortunadamente, el tiempo transcurrido puede
            ser hasta un segundo más o menos del especificado debido a cómo se
            cuentan los segundos, y la planificación de procesos puede
            retrasar incluso más la entrega de la señal).

            Sólo un temporizador puede estar contando cada vez. Cada llamada
            desactiva el temporizador anterior, y se puede indicar un
            argumento 0 para cancelar el temporizador anterior sin empezar uno
            nuevo. El valor devuelto es la cantidad de tiempo restante del
            temporizador anterior.

            Para lapsos de tiempo inferiores a un segundo, el módulo
            Time::HiRes (en CPAN, y a partir de Perl 5.8 como parte de la
            distribución estándar) ofrece "ualarm". Puede también usar la
            versión de "select" de cuatro argumentos, dejando los tres
            primeros indefinidos, o puede usar la interfaz "syscall" para
            acceder a setitimer(2) si su sistema lo soporta. Vea perlfaq8 para
            más detalles.

            Normalmente, es un error entremezclar llamadas a "alarm" y
            "sleep", porque "sleep" se puede, internamente, implementar en su
            sistema con "alarm".

            Si quiere usar "alarm" para controlar la duración de una llamada
            del sistema necesita una pareja "eval"/"die". No puede confiar en
            que la alarma que llama a la llamada del sistema falle y
            establezca $! a "EINTR" porque Perl activa controladores de señal
            para reiniciar llamadas al sistema, en algunos sistemas. Usar
            "eval"/"die" siempre funciona, teniendo en cuenta las advertencias
            dadas en "Señales" in perlipc.

                eval {
                    local $SIG{ALRM} = sub { die "alarma\n" }; # NB: \n necesario
                    alarm $timeout;
                    my $nread = sysread $socket, $bufer, $largo;
                    alarm 0;
                };
                if ($@) {
                    die unless $@ eq "alarma\n";   # propagar errores inesperados
                    # fin de temporización
                }
                else {
                    # no hacer nada
                }

            Para más información ver perlipc.

            Cuestiones de portabilidad: "alarm" in perlport.
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

El alarm() mandará una señal de tiempo agotado a nuestro propio proceso, si se agota el tiempo indicado. Por medio de $SIG{ALRM} indicamos qué debe suceder en ese caso. En el ejemplo, se ejecuta un die(). Como estamos dentro de un eval(), lo capturamos (lo mismo que capturamos los posibles fallos que vengan de hacer la operación "peligrosa" sysread). Después del eval() comprobamos si ha ocurrido algo. Si fue una alarma, podríamos intentar repetir la operación un par de veces más, o simplemente, como se muestra ahí, hacer otro die() para terminar el programa o para pasar el error a la capa superior.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14476
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 1 invitado

cron