• Publicidad

Buscar y almacenar párrafo o hasta determinado símbolo

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

Re: Buscar y almacenar párrafo o hasta determinado símbolo

Notapor explorer » 2019-09-04 10:43 @488

Hay... un error ahí... la línea 33 es así:

my $deletechar = $devueltos{$row}{'smtpdiagnosticcode'} =~ s/'//g;

cuando debería ser así:

(my $deletechar = $devueltos{$row}{'smtpdiagnosticcode'}) =~ s/'//g;

Sin los paréntesis, $deletechar contiene el número de sustituciones hechas, no el texto transformado sin las comillas.

En cuanto al código, se puede simplificar bastante: hay muchas columnas que coinciden en nombre con la clave del valor a recuperar, y unas pocas excepciones a esa regla. Por ejemplo:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/env perl
  2. use v5.14;
  3. use Encode;
  4.  
  5. my @columnas = qw(
  6.     smtpcode            email           smtpaction              smtpstatus
  7.     smtpdiagnosticcode  smtpremotemta   smtplastattempdate
  8.     userid              adminid         campanaid               listaid
  9.     status
  10. );
  11.  
  12. my %columnas_especiales = (
  13.     smtpcode            => 'smtpcode1',
  14.     smtpstatus          => 'smtpcode',
  15.     smtpdiagnosticcode  => 'smtpprefixdetail',
  16.     smtpremotemta       => 'smtpremote',
  17.     smtplastattempdate  => 'smtpdate',
  18.     userid              => 'id_usuario',
  19.     adminid             => 'id_admin',
  20.     campanaid           => 'id_campana',
  21.     listaid             => 'id_lista',
  22. );
  23.  
  24. # Valores de prueba
  25. my %devueltos = (
  26.     1   => {
  27.             smtpcode            => 'smtpcode',
  28.             email               => 'email',
  29.             smtpaction          => 'smtpaction',
  30.             smtpstatus          => 'smtpstatus',
  31.             smtpdiagnosticcode  => "smtpdiagnosticcode \xf1",           # con una "ñ" en iso-8859-1
  32.             smtpremotemta       => 'smtpremotemta',
  33.             smtplastattempdate  => 'smtplastattempdate',
  34.             userid              => 'userid',
  35.             adminid             => 'adminid',
  36.             campanaid           => 'campanaid',
  37.             listaid             => 'listaid',
  38.             status              => 'status',
  39.         },
  40. );
  41.  
  42.  
  43.         for my $row ( sort keys %devueltos ) {
  44.  
  45.             my @queryColumns;
  46.             my @queryValues;
  47.  
  48.             # TODO : Líneas comentadas para rehacer las líneas siguientes
  49.             #
  50.             #if ( exists( $campanas{ $devueltos{$row}{'campanaid'} } ) ) {
  51.             #    $campanas{ $devueltos{$row}{'campanaid'} }{'count'}++;
  52.             #    $campanas{ $devueltos{$row}{'campanaid'} }{'adminid'} = $devueltos{$row}{'adminid'};
  53.             #}
  54.             #else {
  55.             #    $campanas{ $devueltos{$row}{'campanaid'} }{'count'}   = 1;
  56.             #    $campanas{ $devueltos{$row}{'campanaid'} }{'adminid'} = $devueltos{$row}{'adminid'};
  57.             #}
  58.  
  59.             for my $columna (@columnas) {
  60.                 if (defined $devueltos{$row}{$columna}) {
  61.                     my $valor = $devueltos{$row}{$columna};
  62.  
  63.                     # casos especiales
  64.                     if ($columna eq 'smtpdiagnosticcode') {
  65.                         (my $valornuevo = $valor) =~ s/'//g;
  66.                        
  67.                         # FIXME : no es necesario decodificar en 8859-1 porque es la codificación por defecto
  68.                         #$valor = encode('utf8', decode('iso-8859-1', $valornuevo));
  69.                         $valor = encode('utf8', $valornuevo);
  70.                     }
  71.                     elsif ($columna eq 'status') {
  72.                         $valor = 'true';
  73.                     }
  74.  
  75.                     # guardar columna y valor para la consulta
  76.                     my $col = $columnas_especiales{$columna} || $columna;       # cambio de nombre de la columna
  77.  
  78.                     push @queryColumns, $col;
  79.                     push @queryValues, qq('$valor');
  80.                 }
  81.             }
  82.  
  83.             push @queryColumns, 'fecha';
  84.             push @queryValues, 'now()';
  85.  
  86.             #say join ", " => @queryColumns;
  87.             #say join ", " => @queryValues;
  88.  
  89.             my $query = "INSERT INTO ex_tbl_devueltos ("
  90.                       . join(',', @queryColumns)
  91.                       . ") VALUES ("
  92.                       . join(',', @queryValues)
  93.                       . ")"
  94.                       ;
  95.            
  96.             #say $query;
  97.  
  98.             my $sth = $dbh->prepare($query) or die "Can't prepare SQL statement: ", $dbh->errstr(), "\n";
  99.             $sth->execute() or die "Can't execute SQL statement: ", $sth->errstr(), "\n";
  100.         }
  101. __END__
Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4

