Foro - Perl en Español

por **danimera** » 2018-08-05 12:11 @549

: listado.png (150.5 KiB) Visto 2421 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

Pondré por acá el código que tengo para guardar, insertar y actualizar.

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

sub category_add_process {
        my $self = shift;
        my $form = shift;
        my $dbh = $self->dbh;
        my $language = $self->current_language();
        my $category = MyApp::Db::Stock::Category->new($dbh);
        my $categoryP = MyApp::Db::Stock::Category->new($dbh);
        my $q = $self->query();
        my $patch,
        my $user = MyApp::Db::User->new($dbh);
        my @ue = $self->uploadFile('images');
 
 
 
    if ($ue[0]){
    if(!$self->thumbnail($ue[0],120,"thumb")){
        $self->resize($self->cfg('upload_dir')."/images/".$ue[0],120,"thumb");
        };
        }
 
    $user->retrieve_by('username',$self->authen->username);
    $form = $form->fields;
    $self->add_log('debug','Entra proceso guardar category :'.$q->param('name'));
 
    #Si no hay padre, entonces el padre es 0
    $form->{'parent_id'} = 0 if !$form->{'parent_id'};
 
 
            my %d  = (
 
            parent_id                           =>  $form->{'parent_id'},
            name                                        =>  $form->{'name'},
            short_description           =>  $form->{'short_description'},
            long_description            =>  $form->{'long_description'},
 
            thumb                                       =>  $ue[0],
            tags                                        =>  $form->{'tags'},
            meta_tags                           =>  $form->{'meta_tags'},
            meta_description            =>  $form->{'meta_description'},
            created_by                          =>  $user->{data}->{'user_id'},
            status                                      =>  $form->{'status'},
                creation_date                   =>      $self->fecha_actual,
            );
 
            my $id = $category->insert(\%d);
            $categoryP->retrieve($form->{'parent_id'});
            $category->retrieve($id);
 
        if ($form->{'parent_id'}){
                $patch =  $categoryP->{data}->{patch}."/".$self->urlConverter($form->{'name'});
        }else{
                $patch =  "".$self->urlConverter($form->{'name'});
        }
 
 
        $category->update({ patch  =>  $patch  });
 
 
    return $id;
 
}
 
Coloreado en 0.003 segundos,  usando GeSHi 1.0.8.4

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

sub category_edit_process {
        my $self = shift;
        my $form = shift;
        my $dbh = $self->dbh;
        my $language = $self->current_language();
        my $category = MyApp::Db::Stock::Category->new($dbh);
        my $categoryP = MyApp::Db::Stock::Category->new($dbh);
        my $q = $self->query();
        my $user = MyApp::Db::User->new($dbh);
        my @ue = $self->uploadFile('images');
        my $imagen;
       $form = $form->fields;
 
 
 
    if($ue[0] ){
 
        $imagen =  $ue[0];
        if(!$self->thumbnail($ue[0],120,"thumb")){
                $self->resize($self->cfg('upload_dir')."/images/".$ue[0],120,"thumb");
                };
 
        unlink($self->cfg('upload_dir')."/images/".$form->{'last_thumb'});
        unlink($self->cfg('upload_dir')."/images/thumb_".$form->{'last_thumb'});
 
        }else{
 
                $imagen = $form->{'last_thumb'}
        }
 
       $user->retrieve_by('username',$self->authen->username);
       $self->add_log('debug','Entra proceso editar category :'.$q->param('name'));
 
       $category->retrieve($form->{'category_id'});
       $categoryP->retrieve($form->{'parent_id'});
       $form->{'parent_id'} = 0 if !$form->{'parent_id'};
 
        if ($form->{'parent_id'}){
           $patch =  $categoryP->{data}->{patch}."/".$self->urlConverter($form->{'name'});
        }else{
           $patch =  $self->urlConverter($form->{'name'});
        }
 
            my %d  = (
 
            parent_id                   =>  $form->{'parent_id'},
            name                                =>  $form->{'name'},
            short_description           =>  $form->{'short_description'},
            long_description            =>  $form->{'long_description'},
            patch                               =>  $patch,
            thumb                               =>  $imagen,
            tags                                =>  $form->{'tags'},
            meta_tags                   =>  $form->{'meta_tags'},
            meta_description            =>  $form->{'meta_description'},
            status                              =>  $form->{'status'},
            );
 
            my $id = $category->update(\%d);
 
    return $id;
 
 
 
 
}
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

