From d7b4ef67b382308f4ad3537afa1725acfce35720 Mon Sep 17 00:00:00 2001 From: Tom Lane Date: Mon, 17 Aug 2026 16:38:10 -0400 Subject: [PATCH v1] 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. Author: Tom Lane Discussion: https://postgr.es/m/569769.1786901901@sss.pgh.pa.us Backpatch-through: 14 --- 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 d7f1b8ddb48..91dc0771fab 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 00a99d303c6..b43101bd5a6 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 8175407849e..ab1c60a0022 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. * -- 2.52.0