bool_plperl transform

Started by Ivan Panchenkoalmost 6 years ago12 messages

wao@mail.ru

almost 6 years ago

1 attachment(s)

Hi,
While using PL/Perl I have found that it obtains boolean arguments from Postgres as ‘t’ and ‘f’, which is extremely inconvenient because ‘f’ is not false from the perl viewpoint.
So the problem is how to convert the SQL booleans into Perl style.

There are 3 ways to do this:
* make plperl automatically convert bools into something acceptable for perl. This looks simple, but probably is not acceptable as it breaks compatibility.
* try to make some trick like it is done with arrays, i.e. convert bools into special Perl objects which look like ‘t’ and ‘f’ when treated as text, but are true and false for boolean operations. I am not sure that it is possible and reliable.
* make a transform which transforms bool, like it is done with jsonb. This does not break compatibility and is rather straightforward.
So I propose to take the third way and make such transform. This is very simple, a patch is attached.
Also this patch improves the plperl documentation page, which now has nothing said about the transforms.

Regards,
Ivan Panchenko

Attachments:

bool_plperl_transform_v1.patchapplication/octet-stream; name="=?UTF-8?B?Ym9vbF9wbHBlcmxfdHJhbnNmb3JtX3YxLnBhdGNo?="Download

diff --git a/contrib/Makefile b/contrib/Makefile
index 92184ed487..795f69cf64 100644
--- a/contrib/Makefile
+++ b/contrib/Makefile
@@ -75,9 +75,9 @@ ALWAYS_SUBDIRS += sepgsql
 endif
 
 ifeq ($(with_perl),yes)
-SUBDIRS += hstore_plperl jsonb_plperl
+SUBDIRS += hstore_plperl jsonb_plperl bool_plperl
 else
-ALWAYS_SUBDIRS += hstore_plperl jsonb_plperl
+ALWAYS_SUBDIRS += hstore_plperl jsonb_plperl bool_plperl
 endif
 
 ifeq ($(with_python),yes)
diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml
index e4769c0e38..79f781a4ce 100644
--- a/doc/src/sgml/plperl.sgml
+++ b/doc/src/sgml/plperl.sgml
@@ -55,7 +55,10 @@
    syntax:
 
 <programlisting>
-CREATE FUNCTION <replaceable>funcname</replaceable> (<replaceable>argument-types</replaceable>) RETURNS <replaceable>return-type</replaceable> AS $$
+CREATE FUNCTION <replaceable>funcname</replaceable> (<replaceable>argument-types</replaceable>) 
+    RETURNS <replaceable>return-type</replaceable> 
+    -- function attributes
+    AS $$
     # PL/Perl function body
 $$ LANGUAGE plperl;
 </programlisting>
@@ -347,6 +350,36 @@ SELECT * FROM perl_set();
 </programlisting>
   </para>
 
+  <para>
+   By default, <type>json</type> and <type>jsonb</type> values are passed to
+   PL/Perl functions and procedures as text. For <type>jsonb</type> it is 
+   possible to convert the values into internal Perl representation automatically
+   using the transforms, see <xref linkend="sql-createtransform"/> and <xref linkend="sql-createfunction"/>. 
+   <filename>jsonb_plperl</filename> extension provides such transform for <type>jsonb</type> data type. 
+   To enable the transform, create this extension and then specify 
+<programlisting>
+  TRANSFORM FOR TYPE jsonb
+</programlisting>
+   in the <literal>CREATE FUNCTION</literal> statement.
+  </para>
+
+  <para>
+   By default, boolean values are passed to plperl as text, namely <literal>'t'</literal>
+   for <literal>true</literal> and <literal>'f'</literal> for <literal>false</literal>. 
+   To transform these values into Perl true and false values, use the transform
+   provided by <filename>bool_plperl</filename> extension.
+   To enable the transform, create this extension and then specify 
+<programlisting>
+  TRANSFORM FOR TYPE bool
+</programlisting>
+   in the <literal>CREATE FUNCTION</literal> statement.
+  </para>
+
+  <para>
+   The above mentioned <type>jsonb</type> and <type>bool</type> transforms are applied for function arguments,
+   its return value and results of SPI database queries performed inside the function.
+  </para>
+
   <para>
    If you wish to use the <literal>strict</literal> pragma with your code you
    have a few options. For temporary global use you can <command>SET</command>
diff --git a/src/tools/msvc/Mkvcbuild.pm b/src/tools/msvc/Mkvcbuild.pm
index 834c2c39d1..809a2bab0d 100644
--- a/src/tools/msvc/Mkvcbuild.pm
+++ b/src/tools/msvc/Mkvcbuild.pm
@@ -43,6 +43,7 @@ my $contrib_extrasource = {
 	'seg'  => [ 'contrib/seg/segscan.l',   'contrib/seg/segparse.y' ],
 };
 my @contrib_excludes = (
+	'bool_plperl',
 	'commit_ts',        'hstore_plperl',
 	'hstore_plpython',  'intagg',
 	'jsonb_plperl',     'jsonb_plpython',
@@ -763,6 +764,9 @@ sub mkvcbuild
 		}
 
 		# Add transform modules dependent on plperl
