Re: Transform for pl/perl

Tom Lane <tgl@sss.pgh.pa.us> writes:

> ilmari@ilmari.org (Dagfinn Ilmari =?utf-8?Q?Manns=C3=A5ker?=) writes:
>> I tried fixing this by adding an 'if (SvUV(in))' clause to
>> SV_to_JsonbValue, but I couldn't find a function to create a numeric
>> value from an uint64.  If it's not possible, should we error on UVs
>> greater than PG_INT64_MAX?
>
> I think you'd have to convert to text and back.  That's kind of icky,
> but it beats failing.

I had a look, and that's what the PL/Python transform does.  Attached is
a patch that does that for PL/Perl too, but only if the value is
actually > PG_INT64_MAX.

The secondary output files are for Perls with 32bit IV/UV types, but I
haven't been able to test them, since Debian's Perl uses 64bit integers
even on 32bit platforms.

> Or we could add a not-visible-to-SQL uint8-to-numeric function in
> numeric.c.  Not sure if this is enough use-case to justify that
> though.

I don't think this one use-case is enough, but it's worth keeping in
mind if it keeps cropping up.

- ilmari
-- 
"I use RMS as a guide in the same way that a boat captain would use
 a lighthouse.  It's good to know where it is, but you generally
 don't want to find yourself in the same spot." - Tollef Fog Heen

From acf968b4df81797fc06868dac87123413f3f4167 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dagfinn=20Ilmari=20Manns=C3=A5ker?= <ilmari@ilmari.org>
Date: Thu, 5 Apr 2018 16:23:59 +0100
Subject: [PATCH] Handle integers > PG_INT64_MAX in PL/Perl JSONB transform

---
 .../jsonb_plperl/expected/jsonb_plperl.out    |  15 +-
 .../jsonb_plperl/expected/jsonb_plperl_1.out  | 223 ++++++++++++++++++
 .../jsonb_plperl/expected/jsonb_plperlu.out   |  15 +-
 .../jsonb_plperl/expected/jsonb_plperlu_1.out | 223 ++++++++++++++++++
 contrib/jsonb_plperl/jsonb_plperl.c           |  20 +-
 contrib/jsonb_plperl/sql/jsonb_plperl.sql     |   9 +
 contrib/jsonb_plperl/sql/jsonb_plperlu.sql    |  10 +
 7 files changed, 512 insertions(+), 3 deletions(-)
 create mode 100644 contrib/jsonb_plperl/expected/jsonb_plperl_1.out
 create mode 100644 contrib/jsonb_plperl/expected/jsonb_plperlu_1.out

diff --git a/contrib/jsonb_plperl/expected/jsonb_plperl.out b/contrib/jsonb_plperl/expected/jsonb_plperl.out
index 99a2e8e135..c311a603f0 100644
--- a/contrib/jsonb_plperl/expected/jsonb_plperl.out
+++ b/contrib/jsonb_plperl/expected/jsonb_plperl.out
@@ -52,6 +52,19 @@ SELECT testRegexpResultToJsonb();
  0
 (1 row)
 
+CREATE FUNCTION testUVToJsonb() RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+as $$
+$val = ~0;
+return $val;
+$$;
+SELECT testUVToJsonb();
+    testuvtojsonb     
+----------------------
+ 18446744073709551615
+(1 row)
+
 CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
 LANGUAGE plperl
 TRANSFORM FOR TYPE jsonb
@@ -207,4 +220,4 @@ SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
 
 \set VERBOSITY terse \\ -- suppress cascade details
 DROP EXTENSION plperl CASCADE;