Este es un programa por sí solo (se puede ejecutar desde la línea de comandos). Por ello, tiene valores de prueba (líneas 24 a 40) y se han comentado líneas que no influyen en el resto (líneas 48 a 57), por lo que luego habrá que ajustar el código para ponerlo en su sitio definitivo, pero sirve para ver otra forma de resolver el problema.

La idea es tener un array con los nombres de las columnas que nos interesan (línea 5). Si esos nombres coincidiesen con los nombres de las columnas de la base de datos, no necesitaríamos más, pero como no es el caso, necesitamos un hash para que nos haga el paso de un nombre a otro (línea 12).

Luego, no vamos a ir construyendo la consulta poco a poco, agregando columnas y valores a cadenas de texto, sino en arrays (líneas 45 y 46). Así no tenemos peligro de que se nos escape alguna coma de más o de menos.

Por cada fila en %devueltos (línea 43), recorremos todas las columnas (línea 59). Si hay un valor para esa columna (línea 60), miramos que no haya que hacer una transformación especial de ese valor (líneas 63 a 73). Finalmente, guardamos columna y valor (líneas 75 a 79). Agregamos la última columna (83 y 84) y creamos la consulta a partir de los array (89 a 94). Luego la ejecutamos.

Tal cual está así, funciona igual a como estaba antes, pero con menos líneas. Lo interesante es pasar la consulta para que use "placeholder", para que sea más seguro.

Los cambios son muy pequeños:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1.             my $query = "INSERT INTO ex_tbl_devueltos ("
  2.                       . join(',', @queryColumns)
  3.                       . ") VALUES ("
  4.                       . join(',', ('?') x @queryValues)
  5.                       . ")"
  6.                       ;
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1.             $sth->execute(@queryValues) or die "Can't execute SQL statement: ", $sth->errstr(), "\n";
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

Cambiando la línea 92 conseguimos que la consulta tenga este aspecto:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
INSERT INTO ex_tbl_devueltos (smtpcode1,email,smtpaction,smtpcode,smtpprefixdetail,smtpremote,smtpdate,id_usuario,id_admin,id_campana,id_lista,status,fecha) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

y la línea 99 pasa todos los valores a usar. Ya no necesitamos hacer, entonces, el proceso de eliminación de las comillas.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Publicidad

Re: Buscar y almacenar párrafo o hasta determinado símbolo

Notapor felloz » 2019-09-05 07:24 @350

Muchas gracias, explorer, tendré ese código a la mano pero tengo que confesarte que por ahora resolví el problema con

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. while($variable =~ /'/){
  2. $variable =~ s/'//;
  3. }
  4.  
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

Y como corre en una sola línea me ha funcionado bien. Tengo pendiente actualizar las consultas con los placeholders.
Avatar de Usuario
felloz
Perlero nuevo
Perlero nuevo
 
Mensajes: 16
Registrado: 2018-12-10 09:11 @424

Re: Buscar y almacenar párrafo o hasta determinado símbolo

Notapor explorer » 2019-09-05 08:56 @414

Esas tres líneas se reducen a una sola:

$variable =~ s/'//g;

Recuerda: '/g' significa sustitución global.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Anterior

Volver a Básico

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 1 invitado