Hello.
Please, check out jsonb transform
(https://www.postgresql.org/docs/9.5/static/sql-createtransform.html)
for pl/perl language I've implemented.
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..7a85361
--- /dev/null
+++ b/contrib/jsonb_plperl/expected/jsonb_plperl.out
@@ -0,0 +1,76 @@
+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('1');
+ testsvtojsonb2 
+----------------
+ 1
+(1 row)
+
+SELECT testSVToJsonb2('[1,2,3]');
+ testsvtojsonb2 
+----------------
+ [1, 2, 3]
+(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..6d4be1c
--- /dev/null
+++ b/contrib/jsonb_plperl/expected/jsonb_plperlu.out
@@ -0,0 +1,33 @@
+CREATE EXTENSION jsonb_plperlu CASCADE;
+NOTICE:  installing required extension "plperlu"
+-- test jsonb -> hash
+CREATE FUNCTION testJsonbToHV(val jsonb) RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+return $_[0];
+$$;
+SELECT testJsonbToHV('{"aa":"bb", "cc":null, "dd":2}'::jsonb);
+           testjsonbtohv           
+-----------------------------------
+ {"aa": "bb", "cc": null, "dd": 2}
+(1 row)
+
+-- test jsonb -> av
+CREATE FUNCTION testJsonbToAV(val jsonb) RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+return $_[0];
+$$;
+SELECT testJsonbToAV('["bb", null, 2]'::jsonb);
+  testjsonbtoav  
+-----------------
+ ["bb", null, 2]
+(1 row)
+
+DROP EXTENSION plperlu CASCADE;
+NOTICE:  drop cascades to 3 other objects
+DETAIL:  drop cascades to extension jsonb_plperlu
+drop cascades to function testjsonbtohv(jsonb)
+drop cascades to function testjsonbtoav(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..9188af1
--- /dev/null
+++ b/contrib/jsonb_plperl/jsonb_plperl--1.0.sql
@@ -0,0 +1,17 @@
+/* contrib/hstore_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..64929aa
--- /dev/null
+++ b/contrib/jsonb_plperl/jsonb_plperl.c
@@ -0,0 +1,308 @@
+/* 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 jbvNull:
+			result = newSV(0);
+			break;
+		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;
+	}
+	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;
+	HV		   *object;
+	AV		   *av;
+	JsonbIterator *it;
+	JsonbValue	v;
+	const char *key;
+	int			keyLength;
+	SV		   *value;
+	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);
+			while (
+				   (JsonbIteratorNext(&it, &v, true) == WJB_ELEM)
+				)
+			{
+				value = SV_FromJsonbValue(&v);
+				av_push(av, value);
+			}
+			if (raw_scalar)
+				return (newRV(value));
+			else
+				return ((SV *) av);
+			break;
+		case (WJB_DONE):
+		case (WJB_END_OBJECT):
+		case (WJB_END_ARRAY):
+			/* no object is in v */
+			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);
+			}
+			break;
+		case (WJB_ELEM):
+		case (WJB_VALUE):
+		case (WJB_KEY):
+			/* simple objects */
+			return (SV_FromJsonbValue(&v));
+			break;
+	}
+	return ((SV *) object);
+}
+
+/* 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:
+			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..52200c3
--- /dev/null
+++ b/contrib/jsonb_plperl/jsonb_plperl.control
@@ -0,0 +1,6 @@
+# hstore_plperl extension
+comment = 'transform between hstore 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..6f1869b
--- /dev/null
+++ b/contrib/jsonb_plperl/jsonb_plperlu--1.0.sql
@@ -0,0 +1,17 @@
+/* contrib/hstore_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..9ca580b
--- /dev/null
+++ b/contrib/jsonb_plperl/sql/jsonb_plperl.sql
@@ -0,0 +1,48 @@
+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('1');
+SELECT testSVToJsonb2('[1,2,3]');
+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..b7d4530
--- /dev/null
+++ b/contrib/jsonb_plperl/sql/jsonb_plperlu.sql
@@ -0,0 +1,24 @@
+CREATE EXTENSION jsonb_plperlu CASCADE;
+
+-- test jsonb -> hash
+CREATE FUNCTION testJsonbToHV(val jsonb) RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+return $_[0];
+$$;
+
+SELECT testJsonbToHV('{"aa":"bb", "cc":null, "dd":2}'::jsonb);
+
+-- test jsonb -> av
+CREATE FUNCTION testJsonbToAV(val jsonb) RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+return $_[0];
+$$;
+
+SELECT testJsonbToAV('["bb", null, 2]'::jsonb);
+
+
+DROP EXTENSION plperlu CASCADE;
-- 
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers

Reply via email to