-NOTICE:  drop cascades to 6 other objects
+NOTICE:  drop cascades to 7 other objects
diff --git a/contrib/jsonb_plperl/expected/jsonb_plperl_1.out b/contrib/jsonb_plperl/expected/jsonb_plperl_1.out
new file mode 100644
index 0000000000..c425c73b9c
--- /dev/null
+++ b/contrib/jsonb_plperl/expected/jsonb_plperl_1.out
@@ -0,0 +1,223 @@
+CREATE EXTENSION jsonb_plperl CASCADE;
+NOTICE:  installing required extension "plperl"
+CREATE FUNCTION testHVToJsonb() RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+AS $$
+$val = {a => 1, b => 'boo', c => undef};
+return $val;
+$$;
+SELECT testHVToJsonb();
+          testhvtojsonb          
+---------------------------------
+ {"a": 1, "b": "boo", "c": null}
+(1 row)
+
+CREATE FUNCTION testAVToJsonb() RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+AS $$
+$val = [{a => 1, b => 'boo', c => undef}, {d => 2}];
+return $val;
+$$;
+SELECT testAVToJsonb();
+                testavtojsonb                
+---------------------------------------------
+ [{"a": 1, "b": "boo", "c": null}, {"d": 2}]
+(1 row)
+
+CREATE FUNCTION testSVToJsonb() RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+AS $$
+$val = 1;
+return $val;
+$$;
+SELECT testSVToJsonb();
+ testsvtojsonb 
+---------------
+ 1
+(1 row)
+
+-- 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 testUVToJsonb() RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+as $$
+$val = ~0;
+return $val;
+$$;
+SELECT testUVToJsonb();
+ testuvtojsonb 
+---------------
+ 4294967295
+(1 row)
+
+CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+AS $$
+return $_[0];
+$$;
+SELECT roundtrip('null');
+ roundtrip 
+-----------
+ null
+(1 row)
+
+SELECT roundtrip('1');
+ roundtrip 
+-----------
+ 1
+(1 row)
+
+SELECT roundtrip('1E+131071');
+ERROR:  cannot convert infinite value to jsonb
+CONTEXT:  PL/Perl function "roundtrip"
+SELECT roundtrip('-1');
+ roundtrip 
+-----------
+ -1
+(1 row)
+
+SELECT roundtrip('1.2');
+ roundtrip 
+-----------
+ 1.2
+(1 row)
+
+SELECT roundtrip('-1.2');
+ roundtrip 
+-----------
+ -1.2
+(1 row)
+
+SELECT roundtrip('"string"');
+ roundtrip 
+-----------
+ "string"
+(1 row)
+
+SELECT roundtrip('"NaN"');
+ roundtrip 
+-----------
+ "NaN"
+(1 row)
+
+SELECT roundtrip('true');
+ roundtrip 
+-----------
+ 1
+(1 row)
+
+SELECT roundtrip('false');
+ roundtrip 
+-----------
+ 0
+(1 row)
+
+SELECT roundtrip('[]');
+ roundtrip 
+-----------
+ []
+(1 row)
+
+SELECT roundtrip('[null, null]');
+  roundtrip   
+--------------
+ [null, null]
+(1 row)
+
+SELECT roundtrip('[1, 2, 3]');
+ roundtrip 
+-----------
+ [1, 2, 3]
+(1 row)
+
+SELECT roundtrip('[-1, 2, -3]');
+  roundtrip  
+-------------
+ [-1, 2, -3]
+(1 row)
+
+SELECT roundtrip('[1.2, 2.3, 3.4]');
+    roundtrip    
+-----------------
+ [1.2, 2.3, 3.4]
+(1 row)
+
+SELECT roundtrip('[-1.2, 2.3, -3.4]');
+     roundtrip     
+-------------------
+ [-1.2, 2.3, -3.4]
+(1 row)
+
+SELECT roundtrip('["string1", "string2"]');
+       roundtrip        
+------------------------
+ ["string1", "string2"]
+(1 row)
+
+SELECT roundtrip('{}');
+ roundtrip 
+-----------
+ {}
+(1 row)
+
+SELECT roundtrip('{"1": null}');
+  roundtrip  
+-------------
+ {"1": null}
+(1 row)
+
+SELECT roundtrip('{"1": 1}');
+ roundtrip 
+-----------
+ {"1": 1}
+(1 row)
+
+SELECT roundtrip('{"1": -1}');
+ roundtrip 
+-----------
+ {"1": -1}
+(1 row)
+
+SELECT roundtrip('{"1": 1.1}');
+ roundtrip  
+------------
+ {"1": 1.1}
+(1 row)
+
+SELECT roundtrip('{"1": -1.1}');
+  roundtrip  
+-------------
+ {"1": -1.1}
+(1 row)
+
+SELECT roundtrip('{"1": "string1"}');
+    roundtrip     
+------------------
+ {"1": "string1"}
+(1 row)
+
+SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
+            roundtrip            
+---------------------------------
+ {"1": {"2": [3, 4, 5]}, "2": 3}
+(1 row)
+
+\set VERBOSITY terse \\ -- suppress cascade details
+DROP EXTENSION plperl CASCADE;
+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 8053cf6aa8..c4f7caf4c1 100644
--- a/contrib/jsonb_plperl/expected/jsonb_plperlu.out
+++ b/contrib/jsonb_plperl/expected/jsonb_plperlu.out
@@ -52,6 +52,19 @@ SELECT testRegexpResultToJsonb();
  0
 (1 row)
 
