• Publicidad

Ayuda con problema de codificación

Todo lo relacionado con el desarrollo Web con Perl: desde CGI hasta Mojolicious

Ayuda con problema de codificación

Notapor danimera » 2018-08-05 12:11 @549

listado.png
listado.png (150.5 KiB) Visto 2442 veces
Resulta que tengo un CMS hecho en Perl que trabaja con una base de datos CSV.

Pero tengo problemas con acentos, tildes y "ñ", los cuales pensaba que había resuelto. Tengo un código que me inserta un registro y me funciona bien y un código similar que edita el registro. Pero ahí vino el problema: los caracteres especiales se guardan directamente en el archivo lo que hace claro que en la web no se vean bien.

Envío unas fotos para mostrar el problema.

¿Qué podrá ser y qué rayos podrá estar causando esto? Como pueden ver en el mismo listado se muestran que funcionan los acentos pero que hay un error con otro registro y en la otra imagen vemos como los tiene en el archivo plano.
Imagen
Imagen
Pondré por acá el código que tengo para guardar, insertar y actualizar.
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. sub category_add_process {
  2.         my $self = shift;
  3.         my $form = shift;
  4.         my $dbh = $self->dbh;
  5.         my $language = $self->current_language();
  6.         my $category = MyApp::Db::Stock::Category->new($dbh);
  7.         my $categoryP = MyApp::Db::Stock::Category->new($dbh);
  8.         my $q = $self->query();
  9.         my $patch,
  10.         my $user = MyApp::Db::User->new($dbh);
  11.         my @ue = $self->uploadFile('images');
  12.  
  13.  
  14.  
  15.     if ($ue[0]){
  16.     if(!$self->thumbnail($ue[0],120,"thumb")){
  17.         $self->resize($self->cfg('upload_dir')."/images/".$ue[0],120,"thumb");
  18.         };
  19.         }
  20.  
  21.     $user->retrieve_by('username',$self->authen->username);
  22.     $form = $form->fields;
  23.     $self->add_log('debug','Entra proceso guardar category :'.$q->param('name'));
  24.  
  25.     #Si no hay padre, entonces el padre es 0
  26.     $form->{'parent_id'} = 0 if !$form->{'parent_id'};
  27.  
  28.  
  29.             my %d  = (
  30.  
  31.             parent_id                           =>  $form->{'parent_id'},
  32.             name                                        =>  $form->{'name'},
  33.             short_description           =>  $form->{'short_description'},
  34.             long_description            =>  $form->{'long_description'},
  35.  
  36.             thumb                                       =>  $ue[0],
  37.             tags                                        =>  $form->{'tags'},
  38.             meta_tags                           =>  $form->{'meta_tags'},
  39.             meta_description            =>  $form->{'meta_description'},
  40.             created_by                          =>  $user->{data}->{'user_id'},
  41.             status                                      =>  $form->{'status'},
  42.                 creation_date                   =>      $self->fecha_actual,
  43.             );
  44.  
  45.             my $id = $category->insert(\%d);
  46.             $categoryP->retrieve($form->{'parent_id'});
  47.             $category->retrieve($id);
  48.  
  49.         if ($form->{'parent_id'}){
  50.                 $patch =  $categoryP->{data}->{patch}."/".$self->urlConverter($form->{'name'});
  51.         }else{
  52.                 $patch =  "".$self->urlConverter($form->{'name'});
  53.         }
  54.  
  55.  
  56.         $category->update({ patch  =>  $patch  });
  57.  
  58.  
  59.     return $id;
  60.  
  61. }
  62.  
