Skip to content
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.

Commit 341e166

Browse files
peterepetere
committedApr 3, 2018
Transforms for jsonb to PL/Perl
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>
1 parent a08dc71 commit 341e166

File tree

13 files changed

+963
-4
lines changed

13 files changed

+963
-4
lines changed
 

‎contrib/Makefile

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -75,9 +75,9 @@ ALWAYS_SUBDIRS += sepgsql
7575
endif
7676

7777
ifeq ($(with_perl),yes)
78-
SUBDIRS += hstore_plperl
78+
SUBDIRS += hstore_plperl jsonb_plperl
7979
else
80-
ALWAYS_SUBDIRS += hstore_plperl
80+
ALWAYS_SUBDIRS += hstore_plperl jsonb_plperl
8181
endif
8282

8383
ifeq ($(with_python),yes)

‎contrib/jsonb_plperl/.gitignore

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
# Generated subdirectories
2+
/log/
3+
/results/
4+
/tmp_check/

‎contrib/jsonb_plperl/Makefile

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,40 @@
1+
# contrib/jsonb_plperl/Makefile
2+
3+
MODULE_big = jsonb_plperl
4+
OBJS = jsonb_plperl.o $(WIN32RES)
5+
PGFILEDESC = "jsonb_plperl - jsonb transform for plperl"
6+
7+
PG_CPPFLAGS = -I$(top_srcdir)/src/pl/plperl
8+
9+
EXTENSION = jsonb_plperlu jsonb_plperl
10+
DATA = jsonb_plperlu--1.0.sql jsonb_plperl--1.0.sql
11+
12+
REGRESS = jsonb_plperl jsonb_plperlu
13+
14+
ifdef USE_PGXS
15+
PG_CONFIG = pg_config
16+
PGXS := $(shell $(PG_CONFIG) --pgxs)
17+
include $(PGXS)
18+
else
19+
subdir = contrib/jsonb_plperl
20+
top_builddir = ../..
21+
include $(top_builddir)/src/Makefile.global
22+
include $(top_srcdir)/contrib/contrib-global.mk
23+
endif
24+
25+
# We must link libperl explicitly
26+
ifeq ($(PORTNAME), win32)
27+
# these settings are the same as for plperl
28+
override CPPFLAGS += -DPLPERL_HAVE_UID_GID -Wno-comment
29+
# ... see silliness in plperl Makefile ...
30+
SHLIB_LINK += $(sort $(wildcard ../../src/pl/plperl/libperl*.a))
31+
else
32+
rpathdir = $(perl_archlibexp)/CORE
33+
SHLIB_LINK += $(perl_embed_ldflags)
34+
endif
35+
36+
# As with plperl we need to make sure that the CORE directory is included
37+
# last, probably because it sometimes contains some header files with names
38+
# that clash with some of ours, or with some that we include, notably on
39+
# Windows.
40+
override CPPFLAGS := $(CPPFLAGS) $(perl_embed_ccflags) -I$(perl_archlibexp)/CORE

‎contrib/jsonb_plperl/expected/jsonb_plperl.out

Lines changed: 211 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,211 @@
1+
CREATE EXTENSION jsonb_plperl CASCADE;
2+
NOTICE: installing required extension "plperl"
3+
CREATE FUNCTION testHVToJsonb() RETURNS jsonb
4+
LANGUAGE plperl
5+
TRANSFORM FOR TYPE jsonb
6+
AS $$
7+
$val = {a => 1, b => 'boo', c => undef};
8+
return $val;
9+
$$;
10+
SELECT testHVToJsonb();
11+
testhvtojsonb
12+
---------------------------------
13+
{"a": 1, "b": "boo", "c": null}
14+
(1 row)
15+
16+
CREATE FUNCTION testAVToJsonb() RETURNS jsonb
17+
LANGUAGE plperl
18+
TRANSFORM FOR TYPE jsonb
19+
AS $$
20+
$val = [{a => 1, b => 'boo', c => undef}, {d => 2}];
21+
return $val;
22+
$$;
23+
SELECT testAVToJsonb();
24+
testavtojsonb
25+
---------------------------------------------
26+
[{"a": 1, "b": "boo", "c": null}, {"d": 2}]
27+
(1 row)
28+
29+
CREATE FUNCTION testSVToJsonb() RETURNS jsonb
30+
LANGUAGE plperl
31+
TRANSFORM FOR TYPE jsonb
32+
AS $$
33+
$val = 1;
34+
return $val;
35+
$$;
36+
SELECT testSVToJsonb();
37+
testsvtojsonb
38+
---------------
39+
1
40+
(1 row)
41+
42+
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
43+
LANGUAGE plperl
44+
TRANSFORM FOR TYPE jsonb
45+
AS $$
46+
return ('1' =~ m(0\t2));
47+
$$;
48+
SELECT testRegexpToJsonb();
49+
ERROR: cannot transform this Perl type to jsonb
50+
CONTEXT: PL/Perl function "testregexptojsonb"
51+
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
52+
LANGUAGE plperl
53+
TRANSFORM FOR TYPE jsonb
54+
AS $$
55+
return $_[0];
56+
$$;
57+
SELECT roundtrip('null');
58+
roundtrip
59+
-----------
60+
null
61+
(1 row)
62+
63+
SELECT roundtrip('1');
64+
roundtrip
65+
-----------
66+
1
67+
(1 row)
68+
69+
SELECT roundtrip('1E+131071');
70+
ERROR: cannot convert infinite value to jsonb
71+
CONTEXT: PL/Perl function "roundtrip"
72+
SELECT roundtrip('-1');
73+
roundtrip
74+
-----------
75+
-1
76+
(1 row)
77+
78+
SELECT roundtrip('1.2');
79+
roundtrip
80+
-----------
81+
1.2
82+
(1 row)
83+
84+
SELECT roundtrip('-1.2');
85+
roundtrip
86+
-----------
87+
-1.2
88+
(1 row)
89+
90+
SELECT roundtrip('"string"');
91+
roundtrip
92+
-----------
93+
"string"
94+
(1 row)
95+
96+
SELECT roundtrip('"NaN"');
97+
roundtrip
98+
-----------
99+
"NaN"
100+
(1 row)
101+
102+
SELECT roundtrip('true');
103+
roundtrip
104+
-----------
105+
1
106+
(1 row)
107+
108+
SELECT roundtrip('false');
109+
roundtrip
110+
-----------
111+
0
112+
(1 row)
113+
114+
SELECT roundtrip('[]');
115+
roundtrip
116+
-----------
117+
[]
118+
(1 row)
119+
120+
SELECT roundtrip('[null, null]');
121+
roundtrip
122+
--------------
123+
[null, null]
124+
(1 row)
125+
126+
SELECT roundtrip('[1, 2, 3]');
127+
roundtrip
128+
-----------
129+
[1, 2, 3]
130+
(1 row)
131+
132+
SELECT roundtrip('[-1, 2, -3]');
133+
roundtrip
134+
-------------
135+
[-1, 2, -3]
136+
(1 row)
137+
138+
SELECT roundtrip('[1.2, 2.3, 3.4]');
139+
roundtrip
140+
-----------------
141+
[1.2, 2.3, 3.4]
142+
(1 row)
143+
144+
SELECT roundtrip('[-1.2, 2.3, -3.4]');
145+
roundtrip
146+
-------------------
147+
[-1.2, 2.3, -3.4]
148+
(1 row)
149+
150+
SELECT roundtrip('["string1", "string2"]');
151+
roundtrip
152+
------------------------
153+
["string1", "string2"]
154+
(1 row)
155+
156+
SELECT roundtrip('{}');
157+
roundtrip
158+
-----------
159+
{}
160+
(1 row)
161+
162+
SELECT roundtrip('{"1": null}');
163+
roundtrip
164+
-------------
165+
{"1": null}
166+
(1 row)
167+
168+
SELECT roundtrip('{"1": 1}');
169+
roundtrip
170+
-----------
171+
{"1": 1}
172+
(1 row)
173+
174+
SELECT roundtrip('{"1": -1}');
175+
roundtrip
176+
-----------
177+
{"1": -1}
178+
(1 row)
179+
180+
SELECT roundtrip('{"1": 1.1}');
181+
roundtrip
182+
------------
183+
{"1": 1.1}
184+
(1 row)
185+
186+
SELECT roundtrip('{"1": -1.1}');
187+
roundtrip
188+
-------------
189+
{"1": -1.1}
190+
(1 row)
191+
192+
SELECT roundtrip('{"1": "string1"}');
193+
roundtrip
194+
------------------
195+
{"1": "string1"}
196+
(1 row)
197+
198+
SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
199+
roundtrip
200+
---------------------------------
201+
{"1": {"2": [3, 4, 5]}, "2": 3}
202+
(1 row)
203+
204+
DROP EXTENSION plperl CASCADE;
205+
NOTICE: drop cascades to 6 other objects
206+
DETAIL: drop cascades to extension jsonb_plperl
207+
drop cascades to function testhvtojsonb()
208+
drop cascades to function testavtojsonb()
209+
drop cascades to function testsvtojsonb()
210+
drop cascades to function testregexptojsonb()
211+
drop cascades to function roundtrip(jsonb)

