diff --git a/contrib/hstore_plperl/hstore_plperl.c b/contrib/hstore_plperl/hstore_plperl.c index c8e2fd7c657..5d2c4e85d21 100644 --- a/contrib/hstore_plperl/hstore_plperl.c +++ b/contrib/hstore_plperl/hstore_plperl.c @@ -137,7 +137,7 @@ plperl_to_hstore(PG_FUNCTION_ARGS) i = 0; while ((he = hv_iternext(hv))) { - char *key = sv2cstr(HeSVKEY_force(he)); + char *key = hek2cstr(he); SV *value = HeVAL(he); if (i >= pcount) @@ -146,7 +146,7 @@ plperl_to_hstore(PG_FUNCTION_ARGS) pairs = repalloc_array(pairs, Pairs, pcount); } - pairs[i].key = pstrdup(key); + pairs[i].key = key; pairs[i].keylen = hstoreCheckKeyLen(strlen(pairs[i].key)); pairs[i].needfree = true; @@ -158,7 +158,7 @@ plperl_to_hstore(PG_FUNCTION_ARGS) } else { - pairs[i].val = pstrdup(sv2cstr(value)); + pairs[i].val = sv2cstr(value); pairs[i].vallen = hstoreCheckValLen(strlen(pairs[i].val)); pairs[i].isnull = false; } diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c index 676b7393c1d..ce6b62b9380 100644 --- a/contrib/jsonb_plperl/jsonb_plperl.c +++ b/contrib/jsonb_plperl/jsonb_plperl.c @@ -155,9 +155,7 @@ HV_to_JsonbValue(HV *obj, JsonbInState *jsonb_state) { dTHX; JsonbValue key; - SV *val; - char *kstr; - I32 klen; + HE *he; key.type = jbvString; @@ -165,10 +163,13 @@ HV_to_JsonbValue(HV *obj, JsonbInState *jsonb_state) (void) hv_iterinit(obj); - while ((val = hv_iternextsv(obj, &kstr, &klen))) + while ((he = hv_iternext(obj))) { - key.val.string.val = pnstrdup(kstr, klen); - key.val.string.len = klen; + char *k = hek2cstr(he); + SV *val = HeVAL(he); + + key.val.string.val = k; + key.val.string.len = strlen(k); pushJsonbValue(jsonb_state, WJB_KEY, &key); SV_to_JsonbValue(val, jsonb_state, false); } diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index dcade2b4969..5d14d0ab738 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -288,7 +288,6 @@ static void plperl_untrusted_init(void); static HV *plperl_spi_execute_fetch_result(SPITupleTable *tuptable, uint64 processed, int status); static void plperl_return_next_internal(SV *sv); -static char *hek2cstr(HE *he); static SV **hv_store_string(HV *hv, const char *key, SV *val); static SV **hv_fetch_string(HV *hv, const char *key); static void plperl_create_sub(plperl_proc_desc *prodesc, const char *s, @@ -322,60 +321,6 @@ SvREFCNT_dec_current(SV *sv) SvREFCNT_dec(sv); } -/* - * convert a HE (hash entry) key to a cstr in the current database encoding - */ -static char * -hek2cstr(HE *he) -{ - dTHX; - char *ret; - SV *sv; - - /* - * HeSVKEY_force will return a temporary mortal SV*, so we need to make - * sure to free it with ENTER/SAVE/FREE/LEAVE - */ - ENTER; - SAVETMPS; - - /*------------------------- - * Unfortunately, while HeUTF8 is true for most things > 256, for values - * 128..255 it's not, but perl will treat them as unicode code points if - * the utf8 flag is not set ( see The "Unicode Bug" in perldoc perlunicode - * for more) - * - * 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 - *------------------------- - */ - - sv = HeSVKEY_force(he); - if (HeUTF8(he)) - SvUTF8_on(sv); - ret = sv2cstr(sv); - - /* free sv */ - FREETMPS; - LEAVE; - - return ret; -} - /* * _PG_init() - library load-time initialization @@ -1093,8 +1038,8 @@ plperl_build_tuple_result(HV *perlhash, TupleDesc td) hv_iterinit(perlhash); while ((he = hv_iternext(perlhash))) { - SV *val = HeVAL(he); char *key = hek2cstr(he); + SV *val = HeVAL(he); int attn = SPI_fnumber(td, key); Form_pg_attribute attr; @@ -1120,7 +1065,6 @@ plperl_build_tuple_result(HV *perlhash, TupleDesc td) pfree(key); } - hv_iterinit(perlhash); tup = heap_form_tuple(td, values, nulls); pfree(values); @@ -1857,7 +1801,6 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) pfree(key); } - hv_iterinit(hvNew); rtup = heap_modify_tuple(otup, tupdesc, modvalues, modnulls, modrepls); diff --git a/src/pl/plperl/plperl.h b/src/pl/plperl/plperl.h index 4c03f9e0df6..33180b16b6e 100644 --- a/src/pl/plperl/plperl.h +++ b/src/pl/plperl/plperl.h @@ -163,6 +163,61 @@ cstr2sv(const char *str) return sv; } +/* + * Convert a HE (hash entry) key to a cstr in the current database encoding. + * The result is palloc'd. + */ +static inline char * +hek2cstr(HE *he) +{ + dTHX; + char *ret; + SV *sv; + + /* + * HeSVKEY_force will return a temporary mortal SV*, so we need to make + * sure to free it with ENTER/SAVE/FREE/LEAVE + */ + ENTER; + SAVETMPS; + + /*------------------------- + * Unfortunately, while HeUTF8 is true for most things > 256, for values + * 128..255 it's not, but perl will treat them as unicode code points if + * the utf8 flag is not set ( see The "Unicode Bug" in perldoc perlunicode + * for more) + * + * 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 + *------------------------- + */ + + sv = HeSVKEY_force(he); + if (HeUTF8(he)) + SvUTF8_on(sv); + ret = sv2cstr(sv); + + /* free sv */ + FREETMPS; + LEAVE; + + return ret; +} + /* * croak() with specified message, which is given in the database encoding. *