[GENERAL] Plperl functions with OUT parameters crashing each other when used in the same connection

[Philippe Lang]

Hi,

I've got a strange bug with two plperl functions using OUT parameters: with a 
fresh ODBC or pgAdmin connection, I can call the first function, but then all 
further calls to the second function fail, or call the the second function, but 
then all further calls to the first function fail. Even more strange: when the 
second call fails, the message changes at each new try, mentioning one of the 
variables used as OUT parameters in the other function. Something is apprently 
not released from memory between each calls.

I'm using plperlu further in the program, with CPAN libraries; is the mix 
between plperl and plperlu forbidden, or can this be a "plperlU" effect?

Thanks for your help,

Cheers,


------------------------------------------------------------
--  FUNCTION: volets_fiche_fab_1
------------------------------------------------------------
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

$$

    
#----------------------------------------------------------------------------
    #-- 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 my $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
        my $vtxg;
        my $vtxd;
        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(@_);
    }

    
#----------------------------------------------------------------------------
    #-- Helper functions
    
#----------------------------------------------------------------------------
    end_sub(@_);

    sub start_sub
    {
        init(@_);
    }

    sub end_sub
    {
        return undef;
    }

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

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

$$
  
LANGUAGE 'plperl' VOLATILE;

------------------------------------------------------------
--  FUNCTION: volets_fiche_fab_2
------------------------------------------------------------
CREATE OR REPLACE FUNCTION public.volets_fiche_fab_2
(
    IN id_commande              int4,

    OUT pos                           int4,
    OUT article                 varchar(50),
    OUT montage                 varchar(50),
    OUT quant                   int4,
    OUT long                    int4,
    OUT larg                    int4,
    OUT haut                    int4
)
RETURNS SETOF record
AS

$$

    
#----------------------------------------------------------------------------
    #-- Configuration des paramètres de la fonction
    
#----------------------------------------------------------------------------
    @i = ( 'id_commande'
         );
    
    @io = ();
    
    @o = ( 'pos',
             'article', 
           'montage',
           'quant',
           'long', 
           'larg',
           'haut'
         );

    
#----------------------------------------------------------------------------
    #-- 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 my $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};

        # On passe en revue l'éclaté des pièces de la ligne
        for ($j = 0; $j < $fab_nrows; $j = $j + 1)
        {
            if (($fab->{rows}[$j]->{'article'} =~ 
/^(Montant|Traverse|Palette|Panneau|Baguette|Couvre-joint)/) &&
                ($fab->{rows}[$j]->{'t'} eq 'E'))
            {
                $output{'pos'} = $lignes->{rows}[$lignes_rn]->{'pos'};
                $output{'article'} = $fab->{rows}[$j]->{'article'};
                $output{'montage'} = $fab->{rows}[$j]->{'montage'};
                $output{'quant'} = $fab->{rows}[$j]->{'quant'};
                $output{'long'} = $fab->{rows}[$j]->{'long'};
                $output{'larg'} = $fab->{rows}[$j]->{'larg'};
                $output{'haut'} = $fab->{rows}[$j]->{'haut'};
                ret(@_);
            }
        }
    }

    
#----------------------------------------------------------------------------
    #-- Helper functions
    
#----------------------------------------------------------------------------
    end_sub(@_);

    sub start_sub
    {
        init(@_);
    }

    sub end_sub
    {
        return undef;
    }

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

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

$$
  
LANGUAGE 'plperl' VOLATILE;



----------------------------------
Philippe Lang, Ing. Dipl. EPFL
Attik System
rte de la Fonderie 2
1700 Fribourg
Switzerland
http://www.attiksystem.ch

Tel:  +41 (26) 422 13 75
Fax:  +41 (26) 422 13 76  

smime.p7s
Description: S/MIME cryptographic signature