+		my $bool_plperl = AddTransformModule(
+			'bool_plperl',  'contrib/bool_plperl',
+			'plperl',       'src/pl/plperl');
 		my $hstore_plperl = AddTransformModule(
 			'hstore_plperl', 'contrib/hstore_plperl',
 			'plperl',        'src/pl/plperl',
@@ -773,6 +777,7 @@ sub mkvcbuild
 
 		foreach my $f (@perl_embed_ccflags)
 		{
+			$bool_plperl->AddDefine($f);
 			$hstore_plperl->AddDefine($f);
 			$jsonb_plperl->AddDefine($f);
 		}

Tom Lane

tgl@sss.pgh.pa.us

almost 6 years ago

In reply to: Ivan Panchenko (#1)

Re: bool_plperl transform

=?UTF-8?B?SXZhbiBQYW5jaGVua28=?= <wao@mail.ru> writes:

While using PL/Perl I have found that it obtains boolean arguments from Postgres as ‘t’ and ‘f’, which is extremely inconvenient because ‘f’ is not false from the perl viewpoint.
...
* make a transform which transforms bool, like it is done with jsonb. This does not break compatibility and is rather straightforward.

Please register this patch in the commitfest app, so we don't lose track
of it.

https://commitfest.postgresql.org/27/

regards, tom lane

Andrew Dunstan

andrew.dunstan@2ndquadrant.com

almost 6 years ago

In reply to: Ivan Panchenko (#1)

Re: bool_plperl transform

On 2/29/20 4:55 PM, Ivan Panchenko wrote:

Hi,
While using PL/Perl I have found that it obtains boolean arguments
from Postgres as ‘t’ and ‘f’, which is extremely inconvenient because
‘f’ is not false from the perl viewpoint.
So the problem is how to convert the SQL booleans into Perl style.

There are 3 ways to do this:

1. make plperl automatically convert bools into something acceptable
for perl. This looks simple, but probably is not acceptable as it
breaks compatibility.
2. try to make some trick like it is done with arrays, i.e. convert
bools into special Perl objects which look like ‘t’ and ‘f’ when
treated as text, but are true and false for boolean operations. I
am not sure that it is possible and reliable.
3. make a transform which transforms bool, like it is done with
jsonb. This does not break compatibility and is rather
straightforward.

So I propose to take the third way and make such transform. This is
very simple, a patch is attached.
Also this patch improves the plperl documentation page, which now has
nothing said about the transforms.

Patch appears to be missing all the new files.

cheers

andrew

--
Andrew Dunstan https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services

Wao

wao@mail.ru

almost 6 years ago

In reply to: Andrew Dunstan (#3)

1 attachment(s)

Re[2]: bool_plperl transform

Sorry,

Please find the full patch attached.

Ivan

Воскресенье, 1 марта 2020, 7:57 +03:00 от Andrew Dunstan <andrew.dunstan@2ndquadrant.com>:

On 2/29/20 4:55 PM, Ivan Panchenko wrote:

Hi,
While using PL/Perl I have found that it obtains boolean arguments
from Postgres as ‘t’ and ‘f’, which is extremely inconvenient because
‘f’ is not false from the perl viewpoint.
So the problem is how to convert the SQL booleans into Perl style.

There are 3 ways to do this:

1. make plperl automatically convert bools into something acceptable
for perl. This looks simple, but probably is not acceptable as it
breaks compatibility.
2. try to make some trick like it is done with arrays, i.e. convert
bools into special Perl objects which look like ‘t’ and ‘f’ when
treated as text, but are true and false for boolean operations. I
am not sure that it is possible and reliable.
3. make a transform which transforms bool, like it is done with
jsonb. This does not break compatibility and is rather
straightforward.

So I propose to take the third way and make such transform. This is
very simple, a patch is attached.
Also this patch improves the plperl documentation page, which now has
nothing said about the transforms.

Patch appears to be missing all the new files.

cheers

andrew

--
Andrew Dunstan https://www.2ndQuadrant.com
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services

--
Иван Панченко

Attachments:

bool_plperl_transform_v2.patchapplication/octet-stream; name="=?UTF-8?B?Ym9vbF9wbHBlcmxfdHJhbnNmb3JtX3YyLnBhdGNo?="Download

diff --git a/contrib/bool_plperl/Makefile b/contrib/bool_plperl/Makefile
new file mode 100644
index 0000000000..e8c174613c
--- /dev/null
+++ b/contrib/bool_plperl/Makefile
@@ -0,0 +1,39 @@
+# contrib/bool_plperl/Makefile
+
+MODULE_big = bool_plperl
+OBJS = bool_plperl.o $(WIN32RES)
+PGFILEDESC = "bool_plperl - bool transform for plperl"
+
+PG_CPPFLAGS = -I$(top_srcdir)/src/pl/plperl
+
+EXTENSION = bool_plperlu bool_plperl
+DATA = bool_plperlu--1.0.sql bool_plperl--1.0.sql
+
+REGRESS = bool_plperl bool_plperlu
+
+SHLIB_LINK += $(filter -lm, $(LIBS))
+
+ifdef USE_PGXS
+PG_CONFIG = pg_config
+PGXS := $(shell $(PG_CONFIG) --pgxs)
+include $(PGXS)
+else
+subdir = contrib/bool_plperl
+top_builddir = ../..
+include $(top_builddir)/src/Makefile.global
+include $(top_srcdir)/contrib/contrib-global.mk
+endif
+
+# We must link libperl explicitly
+ifeq ($(PORTNAME), win32)
+# these settings are the same as for plperl
+override CPPFLAGS += -DPLPERL_HAVE_UID_GID -Wno-comment
+# ... see silliness in plperl Makefile ...
+SHLIB_LINK_INTERNAL += $(sort $(wildcard ../../src/pl/plperl/libperl*.a))
+else
+rpathdir = $(perl_archlibexp)/CORE
+SHLIB_LINK += $(perl_embed_ldflags)
+endif
+
+# As with plperl we need to include the perl_includespec directory last.
+override CPPFLAGS := $(CPPFLAGS) $(perl_embed_ccflags) $(perl_includespec)
diff --git a/contrib/bool_plperl/bool_plperl--1.0.sql b/contrib/bool_plperl/bool_plperl--1.0.sql
new file mode 100644
index 0000000000..00dc3b826f
--- /dev/null
+++ b/contrib/bool_plperl/bool_plperl--1.0.sql
@@ -0,0 +1,19 @@
+/* contrib/bool_plperl/bool_plperl--1.0.sql */
+
+-- complain if script is sourced in psql, rather than via CREATE EXTENSION
+\echo Use "CREATE EXTENSION bool_plperl" to load this file. \quit
+
+CREATE FUNCTION bool_to_plperl(val internal) RETURNS internal
+LANGUAGE C STRICT IMMUTABLE
+AS 'MODULE_PATHNAME';
+
+CREATE FUNCTION plperl_to_bool(val internal) RETURNS bool
+LANGUAGE C STRICT IMMUTABLE
+AS 'MODULE_PATHNAME';
+
+CREATE TRANSFORM FOR bool LANGUAGE plperl (
+    FROM SQL WITH FUNCTION bool_to_plperl(internal),
+    TO SQL WITH FUNCTION plperl_to_bool(internal)
+);
+
+COMMENT ON TRANSFORM FOR bool LANGUAGE plperl IS 'transform between bool and Perl';
diff --git a/contrib/bool_plperl/bool_plperl.c b/contrib/bool_plperl/bool_plperl.c
new file mode 100644
index 0000000000..01ee9e2898
--- /dev/null
+++ b/contrib/bool_plperl/bool_plperl.c
@@ -0,0 +1,35 @@
+#include "postgres.h"
+
+#include "fmgr.h"
+#include "plperl.h"
+#include "plperl_helpers.h"
+#include "utils/fmgrprotos.h"
+
+PG_MODULE_MAGIC;
+
+PG_FUNCTION_INFO_V1(bool_to_plperl);
+
+Datum
+bool_to_plperl(PG_FUNCTION_ARGS)
+{
+	dTHX;
+	bool in = PG_GETARG_BOOL(0);
+	SV	*sv = newSVnv(SvNV(in ? &PL_sv_yes : &PL_sv_no));
+	return PointerGetDatum(sv);
+}
+
+
+PG_FUNCTION_INFO_V1(plperl_to_bool);
+
+Datum
+plperl_to_bool(PG_FUNCTION_ARGS)
+{
+	dTHX;
+	SV		   *in = (SV *) PG_GETARG_POINTER(0);
+	if ( ! SvOK(in) ) 
+		PG_RETURN_NULL();
+	else if ( SvTRUE(in)) 
+		PG_RETURN_BOOL(true);
+	else
+		PG_RETURN_BOOL(false);
+}
diff --git a/contrib/bool_plperl/bool_plperl.control b/contrib/bool_plperl/bool_plperl.control
new file mode 100644
index 0000000000..23cdb00d67
--- /dev/null
+++ b/contrib/bool_plperl/bool_plperl.control
@@ -0,0 +1,6 @@
+# jsonb_plperl extension
+comment = 'transform between bool and plperl'
+default_version = '1.0'
+module_pathname = '$libdir/bool_plperl'
+relocatable = true
+requires = 'plperl'
diff --git a/contrib/bool_plperl/bool_plperlu--1.0.sql b/contrib/bool_plperl/bool_plperlu--1.0.sql
new file mode 100644
index 0000000000..9134d33014
--- /dev/null
+++ b/contrib/bool_plperl/bool_plperlu--1.0.sql
@@ -0,0 +1,19 @@
+/* contrib/json_plperl/bool_plperl--1.0.sql */
+
+-- complain if script is sourced in psql, rather than via CREATE EXTENSION
+\echo Use "CREATE EXTENSION bool_plperlu" to load this file. \quit
+
+CREATE FUNCTION bool_to_plperlu(val internal) RETURNS internal
+LANGUAGE C STRICT IMMUTABLE
+AS 'MODULE_PATHNAME', 'bool_to_plperl';
+
+CREATE FUNCTION plperlu_to_bool(val internal) RETURNS bool
+LANGUAGE C STRICT IMMUTABLE
+AS 'MODULE_PATHNAME', 'plperl_to_bool';
+
+CREATE TRANSFORM FOR bool LANGUAGE plperlu (
+    FROM SQL WITH FUNCTION bool_to_plperlu(internal),
+    TO SQL WITH FUNCTION plperlu_to_bool(internal)
+);
+
+COMMENT ON TRANSFORM FOR bool LANGUAGE plperlu IS 'transform between bool and Perl';
diff --git a/contrib/bool_plperl/bool_plperlu.control b/contrib/bool_plperl/bool_plperlu.control
new file mode 100644
index 0000000000..c75b8b53ee
--- /dev/null
+++ b/contrib/bool_plperl/bool_plperlu.control
@@ -0,0 +1,6 @@
+# jsonb_plperl extension
+comment = 'transform between bool and plperlu'
+default_version = '1.0'
+module_pathname = '$libdir/bool_plperl'
+relocatable = true
+requires = 'plperlu'
diff --git a/contrib/bool_plperl/expected/bool_plperl.out b/contrib/bool_plperl/expected/bool_plperl.out
new file mode 100644
index 0000000000..475778c3d8
--- /dev/null
+++ b/contrib/bool_plperl/expected/bool_plperl.out
@@ -0,0 +1,110 @@
+CREATE EXTENSION bool_plperl CASCADE;
+NOTICE:  installing required extension "plperl"
+ --- test transforming from perl 
+CREATE FUNCTION perl2int(int) RETURNS bool
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+CREATE FUNCTION perl2text(text) RETURNS bool
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+CREATE FUNCTION perl2undef() RETURNS bool
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+return undef;
+$$;
+SELECT perl2int(1);
+ perl2int 
+----------
+ t
+(1 row)
+
+SELECT perl2int(0);
+ perl2int 
+----------
+ f
+(1 row)
+
+SELECT perl2text('foo');
+ perl2text 
+-----------
+ t
+(1 row)
+
+SELECT perl2text('');
+ perl2text 
+-----------
+ f
+(1 row)
+
+SELECT perl2undef() IS NULL AS p;
+ p 
+---
+ t
+(1 row)
+
+ --- test transforming to perl 
+CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+my ($x, $y, $z) = @_;
+if(defined($z)) {
+die("NULL mistransformed");
+}
+if(!defined($x)) {
+die("TRUE mistransformed to UNDEF");
+}
+if(!defined($y)) {
+die("FALSE mistransformed to UNDEF");
+}
+if(!$x) {
+die("TRUE mistransformed");
+}
+if($y) {
+die("FALSE mistransformed");
+}
+$$;
+SELECT bool2perl (true, false, NULL);
+ bool2perl 
+-----------
+ 
+(1 row)
+
+ --- test selecting bool through SPI
+CREATE FUNCTION spi_test()  RETURNS void
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0];
+if(! defined ($rv->{t})) {
+die("TRUE mistransformed to UNDEF in SPI");
+}
+if(! defined ($rv->{f})) {
+die("FALSE mistransformed to UNDEF in SPI");
+}
+if( defined ($rv->{n})) {
+die("NULL mistransformed in SPI");
+}
+if(! $rv->{t} ) {
+die("TRUE mistransformed in SPI");
+}
+if(  $rv->{f} ) {
+die("FALSE mistransformed in SPI");
+}
+$$;
+SELECT spi_test();
+ spi_test 
+----------
+ 
+(1 row)
+
+\set VERBOSITY terse \\ -- suppress cascade details
+DROP EXTENSION plperl CASCADE;
+NOTICE:  drop cascades to 6 other objects
diff --git a/contrib/bool_plperl/expected/bool_plperlu.out b/contrib/bool_plperl/expected/bool_plperlu.out
new file mode 100644
index 0000000000..679e9ee011
--- /dev/null
+++ b/contrib/bool_plperl/expected/bool_plperlu.out
@@ -0,0 +1,110 @@
+CREATE EXTENSION bool_plperlu CASCADE;
+NOTICE:  installing required extension "plperlu"
+ --- test transforming from perl
+CREATE FUNCTION perl2int(int) RETURNS bool
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+CREATE FUNCTION perl2text(text) RETURNS bool
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+CREATE FUNCTION perl2undef() RETURNS bool
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+return undef;
+$$;
+SELECT perl2int(1);
+ perl2int 
+----------
+ t
+(1 row)
+
+SELECT perl2int(0);
+ perl2int 
+----------
+ f
+(1 row)
+
+SELECT perl2text('foo');
+ perl2text 
+-----------
+ t
+(1 row)
+
+SELECT perl2text('');
+ perl2text 
+-----------
+ f
+(1 row)
+
+SELECT perl2undef() IS NULL AS p;
+ p 
+---
+ t
+(1 row)
+
+ --- test transforming to perl 
+CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+my ($x, $y, $z) = @_;
+if(defined($z)) {
+die("NULL mistransformed");
+}
+if(!defined($x)) {
+die("TRUE mistransformed to UNDEF");
+}
+if(!defined($y)) {
+die("FALSE mistransformed to UNDEF");
+}
+if(!$x) {
+die("TRUE mistransformed");
+}
+if($y) {
+die("FALSE mistransformed");
+}
+$$;
+SELECT bool2perl (true, false, NULL);
+ bool2perl 
+-----------
+ 
+(1 row)
+
+ --- test selecting bool through SPI
+CREATE FUNCTION spi_test()  RETURNS void
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0];
+if(! defined ($rv->{t})) {
+die("TRUE mistransformed to UNDEF in SPI");
+}
+if(! defined ($rv->{f})) {
+die("FALSE mistransformed to UNDEF in SPI");
+}
+if( defined ($rv->{n})) {
+die("NULL mistransformed in SPI");
+}
+if(! $rv->{t} ) {
+die("TRUE mistransformed in SPI");
+}
+if(  $rv->{f} ) {
+die("FALSE mistransformed in SPI");
+}
+$$;
+SELECT spi_test();
+ spi_test 
+----------
+ 
+(1 row)
+
+\set VERBOSITY terse \\ -- suppress cascade details
+DROP EXTENSION plperlu CASCADE;
+NOTICE:  drop cascades to 6 other objects
diff --git a/contrib/bool_plperl/sql/bool_plperl.sql b/contrib/bool_plperl/sql/bool_plperl.sql
new file mode 100644
index 0000000000..8d1e4a6c2c
--- /dev/null
+++ b/contrib/bool_plperl/sql/bool_plperl.sql
@@ -0,0 +1,83 @@
+CREATE EXTENSION bool_plperl CASCADE;
+
+ --- test transforming from perl 
+CREATE FUNCTION perl2int(int) RETURNS bool
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+
+CREATE FUNCTION perl2text(text) RETURNS bool
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+
+CREATE FUNCTION perl2undef() RETURNS bool
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+return undef;
+$$;
+
+SELECT perl2int(1);
+SELECT perl2int(0);
+SELECT perl2text('foo');
+SELECT perl2text('');
+SELECT perl2undef() IS NULL AS p;
+
+ --- test transforming to perl 
+CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+my ($x, $y, $z) = @_;
+if(defined($z)) {
+die("NULL mistransformed");
+}
+if(!defined($x)) {
+die("TRUE mistransformed to UNDEF");
+}
+if(!defined($y)) {
+die("FALSE mistransformed to UNDEF");
+}
+if(!$x) {
+die("TRUE mistransformed");
+}
+if($y) {
+die("FALSE mistransformed");
+}
+$$;
+
+SELECT bool2perl (true, false, NULL);
+
+ --- test selecting bool through SPI
+
+CREATE FUNCTION spi_test()  RETURNS void
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0];
+if(! defined ($rv->{t})) {
+die("TRUE mistransformed to UNDEF in SPI");
+}
+if(! defined ($rv->{f})) {
+die("FALSE mistransformed to UNDEF in SPI");
+}
+if( defined ($rv->{n})) {
+die("NULL mistransformed in SPI");
+}
+if(! $rv->{t} ) {
+die("TRUE mistransformed in SPI");
+}
+if(  $rv->{f} ) {
+die("FALSE mistransformed in SPI");
+}
+$$;
+
+SELECT spi_test();
+
+\set VERBOSITY terse \\ -- suppress cascade details
+DROP EXTENSION plperl CASCADE;
diff --git a/contrib/bool_plperl/sql/bool_plperlu.sql b/contrib/bool_plperl/sql/bool_plperlu.sql
new file mode 100644
index 0000000000..f7ce247988
--- /dev/null
+++ b/contrib/bool_plperl/sql/bool_plperlu.sql
@@ -0,0 +1,83 @@
+CREATE EXTENSION bool_plperlu CASCADE;
+
+ --- test transforming from perl
+CREATE FUNCTION perl2int(int) RETURNS bool
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+
+CREATE FUNCTION perl2text(text) RETURNS bool
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+
+CREATE FUNCTION perl2undef() RETURNS bool
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+return undef;
+$$;
+
+SELECT perl2int(1);
+SELECT perl2int(0);
+SELECT perl2text('foo');
+SELECT perl2text('');
+SELECT perl2undef() IS NULL AS p;
+
+ --- test transforming to perl 
+CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+my ($x, $y, $z) = @_;
+if(defined($z)) {
+die("NULL mistransformed");
+}
+if(!defined($x)) {
+die("TRUE mistransformed to UNDEF");
+}
+if(!defined($y)) {
+die("FALSE mistransformed to UNDEF");
+}
+if(!$x) {
+die("TRUE mistransformed");
+}
+if($y) {
+die("FALSE mistransformed");
+}
+$$;
+
+SELECT bool2perl (true, false, NULL);
+
+ --- test selecting bool through SPI
+
+CREATE FUNCTION spi_test()  RETURNS void
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0];
+if(! defined ($rv->{t})) {
+die("TRUE mistransformed to UNDEF in SPI");
+}
+if(! defined ($rv->{f})) {
+die("FALSE mistransformed to UNDEF in SPI");
+}
+if( defined ($rv->{n})) {
+die("NULL mistransformed in SPI");
+}
+if(! $rv->{t} ) {
+die("TRUE mistransformed in SPI");
+}
+if(  $rv->{f} ) {
+die("FALSE mistransformed in SPI");
+}
+$$;
+
+SELECT spi_test();
+
+\set VERBOSITY terse \\ -- suppress cascade details
+DROP EXTENSION plperlu CASCADE;

