From e0f5048851ff88a53630a0c121a1cd15f6a2f1cd Mon Sep 17 00:00:00 2001
From: Tom Lane <tgl@sss.pgh.pa.us>
Date: Sun, 4 Aug 2019 14:05:34 -0400
Subject: [PATCH] Fix handling of "undef" in contrib/jsonb_plperl.

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
---
 .../jsonb_plperl/expected/jsonb_plperl.out    | 22 ++++++++++++++++++-
 .../jsonb_plperl/expected/jsonb_plperlu.out   | 22 ++++++++++++++++++-
 contrib/jsonb_plperl/jsonb_plperl.c           | 10 ++++-----
 contrib/jsonb_plperl/sql/jsonb_plperl.sql     | 13 +++++++++++
 contrib/jsonb_plperl/sql/jsonb_plperlu.sql    | 13 +++++++++++
 5 files changed, 73 insertions(+), 7 deletions(-)

diff --git a/contrib/jsonb_plperl/expected/jsonb_plperl.out b/contrib/jsonb_plperl/expected/jsonb_plperl.out
index 6dc090a87f..5a73485ac0 100644
--- 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
index 434327bea0..dff316cf98 100644
--- 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
index b26723a958..04b04df953 100644
--- 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
index 8b062dfc6b..a5b2cffe6b 100644
--- 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
index 8d8e841540..c68ef7308a 100644
--- 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