‎contrib/jsonb_plperl/expected/jsonb_plperlu.out

Lines changed: 211 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,211 @@
1+
CREATE EXTENSION jsonb_plperlu CASCADE;
2+
NOTICE: installing required extension "plperlu"
3+
CREATE FUNCTION testHVToJsonb() RETURNS jsonb
4+
LANGUAGE plperlu
5+
TRANSFORM FOR TYPE jsonb
6+
AS $$
7+
$val = {a => 1, b => 'boo', c => undef};
8+
return $val;
9+
$$;
10+
SELECT testHVToJsonb();
11+
testhvtojsonb
12+
---------------------------------
13+
{"a": 1, "b": "boo", "c": null}
14+
(1 row)
15+
16+
CREATE FUNCTION testAVToJsonb() RETURNS jsonb
17+
LANGUAGE plperlu
18+
TRANSFORM FOR TYPE jsonb
19+
AS $$
20+
$val = [{a => 1, b => 'boo', c => undef}, {d => 2}];
21+
return $val;
22+
$$;
23+
SELECT testAVToJsonb();
24+
testavtojsonb
25+
---------------------------------------------
26+
[{"a": 1, "b": "boo", "c": null}, {"d": 2}]
27+
(1 row)
28+
29+
CREATE FUNCTION testSVToJsonb() RETURNS jsonb
30+
LANGUAGE plperlu
31+
TRANSFORM FOR TYPE jsonb
32+
AS $$
33+
$val = 1;
34+
return $val;
35+
$$;
36+
SELECT testSVToJsonb();
37+
testsvtojsonb
38+
---------------
39+
1
40+
(1 row)
41+
42+
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
43+
LANGUAGE plperlu
44+
TRANSFORM FOR TYPE jsonb
45+
AS $$
46+
return ('1' =~ m(0\t2));
47+
$$;
48+
SELECT testRegexpToJsonb();
49+
ERROR: cannot transform this Perl type to jsonb
50+
CONTEXT: PL/Perl function "testregexptojsonb"
51+
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
52+
LANGUAGE plperlu
53+
TRANSFORM FOR TYPE jsonb
54+
AS $$
55+
return $_[0];
56+
$$;
57+
SELECT roundtrip('null');
58+
roundtrip
59+
-----------
60+
null
61+
(1 row)
62+
63+
SELECT roundtrip('1');
64+
roundtrip
65+
-----------
66+
1
67+
(1 row)
68+
69+
SELECT roundtrip('1E+131071');
70+
ERROR: cannot convert infinite value to jsonb
71+
CONTEXT: PL/Perl function "roundtrip"
72+
SELECT roundtrip('-1');
73+
roundtrip
74+
-----------
75+
-1
76+
(1 row)
77+
78+
SELECT roundtrip('1.2');
79+
roundtrip
80+
-----------
81+
1.2
82+
(1 row)
83+
84+
SELECT roundtrip('-1.2');
85+
roundtrip
86+
-----------
87+
-1.2
88+
(1 row)
89+
90+
SELECT roundtrip('"string"');
91+
roundtrip
92+
-----------
93+
"string"
94+
(1 row)
95+
96+
SELECT roundtrip('"NaN"');
97+
roundtrip
98+
-----------
99+
"NaN"
100+
(1 row)
101+
102+
SELECT roundtrip('true');
103+
roundtrip
104+
-----------
105+
1
106+
(1 row)
107+
108+
SELECT roundtrip('false');
109+
roundtrip
110+
-----------
111+
0
112+
(1 row)
113+
114+
SELECT roundtrip('[]');
115+
roundtrip
116+
-----------
117+
[]
118+
(1 row)
119+
120+
SELECT roundtrip('[null, null]');
121+
roundtrip
122+
--------------
123+
[null, null]
124+
(1 row)
125+
126+
SELECT roundtrip('[1, 2, 3]');
127+
roundtrip
128+
-----------
129+
[1, 2, 3]
130+
(1 row)
131+
132+
SELECT roundtrip('[-1, 2, -3]');
133+
roundtrip
134+
-------------
135+
[-1, 2, -3]
136+
(1 row)
137+
138+
SELECT roundtrip('[1.2, 2.3, 3.4]');
139+
roundtrip
140+
-----------------
141+
[1.2, 2.3, 3.4]
142+
(1 row)
143+
144+
SELECT roundtrip('[-1.2, 2.3, -3.4]');
145+
roundtrip
146+
-------------------
147+
[-1.2, 2.3, -3.4]
148+
(1 row)
149+
150+
SELECT roundtrip('["string1", "string2"]');
151+
roundtrip
152+
------------------------
153+
["string1", "string2"]
154+
(1 row)
155+
156+
SELECT roundtrip('{}');
157+
roundtrip
158+
-----------
159+
{}
160+
(1 row)
161+
162+
SELECT roundtrip('{"1": null}');
163+
roundtrip
164+
-------------
165+
{"1": null}
166+
(1 row)
167+
168+
SELECT roundtrip('{"1": 1}');
169+
roundtrip
170+
-----------
171+
{"1": 1}
172+
(1 row)
173+
174+
SELECT roundtrip('{"1": -1}');
175+
roundtrip
176+
-----------
177+
{"1": -1}
178+
(1 row)
179+
180+
SELECT roundtrip('{"1": 1.1}');
181+
roundtrip
182+
------------
183+
{"1": 1.1}
184+
(1 row)
185+
186+
SELECT roundtrip('{"1": -1.1}');
187+
roundtrip
188+
-------------
189+
{"1": -1.1}
190+
(1 row)
191+
192+
SELECT roundtrip('{"1": "string1"}');
193+
roundtrip
194+
------------------
195+
{"1": "string1"}
196+
(1 row)
197+
198+
SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
199+
roundtrip
200+
---------------------------------
201+
{"1": {"2": [3, 4, 5]}, "2": 3}
202+
(1 row)
203+
204+
DROP EXTENSION plperlu CASCADE;
205+
NOTICE: drop cascades to 6 other objects
206+
DETAIL: drop cascades to extension jsonb_plperlu
207+
drop cascades to function testhvtojsonb()
208+
drop cascades to function testavtojsonb()
209+
drop cascades to function testsvtojsonb()
210+
drop cascades to function testregexptojsonb()
211+
drop cascades to function roundtrip(jsonb)

