Forums PostgreSQL.fr

set client_min_messages='WARNING';

drop database if exists test_pg_perl;
create database test_pg_perl;
\c test_pg_perl

create extension unaccent;
create extension plperl;
create extension plperlu;


create or replace function perl_unaccent(param_charset text, param_string text) returns text as $$
        use Text::Unaccent;
        return unac_string($_[0],$_[1]);
$$ language plperlu immutable strict;


create or replace function perl_unaccent_with_bigmap(param_string text) returns text as $$
# Based on:
# http://cpansearch.perl.org/src/PJACKLAM/Text-Unaccent-PurePerl-0.05/lib/Text/Unaccent/PurePerl.pm
# Author:      Peter John Acklam
# Time-stamp:  2013-03-02 12:38:55 +00:00
# E-mail:      pjacklam@online.no
# URL:         http://home.online.no/~pjacklam
if (!defined $_SHARED) {
$_SHARED={
 # 00A0 NO-BREAK SPACE
 # ->   0020 SPACE
 "\xA0" => " ",
--------------------(CUT)--------------------
 # FFEE HALFWIDTH WHITE CIRCLE
 # ->   25CB WHITE CIRCLE
 "\x{FFEE}" => "\x{25CB}"
}
};
my $str_in=$_[0];
my $str_out='';
my $offset_max=length($str_in)-1;
for my $offset (0..$offset_max) {
  my $chr=substr($str_in,$offset,1);
  $str_out.=exists $_SHARED->{$chr} ? $_SHARED->{$chr} : $chr;
};
return $str_out;
$$ language plperl immutable strict;


create or replace function perl_unicode_normalize(param_string text) returns text as $$
        use Unicode::Normalize;
        my $w=NFD($_[0]);
        $w =~ s/\pM//g;  # strip combining characters
        return $w;
$$ language plperlu immutable strict;


\set str2unacc '''Ça va, lʼœil de Владимир a été passé au Kärcher !'''
\echo Test sur la chaine: :str2unacc
select unaccent(:str2unacc);
select perl_unaccent('utf-8',:str2unacc);
select perl_unaccent_with_bigmap(:str2unacc);
select perl_unicode_normalize(:str2unacc);

\set loops 5000
\echo Test sur :loops appels:
explain analyze select unaccent(:str2unacc||seq)                  from generate_series(1,:loops) as tbl(seq);
explain analyze select perl_unaccent('utf-8',:str2unacc||seq)     from generate_series(1,:loops) as tbl(seq);
explain analyze select perl_unaccent_with_bigmap(:str2unacc||seq) from generate_series(1,:loops) as tbl(seq);
explain analyze select perl_unicode_normalize(:str2unacc||seq)    from generate_series(1,:loops) as tbl(seq);

Test sur la chaine: 'Ça va, lʼœil de Владимир a été passé au Kärcher !'
                     unaccent                      
---------------------------------------------------
 Ca va, lʼeil de Владимир a ete passe au Karcher !

                               perl_unaccent                                
----------------------------------------------------------------------------
 Ca va, lʼÅ\u0093il de Ð\u0092ладимиÑ\u0080 a ete passe au Karcher !

             perl_unaccent_with_bigmap             
---------------------------------------------------
 Ca va, lʼœil de Владимир a ete passe au Karcher !

              perl_unicode_normalize               
---------------------------------------------------
 Ca va, lʼœil de Владимир a ete passe au Karcher !
(1 ligne)

Test sur 5000 appels:
                                                        QUERY PLAN                                                        
--------------------------------------------------------------------------------------------------------------------------
 Function Scan on generate_series tbl  (cost=0.00..20.00 rows=1000 width=4) (actual time=0.528..11.804 rows=5000 loops=1)
 Total runtime: 12.073 ms

                                                        QUERY PLAN                                                         
---------------------------------------------------------------------------------------------------------------------------
 Function Scan on generate_series tbl  (cost=0.00..267.50 rows=1000 width=4) (actual time=0.509..55.731 rows=5000 loops=1)
 Total runtime: 56.385 ms

                                                         QUERY PLAN                                                         
----------------------------------------------------------------------------------------------------------------------------
 Function Scan on generate_series tbl  (cost=0.00..267.50 rows=1000 width=4) (actual time=0.469..164.947 rows=5000 loops=1)
 Total runtime: 165.531 ms

                                                        QUERY PLAN                                                         
---------------------------------------------------------------------------------------------------------------------------
 Function Scan on generate_series tbl  (cost=0.00..267.50 rows=1000 width=4) (actual time=0.455..92.159 rows=5000 loops=1)
 Total runtime: 92.847 ms

drop database if exists test_pg_perl;
create database test_pg_perl;
\c test_pg_perl

create extension unaccent;
create extension plperl;
create extension plperlu;

create or replace function perl_unaccent(param_charset text, param_string text) returns text as $$
        use Text::Unaccent;
        return unac_string($_[0],$_[1]);
$$ language plperlu immutable strict;

create or replace function perl_unaccent_pure(param_string text) returns text as $$
# http://cpansearch.perl.org/src/PJACKLAM/Text-Unaccent-PurePerl-0.05/lib/Text/Unaccent/PurePerl.pm
# Author:      Peter John Acklam
# Time-stamp:  2013-03-02 12:38:55 +00:00
# E-mail:      pjacklam@online.no
# URL:         http://home.online.no/~pjacklam
my $map = {
 # 00A0 NO-BREAK SPACE
 # ->   0020 SPACE
 "\xA0" => " ",
...
########################### bon là, j'ai viré tout le tableau associatif pour le paste...
...
 # FFEE HALFWIDTH WHITE CIRCLE
 # ->   25CB WHITE CIRCLE
 "\x{FFEE}" => "\x{25CB}"
};
my $str_in=$_[0];
# Iterate over each character in the input string. If the character exists
# in the map, replace the current character according to the map, otherwise
# keep the character as it is.
my $str_out = '';
my $offset_max = length($str_in) - 1;
for my $offset (0 .. $offset_max) {
  my $chr = substr($str_in, $offset, 1);
  $str_out .= exists $map->{$chr} ? $map->{$chr} : $chr;
};
return $str_out;
$$ language plperl;

\set str2unacc '''Mon œil à été passé au Kärcher'''
\set loops 5000
explain analyze select unaccent(:str2unacc) from generate_series(1,:loops);
explain analyze select perl_unaccent('utf-8',:str2unacc) from generate_series(1,:loops);
explain analyze select perl_unaccent_pure(:str2unacc) from generate_series(1,:loops);

                                                     QUERY PLAN                                                      
---------------------------------------------------------------------------------------------------------------------
 Function Scan on generate_series  (cost=0.00..12.50 rows=1000 width=0) (actual time=0.579..7.934 rows=5000 loops=1)
 Total runtime: 8.207 ms

                                                     QUERY PLAN                                                      
---------------------------------------------------------------------------------------------------------------------
 Function Scan on generate_series  (cost=0.00..10.00 rows=1000 width=0) (actual time=0.406..0.840 rows=5000 loops=1)
 Total runtime: 1.078 ms

                                                       QUERY PLAN                                                        
-------------------------------------------------------------------------------------------------------------------------
 Function Scan on generate_series  (cost=0.00..260.00 rows=1000 width=0) (actual time=2.207..7790.519 rows=5000 loops=1)
 Total runtime: 7791.658 ms