From 5bf8fee543a19ca9ffa5aa99046adae34ba6a864 Mon Sep 17 00:00:00 2001 From: Tom Lane Date: Tue, 18 Aug 2026 17:47:13 -0400 Subject: [PATCH] Make plperl's handling of Perl hashes more consistent. Make hek2cstr() available in plperl.h, so that it can be used in hstore_plperl and jsonb_plperl. Those modules were previously using different coding techniques that probably don't get conversion from Perl strings to the database encoding quite right. (I'd prefer to make hek2cstr() non-inline, but cross-extension calls are messy and plperl has avoided them up to now, so stick with the existing approach.) Consistently use hv_iternext, hek2cstr, and HeVAL for hash iterations, with one exception in plperl_trusted_init: there, hv_iternextsv is fine since we don't actually care about the hash keys. (A later patch will remove the HeVAL calls again, but for now we just want consistency.) Remove unnecessary extra calls of hv_iterinit. Remove duplicative pstrdup's in plperl_to_hstore. The meat of this change is to use hek2cstr() in the contrib modules, which makes a user-visible change in encoding conversion behavior. While it's certainly a bug fix, we've had no field complaints about those modules, so I'm hesitant to make this change in the back branches. Hence, apply to master only. Author: Tom Lane Reviewed-by: Andrey Rachitskiy Discussion: https://postgr.es/m/569769.1786901901@sss.pgh.pa.us --- contrib/hstore_plperl/hstore_plperl.c | 6 +-- contrib/jsonb_plperl/jsonb_plperl.c | 13 +++--- src/pl/plperl/plperl.c | 59 +-------------------------- src/pl/plperl/plperl.h | 55 +++++++++++++++++++++++++ 4 files changed, 66 insertions(+), 67 deletions(-) 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. *