Ivan Panchenko

wao@mail.ru

almost 6 years ago

In reply to: Tom Lane (#2)

Re[2]: bool_plperl transform

Воскресенье, 1 февраля 2020, 1:15 +03:00 от Tom Lane <tgl@sss.pgh.pa.us>:

=?UTF-8?B?SXZhbiBQYW5jaGVua28=?= < wao@mail.ru > writes:

While using PL/Perl I have found that it obtains boolean arguments from Postgres as ‘t’ and ‘f’, which is extremely inconvenient because ‘f’ is not false from the perl viewpoint.
...
* make a transform which transforms bool, like it is done with jsonb. This does not break compatibility and is rather straightforward.

Please register this patch in the commitfest app, so we don't lose track
of it.

https://commitfest.postgresql.org/27/

Done:
https://commitfest.postgresql.org/27/2502/

Regards,
Ivan

regards, tom lane

Tom Lane

tgl@sss.pgh.pa.us

almost 6 years ago

In reply to: Wao (#4)

Re: Re[2]: bool_plperl transform

=?UTF-8?B?V2Fv?= <wao@mail.ru> writes:

Please find the full patch attached.

The cfbot shows this failing to build on Windows:

https://ci.appveyor.com/project/postgresql-cfbot/postgresql/build/1.0.81889

I believe that's a build without plperl, so what it's probably telling
you is that Mkvcbuild.pm needs to be taught to build this module
conditionally, as it already does for hstore_plperl and jsonb_plperl.

Also, while the Linux build is passing, I can't find that it is actually
compiling or testing bool_plperl anywhere:

https://travis-ci.org/postgresql-cfbot/postgresql/builds/656909114

This is likely because you didn't add it to contrib/Makefile.

In general, I'd suggest grepping for references to hstore_plperl
or jsonb_plperl, and making sure that bool_plperl gets added where
appropriate.

I rather imagine you need a .gitignore file, as well.

You're also going to have to provide some documentation, because
I don't see any in the patch.

regards, tom lane

Noname

ilmari@ilmari.org

almost 6 years ago

In reply to: Wao (#4)

Re: bool_plperl transform

Wao <wao@mail.ru> writes:

+Datum
+bool_to_plperl(PG_FUNCTION_ARGS)
+{
+	dTHX;
+	bool in = PG_GETARG_BOOL(0);
+	SV	*sv = newSVnv(SvNV(in ? &PL_sv_yes : &PL_sv_no));
+	return PointerGetDatum(sv);
+}

Why is this only copying the floating point part of the built-in
booleans before returning them? I think this should just return
&PL_sv_yes or &PL_sv_no directly, like boolean expressions in Perl do,
and like what happens for NULL (&PL_sv_undef).

- ilmari
--
"A disappointingly low fraction of the human race is,
at any given time, on fire." - Stig Sandbeck Mathisen

Ivan Panchenko

wao@mail.ru

almost 6 years ago

In reply to: Noname (#7)

Re[2]: bool_plperl transform

Понедельник, 2 марта 2020, 1:09 +03:00 от ilmari@ilmari.org:

Wao < wao@mail.ru > writes:
+Datum
+bool_to_plperl(PG_FUNCTION_ARGS)
+{
+ dTHX;
+ bool in = PG_GETARG_BOOL(0);
+ SV *sv = newSVnv(SvNV(in ? &PL_sv_yes : &PL_sv_no));
+ return PointerGetDatum(sv);
+}
Why is this only copying the floating point part of the built-in
booleans before returning them? I think this should just return
&PL_sv_yes or &PL_sv_no directly, like boolean expressions in Perl do,
and like what happens for NULL (&PL_sv_undef).

Thanks, I will fix this in the next version of the patch.

Regards,
Ivan

- ilmari
--
"A disappointingly low fraction of the human race is,
at any given time, on fire." - Stig Sandbeck Mathisen

Ivan Panchenko

wao@mail.ru

almost 6 years ago

In reply to: Tom Lane (#6)

1 attachment(s)

Re[4]: bool_plperl transform

Thanks, Tom.

I think now it should build, please find the fixed patch attached.
I had no possibility to check it on Windows now, but the relevant changes in Mkvcbuild.pm are done, so I hope it should work.
The documentation changes are also included in the same patch.

Regards,
Ivan

Понедельник, 2 марта 2020, 0:14 +03:00 от Tom Lane <tgl@sss.pgh.pa.us>:

=?UTF-8?B?V2Fv?= < wao@mail.ru > writes:

Please find the full patch attached.

The cfbot shows this failing to build on Windows:

https://ci.appveyor.com/project/postgresql-cfbot/postgresql/build/1.0.81889

I believe that's a build without plperl, so what it's probably telling
you is that Mkvcbuild.pm needs to be taught to build this module
conditionally, as it already does for hstore_plperl and jsonb_plperl.

Also, while the Linux build is passing, I can't find that it is actually
compiling or testing bool_plperl anywhere:

https://travis-ci.org/postgresql-cfbot/postgresql/builds/656909114

This is likely because you didn't add it to contrib/Makefile.

In general, I'd suggest grepping for references to hstore_plperl
or jsonb_plperl, and making sure that bool_plperl gets added where
appropriate.

I rather imagine you need a .gitignore file, as well.

You're also going to have to provide some documentation, because
I don't see any in the patch.

regards, tom lane

Attachments:

bool_plperl_transform_v3.patchapplication/octet-stream; name="=?UTF-8?B?Ym9vbF9wbHBlcmxfdHJhbnNmb3JtX3YzLnBhdGNo?="Download

diff --git a/contrib/Makefile b/contrib/Makefile
index 92184ed487..795f69cf64 100644
--- a/contrib/Makefile
+++ b/contrib/Makefile
@@ -75,9 +75,9 @@ ALWAYS_SUBDIRS += sepgsql
 endif
 
 ifeq ($(with_perl),yes)
-SUBDIRS += hstore_plperl jsonb_plperl
+SUBDIRS += hstore_plperl jsonb_plperl bool_plperl
 else
-ALWAYS_SUBDIRS += hstore_plperl jsonb_plperl
+ALWAYS_SUBDIRS += hstore_plperl jsonb_plperl bool_plperl
 endif
 
 ifeq ($(with_python),yes)
diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml
index e4769c0e38..79f781a4ce 100644
--- a/doc/src/sgml/plperl.sgml
+++ b/doc/src/sgml/plperl.sgml
@@ -55,7 +55,10 @@
    syntax:
 
 <programlisting>
-CREATE FUNCTION <replaceable>funcname</replaceable> (<replaceable>argument-types</replaceable>) RETURNS <replaceable>return-type</replaceable> AS $$
+CREATE FUNCTION <replaceable>funcname</replaceable> (<replaceable>argument-types</replaceable>) 
+    RETURNS <replaceable>return-type</replaceable> 
+    -- function attributes
+    AS $$
     # PL/Perl function body
 $$ LANGUAGE plperl;
 </programlisting>
@@ -347,6 +350,36 @@ SELECT * FROM perl_set();
 </programlisting>
   </para>
 
+  <para>
+   By default, <type>json</type> and <type>jsonb</type> values are passed to
+   PL/Perl functions and procedures as text. For <type>jsonb</type> it is 
+   possible to convert the values into internal Perl representation automatically
+   using the transforms, see <xref linkend="sql-createtransform"/> and <xref linkend="sql-createfunction"/>. 
+   <filename>jsonb_plperl</filename> extension provides such transform for <type>jsonb</type> data type. 
+   To enable the transform, create this extension and then specify 
+<programlisting>
+  TRANSFORM FOR TYPE jsonb
+</programlisting>
+   in the <literal>CREATE FUNCTION</literal> statement.
+  </para>
+
+  <para>
+   By default, boolean values are passed to plperl as text, namely <literal>'t'</literal>
+   for <literal>true</literal> and <literal>'f'</literal> for <literal>false</literal>. 
+   To transform these values into Perl true and false values, use the transform
+   provided by <filename>bool_plperl</filename> extension.
+   To enable the transform, create this extension and then specify 
+<programlisting>
+  TRANSFORM FOR TYPE bool
+</programlisting>
+   in the <literal>CREATE FUNCTION</literal> statement.
+  </para>
+
+  <para>
+   The above mentioned <type>jsonb</type> and <type>bool</type> transforms are applied for function arguments,
+   its return value and results of SPI database queries performed inside the function.
+  </para>
+
   <para>
    If you wish to use the <literal>strict</literal> pragma with your code you
    have a few options. For temporary global use you can <command>SET</command>
diff --git a/src/tools/msvc/Mkvcbuild.pm b/src/tools/msvc/Mkvcbuild.pm
index 834c2c39d1..809a2bab0d 100644
--- a/src/tools/msvc/Mkvcbuild.pm
+++ b/src/tools/msvc/Mkvcbuild.pm
@@ -43,6 +43,7 @@ my $contrib_extrasource = {
 	'seg'  => [ 'contrib/seg/segscan.l',   'contrib/seg/segparse.y' ],
 };
 my @contrib_excludes = (
+	'bool_plperl',
 	'commit_ts',        'hstore_plperl',
 	'hstore_plpython',  'intagg',
 	'jsonb_plperl',     'jsonb_plpython',
@@ -763,6 +764,9 @@ sub mkvcbuild
 		}
 
 		# Add transform modules dependent on plperl
+		my $bool_plperl = AddTransformModule(
+			'bool_plperl',  'contrib/bool_plperl',
+			'plperl',       'src/pl/plperl');
 		my $hstore_plperl = AddTransformModule(
 			'hstore_plperl', 'contrib/hstore_plperl',
 			'plperl',        'src/pl/plperl',
@@ -773,6 +777,7 @@ sub mkvcbuild
 
 		foreach my $f (@perl_embed_ccflags)
 		{
+			$bool_plperl->AddDefine($f);
 			$hstore_plperl->AddDefine($f);
 			$jsonb_plperl->AddDefine($f);
 		}
diff --git a/contrib/bool_plperl/.gitignore b/contrib/bool_plperl/.gitignore
new file mode 100644
index 0000000000..5dcb3ff972
--- /dev/null
+++ b/contrib/bool_plperl/.gitignore
@@ -0,0 +1,4 @@
+# Generated subdirectories
+/log/
+/results/
+/tmp_check/
diff --git a/contrib/bool_plperl/Makefile b/contrib/bool_plperl/Makefile
new file mode 100644
index 0000000000..e8c174613c
--- /dev/null
+++ b/contrib/bool_plperl/Makefile
@@ -0,0 +1,39 @@
+# contrib/bool_plperl/Makefile
+
+MODULE_big = bool_plperl
+OBJS = bool_plperl.o $(WIN32RES)
+PGFILEDESC = "bool_plperl - bool transform for plperl"
+
+PG_CPPFLAGS = -I$(top_srcdir)/src/pl/plperl
+
+EXTENSION = bool_plperlu bool_plperl
+DATA = bool_plperlu--1.0.sql bool_plperl--1.0.sql
+
+REGRESS = bool_plperl bool_plperlu
+
+SHLIB_LINK += $(filter -lm, $(LIBS))
+
+ifdef USE_PGXS
+PG_CONFIG = pg_config
+PGXS := $(shell $(PG_CONFIG) --pgxs)
+include $(PGXS)
+else
+subdir = contrib/bool_plperl
+top_builddir = ../..
+include $(top_builddir)/src/Makefile.global
+include $(top_srcdir)/contrib/contrib-global.mk
+endif
+
+# We must link libperl explicitly
+ifeq ($(PORTNAME), win32)
+# these settings are the same as for plperl
+override CPPFLAGS += -DPLPERL_HAVE_UID_GID -Wno-comment
+# ... see silliness in plperl Makefile ...
+SHLIB_LINK_INTERNAL += $(sort $(wildcard ../../src/pl/plperl/libperl*.a))
+else
+rpathdir = $(perl_archlibexp)/CORE
+SHLIB_LINK += $(perl_embed_ldflags)
+endif
+
+# As with plperl we need to include the perl_includespec directory last.
+override CPPFLAGS := $(CPPFLAGS) $(perl_embed_ccflags) $(perl_includespec)
diff --git a/contrib/bool_plperl/bool_plperl--1.0.sql b/contrib/bool_plperl/bool_plperl--1.0.sql
new file mode 100644
index 0000000000..00dc3b826f
--- /dev/null
+++ b/contrib/bool_plperl/bool_plperl--1.0.sql
@@ -0,0 +1,19 @@
+/* contrib/bool_plperl/bool_plperl--1.0.sql */
+
+-- complain if script is sourced in psql, rather than via CREATE EXTENSION
+\echo Use "CREATE EXTENSION bool_plperl" to load this file. \quit
+
+CREATE FUNCTION bool_to_plperl(val internal) RETURNS internal
+LANGUAGE C STRICT IMMUTABLE
+AS 'MODULE_PATHNAME';
+
+CREATE FUNCTION plperl_to_bool(val internal) RETURNS bool
+LANGUAGE C STRICT IMMUTABLE
+AS 'MODULE_PATHNAME';
+
+CREATE TRANSFORM FOR bool LANGUAGE plperl (
+    FROM SQL WITH FUNCTION bool_to_plperl(internal),
+    TO SQL WITH FUNCTION plperl_to_bool(internal)
+);
+
+COMMENT ON TRANSFORM FOR bool LANGUAGE plperl IS 'transform between bool and Perl';
diff --git a/contrib/bool_plperl/bool_plperl.c b/contrib/bool_plperl/bool_plperl.c
new file mode 100644
index 0000000000..6c94f1e02a
--- /dev/null
+++ b/contrib/bool_plperl/bool_plperl.c
@@ -0,0 +1,27 @@
+#include "postgres.h"
+#include "fmgr.h"
+#include "plperl.h"
+
+PG_MODULE_MAGIC;
+
+PG_FUNCTION_INFO_V1(bool_to_plperl);
+
+Datum
+bool_to_plperl(PG_FUNCTION_ARGS)
+{
+	dTHX;
+	return PointerGetDatum(
+		PG_GETARG_BOOL(0) ? &PL_sv_yes : &PL_sv_no
+	);
+}
+
+
+PG_FUNCTION_INFO_V1(plperl_to_bool);
+
+Datum
+plperl_to_bool(PG_FUNCTION_ARGS)
+{
+	dTHX;
+	SV *in = (SV *) PG_GETARG_POINTER(0);
+	PG_RETURN_BOOL( SvTRUE(in) );
+}
diff --git a/contrib/bool_plperl/bool_plperl.control b/contrib/bool_plperl/bool_plperl.control
new file mode 100644
index 0000000000..23cdb00d67
--- /dev/null
+++ b/contrib/bool_plperl/bool_plperl.control
@@ -0,0 +1,6 @@
+# jsonb_plperl extension
+comment = 'transform between bool and plperl'
+default_version = '1.0'
+module_pathname = '$libdir/bool_plperl'
+relocatable = true
+requires = 'plperl'
diff --git a/contrib/bool_plperl/bool_plperlu--1.0.sql b/contrib/bool_plperl/bool_plperlu--1.0.sql
new file mode 100644
index 0000000000..9134d33014
--- /dev/null
+++ b/contrib/bool_plperl/bool_plperlu--1.0.sql
@@ -0,0 +1,19 @@
+/* contrib/json_plperl/bool_plperl--1.0.sql */
+
+-- complain if script is sourced in psql, rather than via CREATE EXTENSION
+\echo Use "CREATE EXTENSION bool_plperlu" to load this file. \quit
+
+CREATE FUNCTION bool_to_plperlu(val internal) RETURNS internal
+LANGUAGE C STRICT IMMUTABLE
+AS 'MODULE_PATHNAME', 'bool_to_plperl';
+
+CREATE FUNCTION plperlu_to_bool(val internal) RETURNS bool
+LANGUAGE C STRICT IMMUTABLE
+AS 'MODULE_PATHNAME', 'plperl_to_bool';
+
+CREATE TRANSFORM FOR bool LANGUAGE plperlu (
+    FROM SQL WITH FUNCTION bool_to_plperlu(internal),
+    TO SQL WITH FUNCTION plperlu_to_bool(internal)
+);
+
+COMMENT ON TRANSFORM FOR bool LANGUAGE plperlu IS 'transform between bool and Perl';
diff --git a/contrib/bool_plperl/bool_plperlu.control b/contrib/bool_plperl/bool_plperlu.control
new file mode 100644
index 0000000000..c75b8b53ee
--- /dev/null
+++ b/contrib/bool_plperl/bool_plperlu.control
@@ -0,0 +1,6 @@
+# jsonb_plperl extension
+comment = 'transform between bool and plperlu'
+default_version = '1.0'
+module_pathname = '$libdir/bool_plperl'
+relocatable = true
+requires = 'plperlu'
diff --git a/contrib/bool_plperl/expected/bool_plperl.out b/contrib/bool_plperl/expected/bool_plperl.out
new file mode 100644
index 0000000000..475778c3d8
--- /dev/null
+++ b/contrib/bool_plperl/expected/bool_plperl.out
@@ -0,0 +1,110 @@
+CREATE EXTENSION bool_plperl CASCADE;
+NOTICE:  installing required extension "plperl"
+ --- test transforming from perl 
+CREATE FUNCTION perl2int(int) RETURNS bool
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+CREATE FUNCTION perl2text(text) RETURNS bool
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+CREATE FUNCTION perl2undef() RETURNS bool
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+return undef;
+$$;
+SELECT perl2int(1);
+ perl2int 
+----------
+ t
+(1 row)
+
+SELECT perl2int(0);
+ perl2int 
+----------
+ f
+(1 row)
+
+SELECT perl2text('foo');
+ perl2text 
+-----------
+ t
+(1 row)
+
+SELECT perl2text('');
+ perl2text 
+-----------
+ f
+(1 row)
+
+SELECT perl2undef() IS NULL AS p;
+ p 
+---
+ t
+(1 row)
+
+ --- test transforming to perl 
+CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+my ($x, $y, $z) = @_;
+if(defined($z)) {
+die("NULL mistransformed");
+}
+if(!defined($x)) {
+die("TRUE mistransformed to UNDEF");
+}
+if(!defined($y)) {
+die("FALSE mistransformed to UNDEF");
+}
+if(!$x) {
+die("TRUE mistransformed");
+}
+if($y) {
+die("FALSE mistransformed");
+}
+$$;
+SELECT bool2perl (true, false, NULL);
+ bool2perl 
+-----------
+ 
+(1 row)
+
+ --- test selecting bool through SPI
+CREATE FUNCTION spi_test()  RETURNS void
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0];
+if(! defined ($rv->{t})) {
+die("TRUE mistransformed to UNDEF in SPI");
+}
+if(! defined ($rv->{f})) {
+die("FALSE mistransformed to UNDEF in SPI");
+}
+if( defined ($rv->{n})) {
+die("NULL mistransformed in SPI");
+}
+if(! $rv->{t} ) {
+die("TRUE mistransformed in SPI");
+}
+if(  $rv->{f} ) {
+die("FALSE mistransformed in SPI");
+}
+$$;
+SELECT spi_test();
+ spi_test 
+----------
+ 
+(1 row)
+
+\set VERBOSITY terse \\ -- suppress cascade details
+DROP EXTENSION plperl CASCADE;
+NOTICE:  drop cascades to 6 other objects
diff --git a/contrib/bool_plperl/expected/bool_plperlu.out b/contrib/bool_plperl/expected/bool_plperlu.out
new file mode 100644
index 0000000000..679e9ee011
--- /dev/null
+++ b/contrib/bool_plperl/expected/bool_plperlu.out
@@ -0,0 +1,110 @@
+CREATE EXTENSION bool_plperlu CASCADE;
+NOTICE:  installing required extension "plperlu"
+ --- test transforming from perl
+CREATE FUNCTION perl2int(int) RETURNS bool
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+CREATE FUNCTION perl2text(text) RETURNS bool
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+CREATE FUNCTION perl2undef() RETURNS bool
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+return undef;
+$$;
+SELECT perl2int(1);
+ perl2int 
+----------
+ t
+(1 row)
+
+SELECT perl2int(0);
+ perl2int 
+----------
+ f
+(1 row)
+
+SELECT perl2text('foo');
+ perl2text 
+-----------
+ t
+(1 row)
+
+SELECT perl2text('');
+ perl2text 
+-----------
+ f
+(1 row)
+
+SELECT perl2undef() IS NULL AS p;
+ p 
+---
+ t
+(1 row)
+
+ --- test transforming to perl 
+CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+my ($x, $y, $z) = @_;
+if(defined($z)) {
+die("NULL mistransformed");
+}
+if(!defined($x)) {
+die("TRUE mistransformed to UNDEF");
+}
+if(!defined($y)) {
+die("FALSE mistransformed to UNDEF");
+}
+if(!$x) {
+die("TRUE mistransformed");
+}
+if($y) {
+die("FALSE mistransformed");
+}
+$$;
+SELECT bool2perl (true, false, NULL);
+ bool2perl 
+-----------
+ 
+(1 row)
+
+ --- test selecting bool through SPI
+CREATE FUNCTION spi_test()  RETURNS void
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0];
+if(! defined ($rv->{t})) {
+die("TRUE mistransformed to UNDEF in SPI");
+}
+if(! defined ($rv->{f})) {
+die("FALSE mistransformed to UNDEF in SPI");
+}
+if( defined ($rv->{n})) {
+die("NULL mistransformed in SPI");
+}
+if(! $rv->{t} ) {
+die("TRUE mistransformed in SPI");
+}
+if(  $rv->{f} ) {
+die("FALSE mistransformed in SPI");
+}
+$$;
+SELECT spi_test();
+ spi_test 
+----------
+ 
+(1 row)
+
+\set VERBOSITY terse \\ -- suppress cascade details
+DROP EXTENSION plperlu CASCADE;
+NOTICE:  drop cascades to 6 other objects
diff --git a/contrib/bool_plperl/sql/bool_plperl.sql b/contrib/bool_plperl/sql/bool_plperl.sql
new file mode 100644
index 0000000000..8d1e4a6c2c
--- /dev/null
+++ b/contrib/bool_plperl/sql/bool_plperl.sql
@@ -0,0 +1,83 @@
+CREATE EXTENSION bool_plperl CASCADE;
+
+ --- test transforming from perl 
+CREATE FUNCTION perl2int(int) RETURNS bool
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+
+CREATE FUNCTION perl2text(text) RETURNS bool
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+
+CREATE FUNCTION perl2undef() RETURNS bool
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+return undef;
+$$;
+
+SELECT perl2int(1);
+SELECT perl2int(0);
+SELECT perl2text('foo');
+SELECT perl2text('');
+SELECT perl2undef() IS NULL AS p;
+
+ --- test transforming to perl 
+CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+my ($x, $y, $z) = @_;
+if(defined($z)) {
+die("NULL mistransformed");
+}
+if(!defined($x)) {
+die("TRUE mistransformed to UNDEF");
+}
+if(!defined($y)) {
+die("FALSE mistransformed to UNDEF");
+}
+if(!$x) {
+die("TRUE mistransformed");
+}
+if($y) {
+die("FALSE mistransformed");
+}
+$$;
+
+SELECT bool2perl (true, false, NULL);
+
+ --- test selecting bool through SPI
+
+CREATE FUNCTION spi_test()  RETURNS void
+LANGUAGE plperl
+TRANSFORM FOR TYPE bool
+AS $$
+my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0];
+if(! defined ($rv->{t})) {
+die("TRUE mistransformed to UNDEF in SPI");
+}
+if(! defined ($rv->{f})) {
+die("FALSE mistransformed to UNDEF in SPI");
+}
+if( defined ($rv->{n})) {
+die("NULL mistransformed in SPI");
+}
+if(! $rv->{t} ) {
+die("TRUE mistransformed in SPI");
+}
+if(  $rv->{f} ) {
+die("FALSE mistransformed in SPI");
+}
+$$;
+
+SELECT spi_test();
+
+\set VERBOSITY terse \\ -- suppress cascade details
+DROP EXTENSION plperl CASCADE;
diff --git a/contrib/bool_plperl/sql/bool_plperlu.sql b/contrib/bool_plperl/sql/bool_plperlu.sql
new file mode 100644
index 0000000000..f7ce247988
--- /dev/null
+++ b/contrib/bool_plperl/sql/bool_plperlu.sql
@@ -0,0 +1,83 @@
+CREATE EXTENSION bool_plperlu CASCADE;
+
+ --- test transforming from perl
+CREATE FUNCTION perl2int(int) RETURNS bool
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+
+CREATE FUNCTION perl2text(text) RETURNS bool
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+return shift;
+$$;
+
+CREATE FUNCTION perl2undef() RETURNS bool
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+return undef;
+$$;
+
+SELECT perl2int(1);
+SELECT perl2int(0);
+SELECT perl2text('foo');
+SELECT perl2text('');
+SELECT perl2undef() IS NULL AS p;
+
+ --- test transforming to perl 
+CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+my ($x, $y, $z) = @_;
+if(defined($z)) {
+die("NULL mistransformed");
+}
+if(!defined($x)) {
+die("TRUE mistransformed to UNDEF");
+}
+if(!defined($y)) {
+die("FALSE mistransformed to UNDEF");
+}
+if(!$x) {
+die("TRUE mistransformed");
+}
+if($y) {
+die("FALSE mistransformed");
+}
+$$;
+
+SELECT bool2perl (true, false, NULL);
+
+ --- test selecting bool through SPI
+
+CREATE FUNCTION spi_test()  RETURNS void
+LANGUAGE plperlu
+TRANSFORM FOR TYPE bool
+AS $$
+my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0];
+if(! defined ($rv->{t})) {
+die("TRUE mistransformed to UNDEF in SPI");
+}
+if(! defined ($rv->{f})) {
+die("FALSE mistransformed to UNDEF in SPI");
+}
+if( defined ($rv->{n})) {
+die("NULL mistransformed in SPI");
+}
+if(! $rv->{t} ) {
+die("TRUE mistransformed in SPI");
+}
+if(  $rv->{f} ) {
+die("FALSE mistransformed in SPI");
+}
+$$;
+
+SELECT spi_test();
+
+\set VERBOSITY terse \\ -- suppress cascade details
+DROP EXTENSION plperlu CASCADE;

#10

Tom Lane

tgl@sss.pgh.pa.us

almost 6 years ago

In reply to: Ivan Panchenko (#9)

Re: Re[4]: bool_plperl transform

=?UTF-8?B?SXZhbiBQYW5jaGVua28=?= <wao@mail.ru> writes:

[ bool_plperl_transform_v3.patch ]

I reviewed this, fixed some minor problems (mostly cosmetic, but not
entirely), and pushed it.

Thanks for the contribution!

regards, tom lane

#11

Ivan Panchenko

wao@mail.ru

almost 6 years ago

In reply to: Tom Lane (#10)

Re[6]: bool_plperl transform

Tom,

Суббота, 7 марта 2020, 1:15 +03:00 от Tom Lane <tgl@sss.pgh.pa.us>:

=?UTF-8?B?SXZhbiBQYW5jaGVua28=?= < wao@mail.ru > writes:

[ bool_plperl_transform_v3.patch ]

I reviewed this, fixed some minor problems (mostly cosmetic, but not
entirely), and pushed it.

Thanks for the commit and for your work improving the patch.

Do you think the jsonb transform is worth explicit mentioning at the PL/Perl documentation page, or not?

Thanks for the contribution!

regards, tom lane

Regards,
Ivan

#12

Tom Lane

tgl@sss.pgh.pa.us

almost 6 years ago

In reply to: Ivan Panchenko (#11)

Re: Re[6]: bool_plperl transform

=?UTF-8?B?SXZhbiBQYW5jaGVua28=?= <wao@mail.ru> writes:

Do you think the jsonb transform is worth explicit mentioning at the PL/Perl documentation page, or not?

Right now it's documented under the json data types, which seems
sufficient to me.

regards, tom lane