Thread: Postgresql 8.1: plperl code works with LATIN1, fails with UTF8

Hi,

I've got plperl code that works just fine when the database is encoded using LATIN1, but fails as soon as I switch to
UTF8.

I've been testing PG 8.1.4 under Linux, and PG 8.1.6 under FreeBSD, both behave exactly the save.

I'm sorry I'm not able to strip down the code, and show you a small test, but if anyone need the full script, feel free
toask me per email. 

The code is made up of plperl routines, all structured in the same way, but only one of them fails in UTF8. It is:


#----------------------------------------------------------------------------
CREATE OR REPLACE FUNCTION public.volets_fiche_fab_1 (
    IN    id_commande        int4,

    OUT pos            int4,
    OUT quant            int4,
    OUT nbre_vtx        int4,
    OUT nbre_vtx_total        int4,
    OUT larg_maconnerie        int4,
    OUT haut_maconnerie        int4,
    OUT larg_vtx            varchar(20),
    OUT haut_vtx        int4,
    OUT ouv                     int4,
    OUT couvre_joints           text,
    OUT coupe_verticale         text,
    OUT vide_interieur          varchar(20),
    OUT typ            varchar(20)
)
RETURNS SETOF record
AS

$$

    BEGIN { strict->import(); }

    #----------------------------------------------------------------------------
    #-- Lexical variables
    #----------------------------------------------------------------------------
    my @i;
    my @io;
    my @o;
    my $i;
    my $io;
    my $o;
    my %input;
    my %output;
    my $fab;
    my $fab_nrows;
    my $lignes_query;
    my $lignes;
    my $lignes_nrows;
    my $lignes_rn;
    my $c;
    my $j;
    my $key;
    my $value;
    my $ordre;
    my $vtxg;
    my $vtxd;

    #----------------------------------------------------------------------------
    #-- Helper functions
    #----------------------------------------------------------------------------
    my $init = sub
    {
    $c = 0;
        foreach $i (@i) {$input{$i} = @_[$c++]};
        foreach $io (@io) {$input{$io} = @_[$c]; $output{$io} = @_[$c++]};
        foreach $o (@o) {$output{$o} = @_[$c++]};
    };

    my $start_sub = sub
    {
        &$init(@_);
    };

    my $end_sub = sub
    {
        return undef;
    };

    my $ret = sub
    {
    while (($key, $value) = each %output) {if (!defined($value)) {elog(ERROR, 'Valeur indéfinie pour ' . $key)}};
    return_next \%output;
    &$init(@_);
    };

    #----------------------------------------------------------------------------
    #-- Configuration des paramètres de la fonction
    #----------------------------------------------------------------------------
    @i = ( 'id_commande'
         );

    @io = ();

    @o = ( 'pos',
       'quant',
           'nbre_vtx',
           'nbre_vtx_total',
           'larg_maconnerie',
           'haut_maconnerie',
           'larg_vtx',
           'haut_vtx',
           'ouv',
           'couvre_joints',
       'coupe_verticale',
           'vide_interieur',
       'typ'
         );

    #----------------------------------------------------------------------------
    #-- Préparation des paramètres de la fonction
    #----------------------------------------------------------------------------
    &$start_sub(@_);

    #----------------------------------------------------------------------------
    #-- Création de la fiche de fabrication
    #----------------------------------------------------------------------------
    $lignes_query = 'SELECT * FROM lignes WHERE id_commande = ' . $input{'id_commande'} . ' ORDER BY pos;';
    $lignes = spi_exec_query($lignes_query);
    $lignes_nrows = $lignes->{processed};
    foreach $lignes_rn (0 .. $lignes_nrows - 1)
    {
    # Fabrication de la ligne
    $fab = spi_exec_query('SELECT * FROM volets_fab(' . $lignes->{rows}[$lignes_rn]->{'id'} . ');');
    $fab_nrows = $fab->{processed};

    # Recherches des éventuels vantaux de gauche et droite
    for ($j = 0; ($fab->{rows}[$j]->{'article'} ne 'Largeur de vantail gauche') and ($j < $fab_nrows); $j = $j + 1) {};
    if ($j < $fab_nrows) { $vtxg = $fab->{rows}[$j]->{'larg'}; }
    for ($j = 0; ($fab->{rows}[$j]->{'article'} ne 'Largeur de vantail droite') and ($j < $fab_nrows); $j = $j + 1) {};
    if ($j < $fab_nrows) { $vtxd = $fab->{rows}[$j]->{'larg'}; }

    # Position
    $output{'pos'} = $lignes->{rows}[$lignes_rn]->{'pos'};

    # Quantité
        $output{'quant'} = $lignes->{rows}[$lignes_rn]->{'quant'};

    # Nombre de vantaux
    $output{'nbre_vtx'} = $lignes->{rows}[$lignes_rn]->{'nbre_vtx'};

    # Nombre de vantaux total
    $output{'nbre_vtx_total'} = $lignes->{rows}[$lignes_rn]->{'nbre_vtx'} * $lignes->{rows}[$lignes_rn]->{'quant'};

    # Largeur de maçonnerie
    for ($j = 0; ($fab->{rows}[$j]->{'article'} ne 'Largeur de maçonnerie') and ($j < $fab_nrows); $j = $j + 1) {};
    if ($j < $fab_nrows) { $output{'larg_maconnerie'} = $fab->{rows}[$j]->{'larg'}; }
    else { $output{'larg_maconnerie'} = ''; };

    # Hauteur de maçonnerie
        for ($j = 0; ($fab->{rows}[$j]->{'article'} ne 'Hauteur de maçonnerie') and ($j < $fab_nrows); $j = $j + 1) {};
    if ($j < $fab_nrows) { $output{'haut_maconnerie'} = $fab->{rows}[$j]->{'haut'}; }
    else { $output{'haut_maconnerie'} = ''; };

        # Largeur de vantail
    if (defined($vtxg) and defined($vtxd))
    {
        # Vantaux asymétriques
        $output{'larg_vtx'} = $vtxg . " / " . $vtxd;
    }
    else
    {
        # Vantaux symétriques
        for ($j = 0; ($fab->{rows}[$j]->{'article'} ne 'Largeur de vantail') and ($j < $fab_nrows); $j = $j + 1) {};
        if ($j < $fab_nrows) { $output{'larg_vtx'} = $fab->{rows}[$j]->{'larg'}; }
        else { $output{'larg_vtx'} = ''; };
    }

    # Hauteur de vantail
        for ($j = 0; ($fab->{rows}[$j]->{'article'} ne 'Hauteur de vantail') and ($j < $fab_nrows); $j = $j + 1) {};
    if ($j < $fab_nrows) { $output{'haut_vtx'} = $fab->{rows}[$j]->{'haut'}; }
    else { $output{'haut_vtx'} = ''; };

        # Type d'ouverture
    $output{'ouv'} = $lignes->{rows}[$lignes_rn]->{'ouv'};

    # Image des couvre-joints
    for ($j = 0; ($fab->{rows}[$j]->{'article'} ne 'Couvre-joints') and ($j < $fab_nrows); $j = $j + 1) {};
    if ($j < $fab_nrows) { $output{'couvre_joints'} = $fab->{rows}[$j]->{'image'}; }
    else { $output{'couvre_joints'} = ''; };

    # Image de la coupe verticape
    for ($j = 0; ($fab->{rows}[$j]->{'article'} ne 'Coupe verticale') and ($j < $fab_nrows); $j = $j + 1) {};
    if ($j < $fab_nrows) { $output{'coupe_verticale'} = $fab->{rows}[$j]->{'image'}; }
    else { $output{'coupe_verticale'} = ''; };

    # Vide intérieur
    if (defined($vtxg) and defined($vtxd))
    {
        # Vantaux asymétriques
        $output{'vide_interieur'} = ($vtxg - 106) . " / " . ($vtxd - 106);
    }
    else
    {
        # Vantaux symétriques
        for ($j = 0; ($fab->{rows}[$j]->{'article'} ne 'Largeur de vantail') and ($j < $fab_nrows); $j = $j + 1) {};
        if ($j < $fab_nrows) { $output{'vide_interieur'} = $fab->{rows}[$j]->{'larg'} - 106; }
        else { $output{'vide_interieur'} = ''; };
    }

    # Type de volet
    $output{'typ'} = $lignes->{rows}[$lignes_rn]->{'typ'};

    # Sortie
        &$ret(@_);
    }

    #----------------------------------------------------------------------------
    #-- Fin de la fonction
    #----------------------------------------------------------------------------
    &$end_sub(@_);

