Skip to content

P
Postgres FD Implementation
Commit 50d89d42 authored by Andrew Dunstan's avatar Andrew Dunstan
Browse files
Options

Force strings passed to and from plperl to be in UTF8 encoding. 

String are converted to UTF8 on the way into perl and to the
database encoding on the way back. This avoids a number of
observed anomalies, and ensures Perl a consistent view of the
world.

Some minor code cleanups are also accomplished.

Alex Hunsaker, reviewed by Andy Colson.
parent 5ed45ac0
Show whitespace changes
Inline Side-by-side
Showing with 295 additions and 160 deletions
doc/src/sgml/plperl.sgml
View file @ 50d89d42
...@@ -125,6 +125,14 @@ $$ LANGUAGE plperl; ...@@ -125,6 +125,14 @@ $$ LANGUAGE plperl;
</programlisting> </programlisting>
</para> </para>
<note>
<para>
Arguments will be converted from the database's encoding to UTF-8
for use inside plperl, and then converted from UTF-8 back to the
database encoding upon return.
</para>
</note>
<para> <para>
If an SQL null value<indexterm><primary>null value</><secondary If an SQL null value<indexterm><primary>null value</><secondary
sortas="PL/Perl">in PL/Perl</></indexterm> is passed to a function, sortas="PL/Perl">in PL/Perl</></indexterm> is passed to a function,
......
src/pl/plperl/SPI.xs
View file @ 50d89d42
...@@ -9,11 +9,14 @@ ...@@ -9,11 +9,14 @@
/* this must be first: */ /* this must be first: */
#include "postgres.h" #include "postgres.h"
#include "mb/pg_wchar.h" /* for GetDatabaseEncoding */
/* Defined by Perl */ /* Defined by Perl */
#undef _ #undef _
/* perl stuff */ /* perl stuff */
#include "plperl.h" #include "plperl.h"
#include "plperl_helpers.h"
/* /*
...@@ -50,18 +53,21 @@ PROTOTYPES: ENABLE ...@@ -50,18 +53,21 @@ PROTOTYPES: ENABLE
VERSIONCHECK: DISABLE VERSIONCHECK: DISABLE
SV* SV*
spi_spi_exec_query(query, ...) spi_spi_exec_query(sv, ...)
char* query; SV* sv;
PREINIT: PREINIT:
HV *ret_hash; HV *ret_hash;
int limit = 0; int limit = 0;
char *query;
CODE: CODE:
if (items > 2) if (items > 2)
croak("Usage: spi_exec_query(query, limit) " croak("Usage: spi_exec_query(query, limit) "
"or spi_exec_query(query)"); "or spi_exec_query(query)");
if (items == 2) if (items == 2)
limit = SvIV(ST(1)); limit = SvIV(ST(1));
query = sv2cstr(sv);
ret_hash = plperl_spi_exec(query, limit); ret_hash = plperl_spi_exec(query, limit);
pfree(query);
RETVAL = newRV_noinc((SV*) ret_hash); RETVAL = newRV_noinc((SV*) ret_hash);
OUTPUT: OUTPUT:
RETVAL RETVAL
...@@ -73,27 +79,32 @@ spi_return_next(rv) ...@@ -73,27 +79,32 @@ spi_return_next(rv)
do_plperl_return_next(rv); do_plperl_return_next(rv);
SV * SV *
spi_spi_query(query) spi_spi_query(sv)
char *query; SV *sv;
CODE: CODE:
char* query = sv2cstr(sv);
RETVAL = plperl_spi_query(query); RETVAL = plperl_spi_query(query);
pfree(query);
OUTPUT: OUTPUT:
RETVAL RETVAL
SV * SV *
spi_spi_fetchrow(cursor) spi_spi_fetchrow(sv)
char *cursor; SV* sv;
CODE: CODE:
char* cursor = sv2cstr(sv);
RETVAL = plperl_spi_fetchrow(cursor); RETVAL = plperl_spi_fetchrow(cursor);
pfree(cursor);
OUTPUT: OUTPUT:
RETVAL RETVAL
SV* SV*
spi_spi_prepare(query, ...) spi_spi_prepare(sv, ...)
char* query; SV* sv;
CODE: CODE:
int i; int i;
SV** argv; SV** argv;
char* query = sv2cstr(sv);
if (items < 1) if (items < 1)
Perl_croak(aTHX_ "Usage: spi_prepare(query, ...)"); Perl_croak(aTHX_ "Usage: spi_prepare(query, ...)");
argv = ( SV**) palloc(( items - 1) * sizeof(SV*)); argv = ( SV**) palloc(( items - 1) * sizeof(SV*));
...@@ -101,18 +112,20 @@ spi_spi_prepare(query, ...) ...@@ -101,18 +112,20 @@ spi_spi_prepare(query, ...)
argv[i - 1] = ST(i); argv[i - 1] = ST(i);
RETVAL = plperl_spi_prepare(query, items - 1, argv); RETVAL = plperl_spi_prepare(query, items - 1, argv);
pfree( argv); pfree( argv);
pfree(query);
OUTPUT: OUTPUT:
RETVAL RETVAL
SV* SV*
spi_spi_exec_prepared(query, ...) spi_spi_exec_prepared(sv, ...)
char * query; SV* sv;
PREINIT: PREINIT:
HV *ret_hash; HV *ret_hash;
CODE: CODE:
HV *attr = NULL; HV *attr = NULL;
int i, offset = 1, argc; int i, offset = 1, argc;
SV ** argv; SV ** argv;
char *query = sv2cstr(sv);
if ( items < 1) if ( items < 1)
Perl_croak(aTHX_ "Usage: spi_exec_prepared(query, [\\%%attr,] " Perl_croak(aTHX_ "Usage: spi_exec_prepared(query, [\\%%attr,] "
"[\\@bind_values])"); "[\\@bind_values])");
...@@ -128,15 +141,17 @@ spi_spi_exec_prepared(query, ...) ...@@ -128,15 +141,17 @@ spi_spi_exec_prepared(query, ...)
ret_hash = plperl_spi_exec_prepared(query, attr, argc, argv); ret_hash = plperl_spi_exec_prepared(query, attr, argc, argv);
RETVAL = newRV_noinc((SV*)ret_hash); RETVAL = newRV_noinc((SV*)ret_hash);
pfree( argv); pfree( argv);
pfree(query);
OUTPUT: OUTPUT:
RETVAL RETVAL
SV* SV*
spi_spi_query_prepared(query, ...) spi_spi_query_prepared(sv, ...)
char * query; SV * sv;
CODE: CODE:
int i; int i;
SV ** argv; SV ** argv;
char *query = sv2cstr(sv);
if ( items < 1) if ( items < 1)
Perl_croak(aTHX_ "Usage: spi_query_prepared(query, " Perl_croak(aTHX_ "Usage: spi_query_prepared(query, "
"[\\@bind_values])"); "[\\@bind_values])");
...@@ -145,20 +160,25 @@ spi_spi_query_prepared(query, ...) ...@@ -145,20 +160,25 @@ spi_spi_query_prepared(query, ...)
argv[i - 1] = ST(i); argv[i - 1] = ST(i);
RETVAL = plperl_spi_query_prepared(query, items - 1, argv); RETVAL = plperl_spi_query_prepared(query, items - 1, argv);
pfree( argv); pfree( argv);
pfree(query);
OUTPUT: OUTPUT:
RETVAL RETVAL
void void
spi_spi_freeplan(query) spi_spi_freeplan(sv)
char *query; SV *sv;
CODE: CODE:
char *query = sv2cstr(sv);
plperl_spi_freeplan(query); plperl_spi_freeplan(query);
pfree(query);
void void
spi_spi_cursor_close(cursor) spi_spi_cursor_close(sv)
char *cursor; SV *sv;
CODE: CODE:
char *cursor = sv2cstr(sv);
plperl_spi_cursor_close(cursor); plperl_spi_cursor_close(cursor);
pfree(cursor);
BOOT: BOOT:
......
src/pl/plperl/Util.xs
View file @ 50d89d42
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
/* perl stuff */ /* perl stuff */
#include "plperl.h" #include "plperl.h"
#include "plperl_helpers.h"
/* /*
* Implementation of plperl's elog() function * Implementation of plperl's elog() function
...@@ -34,13 +34,16 @@ ...@@ -34,13 +34,16 @@
* This is out-of-line to suppress "might be clobbered by longjmp" warnings. * This is out-of-line to suppress "might be clobbered by longjmp" warnings.
*/ */
static void static void
do_util_elog(int level, char *message) do_util_elog(int level, SV *msg)
{ {
MemoryContext oldcontext = CurrentMemoryContext; MemoryContext oldcontext = CurrentMemoryContext;
char *cmsg = NULL;
PG_TRY(); PG_TRY();
{ {
elog(level, "%s", message); cmsg = sv2cstr(msg);
elog(level, "%s", cmsg);
pfree(cmsg);
} }
PG_CATCH(); PG_CATCH();
{ {
...@@ -51,35 +54,20 @@ do_util_elog(int level, char *message) ...@@ -51,35 +54,20 @@ do_util_elog(int level, char *message)
edata = CopyErrorData(); edata = CopyErrorData();
FlushErrorState(); FlushErrorState();
if (cmsg)
pfree(cmsg);
/* Punt the error to Perl */ /* Punt the error to Perl */
croak("%s", edata->message); croak("%s", edata->message);
} }
PG_END_TRY(); PG_END_TRY();
} }
static SV *
newSVstring_len(const char *str, STRLEN len)
{
SV *sv;
sv = newSVpvn(str, len);
#if PERL_BCDVERSION >= 0x5006000L
if (GetDatabaseEncoding() == PG_UTF8)
SvUTF8_on(sv);
#endif
return sv;
}
static text * static text *
sv2text(SV *sv) sv2text(SV *sv)
{ {
STRLEN sv_len; char *str = sv2cstr(sv);
char *sv_pv; return cstring_to_text(str);
if (!sv)
sv = &PL_sv_undef;
sv_pv = SvPV(sv, sv_len);
return cstring_to_text_with_len(sv_pv, sv_len);
} }
MODULE = PostgreSQL::InServer::Util PREFIX = util_ MODULE = PostgreSQL::InServer::Util PREFIX = util_
...@@ -105,15 +93,15 @@ _aliased_constants() ...@@ -105,15 +93,15 @@ _aliased_constants()
void void
util_elog(level, message) util_elog(level, msg)
int level int level
char* message SV *msg
CODE: CODE:
if (level > ERROR) /* no PANIC allowed thanks */ if (level > ERROR) /* no PANIC allowed thanks */
level = ERROR; level = ERROR;
if (level < DEBUG5) if (level < DEBUG5)
level = DEBUG5; level = DEBUG5;
do_util_elog(level, message); do_util_elog(level, msg);
SV * SV *
util_quote_literal(sv) util_quote_literal(sv)
...@@ -125,7 +113,9 @@ util_quote_literal(sv) ...@@ -125,7 +113,9 @@ util_quote_literal(sv)
else { else {
text *arg = sv2text(sv); text *arg = sv2text(sv);
text *ret = DatumGetTextP(DirectFunctionCall1(quote_literal, PointerGetDatum(arg))); text *ret = DatumGetTextP(DirectFunctionCall1(quote_literal, PointerGetDatum(arg)));
RETVAL = newSVstring_len(VARDATA(ret), (VARSIZE(ret) - VARHDRSZ)); char *str = text_to_cstring(ret);
RETVAL = cstr2sv(str);
pfree(str);
} }
OUTPUT: OUTPUT:
RETVAL RETVAL
...@@ -136,13 +126,15 @@ util_quote_nullable(sv) ...@@ -136,13 +126,15 @@ util_quote_nullable(sv)
CODE: CODE:
if (!sv || !SvOK(sv)) if (!sv || !SvOK(sv))
{ {
RETVAL = newSVstring_len("NULL", 4); RETVAL = cstr2sv("NULL");
} }
else else
{ {
text *arg = sv2text(sv); text *arg = sv2text(sv);
text *ret = DatumGetTextP(DirectFunctionCall1(quote_nullable, PointerGetDatum(arg))); text *ret = DatumGetTextP(DirectFunctionCall1(quote_nullable, PointerGetDatum(arg)));
RETVAL = newSVstring_len(VARDATA(ret), (VARSIZE(ret) - VARHDRSZ)); char *str = text_to_cstring(ret);
RETVAL = cstr2sv(str);
pfree(str);
} }
OUTPUT: OUTPUT:
RETVAL RETVAL
...@@ -153,10 +145,13 @@ util_quote_ident(sv) ...@@ -153,10 +145,13 @@ util_quote_ident(sv)
PREINIT: PREINIT:
text *arg; text *arg;
text *ret; text *ret;
char *str;
CODE: CODE:
arg = sv2text(sv); arg = sv2text(sv);
ret = DatumGetTextP(DirectFunctionCall1(quote_ident, PointerGetDatum(arg))); ret = DatumGetTextP(DirectFunctionCall1(quote_ident, PointerGetDatum(arg)));
RETVAL = newSVstring_len(VARDATA(ret), (VARSIZE(ret) - VARHDRSZ)); str = text_to_cstring(ret);
RETVAL = cstr2sv(str);
pfree(str);
OUTPUT: OUTPUT:
RETVAL RETVAL
...@@ -167,9 +162,9 @@ util_decode_bytea(sv) ...@@ -167,9 +162,9 @@ util_decode_bytea(sv)
char *arg; char *arg;
text *ret; text *ret;
CODE: CODE:
arg = SvPV_nolen(sv); arg = SvPVbyte_nolen(sv);
ret = DatumGetTextP(DirectFunctionCall1(byteain, PointerGetDatum(arg))); ret = DatumGetTextP(DirectFunctionCall1(byteain, PointerGetDatum(arg)));
/* not newSVstring_len because this is raw bytes not utf8'able */ /* not cstr2sv because this is raw bytes not utf8'able */
RETVAL = newSVpvn(VARDATA(ret), (VARSIZE(ret) - VARHDRSZ)); RETVAL = newSVpvn(VARDATA(ret), (VARSIZE(ret) - VARHDRSZ));
OUTPUT: OUTPUT:
RETVAL RETVAL
...@@ -180,10 +175,13 @@ util_encode_bytea(sv) ...@@ -180,10 +175,13 @@ util_encode_bytea(sv)
PREINIT: PREINIT:
text *arg; text *arg;
char *ret; char *ret;
STRLEN len;
CODE: CODE:
arg = sv2text(sv); /* not sv2text because this is raw bytes not utf8'able */
ret = SvPVbyte(sv, len);
arg = cstring_to_text_with_len(ret, len);
ret = DatumGetCString(DirectFunctionCall1(byteaout, PointerGetDatum(arg))); ret = DatumGetCString(DirectFunctionCall1(byteaout, PointerGetDatum(arg)));
RETVAL = newSVstring_len(ret, strlen(ret)); RETVAL = cstr2sv(ret);
OUTPUT: OUTPUT:
RETVAL RETVAL
......
src/pl/plperl/plperl.c
View file @ 50d89d42
...@@ -43,6 +43,7 @@ ...@@ -43,6 +43,7 @@
/* perl stuff */ /* perl stuff */
#include "plperl.h" #include "plperl.h"
#include "plperl_helpers.h"
/* string literal macros defining chunks of perl code */ /* string literal macros defining chunks of perl code */
#include "perlchunks.h" #include "perlchunks.h"
...@@ -222,7 +223,7 @@ static void plperl_init_shared_libs(pTHX); ...@@ -222,7 +223,7 @@ static void plperl_init_shared_libs(pTHX);
static void plperl_trusted_init(void); static void plperl_trusted_init(void);
static void plperl_untrusted_init(void); static void plperl_untrusted_init(void);
static HV *plperl_spi_execute_fetch_result(SPITupleTable *, int, int); static HV *plperl_spi_execute_fetch_result(SPITupleTable *, int, int);
static SV *newSVstring(const char *str); static char *hek2cstr(HE *he);
static SV **hv_store_string(HV *hv, const char *key, SV *val); static SV **hv_store_string(HV *hv, const char *key, SV *val);
static SV **hv_fetch_string(HV *hv, const char *key); static SV **hv_fetch_string(HV *hv, const char *key);
static void plperl_create_sub(plperl_proc_desc *desc, char *s, Oid fn_oid); static void plperl_create_sub(plperl_proc_desc *desc, char *s, Oid fn_oid);
...@@ -239,24 +240,39 @@ static char *setlocale_perl(int category, char *locale); ...@@ -239,24 +240,39 @@ static char *setlocale_perl(int category, char *locale);
#endif #endif
/* /*
* Convert an SV to char * and verify the encoding via pg_verifymbstr() * convert a HE (hash entry) key to a cstr in the current database encoding
*/ */
static inline char * static char *
sv2text_mbverified(SV *sv) hek2cstr(HE *he)
{ {
char *val;
STRLEN len;
/* /*
* The value returned here might include an embedded nul byte, because * Unfortunately, while HeUTF8 is true for most things > 256, for
* perl allows such things. That's OK, because pg_verifymbstr will choke * values 128..255 it's not, but perl will treat them as
* on it, If we just used strlen() instead of getting perl's idea of the * unicode code points if the utf8 flag is not set ( see
* length, whatever uses the "verified" value might get something quite * The "Unicode Bug" in perldoc perlunicode for more)
* weird. *
*/ * So if we did the expected:
val = SvPV(sv, len); * if (HeUTF8(he))
pg_verifymbstr(val, len, false); * utf_u2e(key...);
return val; * else // must be ascii
* return HePV(he);
* we won't match columns with codepoints from 128..255
*
* For a more concrete example given a column with the
* name of the unicode codepoint U+00ae (registered sign)
* and a UTF8 database and the perl return_next {
* "\N{U+00ae}=>'text } would always fail as heUTF8
* returns 0 and HePV() would give us a char * with 1 byte
* contains the decimal value 174
*
* Perl has the brains to know when it should utf8 encode
* 174 properly, so here we force it into an SV so that
* perl will figure it out and do the right thing
*/
SV *sv = HeSVKEY_force(he);
if (HeUTF8(he))
SvUTF8_on(sv);
return sv2cstr(sv);
} }
/* /*
...@@ -568,7 +584,7 @@ select_perl_context(bool trusted) ...@@ -568,7 +584,7 @@ select_perl_context(bool trusted)
eval_pv("PostgreSQL::InServer::SPI::bootstrap()", FALSE); eval_pv("PostgreSQL::InServer::SPI::bootstrap()", FALSE);
if (SvTRUE(ERRSV)) if (SvTRUE(ERRSV))
ereport(ERROR, ereport(ERROR,
(errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))), (errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
errcontext("while executing PostgreSQL::InServer::SPI::bootstrap"))); errcontext("while executing PostgreSQL::InServer::SPI::bootstrap")));
/* Fully initialized, so mark the hashtable entry valid */ /* Fully initialized, so mark the hashtable entry valid */
...@@ -609,7 +625,6 @@ static PerlInterpreter * ...@@ -609,7 +625,6 @@ static PerlInterpreter *
plperl_init_interp(void) plperl_init_interp(void)
{ {
PerlInterpreter *plperl; PerlInterpreter *plperl;
static int perl_sys_init_done;
static char *embedding[3 + 2] = { static char *embedding[3 + 2] = {
"", "-e", PLC_PERLBOOT "", "-e", PLC_PERLBOOT
...@@ -678,6 +693,9 @@ plperl_init_interp(void) ...@@ -678,6 +693,9 @@ plperl_init_interp(void)
* true when MYMALLOC is set. * true when MYMALLOC is set.
*/ */
#if defined(PERL_SYS_INIT3) && !defined(MYMALLOC) #if defined(PERL_SYS_INIT3) && !defined(MYMALLOC)
{
static int perl_sys_init_done;
/* only call this the first time through, as per perlembed man page */ /* only call this the first time through, as per perlembed man page */
if (!perl_sys_init_done) if (!perl_sys_init_done)
{ {
...@@ -688,6 +706,7 @@ plperl_init_interp(void) ...@@ -688,6 +706,7 @@ plperl_init_interp(void)
/* quiet warning if PERL_SYS_INIT3 doesn't use the third argument */ /* quiet warning if PERL_SYS_INIT3 doesn't use the third argument */
dummy_env[0] = NULL; dummy_env[0] = NULL;
} }
}
#endif #endif
plperl = perl_alloc(); plperl = perl_alloc();
...@@ -727,12 +746,12 @@ plperl_init_interp(void) ...@@ -727,12 +746,12 @@ plperl_init_interp(void)
if (perl_parse(plperl, plperl_init_shared_libs, if (perl_parse(plperl, plperl_init_shared_libs,
nargs, embedding, NULL) != 0) nargs, embedding, NULL) != 0)
ereport(ERROR, ereport(ERROR,
(errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))), (errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
errcontext("while parsing Perl initialization"))); errcontext("while parsing Perl initialization")));
if (perl_run(plperl) != 0) if (perl_run(plperl) != 0)
ereport(ERROR, ereport(ERROR,
(errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))), (errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
errcontext("while running Perl initialization"))); errcontext("while running Perl initialization")));
#ifdef PLPERL_RESTORE_LOCALE #ifdef PLPERL_RESTORE_LOCALE
...@@ -836,11 +855,9 @@ plperl_trusted_init(void) ...@@ -836,11 +855,9 @@ plperl_trusted_init(void)
eval_pv(PLC_TRUSTED, FALSE); eval_pv(PLC_TRUSTED, FALSE);
if (SvTRUE(ERRSV)) if (SvTRUE(ERRSV))
ereport(ERROR, ereport(ERROR,
(errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))), (errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
errcontext("while executing PLC_TRUSTED"))); errcontext("while executing PLC_TRUSTED")));
if (GetDatabaseEncoding() == PG_UTF8)
{
/* /*
* Force loading of utf8 module now to prevent errors that can arise * Force loading of utf8 module now to prevent errors that can arise
* from the regex code later trying to load utf8 modules. See * from the regex code later trying to load utf8 modules. See
...@@ -849,9 +866,8 @@ plperl_trusted_init(void) ...@@ -849,9 +866,8 @@ plperl_trusted_init(void)
eval_pv("my $a=chr(0x100); return $a =~ /\\xa9/i", FALSE); eval_pv("my $a=chr(0x100); return $a =~ /\\xa9/i", FALSE);
if (SvTRUE(ERRSV)) if (SvTRUE(ERRSV))
ereport(ERROR, ereport(ERROR,
(errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))), (errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
errcontext("while executing utf8fix"))); errcontext("while executing utf8fix")));
}
/* /*
* Lock down the interpreter * Lock down the interpreter
...@@ -891,7 +907,7 @@ plperl_trusted_init(void) ...@@ -891,7 +907,7 @@ plperl_trusted_init(void)
eval_pv(plperl_on_plperl_init, FALSE); eval_pv(plperl_on_plperl_init, FALSE);
if (SvTRUE(ERRSV)) if (SvTRUE(ERRSV))
ereport(ERROR, ereport(ERROR,
(errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))), (errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
errcontext("while executing plperl.on_plperl_init"))); errcontext("while executing plperl.on_plperl_init")));
} }
...@@ -912,7 +928,7 @@ plperl_untrusted_init(void) ...@@ -912,7 +928,7 @@ plperl_untrusted_init(void)
eval_pv(plperl_on_plperlu_init, FALSE); eval_pv(plperl_on_plperlu_init, FALSE);
if (SvTRUE(ERRSV)) if (SvTRUE(ERRSV))
ereport(ERROR, ereport(ERROR,
(errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))), (errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
errcontext("while executing plperl.on_plperlu_init"))); errcontext("while executing plperl.on_plperlu_init")));
} }
} }
...@@ -940,16 +956,17 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta) ...@@ -940,16 +956,17 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
{ {
TupleDesc td = attinmeta->tupdesc; TupleDesc td = attinmeta->tupdesc;
char **values; char **values;
SV *val; HE *he;
char *key;
I32 klen;
HeapTuple tup; HeapTuple tup;
int i;
values = (char **) palloc0(td->natts * sizeof(char *)); values = (char **) palloc0(td->natts * sizeof(char *));
hv_iterinit(perlhash); hv_iterinit(perlhash);
while ((val = hv_iternextsv(perlhash, &key, &klen))) while ((he = hv_iternext(perlhash)))
{ {
SV *val = HeVAL(he);
char *key = hek2cstr(he);
int attn = SPI_fnumber(td, key); int attn = SPI_fnumber(td, key);
if (attn <= 0 || td->attrs[attn - 1]->attisdropped) if (attn <= 0 || td->attrs[attn - 1]->attisdropped)
...@@ -959,13 +976,22 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta) ...@@ -959,13 +976,22 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
key))); key)));
if (SvOK(val)) if (SvOK(val))
{ {
values[attn - 1] = sv2text_mbverified(val); values[attn - 1] = sv2cstr(val);
} }
pfree(key);
} }
hv_iterinit(perlhash); hv_iterinit(perlhash);
tup = BuildTupleFromCStrings(attinmeta, values); tup = BuildTupleFromCStrings(attinmeta, values);
for(i = 0; i < td->natts; i++)
{
if (values[i])
pfree(values[i]);
}
pfree(values); pfree(values);
return tup; return tup;
} }
...@@ -1025,8 +1051,8 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo) ...@@ -1025,8 +1051,8 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo)
) )
); );
hv_store_string(hv, "name", newSVstring(tdata->tg_trigger->tgname)); hv_store_string(hv, "name", cstr2sv(tdata->tg_trigger->tgname));
hv_store_string(hv, "relid", newSVstring(relid)); hv_store_string(hv, "relid", cstr2sv(relid));
if (TRIGGER_FIRED_BY_INSERT(tdata->tg_event)) if (TRIGGER_FIRED_BY_INSERT(tdata->tg_event))
{ {
...@@ -1062,7 +1088,7 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo) ...@@ -1062,7 +1088,7 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo)
else else
event = "UNKNOWN"; event = "UNKNOWN";
hv_store_string(hv, "event", newSVstring(event)); hv_store_string(hv, "event", cstr2sv(event));
hv_store_string(hv, "argc", newSViv(tdata->tg_trigger->tgnargs)); hv_store_string(hv, "argc", newSViv(tdata->tg_trigger->tgnargs));
if (tdata->tg_trigger->tgnargs > 0) if (tdata->tg_trigger->tgnargs > 0)
...@@ -1071,18 +1097,18 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo) ...@@ -1071,18 +1097,18 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo)
av_extend(av, tdata->tg_trigger->tgnargs); av_extend(av, tdata->tg_trigger->tgnargs);
for (i = 0; i < tdata->tg_trigger->tgnargs; i++) for (i = 0; i < tdata->tg_trigger->tgnargs; i++)
av_push(av, newSVstring(tdata->tg_trigger->tgargs[i])); av_push(av, cstr2sv(tdata->tg_trigger->tgargs[i]));
hv_store_string(hv, "args", newRV_noinc((SV *) av)); hv_store_string(hv, "args", newRV_noinc((SV *) av));
} }
hv_store_string(hv, "relname", hv_store_string(hv, "relname",
newSVstring(SPI_getrelname(tdata->tg_relation))); cstr2sv(SPI_getrelname(tdata->tg_relation)));
hv_store_string(hv, "table_name", hv_store_string(hv, "table_name",
newSVstring(SPI_getrelname(tdata->tg_relation))); cstr2sv(SPI_getrelname(tdata->tg_relation)));
hv_store_string(hv, "table_schema", hv_store_string(hv, "table_schema",
newSVstring(SPI_getnspname(tdata->tg_relation))); cstr2sv(SPI_getnspname(tdata->tg_relation)));
if (TRIGGER_FIRED_BEFORE(tdata->tg_event)) if (TRIGGER_FIRED_BEFORE(tdata->tg_event))
when = "BEFORE"; when = "BEFORE";
...@@ -1092,7 +1118,7 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo) ...@@ -1092,7 +1118,7 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo)
when = "INSTEAD OF"; when = "INSTEAD OF";
else else
when = "UNKNOWN"; when = "UNKNOWN";
hv_store_string(hv, "when", newSVstring(when)); hv_store_string(hv, "when", cstr2sv(when));
if (TRIGGER_FIRED_FOR_ROW(tdata->tg_event)) if (TRIGGER_FIRED_FOR_ROW(tdata->tg_event))
level = "ROW"; level = "ROW";
...@@ -1100,7 +1126,7 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo) ...@@ -1100,7 +1126,7 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo)
level = "STATEMENT"; level = "STATEMENT";
else else
level = "UNKNOWN"; level = "UNKNOWN";
hv_store_string(hv, "level", newSVstring(level)); hv_store_string(hv, "level", cstr2sv(level));
return newRV_noinc((SV *) hv); return newRV_noinc((SV *) hv);
} }
...@@ -1113,10 +1139,8 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) ...@@ -1113,10 +1139,8 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
{ {
SV **svp; SV **svp;
HV *hvNew; HV *hvNew;
HE *he;
HeapTuple rtup; HeapTuple rtup;
SV *val;
char *key;
I32 klen;
int slotsused; int slotsused;
int *modattrs; int *modattrs;
Datum *modvalues; Datum *modvalues;
...@@ -1143,13 +1167,15 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) ...@@ -1143,13 +1167,15 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
slotsused = 0; slotsused = 0;
hv_iterinit(hvNew); hv_iterinit(hvNew);
while ((val = hv_iternextsv(hvNew, &key, &klen))) while ((he = hv_iternext(hvNew)))
{ {
int attn = SPI_fnumber(tupdesc, key);
Oid typinput; Oid typinput;
Oid typioparam; Oid typioparam;
int32 atttypmod; int32 atttypmod;
FmgrInfo finfo; FmgrInfo finfo;
SV *val = HeVAL(he);
char *key = hek2cstr(he);
int attn = SPI_fnumber(tupdesc, key);
if (attn <= 0 || tupdesc->attrs[attn - 1]->attisdropped) if (attn <= 0 || tupdesc->attrs[attn - 1]->attisdropped)
ereport(ERROR, ereport(ERROR,
...@@ -1163,11 +1189,13 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) ...@@ -1163,11 +1189,13 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
atttypmod = tupdesc->attrs[attn - 1]->atttypmod; atttypmod = tupdesc->attrs[attn - 1]->atttypmod;
if (SvOK(val)) if (SvOK(val))
{ {
char *str = sv2cstr(val);
modvalues[slotsused] = InputFunctionCall(&finfo, modvalues[slotsused] = InputFunctionCall(&finfo,
sv2text_mbverified(val), str,
typioparam, typioparam,
atttypmod); atttypmod);
modnulls[slotsused] = ' '; modnulls[slotsused] = ' ';
pfree(str);
} }
else else
{ {
...@@ -1179,6 +1207,8 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) ...@@ -1179,6 +1207,8 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
} }
modattrs[slotsused] = attn; modattrs[slotsused] = attn;
slotsused++; slotsused++;
pfree(key);
} }
hv_iterinit(hvNew); hv_iterinit(hvNew);
...@@ -1420,7 +1450,7 @@ plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid) ...@@ -1420,7 +1450,7 @@ plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid)
SAVETMPS; SAVETMPS;
PUSHMARK(SP); PUSHMARK(SP);
EXTEND(SP, 4); EXTEND(SP, 4);
PUSHs(sv_2mortal(newSVstring(subname))); PUSHs(sv_2mortal(cstr2sv(subname)));
PUSHs(sv_2mortal(newRV_noinc((SV *) pragma_hv))); PUSHs(sv_2mortal(newRV_noinc((SV *) pragma_hv)));
/* /*
* Use 'false' for $prolog in mkfunc, which is kept for compatibility * Use 'false' for $prolog in mkfunc, which is kept for compatibility
...@@ -1428,7 +1458,7 @@ plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid) ...@@ -1428,7 +1458,7 @@ plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid)
* the function compiler. * the function compiler.
*/ */
PUSHs(&PL_sv_no); PUSHs(&PL_sv_no);
PUSHs(sv_2mortal(newSVstring(s))); PUSHs(sv_2mortal(cstr2sv(s)));
PUTBACK; PUTBACK;
/* /*
...@@ -1457,7 +1487,7 @@ plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid) ...@@ -1457,7 +1487,7 @@ plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid)
if (SvTRUE(ERRSV)) if (SvTRUE(ERRSV))
ereport(ERROR, ereport(ERROR,
(errcode(ERRCODE_SYNTAX_ERROR), (errcode(ERRCODE_SYNTAX_ERROR),
errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))))); errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV)))));
if (!subref) if (!subref)
ereport(ERROR, ereport(ERROR,
...@@ -1533,7 +1563,7 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo) ...@@ -1533,7 +1563,7 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
tmp = OutputFunctionCall(&(desc->arg_out_func[i]), tmp = OutputFunctionCall(&(desc->arg_out_func[i]),
fcinfo->arg[i]); fcinfo->arg[i]);
sv = newSVstring(tmp); sv = cstr2sv(tmp);
PUSHs(sv_2mortal(sv)); PUSHs(sv_2mortal(sv));
pfree(tmp); pfree(tmp);
} }
...@@ -1561,7 +1591,7 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo) ...@@ -1561,7 +1591,7 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
LEAVE; LEAVE;
/* XXX need to find a way to assign an errcode here */ /* XXX need to find a way to assign an errcode here */
ereport(ERROR, ereport(ERROR,
(errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))))); (errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV)))));
} }
retval = newSVsv(POPs); retval = newSVsv(POPs);
...@@ -1594,7 +1624,7 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, ...@@ -1594,7 +1624,7 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
EXTEND(sp, tg_trigger->tgnargs); EXTEND(sp, tg_trigger->tgnargs);
for (i = 0; i < tg_trigger->tgnargs; i++) for (i = 0; i < tg_trigger->tgnargs; i++)
PUSHs(sv_2mortal(newSVstring(tg_trigger->tgargs[i]))); PUSHs(sv_2mortal(cstr2sv(tg_trigger->tgargs[i])));
PUTBACK; PUTBACK;
/* Do NOT use G_KEEPERR here */ /* Do NOT use G_KEEPERR here */
...@@ -1618,7 +1648,7 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, ...@@ -1618,7 +1648,7 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
LEAVE; LEAVE;
/* XXX need to find a way to assign an errcode here */ /* XXX need to find a way to assign an errcode here */
ereport(ERROR, ereport(ERROR,
(errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))))); (errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV)))));
} }
retval = newSVsv(POPs); retval = newSVsv(POPs);
...@@ -1766,6 +1796,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) ...@@ -1766,6 +1796,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
else else
{ {
/* Return a perl string converted to a Datum */ /* Return a perl string converted to a Datum */
char *str;
if (prodesc->fn_retisarray && SvROK(perlret) && if (prodesc->fn_retisarray && SvROK(perlret) &&
SvTYPE(SvRV(perlret)) == SVt_PVAV) SvTYPE(SvRV(perlret)) == SVt_PVAV)
...@@ -1775,9 +1806,11 @@ plperl_func_handler(PG_FUNCTION_ARGS) ...@@ -1775,9 +1806,11 @@ plperl_func_handler(PG_FUNCTION_ARGS)
perlret = array_ret; perlret = array_ret;
} }
str = sv2cstr(perlret);
retval = InputFunctionCall(&prodesc->result_in_func, retval = InputFunctionCall(&prodesc->result_in_func,
sv2text_mbverified(perlret), str,
prodesc->result_typioparam, -1); prodesc->result_typioparam, -1);
pfree(str);
} }
/* Restore the previous error callback */ /* Restore the previous error callback */
...@@ -1857,7 +1890,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS) ...@@ -1857,7 +1890,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
HeapTuple trv; HeapTuple trv;
char *tmp; char *tmp;
tmp = SvPV_nolen(perlret); tmp = sv2cstr(perlret);
if (pg_strcasecmp(tmp, "SKIP") == 0) if (pg_strcasecmp(tmp, "SKIP") == 0)
trv = NULL; trv = NULL;
...@@ -1888,6 +1921,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS) ...@@ -1888,6 +1921,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
trv = NULL; trv = NULL;
} }
retval = PointerGetDatum(trv); retval = PointerGetDatum(trv);
pfree(tmp);
} }
/* Restore the previous error callback */ /* Restore the previous error callback */
...@@ -2231,7 +2265,7 @@ plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc) ...@@ -2231,7 +2265,7 @@ plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc)
outputstr = OidOutputFunctionCall(typoutput, attr); outputstr = OidOutputFunctionCall(typoutput, attr);
hv_store_string(hv, attname, newSVstring(outputstr)); hv_store_string(hv, attname, cstr2sv(outputstr));
pfree(outputstr); pfree(outputstr);
} }
...@@ -2336,7 +2370,7 @@ plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed, ...@@ -2336,7 +2370,7 @@ plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed,
result = newHV(); result = newHV();
hv_store_string(result, "status", hv_store_string(result, "status",
newSVstring(SPI_result_code_string(status))); cstr2sv(SPI_result_code_string(status)));
hv_store_string(result, "processed", hv_store_string(result, "processed",
newSViv(processed)); newSViv(processed));
...@@ -2466,16 +2500,20 @@ plperl_return_next(SV *sv) ...@@ -2466,16 +2500,20 @@ plperl_return_next(SV *sv)
if (SvOK(sv)) if (SvOK(sv))
{ {
char *str;
if (prodesc->fn_retisarray && SvROK(sv) && if (prodesc->fn_retisarray && SvROK(sv) &&
SvTYPE(SvRV(sv)) == SVt_PVAV) SvTYPE(SvRV(sv)) == SVt_PVAV)
{ {
sv = plperl_convert_to_pg_array(sv); sv = plperl_convert_to_pg_array(sv);
} }
str = sv2cstr(sv);
ret = InputFunctionCall(&prodesc->result_in_func, ret = InputFunctionCall(&prodesc->result_in_func,
sv2text_mbverified(sv), str,
prodesc->result_typioparam, -1); prodesc->result_typioparam, -1);
isNull = false; isNull = false;
pfree(str);
} }
else else
{ {
...@@ -2531,7 +2569,7 @@ plperl_spi_query(char *query) ...@@ -2531,7 +2569,7 @@ plperl_spi_query(char *query)
if (portal == NULL) if (portal == NULL)
elog(ERROR, "SPI_cursor_open() failed:%s", elog(ERROR, "SPI_cursor_open() failed:%s",
SPI_result_code_string(SPI_result)); SPI_result_code_string(SPI_result));
cursor = newSVstring(portal->name); cursor = cstr2sv(portal->name);
/* Commit the inner transaction, return to outer xact context */ /* Commit the inner transaction, return to outer xact context */
ReleaseCurrentSubTransaction(); ReleaseCurrentSubTransaction();
...@@ -2716,8 +2754,11 @@ plperl_spi_prepare(char *query, int argc, SV **argv) ...@@ -2716,8 +2754,11 @@ plperl_spi_prepare(char *query, int argc, SV **argv)
typInput, typInput,
typIOParam; typIOParam;
int32 typmod; int32 typmod;
char *typstr;
parseTypeString(SvPV_nolen(argv[i]), &typId, &typmod); typstr = sv2cstr(argv[i]);
parseTypeString(typstr, &typId, &typmod);
pfree(typstr);
getTypeInputInfo(typId, &typInput, &typIOParam); getTypeInputInfo(typId, &typInput, &typIOParam);
...@@ -2804,7 +2845,7 @@ plperl_spi_prepare(char *query, int argc, SV **argv) ...@@ -2804,7 +2845,7 @@ plperl_spi_prepare(char *query, int argc, SV **argv)
HASH_ENTER, &found); HASH_ENTER, &found);
hash_entry->query_data = qdesc; hash_entry->query_data = qdesc;
return newSVstring(qdesc->qname); return cstr2sv(qdesc->qname);
} }
HV * HV *
...@@ -2881,11 +2922,13 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv) ...@@ -2881,11 +2922,13 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv)
{ {
if (SvOK(argv[i])) if (SvOK(argv[i]))
{ {
char *str = sv2cstr(argv[i]);
argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i], argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],
sv2text_mbverified(argv[i]), str,
qdesc->argtypioparams[i], qdesc->argtypioparams[i],
-1); -1);
nulls[i] = ' '; nulls[i] = ' ';
pfree(str);
} }
else else
{ {
...@@ -3014,11 +3057,13 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv) ...@@ -3014,11 +3057,13 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv)
{ {
if (SvOK(argv[i])) if (SvOK(argv[i]))
{ {
char *str = sv2cstr(argv[i]);
argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i], argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],
sv2text_mbverified(argv[i]), str,
qdesc->argtypioparams[i], qdesc->argtypioparams[i],
-1); -1);
nulls[i] = ' '; nulls[i] = ' ';
pfree(str);
} }
else else
{ {
...@@ -3044,7 +3089,7 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv) ...@@ -3044,7 +3089,7 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv)
elog(ERROR, "SPI_cursor_open() failed:%s", elog(ERROR, "SPI_cursor_open() failed:%s",
SPI_result_code_string(SPI_result)); SPI_result_code_string(SPI_result));
cursor = newSVstring(portal->name); cursor = cstr2sv(portal->name);
/* Commit the inner transaction, return to outer xact context */ /* Commit the inner transaction, return to outer xact context */
ReleaseCurrentSubTransaction(); ReleaseCurrentSubTransaction();
...@@ -3124,23 +3169,6 @@ plperl_spi_freeplan(char *query) ...@@ -3124,23 +3169,6 @@ plperl_spi_freeplan(char *query)
SPI_freeplan(plan); SPI_freeplan(plan);
} }
/*
* Create a new SV from a string assumed to be in the current database's
* encoding.
*/
static SV *
newSVstring(const char *str)
{
SV *sv;
sv = newSVpv(str, 0);
#if PERL_BCDVERSION >= 0x5006000L
if (GetDatabaseEncoding() == PG_UTF8)
SvUTF8_on(sv);
#endif
return sv;
}
/* /*
* Store an SV into a hash table under a key that is a string assumed to be * Store an SV into a hash table under a key that is a string assumed to be
* in the current database's encoding. * in the current database's encoding.
...@@ -3148,7 +3176,11 @@ newSVstring(const char *str) ...@@ -3148,7 +3176,11 @@ newSVstring(const char *str)
static SV ** static SV **
hv_store_string(HV *hv, const char *key, SV *val) hv_store_string(HV *hv, const char *key, SV *val)
{ {
int32 klen = strlen(key); int32 hlen;
char *hkey;
SV **ret;
hkey = (char*)pg_do_encoding_conversion((unsigned char *)key, strlen(key), GetDatabaseEncoding(), PG_UTF8);
/* /*
* This seems nowhere documented, but under Perl 5.8.0 and up, hv_store() * This seems nowhere documented, but under Perl 5.8.0 and up, hv_store()
...@@ -3156,11 +3188,13 @@ hv_store_string(HV *hv, const char *key, SV *val) ...@@ -3156,11 +3188,13 @@ hv_store_string(HV *hv, const char *key, SV *val)
* does not appear that hashes track UTF-8-ness of keys at all in Perl * does not appear that hashes track UTF-8-ness of keys at all in Perl
* 5.6. * 5.6.
*/ */
#if PERL_BCDVERSION >= 0x5008000L hlen = -strlen(hkey);
if (GetDatabaseEncoding() == PG_UTF8) ret = hv_store(hv, hkey, hlen, val, 0);
klen = -klen;
#endif if (hkey != key)
return hv_store(hv, key, klen, val, 0); pfree(hkey);
return ret;
} }
/* /*
...@@ -3170,14 +3204,20 @@ hv_store_string(HV *hv, const char *key, SV *val) ...@@ -3170,14 +3204,20 @@ hv_store_string(HV *hv, const char *key, SV *val)
static SV ** static SV **
hv_fetch_string(HV *hv, const char *key) hv_fetch_string(HV *hv, const char *key)
{ {
int32 klen = strlen(key); int32 hlen;
char *hkey;
SV **ret;
hkey = (char*)pg_do_encoding_conversion((unsigned char *)key, strlen(key), GetDatabaseEncoding(), PG_UTF8);
/* See notes in hv_store_string */ /* See notes in hv_store_string */
#if PERL_BCDVERSION >= 0x5008000L hlen = -strlen(hkey);
if (GetDatabaseEncoding() == PG_UTF8) ret = hv_fetch(hv, hkey, hlen, 0);
klen = -klen;
#endif if(hkey != key)
return hv_fetch(hv, key, klen, 0); pfree(hkey);
return ret;
} }
/* /*
......
src/pl/plperl/plperl_helpers.h 0 → 100644
View file @ 50d89d42
#ifndef PL_PERL_HELPERS_H
#define PL_PERL_HELPERS_H
/*
* convert from utf8 to database encoding
*/
static inline char *
utf_u2e(const char *utf8_str, size_t len)
{
char *ret = (char*)pg_do_encoding_conversion((unsigned char*)utf8_str, len, PG_UTF8, GetDatabaseEncoding());
if (ret == utf8_str)
ret = pstrdup(ret);
return ret;
}
/*
* convert from database encoding to utf8
*/
static inline char *
utf_e2u(const char *str)
{
char *ret = (char*)pg_do_encoding_conversion((unsigned char*)str, strlen(str), GetDatabaseEncoding(), PG_UTF8);
if (ret == str)
ret = pstrdup(ret);
return ret;
}
/*
* Convert an SV to a char * in the current database encoding
*/
static inline char *
sv2cstr(SV *sv)
{
char *val;
STRLEN len;
/*
* get a utf8 encoded char * out of perl. *note* it may not be valid utf8!
*/
val = SvPVutf8(sv, len);
/*
* we use perls length in the event we had an embedded null byte to ensure
* we error out properly
*/
return utf_u2e(val, len);
}
/*
* Create a new SV from a string assumed to be in the current database's
* encoding.
*/
static inline SV *
cstr2sv(const char *str)
{
SV *sv;
char *utf8_str = utf_e2u(str);
sv = newSVpv(utf8_str, 0);
SvUTF8_on(sv);
pfree(utf8_str);
return sv;
}
#endif /* PL_PERL_HELPERS_H */
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment