]> granicus.if.org Git - postgresql/commitdiff
Transforms for jsonb to PL/Perl
authorPeter Eisentraut <peter_e@gmx.net>
Tue, 3 Apr 2018 13:47:18 +0000 (09:47 -0400)
committerPeter Eisentraut <peter_e@gmx.net>
Tue, 3 Apr 2018 13:47:18 +0000 (09:47 -0400)
Add a new contrib module jsonb_plperl that provides a transform between
jsonb and PL/Perl.  jsonb values are converted to appropriate Perl types
such as arrays and hashes, and vice versa.

Author: Anthony Bykov <a.bykov@postgrespro.ru>
Reviewed-by: Pavel Stehule <pavel.stehule@gmail.com>
Reviewed-by: Aleksander Alekseev <a.alekseev@postgrespro.ru>
Reviewed-by: Nikita Glukhov <n.gluhov@postgrespro.ru>
13 files changed:
contrib/Makefile
contrib/jsonb_plperl/.gitignore [new file with mode: 0644]
contrib/jsonb_plperl/Makefile [new file with mode: 0644]
contrib/jsonb_plperl/expected/jsonb_plperl.out [new file with mode: 0644]
contrib/jsonb_plperl/expected/jsonb_plperlu.out [new file with mode: 0644]
contrib/jsonb_plperl/jsonb_plperl--1.0.sql [new file with mode: 0644]
contrib/jsonb_plperl/jsonb_plperl.c [new file with mode: 0644]
contrib/jsonb_plperl/jsonb_plperl.control [new file with mode: 0644]
contrib/jsonb_plperl/jsonb_plperlu--1.0.sql [new file with mode: 0644]
contrib/jsonb_plperl/jsonb_plperlu.control [new file with mode: 0644]
contrib/jsonb_plperl/sql/jsonb_plperl.sql [new file with mode: 0644]
contrib/jsonb_plperl/sql/jsonb_plperlu.sql [new file with mode: 0644]
doc/src/sgml/json.sgml

index 60d4bf2fd9384c683c1edcaf6bd27ccad8b4311b..92184ed487115905180b2423956a6be35a634811 100644 (file)
@@ -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/.gitignore b/contrib/jsonb_plperl/.gitignore
new file mode 100644 (file)
index 0000000..5dcb3ff
--- /dev/null
@@ -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 (file)
index 0000000..8c427c5
--- /dev/null
@@ -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 (file)
index 0000000..5bb5677
--- /dev/null
@@ -0,0 +1,211 @@
+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 testRegexpToJsonb() RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+AS $$
+return ('1' =~ m(0\t2));
+$$;
+SELECT testRegexpToJsonb();
+ERROR:  cannot transform this Perl type to jsonb
+CONTEXT:  PL/Perl function "testregexptojsonb"
+CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+AS $$
+return $_[0];
+$$;
+SELECT roundtrip('null');
+ roundtrip 
+-----------
+ null
+(1 row)
+
+SELECT roundtrip('1');
+ roundtrip 
+-----------
+ 1
+(1 row)
+
+SELECT roundtrip('1E+131071');
+ERROR:  cannot convert infinite value 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('[]');
+ roundtrip 
+-----------
+ []
+(1 row)
+
+SELECT roundtrip('[null, null]');
+  roundtrip   
+--------------
+ [null, null]
+(1 row)
+
+SELECT roundtrip('[1, 2, 3]');
+ roundtrip 
+-----------
+ [1, 2, 3]
+(1 row)
+
+SELECT roundtrip('[-1, 2, -3]');
+  roundtrip  
+-------------
+ [-1, 2, -3]
+(1 row)
+
+SELECT roundtrip('[1.2, 2.3, 3.4]');
+    roundtrip    
+-----------------
+ [1.2, 2.3, 3.4]
+(1 row)
+
+SELECT roundtrip('[-1.2, 2.3, -3.4]');
+     roundtrip     
+-------------------
+ [-1.2, 2.3, -3.4]
+(1 row)
+
+SELECT roundtrip('["string1", "string2"]');
+       roundtrip        
+------------------------
+ ["string1", "string2"]
+(1 row)
+
+SELECT roundtrip('{}');
+ roundtrip 
+-----------
+ {}
+(1 row)
+
+SELECT roundtrip('{"1": null}');
+  roundtrip  
+-------------
+ {"1": null}
+(1 row)
+
+SELECT roundtrip('{"1": 1}');
+ roundtrip 
+-----------
+ {"1": 1}
+(1 row)
+
+SELECT roundtrip('{"1": -1}');
+ roundtrip 
+-----------
+ {"1": -1}
+(1 row)
+
+SELECT roundtrip('{"1": 1.1}');
+ roundtrip  
+------------
+ {"1": 1.1}
+(1 row)
+
+SELECT roundtrip('{"1": -1.1}');
+  roundtrip  
+-------------
+ {"1": -1.1}
+(1 row)
+
+SELECT roundtrip('{"1": "string1"}');
+    roundtrip     
+------------------
+ {"1": "string1"}
+(1 row)
+
+SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
+            roundtrip            
+---------------------------------
+ {"1": {"2": [3, 4, 5]}, "2": 3}
+(1 row)
+
+DROP EXTENSION plperl CASCADE;
+NOTICE:  drop cascades to 6 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 testregexptojsonb()
+drop cascades to function roundtrip(jsonb)
diff --git a/contrib/jsonb_plperl/expected/jsonb_plperlu.out b/contrib/jsonb_plperl/expected/jsonb_plperlu.out
new file mode 100644 (file)
index 0000000..9527e9e
--- /dev/null
@@ -0,0 +1,211 @@
+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 testRegexpToJsonb() RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+return ('1' =~ m(0\t2));
+$$;
+SELECT testRegexpToJsonb();
+ERROR:  cannot transform this Perl type to jsonb
+CONTEXT:  PL/Perl function "testregexptojsonb"
+CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+return $_[0];
+$$;
+SELECT roundtrip('null');
+ roundtrip 
+-----------
+ null
+(1 row)
+
+SELECT roundtrip('1');
+ roundtrip 
+-----------
+ 1
+(1 row)
+
+SELECT roundtrip('1E+131071');
+ERROR:  cannot convert infinite value 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('[]');
+ roundtrip 
+-----------
+ []
+(1 row)
+
+SELECT roundtrip('[null, null]');
+  roundtrip   
+--------------
+ [null, null]
+(1 row)
+
+SELECT roundtrip('[1, 2, 3]');
+ roundtrip 
+-----------
+ [1, 2, 3]
+(1 row)
+
+SELECT roundtrip('[-1, 2, -3]');
+  roundtrip  
+-------------
+ [-1, 2, -3]
+(1 row)
+
+SELECT roundtrip('[1.2, 2.3, 3.4]');
+    roundtrip    
+-----------------
+ [1.2, 2.3, 3.4]
+(1 row)
+
+SELECT roundtrip('[-1.2, 2.3, -3.4]');
+     roundtrip     
+-------------------
+ [-1.2, 2.3, -3.4]
+(1 row)
+
+SELECT roundtrip('["string1", "string2"]');
+       roundtrip        
+------------------------
+ ["string1", "string2"]
+(1 row)
+
+SELECT roundtrip('{}');
+ roundtrip 
+-----------
+ {}
+(1 row)
+
+SELECT roundtrip('{"1": null}');
+  roundtrip  
+-------------
+ {"1": null}
+(1 row)
+
+SELECT roundtrip('{"1": 1}');
+ roundtrip 
+-----------
+ {"1": 1}
+(1 row)
+
+SELECT roundtrip('{"1": -1}');
+ roundtrip 
+-----------
+ {"1": -1}
+(1 row)
+
+SELECT roundtrip('{"1": 1.1}');
+ roundtrip  
+------------
+ {"1": 1.1}
+(1 row)
+
+SELECT roundtrip('{"1": -1.1}');
+  roundtrip  
+-------------
+ {"1": -1.1}
+(1 row)
+
+SELECT roundtrip('{"1": "string1"}');
+    roundtrip     
+------------------
+ {"1": "string1"}
+(1 row)
+
+SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
+            roundtrip            
+---------------------------------
+ {"1": {"2": [3, 4, 5]}, "2": 3}
+(1 row)
+
+DROP EXTENSION plperlu CASCADE;
+NOTICE:  drop cascades to 6 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 testregexptojsonb()
+drop cascades to function roundtrip(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 (file)
index 0000000..c7964ba
--- /dev/null
@@ -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 (file)
index 0000000..918debd
--- /dev/null
@@ -0,0 +1,262 @@
+#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;
+
+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 newRV(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 newRV(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 (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 (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;
+
+       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_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);
+
+               case SVt_NV:
+               case SVt_IV:
+                       {
+                               char       *str = sv2cstr(in);
+
+                               /*
+                                * Use case-insensitive comparison because infinity
+                                * representation varies across Perl versions.
+                                */
+                               if (pg_strcasecmp(str, "inf") == 0)
+                                       ereport(ERROR,
+                                                       (errcode(ERRCODE_INVALID_PARAMETER_VALUE),
+                                                        (errmsg("cannot convert infinite value 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:
+
+                       /*
+                        * 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(newRV(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 (file)
index 0000000..26c86a7
--- /dev/null
@@ -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 (file)
index 0000000..99b8644
--- /dev/null
@@ -0,0 +1,19 @@
+/* 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)
+);
+
+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 (file)
index 0000000..946fc51
--- /dev/null
@@ -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 (file)
index 0000000..2c779fc
--- /dev/null
@@ -0,0 +1,86 @@
+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 testRegexpToJsonb() RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+AS $$
+return ('1' =~ m(0\t2));
+$$;
+
+SELECT testRegexpToJsonb();
+
+
+CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+AS $$
+return $_[0];
+$$;
+
+
+SELECT roundtrip('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('[]');
+SELECT roundtrip('[null, null]');
+SELECT roundtrip('[1, 2, 3]');
+SELECT roundtrip('[-1, 2, -3]');
+SELECT roundtrip('[1.2, 2.3, 3.4]');
+SELECT roundtrip('[-1.2, 2.3, -3.4]');
+SELECT roundtrip('["string1", "string2"]');
+
+SELECT roundtrip('{}');
+SELECT roundtrip('{"1": null}');
+SELECT roundtrip('{"1": 1}');
+SELECT roundtrip('{"1": -1}');
+SELECT roundtrip('{"1": 1.1}');
+SELECT roundtrip('{"1": -1.1}');
+SELECT roundtrip('{"1": "string1"}');
+
+SELECT roundtrip('{"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 (file)
index 0000000..e2acffa
--- /dev/null
@@ -0,0 +1,86 @@
+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 testRegexpToJsonb() RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+return ('1' =~ m(0\t2));
+$$;
+
+SELECT testRegexpToJsonb();
+
+
+CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+return $_[0];
+$$;
+
+
+SELECT roundtrip('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('[]');
+SELECT roundtrip('[null, null]');
+SELECT roundtrip('[1, 2, 3]');
+SELECT roundtrip('[-1, 2, -3]');
+SELECT roundtrip('[1.2, 2.3, 3.4]');
+SELECT roundtrip('[-1.2, 2.3, -3.4]');
+SELECT roundtrip('["string1", "string2"]');
+
+SELECT roundtrip('{}');
+SELECT roundtrip('{"1": null}');
+SELECT roundtrip('{"1": 1}');
+SELECT roundtrip('{"1": -1}');
+SELECT roundtrip('{"1": 1.1}');
+SELECT roundtrip('{"1": -1.1}');
+SELECT roundtrip('{"1": "string1"}');
+
+SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
+
+
+DROP EXTENSION plperlu CASCADE;
index 1df949e304a117555da809edb0e98236bfcf8e20..e7b68fa0d24d43c83172ccf7484641b15c1aa673 100644 (file)
@@ -575,8 +575,17 @@ SELECT jdoc-&gt;'guid', jdoc-&gt;'name' FROM api WHERE jdoc @&gt; '{"tags": ["qu
 
   <para>
    Additional extensions are available that implement transforms for the
-   <type>jsonb</type> type for the language PL/Python.  The extensions for
-   PL/Python are called <literal>jsonb_plpythonu</literal>,
+   <type>jsonb</type> type for different procedural languages.
+  </para>
+
+  <para>
+   The extensions for PL/Perl are called <literal>jsonb_plperl</literal> and
+   <literal>jsonb_plperlu</literal>.  If you use them, <type>jsonb</type>
+   values are mapped to Perl arrays, hashes, and scalars, as appropriate.
+  </para>
+
+  <para>
+   The extensions for PL/Python are called <literal>jsonb_plpythonu</literal>,
    <literal>jsonb_plpython2u</literal>, and
    <literal>jsonb_plpython3u</literal> (see <xref
    linkend="plpython-python23"/> for the PL/Python naming convention).  If you