Coloreado en 0.003 segundos, usando GeSHi 1.0.8.4


Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. sub category_edit_process {
  2.         my $self = shift;
  3.         my $form = shift;
  4.         my $dbh = $self->dbh;
  5.         my $language = $self->current_language();
  6.         my $category = MyApp::Db::Stock::Category->new($dbh);
  7.         my $categoryP = MyApp::Db::Stock::Category->new($dbh);
  8.         my $q = $self->query();
  9.         my $user = MyApp::Db::User->new($dbh);
  10.         my @ue = $self->uploadFile('images');
  11.         my $imagen;
  12.        $form = $form->fields;
  13.  
  14.  
  15.  
  16.     if($ue[0] ){
  17.  
  18.         $imagen =  $ue[0];
  19.         if(!$self->thumbnail($ue[0],120,"thumb")){
  20.                 $self->resize($self->cfg('upload_dir')."/images/".$ue[0],120,"thumb");
  21.                 };
  22.  
  23.         unlink($self->cfg('upload_dir')."/images/".$form->{'last_thumb'});
  24.         unlink($self->cfg('upload_dir')."/images/thumb_".$form->{'last_thumb'});
  25.  
  26.         }else{
  27.  
  28.                 $imagen = $form->{'last_thumb'}
  29.         }
  30.  
  31.        $user->retrieve_by('username',$self->authen->username);
  32.        $self->add_log('debug','Entra proceso editar category :'.$q->param('name'));
  33.  
  34.        $category->retrieve($form->{'category_id'});
  35.        $categoryP->retrieve($form->{'parent_id'});
  36.        $form->{'parent_id'} = 0 if !$form->{'parent_id'};
  37.  
  38.         if ($form->{'parent_id'}){
  39.            $patch =  $categoryP->{data}->{patch}."/".$self->urlConverter($form->{'name'});
  40.         }else{
  41.            $patch =  $self->urlConverter($form->{'name'});
  42.         }
  43.  
  44.             my %d  = (
  45.  
  46.             parent_id                   =>  $form->{'parent_id'},
  47.             name                                =>  $form->{'name'},
  48.             short_description           =>  $form->{'short_description'},
  49.             long_description            =>  $form->{'long_description'},
  50.             patch                               =>  $patch,
  51.             thumb                               =>  $imagen,
  52.             tags                                =>  $form->{'tags'},
  53.             meta_tags                   =>  $form->{'meta_tags'},
  54.             meta_description            =>  $form->{'meta_description'},
  55.             status                              =>  $form->{'status'},
  56.             );
  57.  
  58.             my $id = $category->update(\%d);
  59.  
  60.     return $id;
  61.  
  62.  
  63.  
  64.  
  65. }
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4

Y estos son los métodos update e insert:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. sub insert {
  2.     my $self = shift;
  3.     my $datos = shift;
  4.     my $dbh = $self->{dbh};
  5.     my $table_name      = $self->{table};
  6.     my $fields          = $self->{fields};
  7.     my $pk              = $self->{primary_key};
  8.     my (@campo,@valor);
  9.  
  10.     #===========================================
  11.     #Incrementar la primary key para CSV
  12.     #===========================================
  13.     if ($self->{db_type} eq 'CSV'){
  14.         my $ld = $self->getLastId($table_name,$pk);
  15.         $campo[0] = $pk;
  16.         $valor[0] = $ld;
  17.         #my $st = $dbh->prepare("SELECT * FROM $tabla ORDER By $pk DESC");
  18.         #$st->execute();
  19.     }
  20.     #===========================================
  21.  
  22.  
  23.     # RECORREMOS LOS DATOS Y SACAMOS LOS PARES LLAVES VALOR
  24.     foreach $key(keys %$datos){
  25.           push @campo, $key;
  26.           push @valor, $datos->{$key};
  27.     };
  28.  
  29.  
  30.    #  return  $datos;
  31.     my $query = 'INSERT INTO ' . $table_name;
  32.     $query .= ' (' . join( ',',@campo ). ')';
  33.     $query .= ' VALUES ('.join( ',', map { '?' } @valor ).')';
  34.     #return   $query;
  35.     my $sth = $dbh->prepare($query) or die $dbh->errstr()."QUERY: ".$query ;
  36.  
  37.  
  38.     if ( $sth->execute(@valor) or die $dbh->errstr()."QUERY: ".$query ) {
  39.  
  40.         my $ld =  $self->getLastId($table_name,$pk);
  41.         return $ld - 1;
  42.     }
  43.     else {
  44.         return 0;
  45.     }
  46. }
  47.  
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4


Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. sub update {
  2.         my $self = shift;
  3.     my $datos = shift;
  4.     my $dbh = $self->{dbh};
  5.     my $table_name      = $self->{table};
  6.     my $fields          = $self->{fields};
  7.     my $pk              = $self->{primary_key};
  8.     my (@campo,@valor);
  9.  
  10.  
  11.     # RECORREMOS LOS DATOS Y SACAMOS LOS PARES LLAVES VALOR
  12.     foreach $key(keys %$datos){
  13.           push @campo, $key;
  14.           push @valor, $datos->{$key};
  15.     };
  16.  
  17.     #return  @campo;
  18.     my $query = 'UPDATE ' . $table_name;
  19.     $query .= ' SET ';
  20.     $query .= join( ',', map { $_ . ' = ?' }  @campo );
  21.     $query .= ' WHERE ' . $pk . ' = ?';
  22.  
  23.     #return $query;
  24.      my $sth = $dbh->prepare($query) or die $dbh->errstr();
  25.  
  26.     if ( $sth->execute(@valor,$self->{data}->{$pk}) or die $dbh->errstr() ) {
  27.         return $pk;
  28.     }
  29.     else {
  30.         return 0;
  31.     }
  32. }
  33.  
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4


