Foro - Perl en Español

Josmanue escribiste:Vayamos por partes, en cuanto a lo de que cómo sabemos que 'SP103' es el nombre del UID, la respuesta es "porque es así y punto", me explico, si recibes una cadena de 6 caracteres que empieza por '@' y va seguido por 5 caracteres, entonces, se trata de un "estoy vivo" y esos 5 caracteres son el UID de la máquina en cuestion.

La pregunta no era por qué se eligió ese formato, sino cómo podemos distinguirlo de otras cadenas que lleguen a la entrada del programa.

Josmanue escribiste:Y en este caso, hay que ver si existe alguna orden en la tabla ordenes para ese UID y enviarlo, cuando llegue el acuse de recibo de esta máquina (@OC1SP103) hay que colocar un '1' en el campo ack_orden de la tabla ordenes, con ello conseguimos que a los 30 segundos, cuando la máquina vuelva a enviar un 'estoy vivo', es decir, un '$SP103', el ack_orden esté a '1' y no le vuelvo a mandar la misma orden.

Entiendo. Es un diálogo o protocolo.

1. Se recibe una orden dentro de una trama de órdenes '@OR.....'.
2. La orden la guardamos para ese UID, y con ack_orden = 0.
3. Se recibe un 'estoy vivo', miramos si hay órdenes pendientes y las enviamos.
4. Se reciben acuses de recibo '@OC1.....' con lo que marcamos ack_orden = 1.

Josmanue escribiste:He estado mirando y creo que la sentencia SQL que tengo que usar es esta:

Código: Seleccionar todo

$sql2=("UPDATE ordenes SET ack_orden='1' WHERE destino_orden = 'UID'")

, pero claro, este 'UID' tengo que sacarlo de la cadena '$SP103' o de la cadena '@OC1SP103' y ahí es donde me quedo atascado.

Pero eso lo haces con una simple expresión regular...

Josmanue escribiste:Aquí pongo el que creo que es el esquema definitivo del programa.

Código: Seleccionar todo

