open-dsi
/
postgres
mirror of https://github.com/postgres/postgres
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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.
pull/1/head
Andrew Dunstan 15 years ago
parent 5ed45ac09c
commit 50d89d422f
5 changed files with 295 additions and 160 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 8
      doc/src/sgml/plperl.sgml
  2. 52
      src/pl/plperl/SPI.xs
  3. 66
      src/pl/plperl/Util.xs
  4. 260
      src/pl/plperl/plperl.c
  5. 69
      src/pl/plperl/plperl_helpers.h

8
doc/src/sgml/plperl.sgml
Unescape View File

@ -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,

52
src/pl/plperl/SPI.xs
Unescape View File

@ -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
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)
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, ...)
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, ...)
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, ...)
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:

66
src/pl/plperl/Util.xs
Unescape View File

@ -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 @@
* 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)
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()
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)
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)
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)
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)
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)
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

260
src/pl/plperl/plperl.c
Unescape View File

@ -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);
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);
#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:
* if (HeUTF8(he))
* utf_u2e(key...);
* 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
*/ */
val = SvPV(sv, len); SV *sv = HeSVKEY_force(he);
pg_verifymbstr(val, len, false); if (HeUTF8(he))
return val; SvUTF8_on(sv);
return sv2cstr(sv);
} }
/* /*
@ -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 *
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,15 +693,19 @@ 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)
/* only call this the first time through, as per perlembed man page */
if (!perl_sys_init_done)
{ {
char *dummy_env[1] = {NULL}; static int perl_sys_init_done;
PERL_SYS_INIT3(&nargs, (char ***) &embedding, (char ***) &dummy_env); /* only call this the first time through, as per perlembed man page */
perl_sys_init_done = 1; if (!perl_sys_init_done)
/* quiet warning if PERL_SYS_INIT3 doesn't use the third argument */ {
dummy_env[0] = NULL; char *dummy_env[1] = {NULL};
PERL_SYS_INIT3(&nargs, (char ***) &embedding, (char ***) &dummy_env);
perl_sys_init_done = 1;
/* quiet warning if PERL_SYS_INIT3 doesn't use the third argument */
dummy_env[0] = NULL;
}
} }
#endif #endif
@ -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,22 +855,19 @@ 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
/* * from the regex code later trying to load utf8 modules. See
* Force loading of utf8 module now to prevent errors that can arise * http://rt.perl.org/rt3/Ticket/Display.html?id=47576
* from the regex code later trying to load utf8 modules. See */
* http://rt.perl.org/rt3/Ticket/Display.html?id=47576 eval_pv("my $a=chr(0x100); return $a =~ /\\xa9/i", FALSE);
*/ if (SvTRUE(ERRSV))
eval_pv("my $a=chr(0x100); return $a =~ /\\xa9/i", FALSE); ereport(ERROR,
if (SvTRUE(ERRSV)) (errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
ereport(ERROR, errcontext("while executing utf8fix")));
(errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))),
errcontext("while executing utf8fix")));
}
/* /*
* Lock down the interpreter * Lock down the interpreter
@ -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)
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,17 +956,18 @@ 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)))
{ {
int attn = SPI_fnumber(td, key); SV *val = HeVAL(he);
char *key = hek2cstr(he);
int attn = SPI_fnumber(td, key);
if (attn <= 0 || td->attrs[attn - 1]->attisdropped) if (attn <= 0 || td->attrs[attn - 1]->attisdropped)
ereport(ERROR, ereport(ERROR,
@ -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)
) )
); );
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)
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)
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)
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)
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)
{ {
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)
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)
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)
} }
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)
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)
* 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)
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)
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)
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,
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,
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)
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)
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)
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)
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)
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,
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)
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)
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)
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)
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)
{ {
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)
{ {
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)
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)
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)
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)
* 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)
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;
} }
/* /*

69
src/pl/plperl/plperl_helpers.h
Unescape View File

@ -0,0 +1,69 @@
#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 */
Write Preview
Loading…
Cancel
Save