sub insert {
    my $self = shift;
    my $datos = shift;
    my $dbh = $self->{dbh};
    my $table_name      = $self->{table};
    my $fields          = $self->{fields};
    my $pk              = $self->{primary_key};
    my (@campo,@valor);
 
    #===========================================
    #Incrementar la primary key para CSV
    #===========================================
    if ($self->{db_type} eq 'CSV'){
        my $ld = $self->getLastId($table_name,$pk);
        $campo[0] = $pk;
        $valor[0] = $ld;
        #my $st = $dbh->prepare("SELECT * FROM $tabla ORDER By $pk DESC");
        #$st->execute();
    }
    #===========================================
 
 
    # RECORREMOS LOS DATOS Y SACAMOS LOS PARES LLAVES VALOR
    foreach $key(keys %$datos){
          push @campo, $key;
          push @valor, $datos->{$key};
    };
 
 
   #  return  $datos;
    my $query = 'INSERT INTO ' . $table_name;
    $query .= ' (' . join( ',',@campo ). ')';
    $query .= ' VALUES ('.join( ',', map { '?' } @valor ).')';
    #return   $query;
    my $sth = $dbh->prepare($query) or die $dbh->errstr()."QUERY: ".$query ;
 
 
    if ( $sth->execute(@valor) or die $dbh->errstr()."QUERY: ".$query ) {
 
        my $ld =  $self->getLastId($table_name,$pk);
        return $ld - 1;
    }
    else {
        return 0;
    }
}
 
Coloreado en 0.002 segundos,  usando GeSHi 1.0.8.4

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

sub update {
        my $self = shift;
    my $datos = shift;
    my $dbh = $self->{dbh};
    my $table_name      = $self->{table};
    my $fields          = $self->{fields};
    my $pk              = $self->{primary_key};
    my (@campo,@valor);
 
 
    # RECORREMOS LOS DATOS Y SACAMOS LOS PARES LLAVES VALOR
    foreach $key(keys %$datos){
          push @campo, $key;
          push @valor, $datos->{$key};
    };
 
    #return  @campo;
    my $query = 'UPDATE ' . $table_name;
    $query .= ' SET ';
    $query .= join( ',', map { $_ . ' = ?' }  @campo );
    $query .= ' WHERE ' . $pk . ' = ?';
 
    #return $query;
     my $sth = $dbh->prepare($query) or die $dbh->errstr();
 
    if ( $sth->execute(@valor,$self->{data}->{$pk}) or die $dbh->errstr() ) {
        return $pk;
    }
    else {
        return 0;
    }
}
 
Coloreado en 0.001 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

sub urlConverter {
        my $selft = shift;
        my $titulo = uc(shift);
 
 
        $titulo = textoEncoded($titulo);
 
        $titulo =~ tr/á&eacute;&iacute;&oacute;úñÁÉÍÓÚÑÂÊÎÔÛâêîôûÄËÏÖÜäëïöü/AEIOUNAEIOUNAEIOUAEIOUAEIOUAEIOU/;
        $titulo =~ s/\W/-/g;
        $titulo =~ s/-{2,}/-/g;
        $titulo =~ s/^(-)(.*)(-)$/$2/;
 
        return  lc($titulo) ;
}
 
sub textoEncoded {
        my $texto = shift;
 
        $texto = decode_entities($texto);
        utf8::decode($texto);
 
        return $texto;
}
 
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

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.

por **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

sub friendly_url {
        my $self = shift;
        my $titulo = shift;
        $titulo = textoEncoded($titulo);
 
 
$titulo =~ tr[áéíóúñÁÉÍÓÚÑÂÊÎÔÛâêîôûÄËÏÖÜäëïöü]
        [aeiounAEIOUNAEIOUaeiouAEIOUaeiou];
$titulo =~ tr/ /-/s;         # la opción /s quita los caracteres duplicados
$titulo =~ s/^-|-$//g;       # quita el inicial y final
 
        return  lc($titulo) ;
}
 
 
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

sub textoEncoded {
        my $texto = shift;
 
        $texto = decode_entities($texto);
        utf8::decode($texto);
 
        return $texto;
}
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

por **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?

por **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

$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.

por **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.

Foro - Perl en Español

Ayuda con problema de codificación

Ayuda con problema de codificación

Publicidad

Re: Ayuda con problema de codificación

Re: Ayuda con problema de codificación

Re: Ayuda con problema de codificación

Re: Ayuda con problema de codificación

Re: Ayuda con problema de codificación

¿Quién está conectado?