while (my @canal = $s->can_read(180))
{

       ## Lectura de la trama #############################################################
        my $linea = <>; #con esto leemos la cadena por la entrada estándar
        chomp $linea;   #y le quitamos el final de línea.
        #print "$linea\n";
        if($linea = 'estoy vivo')
        {
           sacar su 'UID';
       si hay orden para ese 'UID' mandar la orden
        }
        else if($linea='@OC1SP103')
        {
       sacar su 'UID'
       actualizar ack_orden = '1' para ese 'UID'
        }
        else if($linea= #xUIDxxxxxFECxxxxxxTIExxxxxx@ODxxxxx@[email protected]@OPx)
        {
       separar los campos
       construir la sentencia sql para insertar los campos
       insertar los campos en la tabla ordenes
        }
        else
        {
       tratamiento de la trama
        }
}

Supongamos que se reciben las líneas separadas con retornos de carro. Así, por ejemplo, podemos recibir un 'estoy vivo' de esta manera: "$SP103\n";

Entonces, los 'if' anteriores los puedes construir algo así:
Es decir, estamos comprobando que realmente toda la línea (^....$) coincide con ese patrón. Y si coincide, es un 'estoy vivo' y ejecuto esa parte.

Ok entonces si no lo he entendido mal con una sola linea, la de:

Código: Seleccionar todo

if(($uid) = $linea=~/^\$(.....)$/) {

compruebo si la cadena es un estoy vivo y se lo asigno a la variable '$uid' ¿no? Lo que no entiendo muy bien es para que sirve el segundo '$' que has puesto.
Entonces, el primer bucle me quedaría así ¿no?:

Código: Seleccionar todo

if(($uid) = $linea=~/^\$(.....)$/)
{
         my $sth2=$dbh1->prepare("SELECT orden FROM ordenes WHERE destino_orden = '$uid' AND ack_orden='0'")
            or die $dbh1->errstr;
      $sth2->execute()        or die $sth2->errstr;
      my @orden= $sth2->fetchrow_array();
      if(@orden)
       {
                  print "@orden";
        }
}


Y el segundo bucle así:

Código: Seleccionar todo

if(($uid) = $linea=~/^\@OC1(.....)/)
{
         $sql2=("UPDATE ordenes SET ack_orden='1' WHERE destino_orden='$uid';");
         my $fila=$dbh1->do($sql2)
                  or die $dbh1->errstr;
}

Aqui no estoy seguro de si el ';' de después del '$uid' hay que ponerlo o no.

El segundo '$' marca el 'final de línea'. Con la combinación '^' y el '$' indicamos que queremos hacer un test con toda la $linea, no sólo una parte.

Ah ok muchas gracias.
Bueno y ahora la parte más divertida, en el tercer bucle, ¿cómo separo los campos y construyo la sentecia sql? Según me decías tengo que hacer algo parecido al caso $campos, ¿por ejemplo asi?:

Código: Seleccionar todo

my @campos2=qw(
UID.{5}    FEC.{6}    TIE.{6}    @OD.{5}    @OT.{5}    @OR{}    @OP.);
my $campos = join('|', @campos);

Pero claro, no se que debo poner dentro del @OR{}
Y después:

Código: Seleccionar todo

my %campos_bd2=(
UID=>'uid,   FEC=>'dia',   TIE=>'hora',   @OD=>'destino_orden',
@OT=>'tipo_orden',   @OR=>'orden',   @OP=>'prioridad',);

el campo ack_orden se coloca por defecto a '0' cuando inserto una nueva linea en la tabla, así que supongo que aqui no hace falta que lo considere.
¿Van por aquí los tiros o frio frio como el agua del rio?

Lo que hay que poner a @OR está respondida más arriba.

No es posible definir como claves cualquier cosa que empiece por '@'.

En cuanto a los tiros, depende de tu plan de ataque. Perl te permite diseñar más de uno...

Si he de ser sincero... no tengo plan de ataque, sólo de defensa y a duras penas para que nos vamos a engañar, me esfuerzo en aprender perl pero la verdad es que me hago también un poco de lío con las expresiones regulares.
Aqui la idea que he tenido es la de hacer algo parecido a lo que hicimos para la primera cadena, ya que son cadenas parecidas. Sacar los campos con 'my @campos', unirlos con el join en '$campos', después darle a estos campos los nombres que van a tener en la base de datos con my '%campos_bd'. Después construir la sentencia sql y ejecutarla con un 'do(sql)'.
Pero claro si tienes alguna idea de esas que en 2 lineas está hecho, soy todo.... ojos en este caso.

No, en principio sigue siendo buena idea... Lo es si la entiendes, sobre todo.

A ver, en primer lugar no es correcta la expresion regular para detectar el 'estoy vivo', es decir,

Código: Seleccionar todo

if (($uid)=$linea=~ /^\$(.....)$/)
    {
   print " He entrado en el bucle";
}


Me marca en rojo los caracteres '$(' y '$/' dentro de la expresion regular, el '$' y el siguiente caracter y no entra en el bucle. El otro bucle el que detecta '@OC1uid' si funciona bien. ¿Que esta mal en la expresion primera?

En cuanto a lo otro, ¿no me has dicho que no puedo hacerlo asi? me has dicho

No es posible definir como claves cualquier cosa que empiece por '@'.

Entonces... como va? y si puedo hacerlo como te he dicho.... como va la expresion regular, ¿dentro de los corchetes?, es decir,

Código: Seleccionar todo

my @campos2=qw(
UID.{5}    FEC.{6}    TIE.{6}    @OD.{5}    @OT.{5}    @OR{\@OR[^@]+?}    @OP.);
my $campos = join('|', @campos);

Y ¿qué esxpresion tengo que poner para detectar la tercera cadena? la que empieza igual que la primera trama.

Pues a mí me funciona:
Para colocar claves que empiecen por '@' debes usar comillas simples: '@OR' => 'orden'.

Y en @campos2, debes también escapar la arroba:

Todo es para evitar que Perl confunda la '@' con el comienzo de un array.

Pues entonces no lo entiendo, porque a mi no me hace el print que le tengo puesto dentro del if.
Vuelvo a colocar la version actual del programa, a ver si ves algo raro. he añadido lo de '@campos2' y lo de '$campos2' con el join, pero sigo si saber como resuelvo el bucle if para las cadenas de las ordenes. Gracias.

Código: Seleccionar todo

#!/usr/bin/perl
# Traductor de tramas

### Librerías ########################################################################
use DBI;
use IO::Select;

### Modos ############################################################################
use warnings;
 

### Definición de variables ##########################################################
## Base de datos
my $database1 = "database1";
my $database2 = "database2";
my $host1     = "host1";
my $host2     = "host2";
my $port1    = 3306;
my $port2    = 3307;
my $user     = "user";
my $password = "pass";

## Cálculo de las posiciones UTM ####################################################
my ($Latitud_Grados, $Longitud_Grados);
my ($Latitud_Rad, $Longitud_Rad);
my ($Northing,$Easting);
my ($East_Term1, $East_Term2, $East_Term3, $East_Term4);
my ($North_Term1, $North_Term2, $North_Term3, $North_Term4);
my ($MeridianDistance, $Meridian);
my $Nu;
my ($P1_CosLat, $P1_DiffLong, $P1_Psi, $P1_TanLat);
my ($P2_CosLat, $P2_DiffLong, $P2_Psi, $P2_TanLat);
my ($P3_CosLat, $P3_DiffLong, $P3_Psi);
my ($P4_CosLat, $P4_DiffLong, $P4_Psi, $P4_TanLat);
my ($P5_CosLat, $P5_DiffLong);
my ($P6_CosLat, $P6_DiffLong, $P6_TanLat);
my ($P7_CosLat, $P7_DiffLong);
my ($P8_DiffLong);
my ($A0, $A2, $A3, $A4, $A6);
my ($Eccentricity, $Flattening, $SemiMinorAxis, $SegEccentricity);
my ($Radii, $Rho);
my ($CentMeridZona0, $CentralMeridian, $ZoneNum);
my $LongOesteZona0;
my ($MD_Term1, $MD_Term2, $MD_Term3, $MD_Term4);
my $Pi = 3.14159265358979;
my $Huso = 30;
my $InverseFlattening = 297;
my $FalseEasting = 500000;
my $FalseNorthing = 0;
my $MeridianOfZone1 = -177;
my $SemiMajorAxis = 6378388;
my $CentralEscaleFactor = 0.9996;
my $ZoneWidth = 6;


## Especiales #######################################################################
$|++;    #Elimina el buffer de salida.


### Subrutinas ######################################################################
sub tan { sin($_[0]) / cos($_[0]) }  ##En Perl no esta definida la funcion tangente.

### Programa ########################################################################
my %trama;
my $s = IO::Select->new();
$s->add(\*STDIN);

## Conexión a las bases de datos ####################################################
my $dsn1 = "DBI:mysql:database=$database1;host=$host1;port=$port1";
my $dbh1 = DBI->connect($dsn1,$user,$password)
    or die $DBI::errstr;

#my $dsn2 = "DBI:mysql:database=$database1;host=$host2;port=$port2";
#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.
);
   
#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);

###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
    chomp $linea;   #y le quitamos el final de línea.
    print "$trama\n";
   
    if (($uid)=$linea=~ /^\$(.....)$/)
    {
   print "Entro en el bucle 1";
   my $sth2=$dbh1->prepare("SELECT orden FROM ordenes WHERE destino_orden='$uid' AND ack_orden='0'")
       or die $dbh1->errstr;
   $sth2->execute()        or die $sth2->errstr;
   my @orden=$sth2->fetchrow_array();
   if(@orden)
   {
       print "@orden";
   }
   
    }
    if (($uid) = $linea =~ /^\@OC1(.....)/)
    {
   print "entro en el bucle 2";
   $sql2 = ("UPDATE ordenes SET ack_orden='1' WHERE destino_orden='$uid';");
   my $fila = $dbh1->do($sql2)
       ##or die $dbh1->errstr;
    }
    ##if(detectar la cadena que falta)
    ##{
    ##
    ##}
   
    ##else
    ##{
   #Con esto sacamos el valor del campo "#" y lo almacenamos en $fuente
   #lo hago separado de los demas porque es el único campo que no empieza
   #con tres caracteres.
   next unless my($fuente, $trama)=$linea =~/(?:#(1|2)(($campos)+))/;
   $trama{FUE} = $fuente;
   print "Fuente:$fuente\n";

   ## Bucle en el que recorremos los campos para identificarlos #######################
   while ( $trama =~/($campos)/g )
   {
       my ($campo, $valor) = unpack( "A3 A*", $1);
       print "\t$campo\t$valor\n";

       # Ajuste de valores según el campo
       if ($campo eq 'LAT' or $campo eq 'LON')
       {
          my ($GG,$MM,$mmmm) = $valor =~ /(...?)(..),(....)/;
          my $grados = $GG + $MM/60 + $mmmm/600000;
      $Latitud_Grados  = $grados if $campo eq 'LAT';
      $Longitud_Grados = $grados if $campo eq 'LON';
       }
       if ($campo eq 'TIE') { $valor = join(':', $valor =~ /(..)/g) }

       # Lo guardamos
       $trama{$campo} = $valor;
   }

   #Y los paso a negativos si se cumple la condicion necesaria:
   if ($trama{SLA} eq 'S') { $Latitud_Grados  = -$Latitud_Grados  }
   if ($trama{SLO} eq 'W') { $Longitud_Grados = -$Longitud_Grados }

   #valores definitivos de latitud y longitud
   $trama{LAT} .= $trama{SLA};
   $trama{LON} .= $trama{SLO};

   ##print " Latitud  en Grados es: $Latitud_Grados\n";
   ##print " Longitud en Grados es: $Longitud_Grados\n";
   ##print " La hora es: $trama{TIE}\n";

   ##Conversion de coordenadas: #######################################################
   #Parametros derivados del elipsoide:

   $LongOesteZona0 = $MeridianOfZone1 -(1.5*$ZoneWidth);
   $CentMeridZona0 = $LongOesteZona0 + ($ZoneWidth/2);
   $Flattening = 1/$InverseFlattening;
   $SemiMinorAxis = $SemiMajorAxis + (1-$Flattening);
   $Eccentricity = (2*$Flattening) - ($Flattening * $Flattening);
   $SegEccentricity = $Eccentricity/(1-$Eccentricity);
   my $n = ($SemiMajorAxis - $SemiMinorAxis)/($SemiMajorAxis + $SemiMinorAxis);
   my $G = ($SemiMajorAxis*(1-$n)*(1-$n*$n)*(1+(9*$n*$n)/4+(225*$n*$n*$n*$n)/64)*$Pi/180);
   $A0 = (1-($Eccentricity/4)-((3*$Eccentricity*$Eccentricity)/64)-((5*$Eccentricity*$Eccentricity*$Eccentricity)/256));
   $A2 = ((3/8)*($Eccentricity+($Eccentricity*$Eccentricity/4)+((15*$Eccentricity*$Eccentricity*$Eccentricity)/128)));
   $A4 = ((15/256)*($Eccentricity*$Eccentricity+((3*$Eccentricity*$Eccentricity*$Eccentricity)/4)));
   $A6 = (35*($Eccentricity*$Eccentricity*$Eccentricity))/3072;

   $Latitud_Rad = $Latitud_Grados/180*$Pi;
   $Longitud_Rad = $Longitud_Grados/180*$Pi;

   $ZoneNum = ($Longitud_Grados - $LongOesteZona0)/$ZoneWidth;
   $CentralMeridian = $Huso*$ZoneWidth+$CentMeridZona0;

   #Meridian Distance:

   $MD_Term1 = $SemiMajorAxis*$A0*$Latitud_Rad;
   $MD_Term2 = -$SemiMajorAxis*$A2*(sin(2*$Latitud_Rad));
   $MD_Term3 = $SemiMajorAxis*$A4*(sin(4*$Latitud_Rad));
   $MD_Term4 = -$SemiMajorAxis*$A6*(sin(6*$Latitud_Rad));
   $MeridianDistance = $MD_Term1+$MD_Term2+$MD_Term3+$MD_Term4;

   #Radii of Curvature:

   $Rho = $SemiMajorAxis*(1-$Eccentricity)/(1-$Eccentricity*(sin($Latitud_Rad))*(sin($Latitud_Rad)))**1.5;
   $Nu = $SemiMajorAxis/(1-($Eccentricity*(sin($Latitud_Rad))*(sin($Latitud_Rad))))**0.5;

   #Powers:

   $P1_CosLat = cos($Latitud_Rad);
   $P2_CosLat = $P1_CosLat*$P1_CosLat;
   $P3_CosLat = $P1_CosLat*$P2_CosLat;
   $P4_CosLat = $P2_CosLat*$P2_CosLat;
   $P5_CosLat = $P2_CosLat*$P3_CosLat;
   $P6_CosLat = $P3_CosLat*$P3_CosLat;
   $P7_CosLat = $P6_CosLat*$P1_CosLat;
   $P1_DiffLong = (($Longitud_Grados-$CentralMeridian)/180)*$Pi;
   $P2_DiffLong = $P1_DiffLong*$P1_DiffLong;
   $P3_DiffLong = $P2_DiffLong*$P1_DiffLong;
   $P4_DiffLong = $P2_DiffLong*$P2_DiffLong;
   $P5_DiffLong = $P3_DiffLong*$P2_DiffLong;
   $P6_DiffLong = $P3_DiffLong*$P3_DiffLong;
   $P7_DiffLong = $P6_DiffLong*$P1_DiffLong;
   $P8_DiffLong = $P4_DiffLong*$P4_DiffLong;
   $P1_TanLat = &tan($Latitud_Rad);
   $P2_TanLat = $P1_TanLat*$P1_TanLat;
   $P4_TanLat = $P2_TanLat*$P2_TanLat;
   $P6_TanLat = $P4_TanLat*$P2_TanLat;
   $P1_Psi = $Nu/$Rho;
   $P2_Psi = $P1_Psi*$P1_Psi;
   $P3_Psi = $P2_Psi*$P1_Psi;
   $P4_Psi = $P2_Psi*$P2_Psi;

   #Easting: #############################################################################
   $East_Term1 = $Nu*$P1_DiffLong*$P1_CosLat;
   $East_Term2 = $Nu*$P3_DiffLong*$P3_CosLat*($P1_Psi-$P2_TanLat)/6;
   $East_Term3 = $Nu*$P5_DiffLong*$P5_CosLat*(4*$P3_Psi*(1-6*$P2_TanLat)+$P2_Psi*(1+8*$P2_TanLat)-$P1_Psi*(2*$P2_TanLat)+$P4_TanLat)/120;
   $East_Term4 = $Nu*$P7_DiffLong*$P7_CosLat*(61-479*$P2_TanLat+179*$P4_TanLat-$P6_TanLat)/5040;

   $Easting = ($East_Term1 + $East_Term2 + $East_Term3 + $East_Term4)*$CentralEscaleFactor + $FalseEasting;

   $trama{EAS} = $Easting;

   #Northing: ############################################################################
   $North_Term1 = $Nu*sin($Latitud_Rad)*$P2_DiffLong*$P1_CosLat/2;
   $North_Term2 = $Nu*sin($Latitud_Rad)*$P4_DiffLong*$P3_CosLat*(4*$P2_Psi+$P1_Psi-$P2_TanLat)/24;
   $North_Term3 = $Nu*sin($Latitud_Rad)*$P6_DiffLong*$P5_CosLat*(8*$P4_Psi*(11-24*$P2_TanLat)-28*$P3_Psi*(1-6*$P2_TanLat)+$P2_Psi*(1-32*$P2_TanLat)-$P1_Psi*(2*$P2_TanLat)+$P4_TanLat)/720;
   $North_Term4 = $Nu*sin($Latitud_Rad)*$P8_DiffLong*$P7_CosLat*(1385-3111*$P2_TanLat+543*$P4_TanLat-$P6_TanLat)/40320;

   $Northing = ($MeridianDistance + $North_Term1 + $North_Term2 + $North_Term3 + $North_Term4)*$CentralEscaleFactor + $FalseNorthing;

   $trama{NOR} = $Northing;

   ## Preparacion de la cadena INSERT: ###################################################
   # Campos que leeremos de %trama
   my %campos_bd = (
       UID => 'uid',       FEC => 'dia',           TIE => 'hora',      VAL => 'validez',
       ALT => 'altitud',   VEL => 'velocidad',     DIR => 'direccion', TEM => 'temperatura',
       HUM => 'humedad',   VIV => 'vel_viento',    VID => 'dir_viento',VIE => 'veleta',
       NIV => 'nivel_agua',NIG => 'nivel_gasoil',  PTO => 'punto_sing',
       LAT => 'latitud',   LON => 'longitud',
       EAS => 'Easting',   NOR => 'Northing',      FUE => 'fuente',
   );

   my $sql ='INSERT INTO partes_3 SET ';
   $sql   .= join( ', ',
              map  { "$campos_bd{$_} = \'$trama{$_}\'" }
          grep {      defined $campos_bd{$_}       }
               keys %trama
                );
   $sql   .= ';';

   print " la cadena sql tiene: $sql\n";

   ## Busqueda de los servicios: ########################################################

   my $sth = $dbh1->prepare("SELECT servicio FROM unidades WHERE unidad = '$trama{UID}'")
           or die $dbh1->errstr;
   $sth->execute()  or die $sth->errstr;
   my $dato = $sth->fetchrow_array();
   
   print "En sth hay: $sth\n";
   print "El servicio correspondiente es: $dato\n";

   ##Seleccionamos e insertamos en la Base de Datos adecuada: ###########################

   if ($dato == 3)
   {
           my $filas = $dbh1->do($sql)
           or die $dbh1->errstr;   
   }
   #else if($dato == 5)
   #{
   #    my $filas = $dbh2->do($sql)
   #        or die $dbh2->errstr;
   #}
   else
   {
           print "El dato se insertaria en Tragsa\n";
   }

   
   ##Acuse de Recibo: ##################################################################

   print "\$INFOK*\r\n";
   
   ##Envio de ordenes si existen #######################################################
   my $sth2=$dbh1->prepare("SELECT orden FROM ordenes WHERE destino_orden='$trama{UID}' AND ack_orden ='0'")
       or die $dbh1->errstr;
   $sth2->execute()     or die $sth2->errstr;
   my @orden = $sth2->fetchrow_array();
   if(@orden)
   {
      print "@orden";
   }
    ##}
}