Foro - Perl en Español

Podrías guardar la correspondencia entre los viejos y los nuevos. Para eso, lo ideal es un hash.


Luego, en el momento después de leer el $uid, hacemos el cambio si existe la correspondencia:

Una cadena más que hay que tratar y creo que es la ultima. Esbastante parecida a la de los partes:

#x#SOS#UIDxxxxxFECxxxxxxTIExxxxxxVALxLATxxxx,xxxxSLAxLONxxxxx,xxxxSLOx

Si te fijas es exactamente igual al principio de la cadena partes, sólo que entre los campos fuente y UID mete la cadena '#SOS#', y que se acaba después del campo 'SLO'. Si se recibe esta cadena simplemente hay que insertar los campos en la tabla 'SOS'.

Así que hay que crear otro if para detectar esta nueva cadena y en principio se me ocurre hacer otra vez lo que hemos hecho para las otras cadenas, es decir, crear la variable my @campos3 = qw("nueva lista de campos); despues unir los campos con el join 'my $campos3 = join('|', @campos3);' y por último crear 'my %campos3_bd=("campos a los que corresponden en la BD");' y así construir la sentecia sql. ¿Te parece bien o hay alguna forma mejor de hacerlo? Es que me parecen ya muchas variables de campos diferentes y no esta quedando muy limpio, por es lo digo.
Y para detectar si estoy en esta nueva cadena, ¿pordría usar ' if ($trama =~/SOS/)'? o sea:

Código: Seleccionar todo

elsif($primero eq '#')
    {
   if (($fuente, $trama) = $linea =~/^#(1|2)(.+)$/)
   {
       if ($trama =~/SOS/)
       {.......



Detectar la trama de esa manera está bien, siempre que tengamos en cuenta que no confundamos ese 'SOS' con el contenido de algún campo de otra trama distinta. O dicho de otra manera. Ahí llegamos si lo leído empieza por '#' y le sigue un '1' o un '2'. El resto es trama. Si estamos seguros que de todas las tramas posibles que vamos a recibir así, sólo una va a tener un 'SOS', entonces sí que podemos usarlo. Si, por el contrario, alguna trama no 'SOS' aparece con un campo con ese contenido (por ejemplo, dentro del campo 'UID') entonces no nos valdría con sólo buscar por 'SOS', sino que quizás deberíamos poner que buscara por '#SOS'. Y repetir las precauciones comentadas otra vez.

En cuanto a lo de repetir la estrategia de campos, no queda otra forma, ya que todos los campos son distintos o están en distinta disposición. Si, por ejemplo, la definición de @campos2 y @campos3 es la misma, entonces podríamos resumirlos en una única variable, pero creo que no es el caso.

Para que quedara más 'limpio' lo mejor sería resumir la parte principal del programa con llamadas a funciones y poner la definición de todas las variables 'campos' al principio del programa, para que se ejecuten una sola vez. De esa manera te quedaría el núcleo más limpio.

¡Hola de nuevo! Aunque ya parecía que funcionaba el programa aquí estoy de nuevo a ver si me puedes echar una mano con algunos flecos sueltos. En primer lugar 3 warnings que me está dando y no se muy bien donde está el fallo:

~]$ tcpserver -v 0 1056 ./telecolectorp2
tcpserver: status: 0/40
tcpserver: status: 1/40
tcpserver: pid 60128 from 192.168.2.82
Possible attempt to separate words with commas at ./telecolectorp2 line 93.
Possible attempt to separate words with commas at ./telecolectorp2 line 101.
Name "main::uid" used only once: possible typo at ./telecolectorp2 line 224.

En principio te pongo las líneas de la 80 a 130 y de la 215 a la 230 espero que sea suficiente, si no colocaré el programa completo.

Lineas 80 a 130:

Código: Seleccionar todo

my $dbh2 = DBI->connect($dsn2,$user,$password)
    or die $DBI::errstr;
   
## Expresiones regulares a buscar en la trama #######################################
#definimos @campos como una lista de expresiones regulares,
#que son el nombre de cada campo con la correspondiente longitud
#de su valor.
my @campos = qw(
    UID.{5}         FEC.{6}     TIE.{6}         VAL.
    LAT.{4},.{4}    SLA.        LON.{5},.{4}    SLO.
    ALT.{5}         VEL.{3}     DIR.{3}         TEM.{3}
    HUM.{3}         VIV.{3}     VID.{3}         VIE.
    NIV.{5}         NIG.{3}     PTO.
);
my @campos2 = qw(
    UID.{5}       FEC.{6}   TIE.{6}      \@OD.{5}
    \@OT.{3}       \@OR[^@]+   \@OP.
);
my @campos3 = qw(
    UID.{5}         FEC.{6}     TIE.{6}
    LAT.{4},.{4}    SLA.        LON.{5},.{4}    SLO.
);
my %uids=(PF142=>'AN102',PF129=>'AP102',PF126=>'AP103',PF135=>'AP105',PF122=>'AP204',
   PF107=>'AP205',PF153=>'AP207',PF147=>'AP206',
   CP202=>'CP201',CF202=>'CP202',
   80535=>'GP103',
   PF139=>'HP106',PF145=>'HP207',PF144=>'JP104',PF146=>'JP304',PF134=>'JP105',
   PF133=>'JP202',PF137=>'JN301',JP401=>'JP402',PF158=>'JP401',PF141=>'JP405',
   JP102=>'JP103',JF102=>'JP102',
   SP104=>'SP103',SF104=>'SP104');
   
#definimos $campos como la union de todo eso separado con '|',
#que es la 'or' de una expresion regular
my $campos = join('|', @campos);
my $campos2 = join('|', @campos2);
my $campos3 = join('|', @campos3);

###Bucle de espera mientras no ocurra timeout################################
while (my @canal = $s->can_read(180))
{
    ## Lectura de la trama #############################################################
    my $linea = <>; #con esto leemos la cadena por la entrada estándar
    next unless $linea;
    chomp $linea;   #y le quitamos el final de línea.
    my $primero = substr($linea, 0, 1);
   ## DEBUG
   ##select($output);
   ##print $output "Entrada de datos: ".localtime(time)." ";
   ##select(STDOUT);
    if ($primero eq '$')
      {

Lineas 211 a 232:

Código: Seleccionar todo

elsif($linea =~/SOS/)
       {

      $trama{FUE}=$fuente;
      while ($trama =~/($campos3)/g)
      {
         my ($campo,$valor)=unpack("A3 A*",$1);
         if ($campo eq 'TIE') {$valor=join(';',$valor=~/(..)/g)}
         $trama{$campo}=$valor;
         my $uid=$trama{UID};
         $uid=$uids{$uid} if exists $uids{$uid};
         $trama{UID}=$uid;
      }
      print $output "SOS recibido de ".$uid."\n";
      #Valores definitivos de latitud y longitud
      $trama{LAT}.=$trama{SLA};
      $trama{LON}.=$trama{SLO};

      my %campos3_bd=(
      UID=>'uid',   FEC=>'dia',   TIE=>'hora',   LAT=>'latitud',
      LON=>'longitud',   FUE=>'fuente',
      );
      my $sql_sos='INSERT INTO sos SET ';
      $sql_sos.=join(',',
         map {"$campos3_bd{$_}=\'$trama{$_}\'"}
         grep { defined $campos3_bd{$_} }
         keys %trama
      );

El otro problema (el mas grave) es que cuando ejecuto el programa con el tcpserver y hago un telnet al servidor por el puerto en cuestión. Si cierro la ventana del telnet, el programa se me dispara hasta que me peta el servidor

PID USERNAME THR PRI NICE SIZE RES STATE C TIME WCPU COMMAND
60176 jmvazquez 1 99 0 4860K 3960K CPU2 2 0:30 95.44% perl5.8.7
412 root 1 8 0 1228K 628K nanslp 0 3:25 0.00% svscan
320 root 1 96 0 1300K 856K select 0 0:41 0.0

Aquí te pongo una captura de los recursos que consume el programa apenas 10 segundos después de cerrar la ventana del telnet.
¿Alguna idea sobre esto? Y como siempre muchísimas gracias.

Los dos primeros warnings se refieren al hecho de que estás usando ',' dentro de un 'qw()' y Perl se asusta, ya que podrían ser un posible fallo. Nosotros sabemos que no, pero Perl nos avisa por si acaso.

Si no queremos verlo más, hay un par de opciones. Podríamos poner un 'no warnings;' en un ambiente cerrado para que no nos moleste que estas pejigueras.
Este programa nos da el mismo aviso:
pero este ya no:
Observamos que la variable @campos sigue siendo definida en el programa, en el ámbito global (el operador 'my' está fuera del bloque delimitado por las llaves). Dentro del bloque de las llaves, que es un ámbito de trabajo nuevo, desactivamos -momentáneamente- el sistema de avisos, antes de hacer la asignación de la variable. Cuando el bloque termina, el sistema de avisos sigue como estaba antes.

Otra forma de resolverlo es escribiendo el array de la forma tradicional:

El tercer aviso es más problemático porque indica un fallo en la lógica de nuestro programa: Perl ha encontrado que la variable $uid se ha usado sólo una vez. Nos avisa de un posible fallo a la hora de escribirla.

En el segundo trozo de código que pones, defines la variable $uid dentro del bloque while, por lo que al terminar este bloque, esta variable ya no es conocida. Pero veo que la usas en la línea siguiente al bloque while. En ese momento, Perl intenta buscar una variable global llamada $uid. No usará la $uid de dentro del bloque while.

Sobre el problema del telnet, suena a que el programa entra en un bucle sin fin, reservando cada vez más memoria. Eso depende de cómo le has dicho al programa que se comporte cuando la conexión telnet se corte. Ten en cuenta que tcpserver lo que hace es redirigir las entradas y las salidas estándar desde el socket a tu programa. No he manejado ese programa, así que no puedo decirte qué es lo que pasa, pero me suena a que es un problema de que el programa recibe un fin de fichero y debería terminarse.

Vale, solucionados los "pequeños" problemas de los warnings esos que me daban. Ahora a ver si conseguimos solucionar el escollo de que no termine el proceso si se cierra la ventana. A ver quien puede decirme cómo puedo decirle que si se pierde la conexión, que mate el proceso y punto. Yo no le he dicho al programa nada acerca de cómo debe comportarse cuando se cierre la conexion, así que ese debe ser el problema.
El caso es bastante curioso, ya que si hago la prueba via "putty" no da problema alguno, es decir, si hago un putty a la máquina y desde ahí hago el telnet, si cierro la ventana no pasa nada, pero si hago el telnet directamente desde windows (ejecutar/telnet) y cierro la ventana, entonces se me dispara el consumo de la CPU hasta el 99%.

Cómo puedo solucionarlo??
Gracias.

¿A qué ventana te refieres que cierras? ¿Una XTerm? ¿Una ventana de comandos de MSDOS?

Se supone que la aplicación está esperando 180 segundos y si no recibe nada, termina. Y si la shell donde se ejecuta el programa termina, también termina el programa.

Si el problema es el Telnet de Micro$oft, tu mismo has dado con la respuesta: no lo uses.

Me apuesto la paga del domingo a que cuando cierras el Telnet, éste le manda códigos de control a la aplicación remota. A saber qué serán.

Vale, sigo con mi pequeña investigación. Al principio parecía que era del telnet de windows porque cada vez que lo hago se dispara el perl y se come todos los recursos, pero no siempre es así, de vez en cuando y en principio aleatoriamente el programa se me dispara, supongo que le debe llegar algo que hace que responda así y que debe ser lo mismo que le llega cuando se cierra la ventana del telnet de windows.
¿Hay alguna forma de ver lo que le llega al programa en todo momento? para ver si puedo cazar qué es exactamente lo que le hace saltar.
Gracias y espero respuestas desesperadamente.

En el momento de la entrada de datos... podrías sacar un informe de lo recibido (longitud y un extracto, por ejemplo), a un fichero de texto, con un print.