Bueno, es todo lo que tengo. Espero poder solucionar algo.

ANEXO ESTAS DOS FUNCIONES QUE LLAMAN a ambos metodos de editar e insertar:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. sub urlConverter {
  2.         my $selft = shift;
  3.         my $titulo = uc(shift);
  4.  
  5.  
  6.         $titulo = textoEncoded($titulo);
  7.  
  8.         $titulo =~ tr/áéíóúñÁÉÍÓÚÑÂÊÎÔÛâêîôûÄËÏÖÜäëïöü/AEIOUNAEIOUNAEIOUAEIOUAEIOUAEIOU/;
  9.         $titulo =~ s/\W/-/g;
  10.         $titulo =~ s/-{2,}/-/g;
  11.         $titulo =~ s/^(-)(.*)(-)$/$2/;
  12.  
  13.         return  lc($titulo) ;
  14. }
  15.  
  16. sub textoEncoded {
  17.         my $texto = shift;
  18.  
  19.         $texto = decode_entities($texto);
  20.         utf8::decode($texto);
  21.  
  22.         return $texto;
  23. }
  24.  
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
Última edición por explorer el 2018-08-05 13:21 @598, editado 1 vez en total
Razón: Faltas ortográficas.
100% Telch - Perl Web Programming
Cali PerlMongers: http://cali.pm.org
Avatar de Usuario
danimera
Perlero frecuente
Perlero frecuente
 
Mensajes: 871
Registrado: 2005-06-23 19:02 @834
Ubicación: Colombia

Publicidad

Re: Ayuda con problema de codificación

Notapor explorer » 2018-08-05 13:41 @612

Perl no sabe en qué codificación está lo que recibe, bien sea por la entrada estándar o al leer los archivos.

Y a la hora de mandar información, por defecto, siempre lo hará en latin1 (iso-8859-1).

En la mayoría de los casos, no nos daremos cuenta: si estamos leyendo una base de datos que está codificada en UTF-8 y la mostramos tal cual en la página web que, además, indicamos por el lado del servidor, o en la cabecera del HTML, que está codificada en UTF-8, entonces Perl no hará ninguna transformación (él pensará que es una ristra de bytes codificados en iso-8859-1 tanto a la entrada como a la salida), y por eso lo veremos bien en la web.

El problema es cuando nos llegan datos en una codificación que no esperamos.

Por eso, lo recomendable es, siempre, controlar las codificaciones a la entrada y a la salida del programa.

Si recibimos unos datos, ¿en qué codificación están? Si lo sabemos, los pasamos por Encode para que los transforme a Unicode dentro de Perl (Perl los tratará a partir de ahora como textos Unicode, no como ristras de bytes). Y luego, a la hora de la salida, en el momento de hacer el open(), o en el binmode(), indicamos en qué codificación queremos que Perl "traduzca" los caracteres Unicode al exterior.

Viendo las dos primeras imágenes...

"Educación Física" aparece correctamente en web. Dentro del archivo, deberían verse también bien, pero parece que tu editor de texto o terminal no está funcionando en UTF-8.

En cambio, "Gestión Inmobiliaria" aparece mal en web y bien en el archivo CSV. Eso ya te da la pista de:
  • la web está trabajando en UTF-8. Por eso se ve mal "Gestión".
  • la terminal o editor que muestra el CSV está trabajando en latin1. Por eso se ve bien "Gestión", pero no "Educación Física"
Así que... tus problemas empiezan con tu plataforma: debes trabajar en una codificación, a ser posible, la misma en la que está trabajando el servicio web. Si es UTF-8, debes trabajar en una plataforma UTF-8 para ahorrarte problemas. Hoy en día, todos los sistemas modernos ya trabajan en UTF-8.

No es obligatorio, pero hay que saber en qué (codificación) estamos, y en cuál queremos trabajar.

Y decírselo a Perl, que no lo sabe.

En el foro de Avanzado, el primer mensaje de 44 recetas para trabajar con Unicode en Perl hay un ejemplo de preámbulo para los programas para que funcionen en UTF-8. Pero lo importante es el "use open", que define las codificaciones a la entrada y a la salida.

Yo, por ejemplo, en mis programas, solo tengo que poner la línea

use utf8::all;

al principio del programa, y olvidarme.
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

Re: Ayuda con problema de codificación

Notapor danimera » 2018-08-05 20:22 @890

Agradezco la respuesta pero no me satisface totalmente puesto que trabajo todo con utf8 :)

Ya que quiero saber es por qué cuando inserto en la tabla funciona todo bien, pero cuando actualizo el registro se daña la codificación siendo que la vista que inserta o actualiza es la misma :)

