On Fri, 10 Nov 2017 14:40:21 +0100
Pavel Stehule <pavel.steh...@gmail.com> wrote:
> Hi
>
> 2017-10-24 14:27 GMT+02:00 Anthony Bykov <a.by...@postgrespro.ru>:
>
> > There are some moments I should mention:
> > 1. {"1":1}::jsonb is transformed into HV {"1"=>"1"}, while
> > ["1","2"]::jsonb is transformed into AV ["1", "2"]
> >
> > 2. If there is a numeric value appear in jsonb, it will be
> > transformed to SVnv through string (Numeric->String->SV->SVnv). Not
> > the best solution, but as far as I understand this is usual
> > practise in postgresql to serialize Numerics and de-serialize them.
> >
> > 3. SVnv is transformed into jsonb through string
> > (SVnv->String->Numeric).
> >
> > An example may also be helpful to understand extension. So, as an
> > example, function "test" transforms incoming jsonb into perl,
> > transforms it back into jsonb and returns it.
> >
> > create extension jsonb_plperl cascade;
> >
> > create or replace function test(val jsonb)
> > returns jsonb
> > transform for type jsonb
> > language plperl
> > as $$
> > return $_[0];
> > $$;
> >
> > select test('{"1":1,"example": null}'::jsonb);
> >
> >
> I am looking to this patch:
>
> 1. the patch contains some artefacts - look the word "hstore"
>
> 2. I got lot of warnings
>
>
> make[1]: Vstupuje se do adresáře
> „/home/pavel/src/postgresql/contrib/jsonb_plperl“
> gcc -Wall -Wmissing-prototypes -Wpointer-arith
> -Wdeclaration-after-statement -Wendif-labels
> -Wmissing-format-attribute -Wformat-security -fno-strict-aliasing
> -fwrapv -fexcess-precision=standard -g -ggdb -Og -g3
> -fno-omit-frame-pointer -fPIC -I../../src/pl/plperl -I. -I.
> -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:83:9:
> warning: ‘result’ may be used uninitialized in this function
> [-Wmaybe-uninitialized] return (result);
> ^
> jsonb_plperl.c: In function ‘SV_FromJsonb’:
> jsonb_plperl.c:95:10: warning: ‘object’ may be used uninitialized in
> this function [-Wmaybe-uninitialized]
> HV *object;
> ^~~~~~
> In file included from /usr/lib64/perl5/CORE/perl.h:5644:0,
> from ../../src/pl/plperl/plperl.h:52,
> from jsonb_plperl.c:17:
> /usr/lib64/perl5/CORE/embed.h:404:19: warning: ‘value’ may be used
> uninitialized in this function [-Wmaybe-uninitialized]
> #define newRV(a) Perl_newRV(aTHX_ a)
> ^~~~~~~~~~
> jsonb_plperl.c:101:10: note: ‘value’ was declared here
> SV *value;
> ^~~~~
> gcc -Wall -Wmissing-prototypes -Wpointer-arith
> -Wdeclaration-after-statement -Wendif-labels
> -Wmissing-format-attribute -Wformat-security -fno-strict-aliasing
> -fwrapv -fexcess-precision=standard -g -ggdb -Og -g3
> -fno-omit-frame-pointer -fPIC -shared -o jsonb_plperl.so
> jsonb_plperl.o -L../../src/port -L../../src/common -Wl,--as-needed
> -Wl,-rpath,'/usr/lib64/perl5/CORE',--enable-new-dtags -Wl,-z,relro
> -specs=/usr/lib/rpm/redhat/redhat-hardened-ld
> -fstack-protector-strong -L/usr/local/lib -L/usr/lib64/perl5/CORE
> -lperl -lpthread -lresolv -lnsl -ldl -lm -lcrypt -lutil -lc make[1]:
> Opouští se adresář „/home/pavel/src/postgresql/contrib/jsonb_plperl“
>
> [pavel@nemesis contrib]$ gcc --version
> gcc (GCC) 7.2.1 20170915 (Red Hat 7.2.1-2)
> Copyright (C) 2017 Free Software Foundation, Inc.
> This is free software; see the source for copying conditions. There
> is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A
> PARTICULAR PURPOSE.
>
> 3. regress tests passed
>
> 4. There are not any documentation - probably it should be part of
> PLPerl
>
> 5. The regress tests doesn't coverage other datatypes than numbers. I
> miss boolean, binary, object, ... Maybe using data::dumper or some
> similar can be interesting
>
> Note - it is great extension, I am pleasured so transformations are
> used.
>
> Regards
>
> Pavel
> >
> > --
> > Sent via pgsql-hackers mailing list (pgsql-hack...@postgresql.org)
> > To make changes to your subscription:
> > http://www.postgresql.org/mailpref/pgsql-hackers
> >
Hello,
Thank you for your review. I have fixed most of your comments, except
for the 5-th part, about data::dumper - I just couldn't understand
your point, but I've added more tests with more complex objects if this
helps.
Please, take a look at new patch. You can find it in attachments to
this message (it is called "0001-jsonb_plperl-extension-v2.patch")
--
Anthony Bykov
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..8c427c5
--- /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_plperlu
+
+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..eedf90f
--- /dev/null
+++ b/contrib/jsonb_plperl/expected/jsonb_plperl.out
@@ -0,0 +1,184 @@
+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 testAVToJsonb();
+ testavtojsonb
+---------------------------------------------
+ [{"a": 1, "b": "boo", "c": null}, {"d": 2}]
+(1 row)
+
+-- 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('-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('[]');
+ 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)
+
+DROP EXTENSION plperl CASCADE;
+NOTICE: drop cascades to 5 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 testsvtojsonb2(jsonb)
diff --git a/contrib/jsonb_plperl/expected/jsonb_plperlu.out b/contrib/jsonb_plperl/expected/jsonb_plperlu.out
new file mode 100644
index 0000000..7f57ebd
--- /dev/null
+++ b/contrib/jsonb_plperl/expected/jsonb_plperlu.out
@@ -0,0 +1,148 @@
+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 testAVToJsonb();
+ testavtojsonb
+---------------------------------------------
+ [{"a": 1, "b": "boo", "c": null}, {"d": 2}]
+(1 row)
+
+-- 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('1.2');
+ testsvtojsonb2
+----------------
+ 1.2
+(1 row)
+
+SELECT testSVToJsonb2('"string"');
+ testsvtojsonb2
+----------------
+ "string"
+(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,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.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)
+
+DROP EXTENSION plperlu CASCADE;
+NOTICE: drop cascades to 5 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 testsvtojsonb2(jsonb)
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..54a242b
--- /dev/null
+++ b/contrib/jsonb_plperl/jsonb_plperl.c
@@ -0,0 +1,317 @@
+/* This document contains an implementation of transformations from perl
+ * object to jsonb and vise versa.
+ * In this file you can find implementation of transformations:
+ * - SV_FromJsonbValue(JsonbValue *jsonbValue)
+ * - SV_FromJsonb(JsonbContainer *jsonb)
+ * - jsonb_to_plperl(PG_FUNCTION_ARGS)
+ * - SV_ToJsonbValue(SV *in, JsonbParseState *jsonb_state)
+ * - HV_ToJsonbValue(HV *obj, JsonbParseState *jsonb_state)
+ * - AV_ToJsonbValue(AV *in, JsonbParseState *jsonb_state)
+ * - plperl_to_jsonb(PG_FUNCTION_ARGS)
+ */
+#include "postgres.h"
+
+#undef _
+
+#include "fmgr.h"
+#include "plperl.h"
+#include "plperl_helpers.h"
+
+#include "utils/jsonb.h"
+#include "utils/fmgrprotos.h"
+
+PG_MODULE_MAGIC;
+
+/* Links to functions
+ * */
+static SV *SV_FromJsonb(JsonbContainer *jsonb);
+
+static JsonbValue *HV_ToJsonbValue(HV *obj, JsonbParseState *jsonb_state);
+
+static JsonbValue *SV_ToJsonbValue(SV *obj, JsonbParseState *jsonb_state);
+
+/*
+ * Function for transforming JsonbValue type into SV
+ * The first argument defines the JsonbValue to be transformed into SV
+ * Return value is the pointer to transformed object
+ */
+static SV *
+SV_FromJsonbValue(JsonbValue *jsonbValue)
+{
+ dTHX;
+ SV *result;
+ char *str;
+
+ switch (jsonbValue->type)
+ {
+ case jbvBinary:
+ result = (SV *) newRV((SV *) SV_FromJsonb(jsonbValue->val.binary.data));
+ break;
+ case jbvNumeric:
+
+ /*
+ * XXX There should be a better way. Right now Numeric is
+ * transformed into string and then this string is parsed into
+ * perl numeric
+ */
+ str = DatumGetCString(DirectFunctionCall1(
+ numeric_out,
+ NumericGetDatum(jsonbValue->val.numeric)
+ )
+ );
+ result = newSVnv(SvNV(cstr2sv(pnstrdup(str, strlen(str)))));
+ break;
+ case jbvString:
+ result = cstr2sv(pnstrdup(
+ jsonbValue->val.string.val,
+ jsonbValue->val.string.len
+ ));
+ break;
+ 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;
+ case jbvNull:
+ result = newSV(0);
+ break;
+ default:
+ pg_unreachable();
+ break;
+ }
+ return (result);
+}
+
+/*
+ * Function for transforming JsonbContainer type into SV
+ * The first argument defines the JsonbContainer to be transformed into SV
+ * Return value is the pointer to transformed object
+ */
+static SV *
+SV_FromJsonb(JsonbContainer *jsonb)
+{
+ dTHX;
+ SV *result;
+ SV *value;
+ HV *object;
+ AV *av;
+ JsonbIterator *it;
+ JsonbValue v;
+ const char *key;
+ int keyLength;
+ bool raw_scalar;
+
+ it = JsonbIteratorInit(jsonb);
+
+ switch (JsonbIteratorNext(&it, &v, true))
+ {
+ case (WJB_BEGIN_ARRAY):
+ /* array in v */
+ av = newAV();
+ raw_scalar = (v.val.array.rawScalar);
+ value = newSV(0);
+ while (
+ (JsonbIteratorNext(&it, &v, true) == WJB_ELEM)
+ )
+ {
+ value = SV_FromJsonbValue(&v);
+ av_push(av, value);
+ }
+ if (raw_scalar)
+ result = (newRV(value));
+ else
+ result = ((SV *) av);
+ break;
+ case (WJB_BEGIN_OBJECT):
+ object = newHV();
+ while (JsonbIteratorNext(&it, &v, true) == WJB_KEY)
+ {
+ /* json key in v */
+ key = pnstrdup(
+ v.val.string.val,
+ v.val.string.len
+ );
+ keyLength = v.val.string.len;
+ JsonbIteratorNext(&it, &v, true);
+ value = SV_FromJsonbValue(&v);
+ (void) hv_store(object, key, keyLength, value, 0);
+ }
+ result = (SV *) object;
+ break;
+ 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;
+ }
+ return (result);
+}
+
+/* jsonb_to_plperl(Jsonb *in)
+ * Function for transforming Jsonb type into SV
+ * The first argument defines the Jsonb to be transformed into SV
+ * Return value is the pointer to transformed object
+ */
+PG_FUNCTION_INFO_V1(jsonb_to_plperl);
+Datum
+jsonb_to_plperl(PG_FUNCTION_ARGS)
+{
+ dTHX;
+ Jsonb *in = PG_GETARG_JSONB_P(0);
+ SV *sv;
+
+ sv = SV_FromJsonb(&in->root);
+
+ return PointerGetDatum(newRV(sv));
+}
+
+/*
+ * Function for transforming AV type into JsonbValue
+ * The first argument defines the AV to be transformed into JsonbValue
+ * The second argument defines conversion state
+ * Return value is the pointer to transformed object
+ */
+static JsonbValue *
+AV_ToJsonbValue(AV *in, JsonbParseState *jsonb_state)
+{
+ dTHX;
+
+ JsonbValue *jbvElem;
+ JsonbValue *out = NULL;
+ int32 pcount;
+ int32 i;
+
+ pcount = av_len(in) + 1;
+ pushJsonbValue(&jsonb_state, WJB_BEGIN_ARRAY, NULL);
+
+ for (i = 0; i < pcount; i++)
+ {
+ SV **value;
+
+ value = av_fetch(in, i, false);
+ jbvElem = SV_ToJsonbValue(*value, jsonb_state);
+ if (IsAJsonbScalar(jbvElem))
+ pushJsonbValue(&jsonb_state, WJB_ELEM, jbvElem);
+ }
+ out = pushJsonbValue(&jsonb_state, WJB_END_ARRAY, NULL);
+ return (out);
+}
+
+/*
+ * Function for transforming Jsonb type into SV
+ * The first argument defines the Jsonb to be transformed into SV
+ * The second argument defines conversion state
+ * Return value is the pointer to transformed object
+ */
+static JsonbValue *
+SV_ToJsonbValue(SV *in, JsonbParseState *jsonb_state)
+{
+ dTHX;
+ svtype type;
+ JsonbValue *out;
+ char *str;
+ Datum tmp;
+
+ type = SvTYPE(in);
+ switch (type)
+ {
+ case SVt_PVAV:
+ out = AV_ToJsonbValue((AV *) in, jsonb_state);
+ break;
+ case SVt_PVHV:
+ out = HV_ToJsonbValue((HV *) in, jsonb_state);
+ break;
+ case SVt_NV:
+ case SVt_IV:
+ if (SvROK(in))
+ out = SV_ToJsonbValue((SV *) SvRV(in), jsonb_state);
+ else
+ {
+ out = palloc(sizeof(JsonbValue));
+ str = sv2cstr(in);
+ tmp = DirectFunctionCall3(
+ numeric_in,
+ CStringGetDatum(str), 0, -1
+ );
+ out->val.numeric = DatumGetNumeric(tmp);
+ out->type = jbvNumeric;
+ }
+ break;
+ case SVt_NULL:
+ out = palloc(sizeof(JsonbValue));
+ out->type = jbvNull;
+ break;
+ case SVt_PV:
+ default:
+ /* Anything else will be handled as its string repr
+ */
+ out = palloc(sizeof(JsonbValue));
+ out->val.string.val = sv2cstr(in);
+ out->val.string.len = strlen(out->val.string.val);
+ out->type = jbvString;
+ break;
+ }
+ return (out);
+}
+
+/*
+ * Function for transforming Jsonb type into SV
+ * The first argument defines the Jsonb to be transformed into SV
+ * The second argument defines conversion staterl
+ * Return value is the pointer to transformed object
+ */
+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)))
+ {
+ 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);
+}
+
+/*
+ * plperl_to_jsonb(SV *in)
+ * Function for transforming Jsonb type into SV
+ * The first argument defines the Jsonb to be transformed into SV
+ * Return value is the pointer to transformed object
+ */
+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;
+
+ in = (SV *) PG_GETARG_POINTER(0);
+ out = SV_ToJsonbValue(in, jsonb_state);
+ result = JsonbValueToJsonb(out);
+ PG_RETURN_POINTER(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..3cf5e29
--- /dev/null
+++ b/contrib/jsonb_plperl/sql/jsonb_plperl.sql
@@ -0,0 +1,69 @@
+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 testAVToJsonb();
+
+-- 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('-1');
+SELECT testSVToJsonb2('1.2');
+SELECT testSVToJsonb2('-1.2');
+SELECT testSVToJsonb2('"string"');
+
+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}');
+
+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..4d72b38
--- /dev/null
+++ b/contrib/jsonb_plperl/sql/jsonb_plperlu.sql
@@ -0,0 +1,63 @@
+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 testAVToJsonb();
+
+-- 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('1.2');
+SELECT testSVToJsonb2('"string"');
+
+SELECT testSVToJsonb2('[]');
+SELECT testSVToJsonb2('[null,null]');
+SELECT testSVToJsonb2('[1,2,3]');
+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.1}');
+SELECT testSVToJsonb2('{"1":"string1"}');
+
+SELECT testSVToJsonb2('{"1":{"2":[3,4,5]},"2":3}');
+
+DROP EXTENSION plperlu CASCADE;
diff --git a/doc/src/sgml/json.sgml b/doc/src/sgml/json.sgml
index 05ecef2..1c7827f 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/Python. 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>
