Hi.
I have reviewed this patch too. Attached new version with v8-v9 delta-patch.
Here is my changes:
* HV_ToJsonbValue():
- addded missing hv_iterinit()
- used hv_iternextsv() instead of hv_iternext(), HeSVKEY_force(), HeVAL()
* SV_ToJsonbValue():
- added recursive dereferencing for all SV types
- removed unnecessary JsonbValue heap-allocations
* Jsonb_ToSV():
- added iteration to the end of iterator needed for correct freeing of
JsonbIterators
* passed JsonbParseState ** to XX_ToJsonbValue() functions.
* fixed warnings (see below)
* fixed comments (see below)
Also I am not sure if we need to use newRV() for returning SVs in
Jsonb_ToSV() and JsonbValue_ToSV().
On 12.03.2018 18:06, Pavel Stehule wrote:
2018-03-12 9:08 GMT+01:00 Anthony Bykov <a.by...@postgrespro.ru
<mailto:a.by...@postgrespro.ru>>:
On Mon, 5 Mar 2018 14:03:37 +0100
Pavel Stehule <pavel.steh...@gmail.com
<mailto:pavel.steh...@gmail.com>> wrote:
> Hi
>
> I am looking on this patch. I found few issues:
>
> 1. compile warning
>
> I../../src/include -D_GNU_SOURCE -I/usr/include/libxml2
> -I/usr/lib64/perl5/CORE -c -o jsonb_plperl.o jsonb_plperl.c
> jsonb_plperl.c: In function ‘SV_FromJsonbValue’:
> jsonb_plperl.c:69:9: warning: ‘result’ may be used uninitialized in
> this function [-Wmaybe-uninitialized]
> return result;
> ^~~~~~
> jsonb_plperl.c: In function ‘SV_FromJsonb’:
> jsonb_plperl.c:142:9: warning: ‘result’ may be used uninitialized in
> this function [-Wmaybe-uninitialized]
> return result;
> ^~~~~~
Hello, thanks for reviewing my patch! I really appreciate it.
That warnings are created on purpose - I was trying to prevent the
case
when new types are added into pl/perl, but new transform logic was
not.
Maybe there is a better way to do it, but right now I'll just add the
"default: pg_unreachable" logic.
pg_unreachable() is replaced with elog(ERROR) for reporting impossible
JsonbValue types and JsonbIteratorTokens.
> 3. Do we need two identical tests fro PLPerl and PLPerlu? Why?
>
> Regards
>
> Pavel
About the 3 point - I thought that plperlu and plperl uses different
interpreters. And if they act identically on same examples - there
is no need in identical tests for them indeed.
plperlu and plperl uses same interprets - so the duplicate tests has
not any sense. But in last versions there are duplicate tests again
I have not removed duplicate test yet, because I am not sure that this
test does not make sense at all.
The naming convention of functions is not consistent
almost are are src_to_dest
This is different and it is little bit messy
+static SV *
+SV_FromJsonb(JsonbContainer *jsonb)
Renamed to Jsonb_ToSV() and JsonbValue_ToSV().
This comment is broken
+/*
+ * plperl_to_jsonb(SV *in)
+ *
+ * Transform Jsonb into SV ---< should be SV to Jsonb
+ */
+PG_FUNCTION_INFO_V1(plperl_to_jsonb);
+Datum
Fixed.
--
Nikita Glukhov
Postgres Professional: http://www.postgrespro.com
The Russian Postgres Company
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.
</para>
</sect2>
+ <sect2>
+ <title>Transforms</title>
+
+ <para>
+ Additional extensions are available that implement transforms for
+ the <type>jsonb</type> type for the language PL/Perl. The
+ extensions for PL/Perl are called
+ <literal>jsonb_plperlu</literal> and <literal>jsonb_plperl</literal>
+ If you use them, <type>jsonb</type> values are mapped to
+ Perl RV.
+ </para>
+ </sect2>
+
+
</sect1>
diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c
index 52b2d35..80be238 100644
--- a/contrib/jsonb_plperl/jsonb_plperl.c
+++ b/contrib/jsonb_plperl/jsonb_plperl.c
@@ -18,132 +18,134 @@
PG_MODULE_MAGIC;
-static SV *SV_FromJsonb(JsonbContainer *jsonb);
-
-static JsonbValue *HV_ToJsonbValue(HV *obj, JsonbParseState *jsonb_state);
-
-static JsonbValue *SV_ToJsonbValue(SV *obj, JsonbParseState *jsonb_state);
+static SV *Jsonb_ToSV(JsonbContainer *jsonb);
+static JsonbValue *SV_ToJsonbValue(SV *obj, JsonbParseState **ps, bool is_elem);
/*
- * SV_FromJsonbValue
+ * JsonbValue_ToSV
*
* Transform JsonbValue into SV
*/
static SV *
-SV_FromJsonbValue(JsonbValue *jsonbValue)
+JsonbValue_ToSV(JsonbValue *jbv)
{
dTHX;
- SV *result;
- char *str;
- switch (jsonbValue->type)
+ switch (jbv->type)
{
case jbvBinary:
- result = (SV *) newRV((SV *) SV_FromJsonb(jsonbValue->val.binary.data));
- break;
+ 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;
+ }
- /*
- * Transform incoming value into string and generate SV from
- * string
- */
- str = DatumGetCString(DirectFunctionCall1(numeric_out, NumericGetDatum(jsonbValue->val.numeric)));
- result = newSVnv(SvNV(cstr2sv(pstrdup(str))));
- break;
case jbvString:
- result = cstr2sv(pnstrdup(jsonbValue->val.string.val, jsonbValue->val.string.len));
- break;
+ {
+ char *str = pnstrdup(jbv->val.string.val,
+ jbv->val.string.len);
+ SV *result = cstr2sv(str);
+
+ pfree(str);
+
+ return result;
+ }
+
case jbvBool:
- result = newSVnv(SvNV(jsonbValue->val.boolean ? &PL_sv_yes : &PL_sv_no));
- break;
- case jbvArray:
- result = SV_FromJsonbValue(jsonbValue->val.array.elems);
- break;
- case jbvObject:
- result = SV_FromJsonbValue(&(jsonbValue->val.object.pairs->value));
- break;
+ return newSVnv(SvNV(jbv->val.boolean ? &PL_sv_yes : &PL_sv_no));
+
case jbvNull:
- result = newSV(0);
- break;
+ return newSV(0);
+
default:
- pg_unreachable();
- break;
+ elog(ERROR, "unexpected jsonb value type: %d", jbv->type);
+ return NULL;
}
- return result;
}
/*
- * SV_FromJsonb
+ * Jsonb_ToSV
*
* Transform JsonbContainer into SV
*/
-static SV *
-SV_FromJsonb(JsonbContainer *jsonb)
+static SV *
+Jsonb_ToSV(JsonbContainer *jsonb)
{
dTHX;
- SV *result;
- SV *value;
- JsonbIterator *it;
JsonbValue v;
+ JsonbIterator *it;
+ JsonbIteratorToken r;
it = JsonbIteratorInit(jsonb);
+ r = JsonbIteratorNext(&it, &v, true);
- switch (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;
- bool raw_scalar;
-
- /* array in v */
- av = newAV();
- raw_scalar = (v.val.array.rawScalar);
- value = newSV(0);
- while (JsonbIteratorNext(&it, &v, true) == WJB_ELEM)
+ AV *av = newAV();
+
+ while ((r = JsonbIteratorNext(&it, &v, true)) != WJB_DONE)
{
- value = SV_FromJsonbValue(&v);
- av_push(av, value);
+ if (r == WJB_ELEM)
+ av_push(av, JsonbValue_ToSV(&v));
}
- if (raw_scalar)
- result = newRV(value);
- else
- result = (SV *) av;
- break;
+
+ return (SV *) av;
}
+
case WJB_BEGIN_OBJECT:
{
- HV *object;
- const char *key;
- int keyLength;
+ HV *hv = newHV();
- /* hash in v */
- object = newHV();
- while (JsonbIteratorNext(&it, &v, true) == WJB_KEY)
+ while ((r = JsonbIteratorNext(&it, &v, true)) != WJB_DONE)
{
- /* json key in v */
- keyLength = v.val.string.len;
- key = pnstrdup(v.val.string.val, keyLength);
- JsonbIteratorNext(&it, &v, true);
- value = SV_FromJsonbValue(&v);
- (void) hv_store(object, key, keyLength, value, 0);
+ 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);
+ }
+ }
}
- result = (SV *) object;
- break;
+
+ return (SV *) hv;
}
- case WJB_ELEM:
- case WJB_VALUE:
- case WJB_KEY:
- /* simple objects */
- result = SV_FromJsonbValue(&v);
- break;
- case WJB_DONE:
- case WJB_END_OBJECT:
- case WJB_END_ARRAY:
+
default:
- pg_unreachable();
- break;
+ elog(ERROR, "unexpected jsonb token: %d", r);
+ return NULL;
}
- return result;
}
/*
@@ -157,9 +159,7 @@ jsonb_to_plperl(PG_FUNCTION_ARGS)
{
dTHX;
Jsonb *in = PG_GETARG_JSONB_P(0);
- SV *sv;
-
- sv = SV_FromJsonb(&in->root);
+ SV *sv = Jsonb_ToSV(&in->root);
return PointerGetDatum(newRV(sv));
}
@@ -171,34 +171,51 @@ jsonb_to_plperl(PG_FUNCTION_ARGS)
* jsonb_state defines conversion state
*/
static JsonbValue *
-AV_ToJsonbValue(AV *in, JsonbParseState *jsonb_state)
+AV_ToJsonbValue(AV *in, JsonbParseState **jsonb_state)
{
dTHX;
-
- JsonbValue *jbvElem;
- JsonbValue *out = NULL;
- ssize_t pcount;
+ ssize_t pcount = av_len(in) + 1;
ssize_t i;
- pcount = av_len(in) + 1;
- pushJsonbValue(&jsonb_state, WJB_BEGIN_ARRAY, NULL);
+ pushJsonbValue(jsonb_state, WJB_BEGIN_ARRAY, NULL);
for (i = 0; i < pcount; i++)
{
- SV **value;
+ 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);
- value = av_fetch(in, i, false);
- jbvElem = SV_ToJsonbValue(*value, jsonb_state);
+ (void) hv_iterinit(obj);
- /*
- * If "value" was a complex structure, it was already pushed to jsonb
- * and there is no need to push it again
- */
- if (IsAJsonbScalar(jbvElem))
- pushJsonbValue(&jsonb_state, WJB_ELEM, jbvElem);
+ 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);
}
- out = pushJsonbValue(&jsonb_state, WJB_END_ARRAY, NULL);
- return out;
+
+ return pushJsonbValue(jsonb_state, WJB_END_OBJECT, NULL);
}
/*
@@ -207,129 +224,92 @@ AV_ToJsonbValue(AV *in, JsonbParseState *jsonb_state)
* Transform SV into Jsonb
*/
static JsonbValue *
-SV_ToJsonbValue(SV *in, JsonbParseState *jsonb_state)
+SV_ToJsonbValue(SV *in, JsonbParseState **jsonb_state, bool is_elem)
{
dTHX;
svtype type; /* type of incoming object */
- JsonbValue *out; /* result */
+ JsonbValue out; /* result */
+
+ /* Dereference references recursively. */
+ while (SvROK(in))
+ in = SvRV(in);
type = SvTYPE(in);
+
switch (type)
{
case SVt_PVAV:
- out = AV_ToJsonbValue((AV *) in, jsonb_state);
- break;
+ return AV_ToJsonbValue((AV *) in, jsonb_state);
+
case SVt_PVHV:
- out = HV_ToJsonbValue((HV *) in, jsonb_state);
- break;
+ return HV_ToJsonbValue((HV *) in, jsonb_state);
+
case SVt_NV:
case SVt_IV:
{
- if (SvROK(in))
- /* if "in" is a pointer */
- out = SV_ToJsonbValue((SV *) SvRV(in), jsonb_state);
- else
- {
- /* if "in" is a numeric */
- char *str;
- int i;
-
- out = palloc(sizeof(JsonbValue));
- str = sv2cstr(in);
-
- /*
- * 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"))));
- else
- {
- Datum tmp;
-
- tmp = DirectFunctionCall3(numeric_in, CStringGetDatum(str), 0, -1);
- out->val.numeric = DatumGetNumeric(tmp);
- out->type = jbvNumeric;
- }
- }
- break;
+ /* 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 = palloc(sizeof(JsonbValue));
- out->type = jbvNull;
+ out.type = jbvNull;
break;
- case SVt_PV:
-
- /*
- * String
- */
- out = palloc(sizeof(JsonbValue));
- out->val.string.val = sv2cstr(in);
- out->val.string.len = strlen(out->val.string.val);
- out->type = jbvString;
+
+ 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"))));
- break;
+ return NULL;
}
- return out;
-}
-/*
- * HV_ToJsonbValue
- *
- * Transform Jsonb into SV
- */
-static JsonbValue *
-HV_ToJsonbValue(HV *obj, JsonbParseState *jsonb_state)
-{
- dTHX;
- JsonbValue *out;
- HE *he;
-
- pushJsonbValue(&jsonb_state, WJB_BEGIN_OBJECT, NULL);
- while ((he = hv_iternext(obj)) != NULL)
- {
- JsonbValue *key;
- JsonbValue *val;
-
- key = SV_ToJsonbValue(HeSVKEY_force(he), jsonb_state);
- pushJsonbValue(&jsonb_state, WJB_KEY, key);
- val = SV_ToJsonbValue(HeVAL(he), jsonb_state);
- if ((val == NULL) || (IsAJsonbScalar(val)))
- pushJsonbValue(&jsonb_state, WJB_VALUE, val);
- }
- out = pushJsonbValue(&jsonb_state, WJB_END_OBJECT, NULL);
- return out;
+ /* 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 Jsonb into SV
+ * Transform SV into Jsonb
*/
PG_FUNCTION_INFO_V1(plperl_to_jsonb);
Datum
plperl_to_jsonb(PG_FUNCTION_ARGS)
{
dTHX;
- JsonbValue *out = NULL;
- Jsonb *result;
JsonbParseState *jsonb_state = NULL;
- SV *in;
+ SV *in = (SV *) PG_GETARG_POINTER(0);
+ JsonbValue *out = SV_ToJsonbValue(in, &jsonb_state, true);
+ Jsonb *result = JsonbValueToJsonb(out);
- in = (SV *) PG_GETARG_POINTER(0);
- out = SV_ToJsonbValue(in, jsonb_state);
- result = JsonbValueToJsonb(out);
- PG_RETURN_POINTER(result);
+ PG_RETURN_JSONB_P(result);
}
