Fix handling of "undef" in contrib/jsonb_plperl.

tglsfdc · tglsfdc · commit e0f5048851ff · 2019-08-04T14:05:34.000-04:00
Perl has multiple internal representations of "undef", and just testing for SvTYPE(x) == SVt_NULL doesn't recognize all of them, leading to "cannot transform this Perl type to jsonb" errors. Use the approved test SvOK() instead. Report and patch by Ivan Panchenko. Back-patch to v11 where this module was added. Discussion: https://postgr.es/m/1564783533.324795401@f193.i.mail.ru
diff --git a/contrib/jsonb_plperl/expected/jsonb_plperl.out b/contrib/jsonb_plperl/expected/jsonb_plperl.out
@@ -66,6 +66,26 @@ SELECT 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
@@ -230,4 +250,4 @@ SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}', 'HASH');
 
 \set VERBOSITY terse \\ -- suppress cascade details
 DROP EXTENSION plperl CASCADE;
-NOTICE:  drop cascades to 7 other objects
+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
@@ -66,6 +66,26 @@ SELECT 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
@@ -257,4 +277,4 @@ INFO:  $VAR1 = {'1' => {'2' => ['3','4','5']},'2' => '3'};
 
 \set VERBOSITY terse \\ -- suppress cascade details
 DROP EXTENSION plperlu CASCADE;
-NOTICE:  drop cascades to 7 other objects
+NOTICE:  drop cascades to 8 other objects
diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c
@@ -189,12 +189,12 @@ SV_to_JsonbValue(SV *in, JsonbParseState **jsonb_state, bool is_elem)
 		case SVt_PVHV:
 			return HV_to_JsonbValue((HV *) in, jsonb_state);
 
-		case SVt_NULL:
-			out.type = jbvNull;
-			break;
-
 		default:
-			if (SvUOK(in))
+			if (!SvOK(in))
+			{
+				out.type = jbvNull;
+			}
+			else if (SvUOK(in))
 			{
 				/*
 				 * If UV is >=64 bits, we have no better way to make this
diff --git a/contrib/jsonb_plperl/sql/jsonb_plperl.sql b/contrib/jsonb_plperl/sql/jsonb_plperl.sql
@@ -57,6 +57,19 @@ $$;
 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
diff --git a/contrib/jsonb_plperl/sql/jsonb_plperlu.sql b/contrib/jsonb_plperl/sql/jsonb_plperlu.sql
@@ -57,6 +57,19 @@ $$;
 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
