Using perl Syntax Highlighting
Luego, en el momento después de leer el $uid, hacemos el cambio si existe la correspondencia:
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'.#x#SOS#UIDxxxxxFECxxxxxxTIExxxxxxVALxLATxxxx,xxxxSLAxLONxxxxx,xxxxSLOx
elsif($primero eq '#')
{
if (($fuente, $trama) = $linea =~/^#(1|2)(.+)$/)
{
if ($trama =~/SOS/)
{.......
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.~]$ 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.
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 '$')
{
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
);
Aquí te pongo una captura de los recursos que consume el programa apenas 10 segundos después de cerrar la ventana del telnet.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
Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 1 invitado