From 46651ce6fe013220ed397add242004d764fc0153 Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sat, 4 May 2024 14:15:05 +0200 Subject: Adding upstream version 14.5. Signed-off-by: Daniel Baumann --- contrib/jsonb_plperl/.gitignore | 4 + contrib/jsonb_plperl/Makefile | 41 ++++ contrib/jsonb_plperl/expected/jsonb_plperl.out | 253 ++++++++++++++++++++ contrib/jsonb_plperl/expected/jsonb_plperlu.out | 280 ++++++++++++++++++++++ contrib/jsonb_plperl/jsonb_plperl--1.0.sql | 19 ++ contrib/jsonb_plperl/jsonb_plperl.c | 296 ++++++++++++++++++++++++ contrib/jsonb_plperl/jsonb_plperl.control | 7 + contrib/jsonb_plperl/jsonb_plperlu--1.0.sql | 19 ++ contrib/jsonb_plperl/jsonb_plperlu.control | 6 + contrib/jsonb_plperl/sql/jsonb_plperl.sql | 117 ++++++++++ contrib/jsonb_plperl/sql/jsonb_plperlu.sql | 121 ++++++++++ 11 files changed, 1163 insertions(+) create mode 100644 contrib/jsonb_plperl/.gitignore create mode 100644 contrib/jsonb_plperl/Makefile create mode 100644 contrib/jsonb_plperl/expected/jsonb_plperl.out create mode 100644 contrib/jsonb_plperl/expected/jsonb_plperlu.out create mode 100644 contrib/jsonb_plperl/jsonb_plperl--1.0.sql create mode 100644 contrib/jsonb_plperl/jsonb_plperl.c create mode 100644 contrib/jsonb_plperl/jsonb_plperl.control create mode 100644 contrib/jsonb_plperl/jsonb_plperlu--1.0.sql create mode 100644 contrib/jsonb_plperl/jsonb_plperlu.control create mode 100644 contrib/jsonb_plperl/sql/jsonb_plperl.sql create mode 100644 contrib/jsonb_plperl/sql/jsonb_plperlu.sql (limited to 'contrib/jsonb_plperl') diff --git a/contrib/jsonb_plperl/.gitignore b/contrib/jsonb_plperl/.gitignore new file mode 100644 index 0000000..5dcb3ff --- /dev/null +++ b/contrib/jsonb_plperl/.gitignore @@ -0,0 +1,4 @@ +# Generated subdirectories +/log/ +/results/ +/tmp_check/ diff --git a/contrib/jsonb_plperl/Makefile b/contrib/jsonb_plperl/Makefile new file mode 100644 index 0000000..ba9480e --- /dev/null +++ b/contrib/jsonb_plperl/Makefile @@ -0,0 +1,41 @@ +# contrib/jsonb_plperl/Makefile + +MODULE_big = jsonb_plperl +OBJS = \ + $(WIN32RES) \ + jsonb_plperl.o +PGFILEDESC = "jsonb_plperl - jsonb transform for plperl" + +PG_CPPFLAGS = -I$(top_srcdir)/src/pl/plperl + +EXTENSION = jsonb_plperlu jsonb_plperl +DATA = jsonb_plperlu--1.0.sql jsonb_plperl--1.0.sql + +REGRESS = jsonb_plperl jsonb_plperlu + +SHLIB_LINK += $(filter -lm, $(LIBS)) + +ifdef USE_PGXS +PG_CONFIG = pg_config +PGXS := $(shell $(PG_CONFIG) --pgxs) +include $(PGXS) +else +subdir = contrib/jsonb_plperl +top_builddir = ../.. +include $(top_builddir)/src/Makefile.global +include $(top_srcdir)/contrib/contrib-global.mk +endif + +# We must link libperl explicitly +ifeq ($(PORTNAME), win32) +# these settings are the same as for plperl +override CPPFLAGS += -DPLPERL_HAVE_UID_GID -Wno-comment +# ... see silliness in plperl Makefile ... +SHLIB_LINK_INTERNAL += $(sort $(wildcard ../../src/pl/plperl/libperl*.a)) +else +rpathdir = $(perl_archlibexp)/CORE +SHLIB_LINK += $(perl_embed_ldflags) +endif + +# As with plperl we need to include the perl_includespec directory last. +override CPPFLAGS := $(CPPFLAGS) $(perl_embed_ccflags) $(perl_includespec) diff --git a/contrib/jsonb_plperl/expected/jsonb_plperl.out b/contrib/jsonb_plperl/expected/jsonb_plperl.out new file mode 100644 index 0000000..5a73485 --- /dev/null +++ b/contrib/jsonb_plperl/expected/jsonb_plperl.out @@ -0,0 +1,253 @@ +CREATE EXTENSION jsonb_plperl CASCADE; +NOTICE: installing required extension "plperl" +CREATE FUNCTION testHVToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +$val = {a => 1, b => 'boo', c => undef}; +return $val; +$$; +SELECT testHVToJsonb(); + testhvtojsonb +--------------------------------- + {"a": 1, "b": "boo", "c": null} +(1 row) + +CREATE FUNCTION testAVToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +$val = [{a => 1, b => 'boo', c => undef}, {d => 2}]; +return $val; +$$; +SELECT testAVToJsonb(); + testavtojsonb +--------------------------------------------- + [{"a": 1, "b": "boo", "c": null}, {"d": 2}] +(1 row) + +CREATE FUNCTION testSVToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +$val = 1; +return $val; +$$; +SELECT testSVToJsonb(); + testsvtojsonb +--------------- + 1 +(1 row) + +CREATE FUNCTION testUVToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +as $$ +$val = ~0; +return $val; +$$; +-- this might produce either 18446744073709551615 or 4294967295 +SELECT testUVToJsonb() IN ('18446744073709551615'::jsonb, '4294967295'::jsonb); + ?column? +---------- + t +(1 row) + +-- this revealed a bug in the original implementation +CREATE FUNCTION testRegexpResultToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +return ('1' =~ m(0\t2)); +$$; +SELECT testRegexpResultToJsonb(); + testregexpresulttojsonb +------------------------- + 0 +(1 row) + +-- this revealed a different bug +CREATE FUNCTION testTextToJsonbObject(text) RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +my $x = shift; +return {a => $x}; +$$; +SELECT testTextToJsonbObject('abc'); + testtexttojsonbobject +----------------------- + {"a": "abc"} +(1 row) + +SELECT testTextToJsonbObject(NULL); + testtexttojsonbobject +----------------------- + {"a": null} +(1 row) + +CREATE FUNCTION roundtrip(val jsonb, ref text = '') RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +# can't use Data::Dumper, but let's at least check for unexpected ref type +die 'unexpected '.(ref($_[0]) || 'not a').' reference' + if ref($_[0]) ne $_[1]; +return $_[0]; +$$; +SELECT roundtrip('null') is null; + ?column? +---------- + t +(1 row) + +SELECT roundtrip('1'); + roundtrip +----------- + 1 +(1 row) + +SELECT roundtrip('1E+131071'); +ERROR: cannot convert infinity to jsonb +CONTEXT: PL/Perl function "roundtrip" +SELECT roundtrip('-1'); + roundtrip +----------- + -1 +(1 row) + +SELECT roundtrip('1.2'); + roundtrip +----------- + 1.2 +(1 row) + +SELECT roundtrip('-1.2'); + roundtrip +----------- + -1.2 +(1 row) + +SELECT roundtrip('"string"'); + roundtrip +----------- + "string" +(1 row) + +SELECT roundtrip('"NaN"'); + roundtrip +----------- + "NaN" +(1 row) + +SELECT roundtrip('true'); + roundtrip +----------- + 1 +(1 row) + +SELECT roundtrip('false'); + roundtrip +----------- + 0 +(1 row) + +SELECT roundtrip('[]', 'ARRAY'); + roundtrip +----------- + [] +(1 row) + +SELECT roundtrip('[null, null]', 'ARRAY'); + roundtrip +-------------- + [null, null] +(1 row) + +SELECT roundtrip('[1, 2, 3]', 'ARRAY'); + roundtrip +----------- + [1, 2, 3] +(1 row) + +SELECT roundtrip('[-1, 2, -3]', 'ARRAY'); + roundtrip +------------- + [-1, 2, -3] +(1 row) + +SELECT roundtrip('[1.2, 2.3, 3.4]', 'ARRAY'); + roundtrip +----------------- + [1.2, 2.3, 3.4] +(1 row) + +SELECT roundtrip('[-1.2, 2.3, -3.4]', 'ARRAY'); + roundtrip +------------------- + [-1.2, 2.3, -3.4] +(1 row) + +SELECT roundtrip('["string1", "string2"]', 'ARRAY'); + roundtrip +------------------------ + ["string1", "string2"] +(1 row) + +SELECT roundtrip('[["string1", "string2"]]', 'ARRAY'); + roundtrip +-------------------------- + [["string1", "string2"]] +(1 row) + +SELECT roundtrip('{}', 'HASH'); + roundtrip +----------- + {} +(1 row) + +SELECT roundtrip('{"1": null}', 'HASH'); + roundtrip +------------- + {"1": null} +(1 row) + +SELECT roundtrip('{"1": 1}', 'HASH'); + roundtrip +----------- + {"1": 1} +(1 row) + +SELECT roundtrip('{"1": -1}', 'HASH'); + roundtrip +----------- + {"1": -1} +(1 row) + +SELECT roundtrip('{"1": 1.1}', 'HASH'); + roundtrip +------------ + {"1": 1.1} +(1 row) + +SELECT roundtrip('{"1": -1.1}', 'HASH'); + roundtrip +------------- + {"1": -1.1} +(1 row) + +SELECT roundtrip('{"1": "string1"}', 'HASH'); + roundtrip +------------------ + {"1": "string1"} +(1 row) + +SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}', 'HASH'); + roundtrip +--------------------------------- + {"1": {"2": [3, 4, 5]}, "2": 3} +(1 row) + +\set VERBOSITY terse \\ -- suppress cascade details +DROP EXTENSION plperl CASCADE; +NOTICE: drop cascades to 8 other objects diff --git a/contrib/jsonb_plperl/expected/jsonb_plperlu.out b/contrib/jsonb_plperl/expected/jsonb_plperlu.out new file mode 100644 index 0000000..dff316c --- /dev/null +++ b/contrib/jsonb_plperl/expected/jsonb_plperlu.out @@ -0,0 +1,280 @@ +CREATE EXTENSION jsonb_plperlu CASCADE; +NOTICE: installing required extension "plperlu" +CREATE FUNCTION testHVToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +$val = {a => 1, b => 'boo', c => undef}; +return $val; +$$; +SELECT testHVToJsonb(); + testhvtojsonb +--------------------------------- + {"a": 1, "b": "boo", "c": null} +(1 row) + +CREATE FUNCTION testAVToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +$val = [{a => 1, b => 'boo', c => undef}, {d => 2}]; +return $val; +$$; +SELECT testAVToJsonb(); + testavtojsonb +--------------------------------------------- + [{"a": 1, "b": "boo", "c": null}, {"d": 2}] +(1 row) + +CREATE FUNCTION testSVToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +$val = 1; +return $val; +$$; +SELECT testSVToJsonb(); + testsvtojsonb +--------------- + 1 +(1 row) + +CREATE FUNCTION testUVToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +as $$ +$val = ~0; +return $val; +$$; +-- this might produce either 18446744073709551615 or 4294967295 +SELECT testUVToJsonb() IN ('18446744073709551615'::jsonb, '4294967295'::jsonb); + ?column? +---------- + t +(1 row) + +-- this revealed a bug in the original implementation +CREATE FUNCTION testRegexpResultToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +return ('1' =~ m(0\t2)); +$$; +SELECT testRegexpResultToJsonb(); + testregexpresulttojsonb +------------------------- + 0 +(1 row) + +-- this revealed a different bug +CREATE FUNCTION testTextToJsonbObject(text) RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +my $x = shift; +return {a => $x}; +$$; +SELECT testTextToJsonbObject('abc'); + testtexttojsonbobject +----------------------- + {"a": "abc"} +(1 row) + +SELECT testTextToJsonbObject(NULL); + testtexttojsonbobject +----------------------- + {"a": null} +(1 row) + +CREATE FUNCTION roundtrip(val jsonb, ref text = '') RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +use Data::Dumper; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Indent = 0; +elog(INFO, Dumper($_[0])); +die 'unexpected '.(ref($_[0]) || 'not a').' reference' + if ref($_[0]) ne $_[1]; +return $_[0]; +$$; +SELECT roundtrip('null') is null; +INFO: $VAR1 = undef; + ?column? +---------- + t +(1 row) + +SELECT roundtrip('1'); +INFO: $VAR1 = '1'; + roundtrip +----------- + 1 +(1 row) + +-- skip because Data::Dumper produces a platform-dependent spelling of infinity +-- SELECT roundtrip('1E+131071'); +SELECT roundtrip('-1'); +INFO: $VAR1 = '-1'; + roundtrip +----------- + -1 +(1 row) + +SELECT roundtrip('1.2'); +INFO: $VAR1 = '1.2'; + roundtrip +----------- + 1.2 +(1 row) + +SELECT roundtrip('-1.2'); +INFO: $VAR1 = '-1.2'; + roundtrip +----------- + -1.2 +(1 row) + +SELECT roundtrip('"string"'); +INFO: $VAR1 = 'string'; + roundtrip +----------- + "string" +(1 row) + +SELECT roundtrip('"NaN"'); +INFO: $VAR1 = 'NaN'; + roundtrip +----------- + "NaN" +(1 row) + +SELECT roundtrip('true'); +INFO: $VAR1 = '1'; + roundtrip +----------- + 1 +(1 row) + +SELECT roundtrip('false'); +INFO: $VAR1 = '0'; + roundtrip +----------- + 0 +(1 row) + +SELECT roundtrip('[]', 'ARRAY'); +INFO: $VAR1 = []; + roundtrip +----------- + [] +(1 row) + +SELECT roundtrip('[null, null]', 'ARRAY'); +INFO: $VAR1 = [undef,undef]; + roundtrip +-------------- + [null, null] +(1 row) + +SELECT roundtrip('[1, 2, 3]', 'ARRAY'); +INFO: $VAR1 = ['1','2','3']; + roundtrip +----------- + [1, 2, 3] +(1 row) + +SELECT roundtrip('[-1, 2, -3]', 'ARRAY'); +INFO: $VAR1 = ['-1','2','-3']; + roundtrip +------------- + [-1, 2, -3] +(1 row) + +SELECT roundtrip('[1.2, 2.3, 3.4]', 'ARRAY'); +INFO: $VAR1 = ['1.2','2.3','3.4']; + roundtrip +----------------- + [1.2, 2.3, 3.4] +(1 row) + +SELECT roundtrip('[-1.2, 2.3, -3.4]', 'ARRAY'); +INFO: $VAR1 = ['-1.2','2.3','-3.4']; + roundtrip +------------------- + [-1.2, 2.3, -3.4] +(1 row) + +SELECT roundtrip('["string1", "string2"]', 'ARRAY'); +INFO: $VAR1 = ['string1','string2']; + roundtrip +------------------------ + ["string1", "string2"] +(1 row) + +SELECT roundtrip('[["string1", "string2"]]', 'ARRAY'); +INFO: $VAR1 = [['string1','string2']]; + roundtrip +-------------------------- + [["string1", "string2"]] +(1 row) + +SELECT roundtrip('{}', 'HASH'); +INFO: $VAR1 = {}; + roundtrip +----------- + {} +(1 row) + +SELECT roundtrip('{"1": null}', 'HASH'); +INFO: $VAR1 = {'1' => undef}; + roundtrip +------------- + {"1": null} +(1 row) + +SELECT roundtrip('{"1": 1}', 'HASH'); +INFO: $VAR1 = {'1' => '1'}; + roundtrip +----------- + {"1": 1} +(1 row) + +SELECT roundtrip('{"1": -1}', 'HASH'); +INFO: $VAR1 = {'1' => '-1'}; + roundtrip +----------- + {"1": -1} +(1 row) + +SELECT roundtrip('{"1": 1.1}', 'HASH'); +INFO: $VAR1 = {'1' => '1.1'}; + roundtrip +------------ + {"1": 1.1} +(1 row) + +SELECT roundtrip('{"1": -1.1}', 'HASH'); +INFO: $VAR1 = {'1' => '-1.1'}; + roundtrip +------------- + {"1": -1.1} +(1 row) + +SELECT roundtrip('{"1": "string1"}', 'HASH'); +INFO: $VAR1 = {'1' => 'string1'}; + roundtrip +------------------ + {"1": "string1"} +(1 row) + +SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}', 'HASH'); +INFO: $VAR1 = {'1' => {'2' => ['3','4','5']},'2' => '3'}; + roundtrip +--------------------------------- + {"1": {"2": [3, 4, 5]}, "2": 3} +(1 row) + +\set VERBOSITY terse \\ -- suppress cascade details +DROP EXTENSION plperlu CASCADE; +NOTICE: drop cascades to 8 other objects diff --git a/contrib/jsonb_plperl/jsonb_plperl--1.0.sql b/contrib/jsonb_plperl/jsonb_plperl--1.0.sql new file mode 100644 index 0000000..c7964ba --- /dev/null +++ b/contrib/jsonb_plperl/jsonb_plperl--1.0.sql @@ -0,0 +1,19 @@ +/* contrib/jsonb_plperl/jsonb_plperl--1.0.sql */ + +-- complain if script is sourced in psql, rather than via CREATE EXTENSION +\echo Use "CREATE EXTENSION jsonb_plperl" to load this file. \quit + +CREATE FUNCTION jsonb_to_plperl(val internal) RETURNS internal +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME'; + +CREATE FUNCTION plperl_to_jsonb(val internal) RETURNS jsonb +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME'; + +CREATE TRANSFORM FOR jsonb LANGUAGE plperl ( + FROM SQL WITH FUNCTION jsonb_to_plperl(internal), + TO SQL WITH FUNCTION plperl_to_jsonb(internal) +); + +COMMENT ON TRANSFORM FOR jsonb LANGUAGE plperl IS 'transform between jsonb and Perl'; diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c new file mode 100644 index 0000000..22e90af --- /dev/null +++ b/contrib/jsonb_plperl/jsonb_plperl.c @@ -0,0 +1,296 @@ +#include "postgres.h" + +#include + +#include "fmgr.h" +#include "plperl.h" +#include "plperl_helpers.h" +#include "utils/fmgrprotos.h" +#include "utils/jsonb.h" + +PG_MODULE_MAGIC; + +static SV *Jsonb_to_SV(JsonbContainer *jsonb); +static JsonbValue *SV_to_JsonbValue(SV *obj, JsonbParseState **ps, bool is_elem); + + +static SV * +JsonbValue_to_SV(JsonbValue *jbv) +{ + dTHX; + + switch (jbv->type) + { + case jbvBinary: + return Jsonb_to_SV(jbv->val.binary.data); + + case jbvNumeric: + { + char *str = DatumGetCString(DirectFunctionCall1(numeric_out, + NumericGetDatum(jbv->val.numeric))); + SV *result = newSVnv(SvNV(cstr2sv(str))); + + pfree(str); + return result; + } + + case jbvString: + { + char *str = pnstrdup(jbv->val.string.val, + jbv->val.string.len); + SV *result = cstr2sv(str); + + pfree(str); + return result; + } + + case jbvBool: + return newSVnv(SvNV(jbv->val.boolean ? &PL_sv_yes : &PL_sv_no)); + + case jbvNull: + return newSV(0); + + default: + elog(ERROR, "unexpected jsonb value type: %d", jbv->type); + return NULL; + } +} + +static SV * +Jsonb_to_SV(JsonbContainer *jsonb) +{ + dTHX; + JsonbValue v; + JsonbIterator *it; + JsonbIteratorToken r; + + it = JsonbIteratorInit(jsonb); + r = JsonbIteratorNext(&it, &v, true); + + switch (r) + { + case WJB_BEGIN_ARRAY: + if (v.val.array.rawScalar) + { + JsonbValue tmp; + + if ((r = JsonbIteratorNext(&it, &v, true)) != WJB_ELEM || + (r = JsonbIteratorNext(&it, &tmp, true)) != WJB_END_ARRAY || + (r = JsonbIteratorNext(&it, &tmp, true)) != WJB_DONE) + elog(ERROR, "unexpected jsonb token: %d", r); + + return JsonbValue_to_SV(&v); + } + else + { + AV *av = newAV(); + + while ((r = JsonbIteratorNext(&it, &v, true)) != WJB_DONE) + { + if (r == WJB_ELEM) + av_push(av, JsonbValue_to_SV(&v)); + } + + return newRV((SV *) av); + } + + case WJB_BEGIN_OBJECT: + { + HV *hv = newHV(); + + while ((r = JsonbIteratorNext(&it, &v, true)) != WJB_DONE) + { + if (r == WJB_KEY) + { + /* json key in v, json value in val */ + JsonbValue val; + + if (JsonbIteratorNext(&it, &val, true) == WJB_VALUE) + { + SV *value = JsonbValue_to_SV(&val); + + (void) hv_store(hv, + v.val.string.val, v.val.string.len, + value, 0); + } + } + } + + return newRV((SV *) hv); + } + + default: + elog(ERROR, "unexpected jsonb token: %d", r); + return NULL; + } +} + +static JsonbValue * +AV_to_JsonbValue(AV *in, JsonbParseState **jsonb_state) +{ + dTHX; + SSize_t pcount = av_len(in) + 1; + SSize_t i; + + pushJsonbValue(jsonb_state, WJB_BEGIN_ARRAY, NULL); + + for (i = 0; i < pcount; i++) + { + SV **value = av_fetch(in, i, FALSE); + + if (value) + (void) SV_to_JsonbValue(*value, jsonb_state, true); + } + + return pushJsonbValue(jsonb_state, WJB_END_ARRAY, NULL); +} + +static JsonbValue * +HV_to_JsonbValue(HV *obj, JsonbParseState **jsonb_state) +{ + dTHX; + JsonbValue key; + SV *val; + char *kstr; + I32 klen; + + key.type = jbvString; + + pushJsonbValue(jsonb_state, WJB_BEGIN_OBJECT, NULL); + + (void) hv_iterinit(obj); + + while ((val = hv_iternextsv(obj, &kstr, &klen))) + { + key.val.string.val = pnstrdup(kstr, klen); + key.val.string.len = klen; + pushJsonbValue(jsonb_state, WJB_KEY, &key); + (void) SV_to_JsonbValue(val, jsonb_state, false); + } + + return pushJsonbValue(jsonb_state, WJB_END_OBJECT, NULL); +} + +static JsonbValue * +SV_to_JsonbValue(SV *in, JsonbParseState **jsonb_state, bool is_elem) +{ + dTHX; + JsonbValue out; /* result */ + + /* Dereference references recursively. */ + while (SvROK(in)) + in = SvRV(in); + + switch (SvTYPE(in)) + { + case SVt_PVAV: + return AV_to_JsonbValue((AV *) in, jsonb_state); + + case SVt_PVHV: + return HV_to_JsonbValue((HV *) in, jsonb_state); + + default: + if (!SvOK(in)) + { + out.type = jbvNull; + } + else if (SvUOK(in)) + { + /* + * If UV is >=64 bits, we have no better way to make this + * happen than converting to text and back. Given the low + * usage of UV in Perl code, it's not clear it's worth working + * hard to provide alternate code paths. + */ + const char *strval = SvPV_nolen(in); + + out.type = jbvNumeric; + out.val.numeric = + DatumGetNumeric(DirectFunctionCall3(numeric_in, + CStringGetDatum(strval), + ObjectIdGetDatum(InvalidOid), + Int32GetDatum(-1))); + } + else if (SvIOK(in)) + { + IV ival = SvIV(in); + + out.type = jbvNumeric; + out.val.numeric = int64_to_numeric(ival); + } + else if (SvNOK(in)) + { + double nval = SvNV(in); + + /* + * jsonb doesn't allow infinity or NaN (per JSON + * specification), but the numeric type that is used for the + * storage accepts those, so we have to reject them here + * explicitly. + */ + if (isinf(nval)) + ereport(ERROR, + (errcode(ERRCODE_NUMERIC_VALUE_OUT_OF_RANGE), + errmsg("cannot convert infinity to jsonb"))); + if (isnan(nval)) + ereport(ERROR, + (errcode(ERRCODE_NUMERIC_VALUE_OUT_OF_RANGE), + errmsg("cannot convert NaN to jsonb"))); + + out.type = jbvNumeric; + out.val.numeric = + DatumGetNumeric(DirectFunctionCall1(float8_numeric, + Float8GetDatum(nval))); + } + else if (SvPOK(in)) + { + out.type = jbvString; + out.val.string.val = sv2cstr(in); + out.val.string.len = strlen(out.val.string.val); + } + else + { + /* + * XXX It might be nice if we could include the Perl type in + * the error message. + */ + ereport(ERROR, + (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), + errmsg("cannot transform this Perl type to jsonb"))); + return NULL; + } + } + + /* Push result into 'jsonb_state' unless it is a raw scalar. */ + return *jsonb_state + ? pushJsonbValue(jsonb_state, is_elem ? WJB_ELEM : WJB_VALUE, &out) + : memcpy(palloc(sizeof(JsonbValue)), &out, sizeof(JsonbValue)); +} + + +PG_FUNCTION_INFO_V1(jsonb_to_plperl); + +Datum +jsonb_to_plperl(PG_FUNCTION_ARGS) +{ + dTHX; + Jsonb *in = PG_GETARG_JSONB_P(0); + SV *sv = Jsonb_to_SV(&in->root); + + return PointerGetDatum(sv); +} + + +PG_FUNCTION_INFO_V1(plperl_to_jsonb); + +Datum +plperl_to_jsonb(PG_FUNCTION_ARGS) +{ + dTHX; + JsonbParseState *jsonb_state = NULL; + SV *in = (SV *) PG_GETARG_POINTER(0); + JsonbValue *out = SV_to_JsonbValue(in, &jsonb_state, true); + Jsonb *result = JsonbValueToJsonb(out); + + PG_RETURN_JSONB_P(result); +} diff --git a/contrib/jsonb_plperl/jsonb_plperl.control b/contrib/jsonb_plperl/jsonb_plperl.control new file mode 100644 index 0000000..4acee93 --- /dev/null +++ b/contrib/jsonb_plperl/jsonb_plperl.control @@ -0,0 +1,7 @@ +# jsonb_plperl extension +comment = 'transform between jsonb and plperl' +default_version = '1.0' +module_pathname = '$libdir/jsonb_plperl' +relocatable = true +trusted = true +requires = 'plperl' diff --git a/contrib/jsonb_plperl/jsonb_plperlu--1.0.sql b/contrib/jsonb_plperl/jsonb_plperlu--1.0.sql new file mode 100644 index 0000000..aa84b37 --- /dev/null +++ b/contrib/jsonb_plperl/jsonb_plperlu--1.0.sql @@ -0,0 +1,19 @@ +/* contrib/jsonb_plperl/jsonb_plperlu--1.0.sql */ + +-- complain if script is sourced in psql, rather than via CREATE EXTENSION +\echo Use "CREATE EXTENSION jsonb_plperlu" to load this file. \quit + +CREATE FUNCTION jsonb_to_plperlu(val internal) RETURNS internal +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME', 'jsonb_to_plperl'; + +CREATE FUNCTION plperlu_to_jsonb(val internal) RETURNS jsonb +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME', 'plperl_to_jsonb'; + +CREATE TRANSFORM FOR jsonb LANGUAGE plperlu ( + FROM SQL WITH FUNCTION jsonb_to_plperlu(internal), + TO SQL WITH FUNCTION plperlu_to_jsonb(internal) +); + +COMMENT ON TRANSFORM FOR jsonb LANGUAGE plperlu IS 'transform between jsonb and Perl'; diff --git a/contrib/jsonb_plperl/jsonb_plperlu.control b/contrib/jsonb_plperl/jsonb_plperlu.control new file mode 100644 index 0000000..946fc51 --- /dev/null +++ b/contrib/jsonb_plperl/jsonb_plperlu.control @@ -0,0 +1,6 @@ +# jsonb_plperl extension +comment = 'transform between jsonb and plperlu' +default_version = '1.0' +module_pathname = '$libdir/jsonb_plperl' +relocatable = true +requires = 'plperlu' diff --git a/contrib/jsonb_plperl/sql/jsonb_plperl.sql b/contrib/jsonb_plperl/sql/jsonb_plperl.sql new file mode 100644 index 0000000..a5b2cff --- /dev/null +++ b/contrib/jsonb_plperl/sql/jsonb_plperl.sql @@ -0,0 +1,117 @@ +CREATE EXTENSION jsonb_plperl CASCADE; + + +CREATE FUNCTION testHVToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +$val = {a => 1, b => 'boo', c => undef}; +return $val; +$$; + +SELECT testHVToJsonb(); + + +CREATE FUNCTION testAVToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +$val = [{a => 1, b => 'boo', c => undef}, {d => 2}]; +return $val; +$$; + +SELECT testAVToJsonb(); + + +CREATE FUNCTION testSVToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +$val = 1; +return $val; +$$; + +SELECT testSVToJsonb(); + + +CREATE FUNCTION testUVToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +as $$ +$val = ~0; +return $val; +$$; + +-- this might produce either 18446744073709551615 or 4294967295 +SELECT testUVToJsonb() IN ('18446744073709551615'::jsonb, '4294967295'::jsonb); + + +-- this revealed a bug in the original implementation +CREATE FUNCTION testRegexpResultToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +return ('1' =~ m(0\t2)); +$$; + +SELECT testRegexpResultToJsonb(); + + +-- this revealed a different bug +CREATE FUNCTION testTextToJsonbObject(text) RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +my $x = shift; +return {a => $x}; +$$; + +SELECT testTextToJsonbObject('abc'); +SELECT testTextToJsonbObject(NULL); + + +CREATE FUNCTION roundtrip(val jsonb, ref text = '') RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +# can't use Data::Dumper, but let's at least check for unexpected ref type +die 'unexpected '.(ref($_[0]) || 'not a').' reference' + if ref($_[0]) ne $_[1]; +return $_[0]; +$$; + + +SELECT roundtrip('null') is null; +SELECT roundtrip('1'); +SELECT roundtrip('1E+131071'); +SELECT roundtrip('-1'); +SELECT roundtrip('1.2'); +SELECT roundtrip('-1.2'); +SELECT roundtrip('"string"'); +SELECT roundtrip('"NaN"'); + +SELECT roundtrip('true'); +SELECT roundtrip('false'); + +SELECT roundtrip('[]', 'ARRAY'); +SELECT roundtrip('[null, null]', 'ARRAY'); +SELECT roundtrip('[1, 2, 3]', 'ARRAY'); +SELECT roundtrip('[-1, 2, -3]', 'ARRAY'); +SELECT roundtrip('[1.2, 2.3, 3.4]', 'ARRAY'); +SELECT roundtrip('[-1.2, 2.3, -3.4]', 'ARRAY'); +SELECT roundtrip('["string1", "string2"]', 'ARRAY'); +SELECT roundtrip('[["string1", "string2"]]', 'ARRAY'); + +SELECT roundtrip('{}', 'HASH'); +SELECT roundtrip('{"1": null}', 'HASH'); +SELECT roundtrip('{"1": 1}', 'HASH'); +SELECT roundtrip('{"1": -1}', 'HASH'); +SELECT roundtrip('{"1": 1.1}', 'HASH'); +SELECT roundtrip('{"1": -1.1}', 'HASH'); +SELECT roundtrip('{"1": "string1"}', 'HASH'); + +SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}', 'HASH'); + + +\set VERBOSITY terse \\ -- suppress cascade details +DROP EXTENSION plperl CASCADE; diff --git a/contrib/jsonb_plperl/sql/jsonb_plperlu.sql b/contrib/jsonb_plperl/sql/jsonb_plperlu.sql new file mode 100644 index 0000000..c68ef73 --- /dev/null +++ b/contrib/jsonb_plperl/sql/jsonb_plperlu.sql @@ -0,0 +1,121 @@ +CREATE EXTENSION jsonb_plperlu CASCADE; + + +CREATE FUNCTION testHVToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +$val = {a => 1, b => 'boo', c => undef}; +return $val; +$$; + +SELECT testHVToJsonb(); + + +CREATE FUNCTION testAVToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +$val = [{a => 1, b => 'boo', c => undef}, {d => 2}]; +return $val; +$$; + +SELECT testAVToJsonb(); + + +CREATE FUNCTION testSVToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +$val = 1; +return $val; +$$; + +SELECT testSVToJsonb(); + + +CREATE FUNCTION testUVToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +as $$ +$val = ~0; +return $val; +$$; + +-- this might produce either 18446744073709551615 or 4294967295 +SELECT testUVToJsonb() IN ('18446744073709551615'::jsonb, '4294967295'::jsonb); + + +-- this revealed a bug in the original implementation +CREATE FUNCTION testRegexpResultToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +return ('1' =~ m(0\t2)); +$$; + +SELECT testRegexpResultToJsonb(); + + +-- this revealed a different bug +CREATE FUNCTION testTextToJsonbObject(text) RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +my $x = shift; +return {a => $x}; +$$; + +SELECT testTextToJsonbObject('abc'); +SELECT testTextToJsonbObject(NULL); + + +CREATE FUNCTION roundtrip(val jsonb, ref text = '') RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +use Data::Dumper; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Indent = 0; +elog(INFO, Dumper($_[0])); +die 'unexpected '.(ref($_[0]) || 'not a').' reference' + if ref($_[0]) ne $_[1]; +return $_[0]; +$$; + + +SELECT roundtrip('null') is null; +SELECT roundtrip('1'); +-- skip because Data::Dumper produces a platform-dependent spelling of infinity +-- SELECT roundtrip('1E+131071'); +SELECT roundtrip('-1'); +SELECT roundtrip('1.2'); +SELECT roundtrip('-1.2'); +SELECT roundtrip('"string"'); +SELECT roundtrip('"NaN"'); + +SELECT roundtrip('true'); +SELECT roundtrip('false'); + +SELECT roundtrip('[]', 'ARRAY'); +SELECT roundtrip('[null, null]', 'ARRAY'); +SELECT roundtrip('[1, 2, 3]', 'ARRAY'); +SELECT roundtrip('[-1, 2, -3]', 'ARRAY'); +SELECT roundtrip('[1.2, 2.3, 3.4]', 'ARRAY'); +SELECT roundtrip('[-1.2, 2.3, -3.4]', 'ARRAY'); +SELECT roundtrip('["string1", "string2"]', 'ARRAY'); +SELECT roundtrip('[["string1", "string2"]]', 'ARRAY'); + +SELECT roundtrip('{}', 'HASH'); +SELECT roundtrip('{"1": null}', 'HASH'); +SELECT roundtrip('{"1": 1}', 'HASH'); +SELECT roundtrip('{"1": -1}', 'HASH'); +SELECT roundtrip('{"1": 1.1}', 'HASH'); +SELECT roundtrip('{"1": -1.1}', 'HASH'); +SELECT roundtrip('{"1": "string1"}', 'HASH'); + +SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}', 'HASH'); + + +\set VERBOSITY terse \\ -- suppress cascade details +DROP EXTENSION plperlu CASCADE; -- cgit v1.2.3