summaryrefslogtreecommitdiff
path: root/contrib/jsonb_plperl
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/jsonb_plperl')
-rw-r--r--contrib/jsonb_plperl/Makefile2
-rw-r--r--contrib/jsonb_plperl/expected/jsonb_plperl.out26
-rw-r--r--contrib/jsonb_plperl/expected/jsonb_plperlu.out26
-rw-r--r--contrib/jsonb_plperl/jsonb_plperl.c76
-rw-r--r--contrib/jsonb_plperl/sql/jsonb_plperl.sql16
-rw-r--r--contrib/jsonb_plperl/sql/jsonb_plperlu.sql16
6 files changed, 110 insertions, 52 deletions
diff --git a/contrib/jsonb_plperl/Makefile b/contrib/jsonb_plperl/Makefile
index b9fe9431972..eb6d1deb7df 100644
--- a/contrib/jsonb_plperl/Makefile
+++ b/contrib/jsonb_plperl/Makefile
@@ -11,6 +11,8 @@ 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)
diff --git a/contrib/jsonb_plperl/expected/jsonb_plperl.out b/contrib/jsonb_plperl/expected/jsonb_plperl.out
index 5bb5677f711..79d53e5e50f 100644
--- a/contrib/jsonb_plperl/expected/jsonb_plperl.out
+++ b/contrib/jsonb_plperl/expected/jsonb_plperl.out
@@ -39,15 +39,30 @@ SELECT testSVToJsonb();
1
(1 row)
+-- unsupported (for now)
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
LANGUAGE plperl
TRANSFORM FOR TYPE jsonb
AS $$
-return ('1' =~ m(0\t2));
+my $a = qr/foo/;
+return ($a);
$$;
SELECT testRegexpToJsonb();
ERROR: cannot transform this Perl type to jsonb
CONTEXT: PL/Perl function "testregexptojsonb"
+-- 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)
+
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
LANGUAGE plperl
TRANSFORM FOR TYPE jsonb
@@ -201,11 +216,6 @@ SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
{"1": {"2": [3, 4, 5]}, "2": 3}
(1 row)
+\set VERBOSITY terse \\ -- suppress cascade details
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)
+NOTICE: drop cascades to 7 other objects
diff --git a/contrib/jsonb_plperl/expected/jsonb_plperlu.out b/contrib/jsonb_plperl/expected/jsonb_plperlu.out
index 9527e9ee9d4..e842a03396c 100644
--- a/contrib/jsonb_plperl/expected/jsonb_plperlu.out
+++ b/contrib/jsonb_plperl/expected/jsonb_plperlu.out
@@ -39,15 +39,30 @@ SELECT testSVToJsonb();
1
(1 row)
+-- unsupported (for now)
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
LANGUAGE plperlu
TRANSFORM FOR TYPE jsonb
AS $$
-return ('1' =~ m(0\t2));
+my $a = qr/foo/;
+return ($a);
$$;
SELECT testRegexpToJsonb();
ERROR: cannot transform this Perl type to jsonb
CONTEXT: PL/Perl function "testregexptojsonb"
+-- 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)
+
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
LANGUAGE plperlu
TRANSFORM FOR TYPE jsonb
@@ -201,11 +216,6 @@ SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
{"1": {"2": [3, 4, 5]}, "2": 3}
(1 row)
+\set VERBOSITY terse \\ -- suppress cascade details
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)
+NOTICE: drop cascades to 7 other objects
diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c
index ad9e65516f1..837bae2ab50 100644
--- a/contrib/jsonb_plperl/jsonb_plperl.c
+++ b/contrib/jsonb_plperl/jsonb_plperl.c
@@ -1,11 +1,14 @@
#include "postgres.h"
+#include <float.h>
+#include <math.h>
+
+/* Defined by Perl */
#undef _
#include "fmgr.h"
#include "plperl.h"
#include "plperl_helpers.h"
-
#include "utils/jsonb.h"
#include "utils/fmgrprotos.h"
@@ -188,46 +191,51 @@ SV_to_JsonbValue(SV *in, JsonbParseState **jsonb_state, bool is_elem)
case SVt_PVHV:
return HV_to_JsonbValue((HV *) in, jsonb_state);
- case SVt_NV:
- case SVt_IV:
+ case SVt_NULL:
+ out.type = jbvNull;
+ break;
+
+ default:
+ if (SvIOK(in))
{
- char *str = sv2cstr(in);
+ IV ival = SvIV(in);
- /*
- * Use case-insensitive comparison because infinity
- * representation varies across Perl versions.
- */
- if (pg_strcasecmp(str, "inf") == 0)
+ out.type = jbvNumeric;
+ out.val.numeric =
+ DatumGetNumeric(DirectFunctionCall1(int8_numeric,
+ Int64GetDatum((int64) ival)));
+ }
+ else if (SvNOK(in))
+ {
+ double nval = SvNV(in);
+
+ if (isinf(nval))
ereport(ERROR,
- (errcode(ERRCODE_INVALID_PARAMETER_VALUE),
+ (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
(errmsg("cannot convert infinite value to jsonb"))));
out.type = jbvNumeric;
- out.val.numeric = DatumGetNumeric(DirectFunctionCall3(numeric_in,
- CStringGetDatum(str), 0, -1));
+ 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;
}
- 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. */
diff --git a/contrib/jsonb_plperl/sql/jsonb_plperl.sql b/contrib/jsonb_plperl/sql/jsonb_plperl.sql
index 2c779fcd087..9993132ef0d 100644
--- a/contrib/jsonb_plperl/sql/jsonb_plperl.sql
+++ b/contrib/jsonb_plperl/sql/jsonb_plperl.sql
@@ -34,16 +34,29 @@ $$;
SELECT testSVToJsonb();
+-- unsupported (for now)
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
LANGUAGE plperl
TRANSFORM FOR TYPE jsonb
AS $$
-return ('1' =~ m(0\t2));
+my $a = qr/foo/;
+return ($a);
$$;
SELECT testRegexpToJsonb();
+-- 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();
+
+
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
LANGUAGE plperl
TRANSFORM FOR TYPE jsonb
@@ -83,4 +96,5 @@ SELECT roundtrip('{"1": "string1"}');
SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
+\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
index e2acffae36e..ab7d2e76e87 100644
--- a/contrib/jsonb_plperl/sql/jsonb_plperlu.sql
+++ b/contrib/jsonb_plperl/sql/jsonb_plperlu.sql
@@ -34,16 +34,29 @@ $$;
SELECT testSVToJsonb();
+-- unsupported (for now)
CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb
LANGUAGE plperlu
TRANSFORM FOR TYPE jsonb
AS $$
-return ('1' =~ m(0\t2));
+my $a = qr/foo/;
+return ($a);
$$;
SELECT testRegexpToJsonb();
+-- 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();
+
+
CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
LANGUAGE plperlu
TRANSFORM FOR TYPE jsonb
@@ -83,4 +96,5 @@ SELECT roundtrip('{"1": "string1"}');
SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
+\set VERBOSITY terse \\ -- suppress cascade details
DROP EXTENSION plperlu CASCADE;
generated by cgit v1.2.3 (git 2.25.1) at 2025-05-12 00:33:07 +0000