+CREATE FUNCTION testUVToJsonb() RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+as $$
+$val = ~0;
+return $val;
+$$;
+SELECT testUVToJsonb();
+    testuvtojsonb     
+----------------------
+ 18446744073709551615
+(1 row)
+
 CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
 LANGUAGE plperlu
 TRANSFORM FOR TYPE jsonb
@@ -207,4 +220,4 @@ SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
 
 \set VERBOSITY terse \\ -- suppress cascade details
 DROP EXTENSION plperlu CASCADE;
-NOTICE:  drop cascades to 6 other objects
+NOTICE:  drop cascades to 7 other objects
diff --git a/contrib/jsonb_plperl/expected/jsonb_plperlu_1.out b/contrib/jsonb_plperl/expected/jsonb_plperlu_1.out
new file mode 100644
index 0000000000..6bebc1ce3d
--- /dev/null
+++ b/contrib/jsonb_plperl/expected/jsonb_plperlu_1.out
@@ -0,0 +1,223 @@
+CREATE EXTENSION jsonb_plperlu CASCADE;
+NOTICE:  installing required extension "plperlu"
+CREATE FUNCTION testHVToJsonb() RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+$val = {a => 1, b => 'boo', c => undef};
+return $val;
+$$;
+SELECT testHVToJsonb();
+          testhvtojsonb          
+---------------------------------
+ {"a": 1, "b": "boo", "c": null}
+(1 row)
+
+CREATE FUNCTION testAVToJsonb() RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+$val = [{a => 1, b => 'boo', c => undef}, {d => 2}];
+return $val;
+$$;
+SELECT testAVToJsonb();
+                testavtojsonb                
+---------------------------------------------
+ [{"a": 1, "b": "boo", "c": null}, {"d": 2}]
+(1 row)
+
+CREATE FUNCTION testSVToJsonb() RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+$val = 1;
+return $val;
+$$;
+SELECT testSVToJsonb();
+ testsvtojsonb 
+---------------
+ 1
+(1 row)
+
+-- 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 testUVToJsonb() RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+as $$
+$val = ~0;
+return $val;
+$$;
+SELECT testUVToJsonb();
+ testuvtojsonb 
+---------------
+ 4294967295
+(1 row)
+
+CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+AS $$
+return $_[0];
+$$;
+SELECT roundtrip('null');
+ roundtrip 
+-----------
+ null
+(1 row)
+
+SELECT roundtrip('1');
+ roundtrip 
+-----------
+ 1
+(1 row)
+
+SELECT roundtrip('1E+131071');
+ERROR:  cannot convert infinite value to jsonb
+CONTEXT:  PL/Perl function "roundtrip"
+SELECT roundtrip('-1');
+ roundtrip 
+-----------
+ -1
+(1 row)
+
+SELECT roundtrip('1.2');
+ roundtrip 
+-----------
+ 1.2
+(1 row)
+
+SELECT roundtrip('-1.2');
+ roundtrip 
+-----------
+ -1.2
+(1 row)
+
+SELECT roundtrip('"string"');
+ roundtrip 
+-----------
+ "string"
+(1 row)
+
+SELECT roundtrip('"NaN"');
+ roundtrip 
+-----------
+ "NaN"
+(1 row)
+
+SELECT roundtrip('true');
+ roundtrip 
+-----------
+ 1
+(1 row)
+
+SELECT roundtrip('false');
+ roundtrip 
+-----------
+ 0
+(1 row)
+
+SELECT roundtrip('[]');
+ roundtrip 
+-----------
+ []
+(1 row)
+
+SELECT roundtrip('[null, null]');
+  roundtrip   
+--------------
+ [null, null]
+(1 row)
+
+SELECT roundtrip('[1, 2, 3]');
+ roundtrip 
+-----------
+ [1, 2, 3]
+(1 row)
+
+SELECT roundtrip('[-1, 2, -3]');
+  roundtrip  
+-------------
+ [-1, 2, -3]
+(1 row)
+
+SELECT roundtrip('[1.2, 2.3, 3.4]');
+    roundtrip    
+-----------------
+ [1.2, 2.3, 3.4]
+(1 row)
+
+SELECT roundtrip('[-1.2, 2.3, -3.4]');
+     roundtrip     
+-------------------
+ [-1.2, 2.3, -3.4]
+(1 row)
+
+SELECT roundtrip('["string1", "string2"]');
+       roundtrip        
+------------------------
+ ["string1", "string2"]
+(1 row)
+
+SELECT roundtrip('{}');
+ roundtrip 
+-----------
+ {}
+(1 row)
+
+SELECT roundtrip('{"1": null}');
+  roundtrip  
+-------------
+ {"1": null}
+(1 row)
+
+SELECT roundtrip('{"1": 1}');
+ roundtrip 
+-----------
+ {"1": 1}
+(1 row)
+
+SELECT roundtrip('{"1": -1}');
+ roundtrip 
+-----------
+ {"1": -1}
+(1 row)
+
+SELECT roundtrip('{"1": 1.1}');
+ roundtrip  
+------------
+ {"1": 1.1}
+(1 row)
+
+SELECT roundtrip('{"1": -1.1}');
+  roundtrip  
+-------------
+ {"1": -1.1}
+(1 row)
+
+SELECT roundtrip('{"1": "string1"}');
+    roundtrip     
+------------------
+ {"1": "string1"}
+(1 row)
+
+SELECT roundtrip('{"1": {"2": [3, 4, 5]}, "2": 3}');
+            roundtrip            
+---------------------------------
+ {"1": {"2": [3, 4, 5]}, "2": 3}
+(1 row)
+
+\set VERBOSITY terse \\ -- suppress cascade details
+DROP EXTENSION plperlu CASCADE;
+NOTICE:  drop cascades to 7 other objects
diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c
index 837bae2ab5..63bc547c88 100644
--- a/contrib/jsonb_plperl/jsonb_plperl.c
+++ b/contrib/jsonb_plperl/jsonb_plperl.c
@@ -196,7 +196,25 @@ SV_to_JsonbValue(SV *in, JsonbParseState **jsonb_state, bool is_elem)
             break;
 
         default:
