12 files changed, 538 insertions, 0 deletions
diff --git a/contrib/bool_plperl/.gitignore b/contrib/bool_plperl/.gitignore
new file mode 100644
index 0000000..5dcb3ff
--- /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 0000000..efe1de9
--- /dev/null
+++ b/contrib/bool_plperl/Makefile
@@ -0,0 +1,39 @@
+# contrib/bool_plperl/Makefile
+
+MODULE_big = bool_plperl
+OBJS = \
+	$(WIN32RES) \
+	bool_plperl.o
+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
+
+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 0000000..00dc3b8
--- /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 0000000..0fa1eee
--- /dev/null
+++ b/contrib/bool_plperl/bool_plperl.c
@@ -0,0 +1,30 @@
+#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;
+	bool		in = PG_GETARG_BOOL(0);
+
+	return PointerGetDatum(in ? &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 0000000..af3e6b1
--- /dev/null
+++ b/contrib/bool_plperl/bool_plperl.control
@@ -0,0 +1,7 @@
+# bool_plperl extension
+comment = 'transform between bool and plperl'
+default_version = '1.0'
+module_pathname = '$libdir/bool_plperl'
+relocatable = true
+trusted = 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 0000000..52c55b6
--- /dev/null
+++ b/contrib/bool_plperl/bool_plperlu--1.0.sql
@@ -0,0 +1,19 @@
+/* contrib/bool_plperl/bool_plperlu--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 0000000..d03a584
--- /dev/null
+++ b/contrib/bool_plperl/bool_plperlu.control
@@ -0,0 +1,6 @@
+# bool_plperlu 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 0000000..187df8d
--- /dev/null
+++ b/contrib/bool_plperl/expected/bool_plperl.out
@@ -0,0 +1,112 @@
+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, for type boolean  -- duplicate to test ruleutils
+AS $$
+my ($x, $y, $z) = @_;
+
+die("NULL mistransformed") if (defined($z));
+die("TRUE mistransformed to UNDEF") if (!defined($x));
+die("FALSE mistransformed to UNDEF") if (!defined($y));
+die("TRUE mistransformed") if (!$x);
+die("FALSE mistransformed") if ($y);
+$$;
+SELECT bool2perl (true, false, NULL);
+ bool2perl 
+-----------
+ 
+(1 row)
+
+--- test ruleutils
+\sf bool2perl
+CREATE OR REPLACE FUNCTION public.bool2perl(boolean, boolean, boolean)
+ RETURNS void
+ TRANSFORM FOR TYPE boolean, FOR TYPE boolean
+ LANGUAGE plperl
+AS $function$
+my ($x, $y, $z) = @_;
+
+die("NULL mistransformed") if (defined($z));
+die("TRUE mistransformed to UNDEF") if (!defined($x));
+die("FALSE mistransformed to UNDEF") if (!defined($y));
+die("TRUE mistransformed") if (!$x);
+die("FALSE mistransformed") if ($y);
+$function$
+--- 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];
+
+die("TRUE mistransformed to UNDEF in SPI") if (!defined ($rv->{t}));
+die("FALSE mistransformed to UNDEF in SPI") if (!defined ($rv->{f}));
+die("NULL mistransformed in SPI") if (defined ($rv->{n}));
+die("TRUE mistransformed in SPI") if (!$rv->{t});
+die("FALSE mistransformed in SPI") if ($rv->{f});
+$$;
+SELECT spi_test();
+ spi_test 
+----------
+ 
+(1 row)
+
+DROP EXTENSION plperl CASCADE;
+NOTICE:  drop cascades to 6 other objects
+DETAIL:  drop cascades to function spi_test()
+drop cascades to extension bool_plperl
+drop cascades to function perl2int(integer)
+drop cascades to function perl2text(text)
+drop cascades to function perl2undef()
+drop cascades to function bool2perl(boolean,boolean,boolean)
diff --git a/contrib/bool_plperl/expected/bool_plperlu.out b/contrib/bool_plperl/expected/bool_plperlu.out
new file mode 100644
index 0000000..8337d33
--- /dev/null
+++ b/contrib/bool_plperl/expected/bool_plperlu.out
@@ -0,0 +1,112 @@
+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, for type boolean  -- duplicate to test ruleutils
+AS $$
+my ($x, $y, $z) = @_;
+
+die("NULL mistransformed") if (defined($z));
+die("TRUE mistransformed to UNDEF") if (!defined($x));
+die("FALSE mistransformed to UNDEF") if (!defined($y));
+die("TRUE mistransformed") if (!$x);
+die("FALSE mistransformed") if ($y);
+$$;
+SELECT bool2perl (true, false, NULL);
+ bool2perl 
+-----------
+ 
+(1 row)
+
+--- test ruleutils
+\sf bool2perl
+CREATE OR REPLACE FUNCTION public.bool2perl(boolean, boolean, boolean)
+ RETURNS void
+ TRANSFORM FOR TYPE boolean, FOR TYPE boolean
+ LANGUAGE plperlu
+AS $function$
+my ($x, $y, $z) = @_;
+
+die("NULL mistransformed") if (defined($z));
+die("TRUE mistransformed to UNDEF") if (!defined($x));
+die("FALSE mistransformed to UNDEF") if (!defined($y));
+die("TRUE mistransformed") if (!$x);
+die("FALSE mistransformed") if ($y);
+$function$
+--- 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];
+
+die("TRUE mistransformed to UNDEF in SPI") if (!defined ($rv->{t}));
+die("FALSE mistransformed to UNDEF in SPI") if (!defined ($rv->{f}));
+die("NULL mistransformed in SPI") if (defined ($rv->{n}));
+die("TRUE mistransformed in SPI") if (!$rv->{t});
+die("FALSE mistransformed in SPI") if ($rv->{f});
+$$;
+SELECT spi_test();
+ spi_test 
+----------
+ 
+(1 row)
+
+DROP EXTENSION plperlu CASCADE;
+NOTICE:  drop cascades to 6 other objects
+DETAIL:  drop cascades to function spi_test()
+drop cascades to extension bool_plperlu
+drop cascades to function perl2int(integer)
+drop cascades to function perl2text(text)
+drop cascades to function perl2undef()
+drop cascades to function bool2perl(boolean,boolean,boolean)
diff --git a/contrib/bool_plperl/meson.build b/contrib/bool_plperl/meson.build
new file mode 100644
index 0000000..8d29d33
--- /dev/null
+++ b/contrib/bool_plperl/meson.build
@@ -0,0 +1,50 @@
+# Copyright (c) 2022-2023, PostgreSQL Global Development Group
+
+if not perl_dep.found()
+  subdir_done()
+endif
+
+bool_plperl_sources = files(
+  'bool_plperl.c',
+)
+
+if host_system == 'windows'
+  bool_plperl_sources += rc_lib_gen.process(win32ver_rc, extra_args: [
+    '--NAME', 'bool_plperl',
+    '--FILEDESC', 'bool_plperl - bool transform for plperl',])
+endif
+
+bool_plperl = shared_module('bool_plperl',
+  bool_plperl_sources,
+  include_directories: [plperl_inc, include_directories('.')],
+  kwargs: contrib_mod_args + {
+    'dependencies': [perl_dep, contrib_mod_args['dependencies']],
+    'install_rpath': ':'.join(mod_install_rpaths + ['@0@/CORE'.format(archlibexp)]),
+    'build_rpath': '@0@/CORE'.format(archlibexp),
+  },
+)
+contrib_targets += bool_plperl
+
+install_data(
+  'bool_plperl.control',
+  'bool_plperl--1.0.sql',
+  kwargs: contrib_data_args,
+)
+
+install_data(
+  'bool_plperlu.control',
+  'bool_plperlu--1.0.sql',
+  kwargs: contrib_data_args,
+)
+
+tests += {
+  'name': 'bool_plperl',
+  'sd': meson.current_source_dir(),
+  'bd': meson.current_build_dir(),
+  'regress': {
+    'sql': [
+      'bool_plperl',
+      'bool_plperlu',
+    ],
+  },
+}
diff --git a/contrib/bool_plperl/sql/bool_plperl.sql b/contrib/bool_plperl/sql/bool_plperl.sql
new file mode 100644
index 0000000..b7f5708
--- /dev/null
+++ b/contrib/bool_plperl/sql/bool_plperl.sql
@@ -0,0 +1,70 @@
+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, for type boolean  -- duplicate to test ruleutils
+AS $$
+my ($x, $y, $z) = @_;
+
+die("NULL mistransformed") if (defined($z));
+die("TRUE mistransformed to UNDEF") if (!defined($x));
+die("FALSE mistransformed to UNDEF") if (!defined($y));
+die("TRUE mistransformed") if (!$x);
+die("FALSE mistransformed") if ($y);
+$$;
+
+SELECT bool2perl (true, false, NULL);
+
+--- test ruleutils
+
+\sf bool2perl
+
+--- 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];
+
+die("TRUE mistransformed to UNDEF in SPI") if (!defined ($rv->{t}));
+die("FALSE mistransformed to UNDEF in SPI") if (!defined ($rv->{f}));
+die("NULL mistransformed in SPI") if (defined ($rv->{n}));
+die("TRUE mistransformed in SPI") if (!$rv->{t});
+die("FALSE mistransformed in SPI") if ($rv->{f});
+$$;
+
+SELECT spi_test();
+
+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 0000000..1480a04
--- /dev/null
+++ b/contrib/bool_plperl/sql/bool_plperlu.sql
@@ -0,0 +1,70 @@
+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, for type boolean  -- duplicate to test ruleutils
+AS $$
+my ($x, $y, $z) = @_;
+
+die("NULL mistransformed") if (defined($z));
+die("TRUE mistransformed to UNDEF") if (!defined($x));
+die("FALSE mistransformed to UNDEF") if (!defined($y));
+die("TRUE mistransformed") if (!$x);
+die("FALSE mistransformed") if ($y);
+$$;
+
+SELECT bool2perl (true, false, NULL);
+
+--- test ruleutils
+
+\sf bool2perl
+
+--- 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];
+
+die("TRUE mistransformed to UNDEF in SPI") if (!defined ($rv->{t}));
+die("FALSE mistransformed to UNDEF in SPI") if (!defined ($rv->{f}));
+die("NULL mistransformed in SPI") if (defined ($rv->{n}));
+die("TRUE mistransformed in SPI") if (!$rv->{t});
+die("FALSE mistransformed in SPI") if ($rv->{f});
+$$;
+
+SELECT spi_test();
+
+DROP EXTENSION plperlu CASCADE;