diff --git a/contrib/Makefile b/contrib/Makefile index 8046ca4..53d44fe 100644 --- a/contrib/Makefile +++ b/contrib/Makefile @@ -75,9 +75,9 @@ ALWAYS_SUBDIRS += sepgsql endif ifeq ($(with_perl),yes) -SUBDIRS += hstore_plperl +SUBDIRS += hstore_plperl jsonb_plperl else -ALWAYS_SUBDIRS += hstore_plperl +ALWAYS_SUBDIRS += hstore_plperl jsonb_plperl endif ifeq ($(with_python),yes) diff --git a/contrib/jsonb_plperl/Makefile b/contrib/jsonb_plperl/Makefile new file mode 100644 index 0000000..cd86553 --- /dev/null +++ b/contrib/jsonb_plperl/Makefile @@ -0,0 +1,40 @@ +# contrib/jsonb_plperl/Makefile + +MODULE_big = jsonb_plperl +OBJS = jsonb_plperl.o $(WIN32RES) +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_plperl_relocatability jsonb_plperlu jsonb_plperlu_relocatability + +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 += $(sort $(wildcard ../../src/pl/plperl/libperl*.a)) +else +rpathdir = $(perl_archlibexp)/CORE +SHLIB_LINK += $(perl_embed_ldflags) +endif + +# As with plperl we need to make sure that the CORE directory is included +# last, probably because it sometimes contains some header files with names +# that clash with some of ours, or with some that we include, notably on +# Windows. +override CPPFLAGS := $(CPPFLAGS) $(perl_embed_ccflags) -I$(perl_archlibexp)/CORE diff --git a/contrib/jsonb_plperl/expected/jsonb_plperl.out b/contrib/jsonb_plperl/expected/jsonb_plperl.out new file mode 100644 index 0000000..152e62d --- /dev/null +++ b/contrib/jsonb_plperl/expected/jsonb_plperl.out @@ -0,0 +1,243 @@ +CREATE EXTENSION jsonb_plperl CASCADE; +NOTICE: installing required extension "plperl" +-- test hash -> jsonb +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) + +-- test array -> jsonb +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) + +-- test scalar -> jsonb +CREATE FUNCTION testSVToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +$val = 1; +return $val; +$$; +SELECT testSVToJsonb(); + testsvtojsonb +--------------- + 1 +(1 row) + +-- test blessed scalar -> jsonb +CREATE FUNCTION testBlessedToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +my $class = shift; +my $tmp = { a=>"a", 1=>"1" }; +bless $tmp, $class; +return $tmp; +$$; +SELECT testBlessedToJsonb(); + testblessedtojsonb +---------------------- + {"1": "1", "a": "a"} +(1 row) + +-- test blessed scalar -> jsonb +CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +return ('1' =~ m(0\t2)); +$$; +SELECT testRegexpToJsonb(); +ERROR: could not transform to type "jsonb" +DETAIL: The type you are trying to transform can't be transformed to jsonb +CONTEXT: PL/Perl function "testregexptojsonb" +-- test jsonb -> scalar -> jsonb +CREATE FUNCTION testSVToJsonb2(val jsonb) RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +return $_[0]; +$$; +SELECT testSVToJsonb2('null'); + testsvtojsonb2 +---------------- + null +(1 row) + +SELECT testSVToJsonb2('1'); + testsvtojsonb2 +---------------- + 1 +(1 row) + +SELECT testSVToJsonb2('1E+131071'); +ERROR: could not transform to type "jsonb" +DETAIL: The type you are trying to transform can't be transformed to jsonb +CONTEXT: PL/Perl function "testsvtojsonb2" +SELECT testSVToJsonb2('-1'); + testsvtojsonb2 +---------------- + -1 +(1 row) + +SELECT testSVToJsonb2('1.2'); + testsvtojsonb2 +---------------- + 1.2 +(1 row) + +SELECT testSVToJsonb2('-1.2'); + testsvtojsonb2 +---------------- + -1.2 +(1 row) + +SELECT testSVToJsonb2('"string"'); + testsvtojsonb2 +---------------- + "string" +(1 row) + +SELECT testSVToJsonb2('"NaN"'); + testsvtojsonb2 +---------------- + "NaN" +(1 row) + +SELECT testSVToJsonb2('true'); + testsvtojsonb2 +---------------- + 1 +(1 row) + +SELECT testSVToJsonb2('false'); + testsvtojsonb2 +---------------- + 0 +(1 row) + +SELECT testSVToJsonb2('[]'); + testsvtojsonb2 +---------------- + [] +(1 row) + +SELECT testSVToJsonb2('[null,null]'); + testsvtojsonb2 +---------------- + [null, null] +(1 row) + +SELECT testSVToJsonb2('[1,2,3]'); + testsvtojsonb2 +---------------- + [1, 2, 3] +(1 row) + +SELECT testSVToJsonb2('[-1,2,-3]'); + testsvtojsonb2 +---------------- + [-1, 2, -3] +(1 row) + +SELECT testSVToJsonb2('[1.2,2.3,3.4]'); + testsvtojsonb2 +----------------- + [1.2, 2.3, 3.4] +(1 row) + +SELECT testSVToJsonb2('[-1.2,2.3,-3.4]'); + testsvtojsonb2 +------------------- + [-1.2, 2.3, -3.4] +(1 row) + +SELECT testSVToJsonb2('["string1","string2"]'); + testsvtojsonb2 +------------------------ + ["string1", "string2"] +(1 row) + +SELECT testSVToJsonb2('{}'); + testsvtojsonb2 +---------------- + {} +(1 row) + +SELECT testSVToJsonb2('{"1":null}'); + testsvtojsonb2 +---------------- + {"1": null} +(1 row) + +SELECT testSVToJsonb2('{"1":1}'); + testsvtojsonb2 +---------------- + {"1": 1} +(1 row) + +SELECT testSVToJsonb2('{"1":-1}'); + testsvtojsonb2 +---------------- + {"1": -1} +(1 row) + +SELECT testSVToJsonb2('{"1":1.1}'); + testsvtojsonb2 +---------------- + {"1": 1.1} +(1 row) + +SELECT testSVToJsonb2('{"1":-1.1}'); + testsvtojsonb2 +---------------- + {"1": -1.1} +(1 row) + +SELECT testSVToJsonb2('{"1":"string1"}'); + testsvtojsonb2 +------------------ + {"1": "string1"} +(1 row) + +SELECT testSVToJsonb2('{"1":{"2":[3,4,5]},"2":3}'); + testsvtojsonb2 +--------------------------------- + {"1": {"2": [3, 4, 5]}, "2": 3} +(1 row) + +-- testing large numbers which are not represented as "inf" inside perl. +-- 1E+309 - is inf while 1E+308 is not +SELECT testSVToJsonb2('1E+308'); + testsvtojsonb2 +----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- + 100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 +(1 row) + +DROP EXTENSION plperl CASCADE; +NOTICE: drop cascades to 7 other objects +DETAIL: drop cascades to extension jsonb_plperl +drop cascades to function testhvtojsonb() +drop cascades to function testavtojsonb() +drop cascades to function testsvtojsonb() +drop cascades to function testblessedtojsonb() +drop cascades to function testregexptojsonb() +drop cascades to function testsvtojsonb2(jsonb) diff --git a/contrib/jsonb_plperl/expected/jsonb_plperl_relocatability.out b/contrib/jsonb_plperl/expected/jsonb_plperl_relocatability.out new file mode 100644 index 0000000..b334d0c --- /dev/null +++ b/contrib/jsonb_plperl/expected/jsonb_plperl_relocatability.out @@ -0,0 +1,21 @@ +CREATE EXTENSION jsonb_plperl CASCADE; +NOTICE: installing required extension "plperl" +CREATE SCHEMA test; +alter extension jsonb_plperl set schema test; +create function test.test(val jsonb) returns jsonb +language plperl +transform for type jsonb +as $$ +return val +$$; +select test.test('1'::jsonb); + test +------- + "val" +(1 row) + +drop extension plperl cascade; +NOTICE: drop cascades to 2 other objects +DETAIL: drop cascades to extension jsonb_plperl +drop cascades to function test.test(jsonb) +drop schema test cascade; diff --git a/contrib/jsonb_plperl/expected/jsonb_plperlu.out b/contrib/jsonb_plperl/expected/jsonb_plperlu.out new file mode 100644 index 0000000..fc989ce --- /dev/null +++ b/contrib/jsonb_plperl/expected/jsonb_plperlu.out @@ -0,0 +1,243 @@ +CREATE EXTENSION jsonb_plperlu CASCADE; +NOTICE: installing required extension "plperlu" +-- test hash -> jsonb +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) + +-- test array -> jsonb +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) + +-- test scalar -> jsonb +CREATE FUNCTION testSVToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +$val = 1; +return $val; +$$; +SELECT testSVToJsonb(); + testsvtojsonb +--------------- + 1 +(1 row) + +-- test blessed scalar -> jsonb +CREATE FUNCTION testBlessedToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +my $class = shift; +my $tmp = { a=>"a", 1=>"1" }; +bless $tmp, $class; +return $tmp; +$$; +SELECT testBlessedToJsonb(); + testblessedtojsonb +---------------------- + {"1": "1", "a": "a"} +(1 row) + +-- test blessed scalar -> jsonb +CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +return ('1' =~ m(0\t2)); +$$; +SELECT testRegexpToJsonb(); +ERROR: could not transform to type "jsonb" +DETAIL: The type you are trying to transform can't be transformed to jsonb +CONTEXT: PL/Perl function "testregexptojsonb" +-- test jsonb -> scalar -> jsonb +CREATE FUNCTION testSVToJsonb2(val jsonb) RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +return $_[0]; +$$; +SELECT testSVToJsonb2('null'); + testsvtojsonb2 +---------------- + null +(1 row) + +SELECT testSVToJsonb2('1'); + testsvtojsonb2 +---------------- + 1 +(1 row) + +SELECT testSVToJsonb2('1E+131071'); +ERROR: could not transform to type "jsonb" +DETAIL: The type you are trying to transform can't be transformed to jsonb +CONTEXT: PL/Perl function "testsvtojsonb2" +SELECT testSVToJsonb2('-1'); + testsvtojsonb2 +---------------- + -1 +(1 row) + +SELECT testSVToJsonb2('1.2'); + testsvtojsonb2 +---------------- + 1.2 +(1 row) + +SELECT testSVToJsonb2('-1.2'); + testsvtojsonb2 +---------------- + -1.2 +(1 row) + +SELECT testSVToJsonb2('"string"'); + testsvtojsonb2 +---------------- + "string" +(1 row) + +SELECT testSVToJsonb2('"NaN"'); + testsvtojsonb2 +---------------- + "NaN" +(1 row) + +SELECT testSVToJsonb2('true'); + testsvtojsonb2 +---------------- + 1 +(1 row) + +SELECT testSVToJsonb2('false'); + testsvtojsonb2 +---------------- + 0 +(1 row) + +SELECT testSVToJsonb2('[]'); + testsvtojsonb2 +---------------- + [] +(1 row) + +SELECT testSVToJsonb2('[null,null]'); + testsvtojsonb2 +---------------- + [null, null] +(1 row) + +SELECT testSVToJsonb2('[1,2,3]'); + testsvtojsonb2 +---------------- + [1, 2, 3] +(1 row) + +SELECT testSVToJsonb2('[-1,2,-3]'); + testsvtojsonb2 +---------------- + [-1, 2, -3] +(1 row) + +SELECT testSVToJsonb2('[1.2,2.3,3.4]'); + testsvtojsonb2 +----------------- + [1.2, 2.3, 3.4] +(1 row) + +SELECT testSVToJsonb2('[-1.2,2.3,-3.4]'); + testsvtojsonb2 +------------------- + [-1.2, 2.3, -3.4] +(1 row) + +SELECT testSVToJsonb2('["string1","string2"]'); + testsvtojsonb2 +------------------------ + ["string1", "string2"] +(1 row) + +SELECT testSVToJsonb2('{}'); + testsvtojsonb2 +---------------- + {} +(1 row) + +SELECT testSVToJsonb2('{"1":null}'); + testsvtojsonb2 +---------------- + {"1": null} +(1 row) + +SELECT testSVToJsonb2('{"1":1}'); + testsvtojsonb2 +---------------- + {"1": 1} +(1 row) + +SELECT testSVToJsonb2('{"1":-1}'); + testsvtojsonb2 +---------------- + {"1": -1} +(1 row) + +SELECT testSVToJsonb2('{"1":1.1}'); + testsvtojsonb2 +---------------- + {"1": 1.1} +(1 row) + +SELECT testSVToJsonb2('{"1":-1.1}'); + testsvtojsonb2 +---------------- + {"1": -1.1} +(1 row) + +SELECT testSVToJsonb2('{"1":"string1"}'); + testsvtojsonb2 +------------------ + {"1": "string1"} +(1 row) + +SELECT testSVToJsonb2('{"1":{"2":[3,4,5]},"2":3}'); + testsvtojsonb2 +--------------------------------- + {"1": {"2": [3, 4, 5]}, "2": 3} +(1 row) + +-- testing large numbers which are not represented as "inf" inside perl. +-- 1E+309 - is inf while 1E+308 is not +SELECT testSVToJsonb2('1E+308'); + testsvtojsonb2 +----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- + 100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 +(1 row) + +DROP EXTENSION plperlu CASCADE; +NOTICE: drop cascades to 7 other objects +DETAIL: drop cascades to extension jsonb_plperlu +drop cascades to function testhvtojsonb() +drop cascades to function testavtojsonb() +drop cascades to function testsvtojsonb() +drop cascades to function testblessedtojsonb() +drop cascades to function testregexptojsonb() +drop cascades to function testsvtojsonb2(jsonb) diff --git a/contrib/jsonb_plperl/expected/jsonb_plperlu_relocatability.out b/contrib/jsonb_plperl/expected/jsonb_plperlu_relocatability.out new file mode 100644 index 0000000..a640da7 --- /dev/null +++ b/contrib/jsonb_plperl/expected/jsonb_plperlu_relocatability.out @@ -0,0 +1,21 @@ +CREATE EXTENSION jsonb_plperlu CASCADE; +NOTICE: installing required extension "plperlu" +CREATE SCHEMA test; +alter extension jsonb_plperlu set schema test; +create function test.test(val jsonb) returns jsonb +language plperlu +transform for type jsonb +as $$ +return val +$$; +select test.test('1'::jsonb); + test +------- + "val" +(1 row) + +drop extension plperlu cascade; +NOTICE: drop cascades to 2 other objects +DETAIL: drop cascades to extension jsonb_plperlu +drop cascades to function test.test(jsonb) +drop schema test cascade; 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..25dedbe --- /dev/null +++ b/contrib/jsonb_plperl/jsonb_plperl--1.0.sql @@ -0,0 +1,17 @@ +/* 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) +); diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c new file mode 100644 index 0000000..80be238 --- /dev/null +++ b/contrib/jsonb_plperl/jsonb_plperl.c @@ -0,0 +1,315 @@ +/* This document contains an implementation of transformations from perl + * object to jsonb and vise versa. + * In this file you can find implementation of transformations: + * - jsonb_to_plperl(PG_FUNCTION_ARGS) + * - plperl_to_jsonb(PG_FUNCTION_ARGS) + */ +#include "postgres.h" + +/* #undef _ is needed because "_" was already defined in include/c.h:971:0 */ +#undef _ + +#include "fmgr.h" +#include "plperl.h" +#include "plperl_helpers.h" + +#include "utils/jsonb.h" +#include "utils/fmgrprotos.h" + +PG_MODULE_MAGIC; + +static SV *Jsonb_ToSV(JsonbContainer *jsonb); +static JsonbValue *SV_ToJsonbValue(SV *obj, JsonbParseState **ps, bool is_elem); + +/* + * JsonbValue_ToSV + * + * Transform JsonbValue into SV + */ +static SV * +JsonbValue_ToSV(JsonbValue *jbv) +{ + dTHX; + + switch (jbv->type) + { + case jbvBinary: + return newRV(Jsonb_ToSV(jbv->val.binary.data)); + + case jbvNumeric: + { + /* + * Transform incoming value into string and generate SV from + * string + */ + 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; + } +} + +/* + * Jsonb_ToSV + * + * Transform JsonbContainer into SV + */ +static SV * +Jsonb_ToSV(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 newRV(JsonbValue_ToSV(&v)); + } + else + { + AV *av = newAV(); + + while ((r = JsonbIteratorNext(&it, &v, true)) != WJB_DONE) + { + if (r == WJB_ELEM) + av_push(av, JsonbValue_ToSV(&v)); + } + + return (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_ToSV(&val); + + (void) hv_store(hv, v.val.string.val, + v.val.string.len, value, 0); + } + } + } + + return (SV *) hv; + } + + default: + elog(ERROR, "unexpected jsonb token: %d", r); + return NULL; + } +} + +/* + * jsonb_to_plperl + * + * Transform Jsonb into SV + */ +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_ToSV(&in->root); + + return PointerGetDatum(newRV(sv)); +} + +/* + * AV_ToJsonbValue + * + * Transform AV into JsonbValue + * jsonb_state defines conversion state + */ +static JsonbValue * +AV_ToJsonbValue(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_ToJsonbValue(*value, jsonb_state, true); + } + + return pushJsonbValue(jsonb_state, WJB_END_ARRAY, NULL); +} + +/* + * HV_ToJsonbValue + * + * Transform HV into Jsonb + */ +static JsonbValue * +HV_ToJsonbValue(HV *obj, JsonbParseState **jsonb_state) +{ + dTHX; + JsonbValue key; + SV *val; + + key.type = jbvString; + + pushJsonbValue(jsonb_state, WJB_BEGIN_OBJECT, NULL); + + (void) hv_iterinit(obj); + + while ((val = hv_iternextsv(obj, &key.val.string.val, &key.val.string.len))) + { + key.val.string.val = pnstrdup(key.val.string.val,key.val.string.len); + pushJsonbValue(jsonb_state, WJB_KEY, &key); + (void) SV_ToJsonbValue(val, jsonb_state, false); + } + + return pushJsonbValue(jsonb_state, WJB_END_OBJECT, NULL); +} + +/* + * SV_ToJsonbValue + * + * Transform SV into Jsonb + */ +static JsonbValue * +SV_ToJsonbValue(SV *in, JsonbParseState **jsonb_state, bool is_elem) +{ + dTHX; + svtype type; /* type of incoming object */ + JsonbValue out; /* result */ + + /* Dereference references recursively. */ + while (SvROK(in)) + in = SvRV(in); + + type = SvTYPE(in); + + switch (type) + { + case SVt_PVAV: + return AV_ToJsonbValue((AV *) in, jsonb_state); + + case SVt_PVHV: + return HV_ToJsonbValue((HV *) in, jsonb_state); + + case SVt_NV: + case SVt_IV: + { + /* if "in" is a numeric */ + char *str = sv2cstr(in); + int i; + + /* + * We need to lowercase the string because infinity + * representation varies from version to version + */ + for (i = 0; str[i]; i++) + str[i] = tolower(str[i]); + + if (strcmp(str, "inf") == 0) + /* in case when variable in is "inf" */ + ereport(ERROR, + (errcode(ERRCODE_INVALID_PARAMETER_VALUE), + (errmsg("could not transform to type \"%s\"", "jsonb"), + errdetail("The type you are trying to transform can't be transformed to jsonb")))); + + out.type = jbvNumeric; + out.val.numeric = DatumGetNumeric( + DirectFunctionCall3(numeric_in, + CStringGetDatum(str), 0, -1)); + } + break; + + case SVt_NULL: + out.type = jbvNull; + break; + + case SVt_PV: /* string */ + out.type = jbvString; + out.val.string.val = sv2cstr(in); + out.val.string.len = strlen(out.val.string.val); + break; + + default: + ereport(ERROR, + (errcode(ERRCODE_INVALID_PARAMETER_VALUE), + (errmsg("could not transform to type \"%s\"", "jsonb"), + errdetail("The type you are trying to transform can't be transformed 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)); +} + +/* + * plperl_to_jsonb(SV *in) + * + * Transform SV into Jsonb + */ +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_ToJsonbValue(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..26c86a7 --- /dev/null +++ b/contrib/jsonb_plperl/jsonb_plperl.control @@ -0,0 +1,6 @@ +# jsonb_plperl extension +comment = 'transform between jsonb and plperl' +default_version = '1.0' +module_pathname = '$libdir/jsonb_plperl' +relocatable = 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..65404f6 --- /dev/null +++ b/contrib/jsonb_plperl/jsonb_plperlu--1.0.sql @@ -0,0 +1,17 @@ +/* contrib/json_plperl/jsonb_plperl--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_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 plperlu ( + FROM SQL WITH FUNCTION jsonb_to_plperl(internal), + TO SQL WITH FUNCTION plperl_to_jsonb(internal) +); 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..d4d7973 --- /dev/null +++ b/contrib/jsonb_plperl/sql/jsonb_plperl.sql @@ -0,0 +1,104 @@ +CREATE EXTENSION jsonb_plperl CASCADE; + +-- test hash -> jsonb +CREATE FUNCTION testHVToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +$val = {a => 1, b => 'boo', c => undef}; +return $val; +$$; + +SELECT testHVToJsonb(); + +-- test array -> jsonb +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(); + +-- test scalar -> jsonb +CREATE FUNCTION testSVToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +$val = 1; +return $val; +$$; + +SELECT testSVToJsonb(); + +-- test blessed scalar -> jsonb +CREATE FUNCTION testBlessedToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +my $class = shift; +my $tmp = { a=>"a", 1=>"1" }; +bless $tmp, $class; +return $tmp; +$$; + +SELECT testBlessedToJsonb(); + +-- test blessed scalar -> jsonb +CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +return ('1' =~ m(0\t2)); +$$; + +SELECT testRegexpToJsonb(); + + +-- test jsonb -> scalar -> jsonb +CREATE FUNCTION testSVToJsonb2(val jsonb) RETURNS jsonb +LANGUAGE plperl +TRANSFORM FOR TYPE jsonb +AS $$ +return $_[0]; +$$; + + +SELECT testSVToJsonb2('null'); +SELECT testSVToJsonb2('1'); +SELECT testSVToJsonb2('1E+131071'); +SELECT testSVToJsonb2('-1'); +SELECT testSVToJsonb2('1.2'); +SELECT testSVToJsonb2('-1.2'); +SELECT testSVToJsonb2('"string"'); +SELECT testSVToJsonb2('"NaN"'); + +SELECT testSVToJsonb2('true'); +SELECT testSVToJsonb2('false'); + +SELECT testSVToJsonb2('[]'); +SELECT testSVToJsonb2('[null,null]'); +SELECT testSVToJsonb2('[1,2,3]'); +SELECT testSVToJsonb2('[-1,2,-3]'); +SELECT testSVToJsonb2('[1.2,2.3,3.4]'); +SELECT testSVToJsonb2('[-1.2,2.3,-3.4]'); +SELECT testSVToJsonb2('["string1","string2"]'); + +SELECT testSVToJsonb2('{}'); +SELECT testSVToJsonb2('{"1":null}'); +SELECT testSVToJsonb2('{"1":1}'); +SELECT testSVToJsonb2('{"1":-1}'); +SELECT testSVToJsonb2('{"1":1.1}'); +SELECT testSVToJsonb2('{"1":-1.1}'); +SELECT testSVToJsonb2('{"1":"string1"}'); + +SELECT testSVToJsonb2('{"1":{"2":[3,4,5]},"2":3}'); + +-- testing large numbers which are not represented as "inf" inside perl. +-- 1E+309 - is inf while 1E+308 is not +SELECT testSVToJsonb2('1E+308'); + + +DROP EXTENSION plperl CASCADE; diff --git a/contrib/jsonb_plperl/sql/jsonb_plperl_relocatability.sql b/contrib/jsonb_plperl/sql/jsonb_plperl_relocatability.sql new file mode 100644 index 0000000..4745443 --- /dev/null +++ b/contrib/jsonb_plperl/sql/jsonb_plperl_relocatability.sql @@ -0,0 +1,14 @@ +CREATE EXTENSION jsonb_plperl CASCADE; +CREATE SCHEMA test; +alter extension jsonb_plperl set schema test; +create function test.test(val jsonb) returns jsonb +language plperl +transform for type jsonb +as $$ +return val +$$; + +select test.test('1'::jsonb); + +drop extension plperl cascade; +drop schema test 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..4a040a6 --- /dev/null +++ b/contrib/jsonb_plperl/sql/jsonb_plperlu.sql @@ -0,0 +1,104 @@ +CREATE EXTENSION jsonb_plperlu CASCADE; + +-- test hash -> jsonb +CREATE FUNCTION testHVToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +$val = {a => 1, b => 'boo', c => undef}; +return $val; +$$; + +SELECT testHVToJsonb(); + +-- test array -> jsonb +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(); + +-- test scalar -> jsonb +CREATE FUNCTION testSVToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +$val = 1; +return $val; +$$; + +SELECT testSVToJsonb(); + +-- test blessed scalar -> jsonb +CREATE FUNCTION testBlessedToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +my $class = shift; +my $tmp = { a=>"a", 1=>"1" }; +bless $tmp, $class; +return $tmp; +$$; + +SELECT testBlessedToJsonb(); + +-- test blessed scalar -> jsonb +CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +return ('1' =~ m(0\t2)); +$$; + +SELECT testRegexpToJsonb(); + + +-- test jsonb -> scalar -> jsonb +CREATE FUNCTION testSVToJsonb2(val jsonb) RETURNS jsonb +LANGUAGE plperlu +TRANSFORM FOR TYPE jsonb +AS $$ +return $_[0]; +$$; + + +SELECT testSVToJsonb2('null'); +SELECT testSVToJsonb2('1'); +SELECT testSVToJsonb2('1E+131071'); +SELECT testSVToJsonb2('-1'); +SELECT testSVToJsonb2('1.2'); +SELECT testSVToJsonb2('-1.2'); +SELECT testSVToJsonb2('"string"'); +SELECT testSVToJsonb2('"NaN"'); + +SELECT testSVToJsonb2('true'); +SELECT testSVToJsonb2('false'); + +SELECT testSVToJsonb2('[]'); +SELECT testSVToJsonb2('[null,null]'); +SELECT testSVToJsonb2('[1,2,3]'); +SELECT testSVToJsonb2('[-1,2,-3]'); +SELECT testSVToJsonb2('[1.2,2.3,3.4]'); +SELECT testSVToJsonb2('[-1.2,2.3,-3.4]'); +SELECT testSVToJsonb2('["string1","string2"]'); + +SELECT testSVToJsonb2('{}'); +SELECT testSVToJsonb2('{"1":null}'); +SELECT testSVToJsonb2('{"1":1}'); +SELECT testSVToJsonb2('{"1":-1}'); +SELECT testSVToJsonb2('{"1":1.1}'); +SELECT testSVToJsonb2('{"1":-1.1}'); +SELECT testSVToJsonb2('{"1":"string1"}'); + +SELECT testSVToJsonb2('{"1":{"2":[3,4,5]},"2":3}'); + +-- testing large numbers which are not represented as "inf" inside perl. +-- 1E+309 - is inf while 1E+308 is not +SELECT testSVToJsonb2('1E+308'); + + +DROP EXTENSION plperlu CASCADE; diff --git a/contrib/jsonb_plperl/sql/jsonb_plperlu_relocatability.sql b/contrib/jsonb_plperl/sql/jsonb_plperlu_relocatability.sql new file mode 100644 index 0000000..29233e4 --- /dev/null +++ b/contrib/jsonb_plperl/sql/jsonb_plperlu_relocatability.sql @@ -0,0 +1,14 @@ +CREATE EXTENSION jsonb_plperlu CASCADE; +CREATE SCHEMA test; +alter extension jsonb_plperlu set schema test; +create function test.test(val jsonb) returns jsonb +language plperlu +transform for type jsonb +as $$ +return val +$$; + +select test.test('1'::jsonb); + +drop extension plperlu cascade; +drop schema test cascade; diff --git a/doc/src/sgml/json.sgml b/doc/src/sgml/json.sgml index 731b469..c461dba 100644 --- a/doc/src/sgml/json.sgml +++ b/doc/src/sgml/json.sgml @@ -569,4 +569,18 @@ SELECT jdoc->'guid', jdoc->'name' FROM api WHERE jdoc @> '{"tags": ["qu compared using the default database collation. + + Transforms + + + Additional extensions are available that implement transforms for + the jsonb type for the language PL/Perl. The + extensions for PL/Perl are called + jsonb_plperlu and jsonb_plperl + If you use them, jsonb values are mapped to + Perl RV. + + + +