-            if (SvIOK(in))
+            if (SvUOK(in))
+            {
+                UV            uval = SvUV(in);
+
+                out.type = jbvNumeric;
+                if (uval > PG_INT64_MAX)
+                {
+                    const char *strval = SvPV_nolen(in);
+
+                    out.val.numeric =
+                        DatumGetNumeric(DirectFunctionCall3(numeric_in,
+                                                            CStringGetDatum(strval), 0, -1));
+                }
+                else
+                    out.val.numeric =
+                        DatumGetNumeric(DirectFunctionCall1(int8_numeric,
+                                                            Int64GetDatum((int64) uval)));
+            }
+            else if (SvIOK(in))
             {
                 IV            ival = SvIV(in);
 
diff --git a/contrib/jsonb_plperl/sql/jsonb_plperl.sql b/contrib/jsonb_plperl/sql/jsonb_plperl.sql
index 8b0a8764af..7b0c7683d2 100644
--- a/contrib/jsonb_plperl/sql/jsonb_plperl.sql
+++ b/contrib/jsonb_plperl/sql/jsonb_plperl.sql
@@ -44,6 +44,15 @@ $$;
 
 SELECT testRegexpResultToJsonb();
 
+CREATE FUNCTION testUVToJsonb() RETURNS jsonb
+LANGUAGE plperl
+TRANSFORM FOR TYPE jsonb
+as $$
+$val = ~0;
+return $val;
+$$;
+
+SELECT testUVToJsonb();
 
 CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
 LANGUAGE plperl
diff --git a/contrib/jsonb_plperl/sql/jsonb_plperlu.sql b/contrib/jsonb_plperl/sql/jsonb_plperlu.sql
index 9287f7672f..a68e7f1b4d 100644
--- a/contrib/jsonb_plperl/sql/jsonb_plperlu.sql
+++ b/contrib/jsonb_plperl/sql/jsonb_plperlu.sql
@@ -45,6 +45,16 @@ $$;
 SELECT testRegexpResultToJsonb();
 
 
+CREATE FUNCTION testUVToJsonb() RETURNS jsonb
+LANGUAGE plperlu
+TRANSFORM FOR TYPE jsonb
+as $$
+$val = ~0;
+return $val;
+$$;
+
+SELECT testUVToJsonb();
+
 CREATE FUNCTION roundtrip(val jsonb) RETURNS jsonb
 LANGUAGE plperlu
 TRANSFORM FOR TYPE jsonb
-- 
2.17.0