diff options
| -rw-r--r-- | src/pl/plperl/GNUmakefile | 2 | ||||
| -rw-r--r-- | src/pl/plperl/Util.xs | 27 | ||||
| -rw-r--r-- | src/pl/plperl/expected/plperl.out | 10 | ||||
| -rw-r--r-- | src/pl/plperl/plperl_helpers.h | 70 | ||||
| -rw-r--r-- | src/pl/plperl/sql/plperl.sql | 9 |
5 files changed, 71 insertions, 47 deletions
diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile index 2f448018a42..25294f0a777 100644 --- a/src/pl/plperl/GNUmakefile +++ b/src/pl/plperl/GNUmakefile @@ -44,7 +44,7 @@ PERLCHUNKS = plc_perlboot.pl plc_trusted.pl SHLIB_LINK = $(perl_embed_ldflags) REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-extension=plperl --load-extension=plperlu -REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperl_util plperl_init plperlu plperl_array +REGRESS = plperl plperl_lc plperl_trigger plperl_shared plperl_elog plperl_util plperl_init plperlu plperl_array # if Perl can support two interpreters in one backend, # test plperl-and-plperlu cases ifneq ($(PERL),) diff --git a/src/pl/plperl/Util.xs b/src/pl/plperl/Util.xs index 7d0102b837f..b2e0dfcf75d 100644 --- a/src/pl/plperl/Util.xs +++ b/src/pl/plperl/Util.xs @@ -67,8 +67,11 @@ static text * sv2text(SV *sv) { char *str = sv2cstr(sv); + text *text; - return cstring_to_text(str); + text = cstring_to_text(str); + pfree(str); + return text; } MODULE = PostgreSQL::InServer::Util PREFIX = util_ @@ -113,8 +116,11 @@ util_quote_literal(sv) } else { text *arg = sv2text(sv); - text *ret = DatumGetTextP(DirectFunctionCall1(quote_literal, PointerGetDatum(arg))); - char *str = text_to_cstring(ret); + text *quoted = DatumGetTextP(DirectFunctionCall1(quote_literal, PointerGetDatum(arg))); + char *str; + + pfree(arg); + str = text_to_cstring(quoted); RETVAL = cstr2sv(str); pfree(str); } @@ -132,8 +138,11 @@ util_quote_nullable(sv) else { text *arg = sv2text(sv); - text *ret = DatumGetTextP(DirectFunctionCall1(quote_nullable, PointerGetDatum(arg))); - char *str = text_to_cstring(ret); + text *quoted = DatumGetTextP(DirectFunctionCall1(quote_nullable, PointerGetDatum(arg))); + char *str; + + pfree(arg); + str = text_to_cstring(quoted); RETVAL = cstr2sv(str); pfree(str); } @@ -145,12 +154,14 @@ util_quote_ident(sv) SV *sv PREINIT: text *arg; - text *ret; + text *quoted; char *str; CODE: arg = sv2text(sv); - ret = DatumGetTextP(DirectFunctionCall1(quote_ident, PointerGetDatum(arg))); - str = text_to_cstring(ret); + quoted = DatumGetTextP(DirectFunctionCall1(quote_ident, PointerGetDatum(arg))); + + pfree(arg); + str = text_to_cstring(quoted); RETVAL = cstr2sv(str); pfree(str); OUTPUT: diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out index df54937f494..906dc15e0ca 100644 --- a/src/pl/plperl/expected/plperl.out +++ b/src/pl/plperl/expected/plperl.out @@ -650,16 +650,6 @@ CONTEXT: PL/Perl anonymous code block DO $do$ use warnings FATAL => qw(void) ; my @y; my $x = sort @y; 1; $do$ LANGUAGE plperl; ERROR: Useless use of sort in scalar context at line 1. CONTEXT: PL/Perl anonymous code block --- --- Make sure strings are validated --- Should fail for all encodings, as nul bytes are never permitted. --- -CREATE OR REPLACE FUNCTION perl_zerob() RETURNS TEXT AS $$ - return "abcd\0efg"; -$$ LANGUAGE plperl; -SELECT perl_zerob(); -ERROR: invalid byte sequence for encoding "UTF8": 0x00 -CONTEXT: PL/Perl function "perl_zerob" -- make sure functions marked as VOID without an explicit return work CREATE OR REPLACE FUNCTION myfuncs() RETURNS void AS $$ $_SHARED{myquote} = sub { diff --git a/src/pl/plperl/plperl_helpers.h b/src/pl/plperl/plperl_helpers.h index d3bdc1b9808..30d8c0bb0b0 100644 --- a/src/pl/plperl/plperl_helpers.h +++ b/src/pl/plperl/plperl_helpers.h @@ -3,21 +3,29 @@ /* * convert from utf8 to database encoding + * + * Returns a palloc'ed copy of the original string */ static inline char * -utf_u2e(const char *utf8_str, size_t len) +utf_u2e(char *utf8_str, size_t len) { - int enc = GetDatabaseEncoding(); - - char *ret = (char *) pg_do_encoding_conversion((unsigned char *) utf8_str, len, PG_UTF8, enc); + int enc = GetDatabaseEncoding(); + char *ret; /* - * when we are a PG_UTF8 or SQL_ASCII database - * pg_do_encoding_conversion() will not do any conversion or - * verification. we need to do it manually instead. - */ + * When we are in a PG_UTF8 or SQL_ASCII database + * pg_do_encoding_conversion() will not do any conversion (which is good) + * or verification (not so much), so we need to run the verification step + * separately. + */ if (enc == PG_UTF8 || enc == PG_SQL_ASCII) - pg_verify_mbstr_len(PG_UTF8, utf8_str, len, false); + { + pg_verify_mbstr_len(enc, utf8_str, len, false); + ret = utf8_str; + } + else + ret = (char *) pg_do_encoding_conversion((unsigned char *) utf8_str, + len, PG_UTF8, enc); if (ret == utf8_str) ret = pstrdup(ret); @@ -27,11 +35,15 @@ utf_u2e(const char *utf8_str, size_t len) /* * convert from database encoding to utf8 + * + * Returns a palloc'ed copy of the original string */ static inline char * utf_e2u(const char *str) { - char *ret = (char *) pg_do_encoding_conversion((unsigned char *) str, strlen(str), GetDatabaseEncoding(), PG_UTF8); + char *ret = + (char *) pg_do_encoding_conversion((unsigned char *) str, strlen(str), + GetDatabaseEncoding(), PG_UTF8); if (ret == str) ret = pstrdup(ret); @@ -41,6 +53,8 @@ utf_e2u(const char *str) /* * Convert an SV to a char * in the current database encoding + * + * Returns a palloc'ed copy of the original string */ static inline char * sv2cstr(SV *sv) @@ -50,7 +64,9 @@ sv2cstr(SV *sv) /* * get a utf8 encoded char * out of perl. *note* it may not be valid utf8! - * + */ + + /* * SvPVutf8() croaks nastily on certain things, like typeglobs and * readonly objects such as $^V. That's a perl bug - it's not supposed to * happen. To avoid crashing the backend, we make a copy of the sv before @@ -62,15 +78,27 @@ sv2cstr(SV *sv) (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM)) sv = newSVsv(sv); else - /* increase the reference count so we cant just SvREFCNT_dec() it when - * we are done */ + { + /* + * increase the reference count so we can just SvREFCNT_dec() it when + * we are done + */ SvREFCNT_inc_simple_void(sv); + } - val = SvPVutf8(sv, len); + /* + * Request the string from Perl, in UTF-8 encoding; but if we're in a + * SQL_ASCII database, just request the byte soup without trying to make it + * UTF8, because that might fail. + */ + if (GetDatabaseEncoding() == PG_SQL_ASCII) + val = SvPV(sv, len); + else + val = SvPVutf8(sv, len); /* - * we use perl's length in the event we had an embedded null byte to ensure - * we error out properly + * Now convert to database encoding. We use perl's length in the event we + * had an embedded null byte to ensure we error out properly. */ res = utf_u2e(val, len); @@ -84,16 +112,20 @@ sv2cstr(SV *sv) * 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); + char *utf8_str; + + /* no conversion when SQL_ASCII */ + if (GetDatabaseEncoding() == PG_SQL_ASCII) + return newSVpv(str, 0); + + utf8_str = utf_e2u(str); sv = newSVpv(utf8_str, 0); SvUTF8_on(sv); - pfree(utf8_str); return sv; diff --git a/src/pl/plperl/sql/plperl.sql b/src/pl/plperl/sql/plperl.sql index 84af1fd73fb..a5e3840dac2 100644 --- a/src/pl/plperl/sql/plperl.sql +++ b/src/pl/plperl/sql/plperl.sql @@ -423,15 +423,6 @@ DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl; -- yields "ERROR: Useless use of sort in scalar context." DO $do$ use warnings FATAL => qw(void) ; my @y; my $x = sort @y; 1; $do$ LANGUAGE plperl; --- --- Make sure strings are validated --- Should fail for all encodings, as nul bytes are never permitted. --- -CREATE OR REPLACE FUNCTION perl_zerob() RETURNS TEXT AS $$ - return "abcd\0efg"; -$$ LANGUAGE plperl; -SELECT perl_zerob(); - -- make sure functions marked as VOID without an explicit return work CREATE OR REPLACE FUNCTION myfuncs() RETURNS void AS $$ $_SHARED{myquote} = sub { |