$$

LANGUAGE 'plperl' VOLATILE;
#----------------------------------------------------------------------------


When running:
-------------

  select * from volets_fiche_fab_1(1)

Database replies:
-----------------

  ERROR: error from Perl function: invalid input syntax for integer: "" at line 54.
  SQL state: XX000



Does anyone have a small idea where to search?

Thanks

Philippe Lang

On Fri, Jan 26, 2007 at 06:17:03PM +0100, Philippe Lang wrote:
> I've got plperl code that works just fine when the database is
> encoded using LATIN1, but fails as soon as I switch to UTF8.
>
> I've been testing PG 8.1.4 under Linux, and PG 8.1.6 under FreeBSD,
> both behave exactly the save.
[...]
>   ERROR: error from Perl function: invalid input syntax for integer: "" at line 54.

The function has several integer output parameters and in some cases
the code sets the output value to '' (empty string).  A couple of
those cases (larg_maconnerie, haut_maconnerie) involve comparisons
against strings with non-ASCII characters -- if you add an elog()
statement in each of those places you'll probably see that at least
one of them is being reached unexpectedly.

Aside from the fact that an empty string isn't a valid integer, I
think the problem can be reduced to the following example:

CREATE FUNCTION test(text) RETURNS boolean AS $$
  return ($_[0] eq 'ä') ? 't' : 'f';
$$ LANGUAGE plperl IMMUTABLE STRICT;

SELECT test('ä');
 test
------
 f
(1 row)

In an 8.1.6 UTF-8 database this example returns false; in 8.2.1 it
returns true.  See the following commit message and the related bug
report regarding PL/Perl and UTF-8:

http://archives.postgresql.org/pgsql-committers/2006-10/msg00277.php
http://archives.postgresql.org/pgsql-bugs/2006-10/msg00077.php

If you can't upgrade to 8.2 then you might be able to work around
the problem by creating the function as plperlu and adding 'use utf8;'.

--
Michael Fuhr

pgsql-general-owner@postgresql.org wrote:

> If you can't upgrade to 8.2 then you might be able to work around the
> problem by creating the function as plperlu and adding 'use utf8;'.

After upgrading to 8.2.1, everything runs just fine. Thanks a lot for
your help,

Regards,

Philippe Lang