Adding upstream version 13.4.upstream/13.4upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

11 files changed, 1167 insertions, 0 deletions

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