Foro - Perl en Español

por **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

use Fcntl;
use bytes;
 
my $ruta = qw(/home/USER/);
 
my $archivo = "log.log";
 
my $regex_joinfile = '^\\[(.*)\\](\\s+)\\[(.*)\\](\\s+)Join(\\s+)(.*)(\\s+)\\((.*)@(.*)\\)(.*)$';
 
my $match = 0;
 
my $regs = 0;
 
open my $p, sprintf("<%s/%s", $ruta, $archivo);
 
open my $q, sprintf(">%s/%s", $ruta, "index.bin");
 
binmode $q;
 
my %hash_ips;
 
 
while (<$p>)
{
        chomp $p;
 
        if ($_ =~ $regex_joinfile)
        {
                my $seekpoint = toId($9);
 
                seek $q, ($seekpoint * 32), SEEK_SET;
 
                if (defined($hash_ips{$9}))
                {
                        $hash_ips{$9} = $hash_ips{$9} + 1;
                } else {
                        $hash_ips{$9} = 1;
                        $regs++;
                }
 
                print $q $9;
 
                $match++;
        }
}
 
close($p);
close($q);
 
sub toId {
        my($v) = (shift);
 
        my @toks = split(//, $v);
 
        my $id;
 
        for(my $chr = 0; $chr < scalar(@toks); $chr++)
        {
 
                $id += ord($toks[$chr]);
        
        }
 
        return $id
}
 
my $diff = $match - $regs;
 
print "Fin del archivo $ruta, coincidencias $match veces. registros $regs adicionados, ignorados $diff ips\n";
 
Coloreado en 0.004 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

use Fcntl;
use bytes;
my $ruta = qw(/home/USER/);
 
my $archivo = "log.log";
 
my $regex_joinfile = '^\\[(.*)\\](\\s+)\\[(.*)\\](\\s+)Join(\\s+)(.*)(\\s+)\\((.*)@(.*)\\)(.*)$';
 
open my $p, sprintf("<%s/%s", $ruta, $archivo);
 
open my $q, sprintf("<%s/%s", $ruta, "index.bin");
 
binmode $q;
 
while (<$p>)
{
        chomp $p;
 
        if ($_ =~ $regex_joinfile)
        {
 
                my $point = (toId($9) * 32);
 
                seek $q, $point, SEEK_SET;
 
                my $lectura; 
 
                read($q, $lectura, 32);
 
                my $i = toId($lectura);
                my $j = toId($9);
 
                print "--> $lectura - $9 -- $i - $j \n";
 
                sleep(5);
        }
}
 
close($p);
close($q);
 
sub toId {
        my($v) = (shift);
 
        my @toks = split(//, $v);
 
        my $id;
 
        for(my $chr = 0; $chr < scalar(@toks); $chr++)
        {
 
                $id += ord($toks[$chr]);
                
        }
 
        return $id
}
 
Coloreado en 0.002 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?

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...

por **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.

por **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

use Fcntl;
use bytes;
 
my $ruta = qw(/home/USER/);
 
my $archivo = "log.log";
 
my $regex_joinfile = '^\\[(.*)\\](\\s+)\\[(.*)\\](\\s+)Join(\\s+)(.*)(\\s+)\\((.*)@(.*)\\)(.*)$';
 
my $match = 0;
 
my $regs = 0;
 
open my $p, sprintf("<%s/%s", $ruta, $archivo);
 
my %hash_ips;
 
while (<$p>)
{
        chomp $p;
 
        if ($_ =~ $regex_joinfile)
        {
                my $r = $9;
 
                if (defined($hash_ips{lc($r)}))
                {
                        $hash_ips{lc($r)} = $hash_ips{lc($r)} + 1;
                } else {
                        $hash_ips{lc($r)} = 1;
                        $regs++;
                }
                
                $match++;
        }
}
 
close($p);
 
sub toId {
        my($v) = (shift);
 
        my $regex = '^chat-(.*)\\.ip$';
 
        my $id;
 
        if ($v =~ $regex)
        {
                my $data = $1;
 
                my @parts = split(/\./, $data);
 
                foreach my $octeto (@parts)
                {
                        $id .= $octeto;
                }
 
        } else {
 
                my @parts = split(/\./, $v);
                
                foreach my $octeto (@parts)
                {
 
                        $id .= $octeto;
                }
        }
 
        my @toks = split(//, $id);
 
        my $_id;
 
        foreach my $chr (@toks)
        {
                $_id += (ord($chr) ^ 0x05f);
        }
 
        return $_id
}
 
my $diff = $match - $regs;
 
print "Fin del archivo $ruta, coincidencias $match veces. registros $regs adicionados, ignorados $diff ips, escribiendo datos...\n";
 
sleep(2);
 
open my $q, sprintf("+>%s/%s", $ruta, "index.bin");
 
binmode $q;
 
foreach my $key (keys %hash_ips)
{
        my $id = toId(lc($key));
 
        print "Grabando $key, Id: $id\n";
 
        #sleep(1);
        
        my $seekpoint = (70 * $id);
                        
        seek $q, $seekpoint, SEEK_SET;
 
        print $q $key;
}
 
close $q;
 
Coloreado en 0.003 segundos,  usando GeSHi 1.0.8.4

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

use Fcntl;
use bytes;
my $ruta = qw(/home/USER/);
 
my $archivo = "log.log";
 
my $regex_joinfile = '^\\[(.*)\\](\\s+)\\[(.*)\\](\\s+)Join(\\s+)(.*)(\\s+)\\((.*)@(.*)\\)(.*)$';
 
open my $p, sprintf("<%s/%s", $ruta, $archivo);
 
open my $q, sprintf("<%s/%s", $ruta, "index.bin");
 
binmode $q;
 
while (<$p>)
{
        chomp $p;
 
        if ($_ =~ $regex_joinfile)
        {
                my $r = $9;
 
                my $point = toId(lc($r));
                
 
                seek $q, (70 * $point), SEEK_SET;
 
                my $lectura; 
 
                read($q, $lectura, 70, 0);
 
                my $i = toId(lc($r));
                my $j = toId(lc($lectura));
 
                print "--> $lectura - $r / $j - $i\n";
 
                sleep(1);
        }
}
 
close($p);
close($q);
 
 
sub toId {
        my($v) = (shift);
 
        my $regex = '^chat-(.*)\\.ip$';
 
        my $id;
 
        if ($v =~ $regex)
        {
                my $data = $1;
 
 
                my @parts = split(/\./, $data);
 
                foreach my $octeto (@parts)
                {
                        $id .= $octeto;
                }
 
        } else {
 
                my @parts = split(/\./, $v);
                
                foreach my $octeto (@parts)
                {
 
                        $id .= $octeto;
                }
        }
 
        my @toks = split(//, $id);
 
        my $_id;
 
 
        foreach my $chr (@toks)
        {
                $_id += (ord($chr) ^ 0x05f);
        }
 
        return $_id
}
 
Coloreado en 0.002 segundos,  usando GeSHi 1.0.8.4

por **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.

por **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.

por **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:

¿Qué quieres escribir? Lo que yo veo es que quieres guardar el propio dominio. ¿Es así?
¿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).

por **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

#Desde un *.pm llamo a la clase 'Parse' así:
my $p = new Parse;
 
$p->parse($buf, $s, $config, $p);
 
#Esta sería la clase 'Parse'
 
my %mychan = {
   entries => 0,
};
 
class Parse 
{
        method update
        {
                $mychan{entries} = 0;
        }
        method getn
        {
                return $NICK;
        }
        method getu
        {
                return $USER;
        }
        method clean
        {
                my($m) = (shift);
 
                $m =~ s/(\n|\r|\t)//g;
                
                return $m;
 
        }
        method parse
        {
                        my($buffer, $socket, $c, $p) = (shift, shift, shift, shift);
                        $mychan{entries} +=1;
                        if (!$pendingLoop)
                        {
                                $pendingLoop = 1;
                                if (($pid = fork()))
                                {
                                                #exit;
                                                local $loop = IO::Async::Loop->new;
                                                         
                                                local $timer = IO::Async::Timer::Periodic->new(
                                                           interval => 3,
                                                         
                                                           on_tick => sub {
                                                                        $p->update();
                                                           },
                                                );
                                                         
                                                $timer->start;
                                                         
                                                $loop->add( $timer );
                                                                 
                                                $loop->run;
                                }
                        } 
 
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

por **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.

Foro - Perl en Español

Archivos binarios: lectura, escritura

Archivos binarios: lectura, escritura

Publicidad

Re: Archivos binarios: lectura, escritura

Re: Archivos binarios: lectura, escritura

Re: Archivos binarios: lectura, escritura

Re: Archivos binarios: lectura, escritura

Re: Archivos binarios: lectura, escritura

Re: Archivos binarios: lectura, escritura

Re: Archivos binarios: lectura, escritura

Re: Archivos binarios: lectura, escritura

¿Quién está conectado?