Aunque creo que vi algo en el código que podrías explicarme, quizás es un error mio a la hora de crear las URL semánticas o amigables parece que se trabaja con la codificación, ya que solo quiero crear URL amigables y ese es el código, pero no entiendo por que hace una codificación ahí:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. sub friendly_url {
  2.         my $self = shift;
  3.         my $titulo = shift;
  4.         $titulo = textoEncoded($titulo);
  5.  
  6.  
  7. $titulo =~ tr[áéíóúñÁÉÍÓÚÑÂÊÎÔÛâêîôûÄËÏÖÜäëïöü]
  8.         [aeiounAEIOUNAEIOUaeiouAEIOUaeiou];
  9. $titulo =~ tr/ /-/s;         # la opción /s quita los caracteres duplicados
  10. $titulo =~ s/^-|-$//g;       # quita el inicial y final
  11.  
  12.         return  lc($titulo) ;
  13. }
  14.  
  15.  
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

Vemos que se llama una función textoEncode, y aquí creo que está el detalle.

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. sub textoEncoded {
  2.         my $texto = shift;
  3.  
  4.         $texto = decode_entities($texto);
  5.         utf8::decode($texto);
  6.  
  7.         return $texto;
  8. }
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
100% Telch - Perl Web Programming
Cali PerlMongers: http://cali.pm.org
Avatar de Usuario
danimera
Perlero frecuente
Perlero frecuente
 
Mensajes: 871
Registrado: 2005-06-23 19:02 @834
Ubicación: Colombia

Re: Ayuda con problema de codificación

Notapor explorer » 2018-08-07 21:19 @930

utf8::decode($cadena) no sirve para decodificar una cadena, si ésta llega con un codificación cualquiera.

Lo que hace es traducir las combinaciones de múltiples bytes de codificaciones utf8, en caracteres Unicode. Si lo consigue, activará el indicador utf8 de la $cadena para indicar que efectivamente está en UTF-8. Si no, la función devolverá falso.

Yo usaría las funciones del módulo Encode.

Es más... creo que el problema es que está recibiendo los nuevos registros en formato iso-8859-1, y los guarda tal cual. Eso es quizás porque la codificación de la página con el formulario de entrada está en esa codificación.

Y dices que trabajas todo con utf-8. Si es así, la segunda imagen es aún más perturbadora, ya que entonces lo que está mal son las entradas "Educación Física". ¿Es así? ¿Es ese el registro que está mal?
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

Re: Ayuda con problema de codificación

Notapor danimera » 2018-08-07 21:33 @939

explorer, eres un genio. El módulo DBD::CSV con el que trabajo tiene esta configuración usada por mi ¡ja,ja,ja!
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. $CFG{db_dsn} ="DBI:CSV:f_dir=".$CFG{path}."/data_files/;f_encoding=CP1252";
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

Es decir, que el administrador de contenidos que he realizado trabaja en formato ISO-8859-1, pero la página web donde muestra los datos definitivamente todo está configurado para trabajar como UTF-8.

El problema por el cual se daña en edición finalmente es producido cuando llamo a la función friendly_url() y al llamar, como dices tu, al utf8::decode($texto); ya que al comentar esta línea, los problema de codificación desaparecen y todo me funciona bien.

Ahora, para mí sería más fácil si existiera un módulo en Perl, y creo que no hay, para generar URL amigables y que un título como este:

me gusta la piña y la acción y la pe#%$

se transformara en:

me-gusta-la-pina-y-la-accion-y-la-po

Muchas gracias por tu ayuda. Me ha servido mucho y me di cuenta que realmente mi CMS no estaba en UTF-8 aunque la página web sí sale bien UTF-8.
100% Telch - Perl Web Programming
Cali PerlMongers: http://cali.pm.org
Avatar de Usuario
danimera
Perlero frecuente
Perlero frecuente
 
Mensajes: 871
Registrado: 2005-06-23 19:02 @834
Ubicación: Colombia

Re: Ayuda con problema de codificación

Notapor explorer » 2018-08-08 14:23 @641

No, yo tampoco he encontrado ningún módulo que cree URL amigables. Tampoco he buscado mucho.

Lo que haría... primero sería pasar el texto a una codificación más sencilla, por ejemplo, iso-8859-1, usando el módulo Encode.
Luego... lo pasaría a minúsculas con la función fc().
Y finalmente, le pasaría un tr/// como tienes definida antes (bueno, más corta porque solo nos interesa traducir los caracteres tildados en minúscula. Un pase por s/// para quitar los caracteres que no sean alfanuméricos o espacios. Y finalmente, otro paso por tr/// para traducir los espacios.
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


Volver a Web

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 0 invitados