‎contrib/jsonb_plperl/jsonb_plperl--1.0.sql

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
/* contrib/jsonb_plperl/jsonb_plperl--1.0.sql */
2+
3+
-- complain if script is sourced in psql, rather than via CREATE EXTENSION
4+
\echo Use "CREATE EXTENSION jsonb_plperl" to load this file. \quit
5+
6+
CREATE FUNCTION jsonb_to_plperl(val internal) RETURNS internal
7+
LANGUAGE C STRICT IMMUTABLE
8+
AS 'MODULE_PATHNAME';
9+
10+
CREATE FUNCTION plperl_to_jsonb(val internal) RETURNS jsonb
11+
LANGUAGE C STRICT IMMUTABLE
12+
AS 'MODULE_PATHNAME';
13+
14+
CREATE TRANSFORM FOR jsonb LANGUAGE plperl (
15+
FROM SQL WITH FUNCTION jsonb_to_plperl(internal),
16+
TO SQL WITH FUNCTION plperl_to_jsonb(internal)
17+
);
18+
19+
COMMENT ON TRANSFORM FOR jsonb LANGUAGE plperl IS 'transform between jsonb and Perl';

‎contrib/jsonb_plperl/jsonb_plperl.c

Lines changed: 262 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,262 @@
1+
#include "postgres.h"
2+
3+
#undef _
4+
5+
#include "fmgr.h"
6+
#include "plperl.h"
7+
#include "plperl_helpers.h"
8+
9+
#include "utils/jsonb.h"
10+
#include "utils/fmgrprotos.h"
11+
12+
PG_MODULE_MAGIC;
13+
14+
static SV *Jsonb_to_SV(JsonbContainer *jsonb);
15+
static JsonbValue *SV_to_JsonbValue(SV *obj, JsonbParseState **ps, bool is_elem);
16+
17+
18+
static SV *
19+
JsonbValue_to_SV(JsonbValue *jbv)
20+
{
21+
dTHX;
22+
23+
switch (jbv->type)
24+
{
25+
case jbvBinary:
26+
return newRV(Jsonb_to_SV(jbv->val.binary.data));
27+
28+
case jbvNumeric:
29+
{
30+
char *str = DatumGetCString(DirectFunctionCall1(numeric_out,
31+
NumericGetDatum(jbv->val.numeric)));
32+
SV *result = newSVnv(SvNV(cstr2sv(str)));
33+
pfree(str);
34+
return result;
35+
}
36+
37+
case jbvString:
38+
{
39+
char *str = pnstrdup(jbv->val.string.val,
40+
jbv->val.string.len);
41+
SV *result = cstr2sv(str);
42+
pfree(str);
43+
return result;
44+
}
45+
46+
case jbvBool:
47+
return newSVnv(SvNV(jbv->val.boolean ? &PL_sv_yes : &PL_sv_no));
48+
49+
case jbvNull:
50+
return newSV(0);
51+
52+
default:
53+
elog(ERROR, "unexpected jsonb value type: %d", jbv->type);
54+
return NULL;
55+
}
56+
}
57+
58+
static SV *
59+
Jsonb_to_SV(JsonbContainer *jsonb)
60+
{
61+
dTHX;
62+
JsonbValue v;
63+
JsonbIterator *it;
64+
JsonbIteratorToken r;
65+
66+
it = JsonbIteratorInit(jsonb);
67+
r = JsonbIteratorNext(&it, &v, true);
68+
69+
switch (r)
70+
{
71+
case WJB_BEGIN_ARRAY:
72+
if (v.val.array.rawScalar)
73+
{
74+
JsonbValue tmp;
75+
76+
if ((r = JsonbIteratorNext(&it, &v, true)) != WJB_ELEM ||
77+
(r = JsonbIteratorNext(&it, &tmp, true)) != WJB_END_ARRAY ||
78+
(r = JsonbIteratorNext(&it, &tmp, true)) != WJB_DONE)
79+
elog(ERROR, "unexpected jsonb token: %d", r);
80+
81+
return newRV(JsonbValue_to_SV(&v));
82+
}
83+
else
84+
{
85+
AV *av = newAV();
86+
87+
while ((r = JsonbIteratorNext(&it, &v, true)) != WJB_DONE)
88+
{
89+
if (r == WJB_ELEM)
90+
av_push(av, JsonbValue_to_SV(&v));
91+
}
92+
93+
return (SV *) av;
94+
}
95+
96+
case WJB_BEGIN_OBJECT:
97+
{
98+
HV *hv = newHV();
99+
100+
while ((r = JsonbIteratorNext(&it, &v, true)) != WJB_DONE)
101+
{
102+
if (r == WJB_KEY)
103+
{
104+
/* json key in v, json value in val */
105+
JsonbValue val;
106+
107+
if (JsonbIteratorNext(&it, &val, true) == WJB_VALUE)
108+
{
109+
SV *value = JsonbValue_to_SV(&val);
110+
111+
(void) hv_store(hv,
112+
v.val.string.val, v.val.string.len,
113+
value, 0);
114+
}
115+
}
116+
}
117+
118+
return (SV *) hv;
119+
}
120+
121+
default:
122+
elog(ERROR, "unexpected jsonb token: %d", r);
123+
return NULL;
124+
}
125+
}
126+
127+
static JsonbValue *
128+
AV_to_JsonbValue(AV *in, JsonbParseState **jsonb_state)
129+
{
130+
dTHX;
131+
SSize_t pcount = av_len(in) + 1;
132+
SSize_t i;
133+
134+
pushJsonbValue(jsonb_state, WJB_BEGIN_ARRAY, NULL);
135+
136+
for (i = 0; i < pcount; i++)
137+
{
138+
SV **value = av_fetch(in, i, FALSE);
139+
140+
if (value)
141+
(void) SV_to_JsonbValue(*value, jsonb_state, true);
142+
}
143+
144+
return pushJsonbValue(jsonb_state, WJB_END_ARRAY, NULL);
145+
}
146+
147+
static JsonbValue *
148+
HV_to_JsonbValue(HV *obj, JsonbParseState **jsonb_state)
149+
{
150+
dTHX;
151+
JsonbValue key;
152+
SV *val;
153+
154+
key.type = jbvString;
155+
156+
pushJsonbValue(jsonb_state, WJB_BEGIN_OBJECT, NULL);
157+
158+
(void) hv_iterinit(obj);
159+
160+
while ((val = hv_iternextsv(obj, &key.val.string.val, &key.val.string.len)))
161+
{
162+
key.val.string.val = pnstrdup(key.val.string.val, key.val.string.len);
163+
pushJsonbValue(jsonb_state, WJB_KEY, &key);
164+
(void) SV_to_JsonbValue(val, jsonb_state, false);
165+
}
166+
167+
return pushJsonbValue(jsonb_state, WJB_END_OBJECT, NULL);
168+
}
169+
170+
static JsonbValue *
171+
SV_to_JsonbValue(SV *in, JsonbParseState **jsonb_state, bool is_elem)
172+
{
173+
dTHX;
174+
JsonbValue out; /* result */
175+
176+
/* Dereference references recursively. */
177+
while (SvROK(in))
178+
in = SvRV(in);
179+
180+
switch (SvTYPE(in))
181+
{
182+
case SVt_PVAV:
183+
return AV_to_JsonbValue((AV *) in, jsonb_state);
184+
185+
case SVt_PVHV:
186+
return HV_to_JsonbValue((HV *) in, jsonb_state);
187+
188+
case SVt_NV:
189+
case SVt_IV:
190+
{
191+
char *str = sv2cstr(in);
192+
193+
/*
194+
* Use case-insensitive comparison because infinity
195+
* representation varies across Perl versions.
196+
*/
197+
if (pg_strcasecmp(str, "inf") == 0)
198+
ereport(ERROR,
199+
(errcode(ERRCODE_INVALID_PARAMETER_VALUE),
200+
(errmsg("cannot convert infinite value to jsonb"))));
201+
202+
out.type = jbvNumeric;
203+
out.val.numeric = DatumGetNumeric(DirectFunctionCall3(numeric_in,
204+
CStringGetDatum(str), 0, -1));
205+
}
206+
break;
207+
208+
case SVt_NULL:
209+
out.type = jbvNull;
210+
break;
211+
212+
case SVt_PV: /* string */
213+
out.type = jbvString;
214+
out.val.string.val = sv2cstr(in);
215+
out.val.string.len = strlen(out.val.string.val);
216+
break;
217+
218+
default:
219+
220+
/*
221+
* XXX It might be nice if we could include the Perl type in the
222+
* error message.
223+
*/
224+
ereport(ERROR,
225+
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
226+
(errmsg("cannot transform this Perl type to jsonb"))));
227+
return NULL;
228+
}
229+
230+
/* Push result into 'jsonb_state' unless it is a raw scalar. */
231+
return *jsonb_state
232+
? pushJsonbValue(jsonb_state, is_elem ? WJB_ELEM : WJB_VALUE, &out)
233+
: memcpy(palloc(sizeof(JsonbValue)), &out, sizeof(JsonbValue));
234+
}
235+
236+
237+
PG_FUNCTION_INFO_V1(jsonb_to_plperl);
238+
239+
Datum
240+
jsonb_to_plperl(PG_FUNCTION_ARGS)
241+
{
242+
dTHX;
243+
Jsonb *in = PG_GETARG_JSONB_P(0);
244+
SV *sv = Jsonb_to_SV(&in->root);
245+
246+
return PointerGetDatum(newRV(sv));
247+
}
248+
249+
250+
PG_FUNCTION_INFO_V1(plperl_to_jsonb);
251+
252+
Datum
253+
plperl_to_jsonb(PG_FUNCTION_ARGS)
254+
{
255+
dTHX;
256+
JsonbParseState *jsonb_state = NULL;
257+
SV *in = (SV *) PG_GETARG_POINTER(0);
258+
JsonbValue *out = SV_to_JsonbValue(in, &jsonb_state, true);
259+
Jsonb *result = JsonbValueToJsonb(out);
260+
261+
PG_RETURN_JSONB_P(result);
262+
}

