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 $$ +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 testRegexpToJsonb(); -ERROR: cannot transform this Perl type to jsonb -CONTEXT: PL/Perl function "testregexptojsonb" +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 $$ +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 testRegexpToJsonb(); -ERROR: cannot transform this Perl type to jsonb -CONTEXT: PL/Perl function "testregexptojsonb" +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 +#include + +/* 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: - { - 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: + if (SvIOK(in)) + { + IV ival = SvIV(in); - /* - * 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; + 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_FEATURE_NOT_SUPPORTED), + (errmsg("cannot convert infinite value 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. */ 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,14 +34,27 @@ $$; SELECT testSVToJsonb(); +-- unsupported (for now) CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb LANGUAGE plperl TRANSFORM FOR TYPE jsonb AS $$ +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 testRegexpToJsonb(); +SELECT testRegexpResultToJsonb(); CREATE FUNCTION roundtrip(val jsonb) RETURNS 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,14 +34,27 @@ $$; SELECT testSVToJsonb(); +-- unsupported (for now) CREATE FUNCTION testRegexpToJsonb() RETURNS jsonb LANGUAGE plperlu TRANSFORM FOR TYPE jsonb AS $$ +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 testRegexpToJsonb(); +SELECT testRegexpResultToJsonb(); CREATE FUNCTION roundtrip(val jsonb) RETURNS 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;