1
0
mirror of https://github.com/postgres/postgres.git synced 2026-10-23 13:29:09 +03:00

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 <tgl@sss.pgh.pa.us>
Reviewed-by: Andrey Rachitskiy <pl0h0yp1@gmail.com>
Discussion: https://postgr.es/m/569769.1786901901@sss.pgh.pa.us
This commit is contained in:
Tom Lane
2026-08-18 17:47:13 -04:00
parent c0641ae4e1
commit 5bf8fee543
4 changed files with 66 additions and 67 deletions

View File

@@ -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;
}

View File

@@ -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);
}

View File

@@ -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);

View File

@@ -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.
*