‎contrib/jsonb_plperl/jsonb_plperl.control

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
# jsonb_plperl extension
2+
comment = 'transform between jsonb and plperl'
3+
default_version = '1.0'
4+
module_pathname = '$libdir/jsonb_plperl'
5+
relocatable = true
6+
requires = 'plperl'

‎contrib/jsonb_plperl/jsonb_plperlu--1.0.sql

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
/* contrib/json_plperl/jsonb_plperl--1.0.sql */
2+
3+
-- complain if script is sourced in psql, rather than via CREATE EXTENSION
4+
\echo Use "CREATE EXTENSION jsonb_plperlu" to load this file. \quit
5+
6+
CREATE FUNCTION jsonb_to_plperl(val internal) RETURNS internal
7+
LANGUAGE C STRICT IMMUTABLE
8+
AS 'MODULE_PATHNAME';
9+
10+
CREATE FUNCTION plperl_to_jsonb(val internal) RETURNS jsonb
11+
LANGUAGE C STRICT IMMUTABLE
12+
AS 'MODULE_PATHNAME';
13+
14+
CREATE TRANSFORM FOR jsonb LANGUAGE plperlu (
15+
FROM SQL WITH FUNCTION jsonb_to_plperl(internal),
16+
TO SQL WITH FUNCTION plperl_to_jsonb(internal)
17+
);
18+
19+
COMMENT ON TRANSFORM FOR jsonb LANGUAGE plperlu IS 'transform between jsonb and Perl';

