From: Andrey Rachitskiy Subject: [PATCH v4 2/3] Honor Perl FETCH for tied hashes and arrays After the hash-iteration cleanup, replace HeVAL() with hv_iterval() so tied hash values run FETCH. Call SvGETMAGIC via plperl_materialize_sv() at conversion entry, before SvOK/SvROK. diff --git a/contrib/hstore_plperl/hstore_plperl.c b/contrib/hstore_plperl/hstore_plperl.c index 6665300d6d8..3ef40466022 100644 --- a/contrib/hstore_plperl/hstore_plperl.c +++ b/contrib/hstore_plperl/hstore_plperl.c @@ -138,7 +138,9 @@ plperl_to_hstore(PG_FUNCTION_ARGS) while ((he = hv_iternext(hv))) { char *key = hek2cstr(he); - SV *value = HeVAL(he); + SV *value = hv_iterval(hv, he); + + plperl_materialize_sv(value); if (i >= pcount) { diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c index b43101bd5a6..07584654e2b 100644 --- a/contrib/jsonb_plperl/jsonb_plperl.c +++ b/contrib/jsonb_plperl/jsonb_plperl.c @@ -166,7 +166,7 @@ HV_to_JsonbValue(HV *obj, JsonbInState *jsonb_state) while ((he = hv_iternext(obj))) { char *k = hek2cstr(he); - SV *val = HeVAL(he); + SV *val = hv_iterval(obj, he); key.val.string.val = k; key.val.string.len = strlen(k); @@ -186,6 +186,8 @@ SV_to_JsonbValue(SV *in, JsonbInState *jsonb_state, bool is_elem) /* this can recurse via AV_to_JsonbValue() or HV_to_JsonbValue() */ check_stack_depth(); + plperl_materialize_sv(in); + /* Dereference references recursively. */ while (SvROK(in)) { diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index ab1c60a0022..aaaaaaaaaaa 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -1039,7 +1039,7 @@ plperl_build_tuple_result(HV *perlhash, TupleDesc td) while ((he = hv_iternext(perlhash))) { char *key = hek2cstr(he); - SV *val = HeVAL(he); + SV *val = hv_iterval(perlhash, he); int attn = SPI_fnumber(td, key); Form_pg_attribute attr; @@ -1084,11 +1084,17 @@ plperl_hash_to_datum(SV *src, TupleDesc td) * if we are an array ref return the reference. this is special in that if we * are a PostgreSQL::InServer::ARRAY object we will return the 'magic' array. + * + * The caller must already have invoked plperl_materialize_sv() on sv. + * sv may be NULL. */ static SV * get_perl_array_ref(SV *sv) { dTHX; + if (!sv) + return NULL; + if (SvOK(sv) && SvROK(sv)) { if (SvTYPE(SvRV(sv)) == SVt_PVAV) @@ -1099,9 +1105,13 @@ get_perl_array_ref(SV *sv) HV *hv = (HV *) SvRV(sv); SV **sav = hv_fetch_string(hv, "array"); - if (sav && *sav && SvOK(*sav) && SvROK(*sav) && - SvTYPE(SvRV(*sav)) == SVt_PVAV) - return *sav; + if (sav && *sav) + { + plperl_materialize_sv(*sav); + if (SvOK(*sav) && SvROK(*sav) && + SvTYPE(SvRV(*sav)) == SVt_PVAV) + return *sav; + } elog(ERROR, "could not get array reference from PostgreSQL::InServer::ARRAY object"); } @@ -1135,9 +1145,11 @@ array_to_datum_internal(AV *av, ArrayBuildState **astatep, { /* fetch the array element */ SV **svp = av_fetch(av, i, FALSE); + SV *elem = svp ? *svp : NULL; + SV *sav; - /* see if this element is an array, if so get that */ - SV *sav = svp ? get_perl_array_ref(*svp) : NULL; + plperl_materialize_sv(elem); + sav = get_perl_array_ref(elem); /* multi-dimensional array? */ if (sav) @@ -1185,13 +1197,13 @@ array_to_datum_internal(AV *av, ArrayBuildState **astatep, (errcode(ERRCODE_INVALID_TEXT_REPRESENTATION), errmsg("multidimensional arrays must have array expressions with matching dimensions"))); - dat = plperl_sv_to_datum(svp ? *svp : NULL, - elemtypid, - typmod, - NULL, - finfo, - typioparam, - &isnull); + dat = plperl_sv_to_datum(elem, + elemtypid, + typmod, + NULL, + finfo, + typioparam, + &isnull); /* Create ArrayBuildState if we didn't already */ if (*astatep == NULL) @@ -1301,6 +1313,8 @@ plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod, FmgrInfo tmp; Oid funcid; + plperl_materialize_sv(sv); + /* we might recurse */ check_stack_depth(); @@ -1751,6 +1765,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) ereport(ERROR, (errcode(ERRCODE_UNDEFINED_COLUMN), errmsg("$_TD->{new} does not exist"))); + plperl_materialize_sv(*svp); if (!SvOK(*svp) || !SvROK(*svp) || SvTYPE(SvRV(*svp)) != SVt_PVHV) ereport(ERROR, (errcode(ERRCODE_DATATYPE_MISMATCH), @@ -1768,7 +1783,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) while ((he = hv_iternext(hvNew))) { char *key = hek2cstr(he); - SV *val = HeVAL(he); + SV *val = hv_iterval(hvNew, he); int attn = SPI_fnumber(tupdesc, key); Form_pg_attribute attr; @@ -2437,6 +2452,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) * SRFs that didn't know about return_next(). Any other sort of return * value is an error, except undef which means return an empty set. */ + plperl_materialize_sv(perlret); sav = get_perl_array_ref(perlret); if (sav) { @@ -2537,6 +2553,8 @@ plperl_trigger_handler(PG_FUNCTION_ARGS) if (SPI_finish() != SPI_OK_FINISH) elog(ERROR, "SPI_finish() failed"); + plperl_materialize_sv(perlret); + if (perlret == NULL || !SvOK(perlret)) { /* undef result means go ahead with original tuple */ @@ -3335,6 +3353,7 @@ plperl_return_next_internal(SV *sv) { HeapTuple tuple; + plperl_materialize_sv(sv); if (!(SvOK(sv) && SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV)) ereport(ERROR, (errcode(ERRCODE_DATATYPE_MISMATCH), diff --git a/src/pl/plperl/plperl.h b/src/pl/plperl/plperl.h index 33180b16b6e..bbbbbbbbbbb 100644 --- a/src/pl/plperl/plperl.h +++ b/src/pl/plperl/plperl.h @@ -163,9 +163,24 @@ cstr2sv(const char *str) return sv; } +/* + * Invoke SvGETMAGIC before SvOK/SvROK. Tied scalars stay magical. + * A second call on the same SV re-runs FETCH. + */ +static inline void +plperl_materialize_sv(SV *sv) +{ + dTHX; + + if (sv) + SvGETMAGIC(sv); +} + /* * Convert a HE (hash entry) key to a cstr in the current database encoding. * The result is palloc'd. + * + * Uses FREETMPS, so call this before hv_iterval() if both are needed. */ static inline char * hek2cstr(HE *he)