‎contrib/jsonb_plperl/jsonb_plperlu.control

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
# jsonb_plperl extension
2+
comment = 'transform between jsonb and plperlu'
3+
default_version = '1.0'
4+
module_pathname = '$libdir/jsonb_plperl'
5+
relocatable = true
6+
requires = 'plperlu'

‎contrib/jsonb_plperl/sql/jsonb_plperl.sql

Lines changed: 86 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
CREATE EXTENSION jsonb_plperl CASCADE;
2+
3+
4+
CREATE FUNCTION testHVToJsonb() RETURNS jsonb
5+
LANGUAGE plperl
6+
TRANSFORM FOR TYPE jsonb
7+
AS $$
8+
$val = {a => 1, b => 'boo', c => undef};
9+
return $val;
10+
$$;
11+
12+
SELECT testHVToJsonb();
13+
14+
15+
CREATE FUNCTION testAVToJsonb() RETURNS jsonb
16+
LANGUAGE plperl
17+
TRANSFORM FOR TYPE jsonb
18+
AS $$
19+
$val = [{a => 1, b => 'boo', c => undef}, {d => 2}];
20+
return $val;
21+
$$;
22+
23+
SELECT testAVToJsonb();
24+
25+
26+
CREATE FUNCTION testSVToJsonb() RETURNS jsonb
27+
LANGUAGE plperl
28+
TRANSFORM FOR TYPE jsonb
29+
AS $$
30+
$val = 1;
31+
return $val;
32+
$$;
33+
34+
SELECT testSVToJsonb();
35+
36+
37+
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
38+
LANGUAGE plperl
39+
TRANSFORM FOR TYPE jsonb
40+
AS $$
41+
return ('1' =~ m(0\t2));
42+
$$;
43+
44+
SELECT testRegexpToJsonb();
45+
46+
47+
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
48+
LANGUAGE plperl
49+
TRANSFORM FOR TYPE jsonb
50+
AS $$
51+
return $_[0];
52+
$$;
53+
54+
55+
SELECT roundtrip('null');
56+
SELECT roundtrip('1');
57+
SELECT roundtrip('1E+131071');
58+
SELECT roundtrip('-1');
59+
SELECT roundtrip('1.2');
60+
SELECT roundtrip('-1.2');
61+
SELECT roundtrip('"string"');
62+
SELECT roundtrip('"NaN"');
63+
64+
SELECT roundtrip('true');
65+
SELECT roundtrip('false');
66+
67+
SELECT roundtrip('[]');
68+
SELECT roundtrip('[null, null]');
69+
SELECT roundtrip('[1, 2, 3]');
70+
SELECT roundtrip('[-1, 2, -3]');
71+
SELECT roundtrip('[1.2, 2.3, 3.4]');
72+
SELECT roundtrip('[-1.2, 2.3, -3.4]');
73+
SELECT roundtrip('["string1", "string2"]');
74+
75+
SELECT roundtrip('{}');
76+
SELECT roundtrip('{"1": null}');
77+
SELECT roundtrip('{"1": 1}');
78+
SELECT roundtrip('{"1": -1}');
79+
SELECT roundtrip('{"1": 1.1}');
80+
SELECT roundtrip('{"1": -1.1}');
81+
SELECT roundtrip('{"1": "string1"}');
82+
83+
SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
84+
85+
86+
DROP EXTENSION plperl CASCADE;

‎contrib/jsonb_plperl/sql/jsonb_plperlu.sql

Lines changed: 86 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
CREATE EXTENSION jsonb_plperlu CASCADE;
2+
3+
4+
CREATE FUNCTION testHVToJsonb() RETURNS jsonb
5+
LANGUAGE plperlu
6+
TRANSFORM FOR TYPE jsonb
7+
AS $$
8+
$val = {a => 1, b => 'boo', c => undef};
9+
return $val;
10+
$$;
11+
12+
SELECT testHVToJsonb();
13+
14+
15+
CREATE FUNCTION testAVToJsonb() RETURNS jsonb
16+
LANGUAGE plperlu
17+
TRANSFORM FOR TYPE jsonb
18+
AS $$
19+
$val = [{a => 1, b => 'boo', c => undef}, {d => 2}];
20+
return $val;
21+
$$;
22+
23+
SELECT testAVToJsonb();
24+
25+
26+
CREATE FUNCTION testSVToJsonb() RETURNS jsonb
27+
LANGUAGE plperlu
28+
TRANSFORM FOR TYPE jsonb
29+
AS $$
30+
$val = 1;
31+
return $val;
32+
$$;
33+
34+
SELECT testSVToJsonb();
35+
36+
37+
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
38+
LANGUAGE plperlu
39+
TRANSFORM FOR TYPE jsonb
40+
AS $$
41+
return ('1' =~ m(0\t2));
42+
$$;
43+
44+
SELECT testRegexpToJsonb();
45+
46+
47+
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
48+
LANGUAGE plperlu
49+
TRANSFORM FOR TYPE jsonb
50+
AS $$
51+
return $_[0];
52+
$$;
53+
54+
55+
SELECT roundtrip('null');
56+
SELECT roundtrip('1');
57+
SELECT roundtrip('1E+131071');
58+
SELECT roundtrip('-1');
59+
SELECT roundtrip('1.2');
60+
SELECT roundtrip('-1.2');
61+
SELECT roundtrip('"string"');
62+
SELECT roundtrip('"NaN"');
63+
64+
SELECT roundtrip('true');
65+
SELECT roundtrip('false');
66+
67+
SELECT roundtrip('[]');
68+
SELECT roundtrip('[null, null]');
69+
SELECT roundtrip('[1, 2, 3]');
70+
SELECT roundtrip('[-1, 2, -3]');
71+
SELECT roundtrip('[1.2, 2.3, 3.4]');
72+
SELECT roundtrip('[-1.2, 2.3, -3.4]');
73+
SELECT roundtrip('["string1", "string2"]');
74+
75+
SELECT roundtrip('{}');
76+
SELECT roundtrip('{"1": null}');
77+
SELECT roundtrip('{"1": 1}');
78+
SELECT roundtrip('{"1": -1}');
79+
SELECT roundtrip('{"1": 1.1}');
80+
SELECT roundtrip('{"1": -1.1}');
81+
SELECT roundtrip('{"1": "string1"}');
82+
83+
SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
84+
85+
86+
DROP EXTENSION plperlu CASCADE;

‎doc/src/sgml/json.sgml

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -575,8 +575,17 @@ SELECT jdoc-&gt;'guid', jdoc-&gt;'name' FROM api WHERE jdoc @&gt; '{"tags": ["qu
575575

576576
<para>
577577
Additional extensions are available that implement transforms for the
578-
<type>jsonb</type> type for the language PL/Python. The extensions for
579-
PL/Python are called <literal>jsonb_plpythonu</literal>,
578+
<type>jsonb</type> type for different procedural languages.
579+
</para>
580+
581+
<para>
582+
The extensions for PL/Perl are called <literal>jsonb_plperl</literal> and
583+
<literal>jsonb_plperlu</literal>. If you use them, <type>jsonb</type>
584+
values are mapped to Perl arrays, hashes, and scalars, as appropriate.
585+
</para>
586+
587+
<para>
588+
The extensions for PL/Python are called <literal>jsonb_plpythonu</literal>,
580589
<literal>jsonb_plpython2u</literal>, and
581590
<literal>jsonb_plpython3u</literal> (see <xref
582591
linkend="plpython-python23"/> for the PL/Python naming convention). If you

0 commit comments

Comments
 (0)
Please sign in to comment.