Subject: Bytea PL/Perl transform

From: Иван Панченко <[email-masked]>
Date: Sun, 19 Mar 2023 01:25:27 +0300

Hi,
PostgreSQL passes bytea arguments to PL/Perl functions as hexadecimal strings, which is not only inconvenient, but also memory and time consuming.
So I decided to propose a simple transform extension to pass bytea as native Perl octet strings.
Please find the patch attached.
 
Regards,
Ivan Panchenko

diff --git a/contrib/Makefile b/contrib/Makefile
index bbf220407b..bb997dda69 100644
--- a/contrib/Makefile
+++ b/contrib/Makefile
@@ -78,9 +78,9 @@ ALWAYS_SUBDIRS += sepgsql
 endif
 
 ifeq ($(with_perl),yes)
-SUBDIRS += bool_plperl hstore_plperl jsonb_plperl
+SUBDIRS += bool_plperl bytea_plperl hstore_plperl jsonb_plperl
 else
-ALWAYS_SUBDIRS += bool_plperl hstore_plperl jsonb_plperl
+ALWAYS_SUBDIRS += bool_plperl bytea_plperl hstore_plperl jsonb_plperl
 endif
 
 ifeq ($(with_python),yes)
diff --git a/contrib/bytea_plperl/Makefile b/contrib/bytea_plperl/Makefile
new file mode 100644
index 0000000000..1814d2f418
--- /dev/null
+++ b/contrib/bytea_plperl/Makefile
@@ -0,0 +1,39 @@
+# contrib/bytea_plperl/Makefile
+
+MODULE_big = bytea_plperl
+OBJS = \
+	$(WIN32RES) \
+	bytea_plperl.o
+PGFILEDESC = "bytea_plperl - bytea transform for plperl"
+
+PG_CPPFLAGS = -I$(top_srcdir)/src/pl/plperl
+
+EXTENSION = bytea_plperlu bytea_plperl
+DATA = bytea_plperlu--1.0.sql bytea_plperl--1.0.sql
+
+REGRESS = bytea_plperl bytea_plperlu
+
+ifdef USE_PGXS
+PG_CONFIG = pg_config
+PGXS := $(shell $(PG_CONFIG) --pgxs)
+include $(PGXS)
+else
+subdir = contrib/bytea_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/bytea_plperl/bytea_plperl--1.0.sql b/contrib/bytea_plperl/bytea_plperl--1.0.sql
new file mode 100644
index 0000000000..6544b2ac85
--- /dev/null
+++ b/contrib/bytea_plperl/bytea_plperl--1.0.sql
@@ -0,0 +1,19 @@
+/* contrib/bytea_plperl/bytea_plperl--1.0.sql */
+
+-- complain if script is sourced in psql, rather than via CREATE EXTENSION
+\echo Use "CREATE EXTENSION bytea_plperl" to load this file. \quit
+
+CREATE FUNCTION bytea_to_plperl(val internal) RETURNS internal
+LANGUAGE C STRICT IMMUTABLE
+AS 'MODULE_PATHNAME';
+
+CREATE FUNCTION plperl_to_bytea(val internal) RETURNS bytea
+LANGUAGE C STRICT IMMUTABLE
+AS 'MODULE_PATHNAME';
+
+CREATE TRANSFORM FOR bytea LANGUAGE plperl (
+    FROM SQL WITH FUNCTION bytea_to_plperl(internal),
+    TO SQL WITH FUNCTION plperl_to_bytea(internal)
+);
+
+COMMENT ON TRANSFORM FOR bytea LANGUAGE plperl IS 'transform between bytea and Perl';
diff --git a/contrib/bytea_plperl/bytea_plperl.c b/contrib/bytea_plperl/bytea_plperl.c
new file mode 100644
index 0000000000..0e20761b69
--- /dev/null
+++ b/contrib/bytea_plperl/bytea_plperl.c
@@ -0,0 +1,36 @@
+#include "postgres.h"
+
+#include "fmgr.h"
+#include "plperl.h"
+#include "varatt.h"
+
+PG_MODULE_MAGIC;
+
+PG_FUNCTION_INFO_V1(bytea_to_plperl);
+
+Datum
+bytea_to_plperl(PG_FUNCTION_ARGS)
+{
+	dTHX;
+	bytea *in = PG_GETARG_BYTEA_PP(0);
+	return PointerGetDatum(newSVpvn_flags( (char *) VARDATA_ANY(in), VARSIZE_ANY_EXHDR(in), 0 ));
+}
+
+
+PG_FUNCTION_INFO_V1(plperl_to_bytea);
+
+Datum
+plperl_to_bytea(PG_FUNCTION_ARGS)
+{
+	dTHX;
+	bytea *result;
+	STRLEN len;
+	SV *in = (SV *) PG_GETARG_POINTER(0);
+	char *ptr = SvPVbyte(in, len);
+	result = palloc(VARHDRSZ + len );
+	SET_VARSIZE(result, VARHDRSZ + len );
+	memcpy(VARDATA_ANY(result), ptr,len );
+	PG_RETURN_BYTEA_P(result);
+}
+
+
diff --git a/contrib/bytea_plperl/bytea_plperl.control b/contrib/bytea_plperl/bytea_plperl.control
new file mode 100644
index 0000000000..9ff0f2a8dd
--- /dev/null
+++ b/contrib/bytea_plperl/bytea_plperl.control
@@ -0,0 +1,7 @@
+# bytea_plperl extension
+comment = 'transform between bytea and plperl'
+default_version = '1.0'
+module_pathname = '$libdir/bytea_plperl'
+relocatable = true
+trusted = true
+requires = 'plperl'
diff --git a/contrib/bytea_plperl/bytea_plperlu--1.0.sql b/contrib/bytea_plperl/bytea_plperlu--1.0.sql
new file mode 100644
index 0000000000..d43e8fbaf4
--- /dev/null
+++ b/contrib/bytea_plperl/bytea_plperlu--1.0.sql
@@ -0,0 +1,19 @@
+/* contrib/bytea_plperl/bytea_plperlu--1.0.sql */
+
+-- complain if script is sourced in psql, rather than via CREATE EXTENSION
+\echo Use "CREATE EXTENSION bytea_plperlu" to load this file. \quit
+
+CREATE FUNCTION bytea_to_plperlu(val internal) RETURNS internal
+LANGUAGE C STRICT IMMUTABLE
+AS 'MODULE_PATHNAME', 'bytea_to_plperl';
+
+CREATE FUNCTION plperlu_to_bytea(val internal) RETURNS bytea
+LANGUAGE C STRICT IMMUTABLE
+AS 'MODULE_PATHNAME', 'plperl_to_bytea';
+
+CREATE TRANSFORM FOR bytea LANGUAGE plperlu (
+    FROM SQL WITH FUNCTION bytea_to_plperlu(internal),
+    TO SQL WITH FUNCTION plperlu_to_bytea(internal)
+);
+
+COMMENT ON TRANSFORM FOR bytea LANGUAGE plperlu IS 'transform between bytea and Perl';
diff --git a/contrib/bytea_plperl/bytea_plperlu.control b/contrib/bytea_plperl/bytea_plperlu.control
new file mode 100644
index 0000000000..96cc8c35fb
--- /dev/null
+++ b/contrib/bytea_plperl/bytea_plperlu.control
@@ -0,0 +1,6 @@
+# bytea_plperlu extension
+comment = 'transform between bytea and plperlu'
+default_version = '1.0'
+module_pathname = '$libdir/bytea_plperl'
+relocatable = true
+requires = 'plperlu'
diff --git a/contrib/bytea_plperl/expected/bytea_plperl.out b/contrib/bytea_plperl/expected/bytea_plperl.out
new file mode 100644
index 0000000000..eb6fceb9e0
--- /dev/null
+++ b/contrib/bytea_plperl/expected/bytea_plperl.out
@@ -0,0 +1,36 @@
+CREATE EXTENSION bytea_plperl CASCADE;
+NOTICE:  installing required extension "plperl"
+CREATE FUNCTION cat_bytea(bytea) RETURNS bytea LANGUAGE plperl
+ TRANSFORM FOR TYPE bytea
+ AS $$
+    return $_[0];
+ $$;
+SELECT data = cat_bytea(data)
+    FROM (
+        SELECT decode(repeat(unnest(ARRAY[ 'a','abc', 'abcd', 'abcdefgh\000ijkl12' , '爱' ]), 10000), 'escape') data
+    ) line;
+ ?column? 
+----------
+ t
+ t
+ t
+ t
+ t
+(5 rows)
+
+CREATE FUNCTION perl_inverse_bytes(bytea) RETURNS bytea
+TRANSFORM FOR TYPE bytea
+AS $$
+	return join '', reverse split('', $_[0]);
+$$ LANGUAGE plperl;
+SELECT 'ξενία'::bytea, perl_inverse_bytes('ξενία'::bytea);
+         bytea          |   perl_inverse_bytes   
+------------------------+------------------------
+ \xcebeceb5cebdceafceb1 | \xb1ceafcebdceb5cebece
+(1 row)
+
+DROP EXTENSION plperl CASCADE;
+NOTICE:  drop cascades to 3 other objects
+DETAIL:  drop cascades to extension bytea_plperl
+drop cascades to function cat_bytea(bytea)
+drop cascades to function perl_inverse_bytes(bytea)
diff --git a/contrib/bytea_plperl/expected/bytea_plperlu.out b/contrib/bytea_plperl/expected/bytea_plperlu.out
new file mode 100644
index 0000000000..4b69eaffb1
--- /dev/null
+++ b/contrib/bytea_plperl/expected/bytea_plperlu.out
@@ -0,0 +1,36 @@
+CREATE EXTENSION bytea_plperlu CASCADE;
+NOTICE:  installing required extension "plperlu"
+CREATE FUNCTION cat_bytea(bytea) RETURNS bytea LANGUAGE plperlu
+ TRANSFORM FOR TYPE bytea
+ AS $$
+    return $_[0];
+ $$;
+SELECT data = cat_bytea(data)
+    FROM (
+        SELECT decode(repeat(unnest(ARRAY[ 'a','abc', 'abcd', 'abcdefgh\000ijkl12' , '爱' ]), 10000), 'escape') data
+    ) line;
+ ?column? 
+----------
+ t
+ t
+ t
+ t
+ t
+(5 rows)
+
+CREATE FUNCTION perlu_inverse_bytes(bytea) RETURNS bytea
+TRANSFORM FOR TYPE bytea
+AS $$
+	return join '', reverse split('', $_[0]);
+$$ LANGUAGE plperlu;
+SELECT 'ξενία'::bytea, perlu_inverse_bytes('ξενία'::bytea);
+         bytea          |  perlu_inverse_bytes   
+------------------------+------------------------
+ \xcebeceb5cebdceafceb1 | \xb1ceafcebdceb5cebece
+(1 row)
+
+DROP EXTENSION plperlu CASCADE;
+NOTICE:  drop cascades to 3 other objects
+DETAIL:  drop cascades to extension bytea_plperlu
+drop cascades to function cat_bytea(bytea)
+drop cascades to function perlu_inverse_bytes(bytea)
diff --git a/contrib/bytea_plperl/sql/bytea_plperl.sql b/contrib/bytea_plperl/sql/bytea_plperl.sql
new file mode 100644
index 0000000000..67dfc973c6
--- /dev/null
+++ b/contrib/bytea_plperl/sql/bytea_plperl.sql
@@ -0,0 +1,22 @@
+CREATE EXTENSION bytea_plperl CASCADE;
+
+CREATE FUNCTION cat_bytea(bytea) RETURNS bytea LANGUAGE plperl
+ TRANSFORM FOR TYPE bytea
+ AS $$
+    return $_[0];
+ $$;
+
+SELECT data = cat_bytea(data)
+    FROM (
+        SELECT decode(repeat(unnest(ARRAY[ 'a','abc', 'abcd', 'abcdefgh\000ijkl12' , '爱' ]), 10000), 'escape') data
+    ) line;
+
+CREATE FUNCTION perl_inverse_bytes(bytea) RETURNS bytea
+TRANSFORM FOR TYPE bytea
+AS $$
+	return join '', reverse split('', $_[0]);
+$$ LANGUAGE plperl;
+
+SELECT 'ξενία'::bytea, perl_inverse_bytes('ξενία'::bytea);
+
+DROP EXTENSION plperl CASCADE;
diff --git a/contrib/bytea_plperl/sql/bytea_plperlu.sql b/contrib/bytea_plperl/sql/bytea_plperlu.sql
new file mode 100644
index 0000000000..5e47788a73
--- /dev/null
+++ b/contrib/bytea_plperl/sql/bytea_plperlu.sql
@@ -0,0 +1,22 @@
+CREATE EXTENSION bytea_plperlu CASCADE;
+
+CREATE FUNCTION cat_bytea(bytea) RETURNS bytea LANGUAGE plperlu
+ TRANSFORM FOR TYPE bytea
+ AS $$
+    return $_[0];
+ $$;
+
+SELECT data = cat_bytea(data)
+    FROM (
+        SELECT decode(repeat(unnest(ARRAY[ 'a','abc', 'abcd', 'abcdefgh\000ijkl12' , '爱' ]), 10000), 'escape') data
+    ) line;
+
+CREATE FUNCTION perlu_inverse_bytes(bytea) RETURNS bytea
+TRANSFORM FOR TYPE bytea
+AS $$
+	return join '', reverse split('', $_[0]);
+$$ LANGUAGE plperlu;
+
+SELECT 'ξενία'::bytea, perlu_inverse_bytes('ξενία'::bytea);
+
+DROP EXTENSION plperlu CASCADE;
diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml
index 6c81ee8fbe..0d4f9b4e7a 100644
--- a/doc/src/sgml/plperl.sgml
+++ b/doc/src/sgml/plperl.sgml
@@ -224,6 +224,22 @@ $$ LANGUAGE plperl;
    (<xref linkend="plperl-database"/>).
   </para>
 
+  <para>
+   Normally the <type>bytea</type> arguments are seen by Perl as strings in hex format (see
+   <xref linkend="datatype-binary"/>).
+   If the transform defined by the <filename>bytea_plperl</filename> extension is used, they are
+   passed and returned as native Perl octet strings, see example below:
+<programlisting>
+CREATE EXTENSION bytea_plperl;
+CREATE FUNCTION perl_inverse_bytes(bytea) RETURNS bytea
+TRANSFORM FOR TYPE bytea
+AS $$
+    return join '', reverse split('', $_[0]);
+$$ LANGUAGE plperl;
+</programlisting>
+
+  </para>
+
   <para>
    Perl can return <productname>PostgreSQL</productname> arrays as
    references to Perl arrays.  Here is an example:
diff --git a/src/tools/msvc/Mkvcbuild.pm b/src/tools/msvc/Mkvcbuild.pm
index e3ffc653e5..963317e3ec 100644
--- a/src/tools/msvc/Mkvcbuild.pm
+++ b/src/tools/msvc/Mkvcbuild.pm
@@ -43,7 +43,7 @@ my $contrib_extralibs      = { 'libpq_pipeline' => ['ws2_32.lib'] };
 my $contrib_extraincludes  = {};
 my $contrib_extrasource    = {};
 my @contrib_excludes       = (
-	'bool_plperl',     'commit_ts',
+	'bool_plperl',     'bytea_plperl',      'commit_ts',
 	'hstore_plperl',   'hstore_plpython',
 	'intagg',          'jsonb_plperl',
 	'jsonb_plpython',  'ltree_plpython',
@@ -789,6 +789,9 @@ sub mkvcbuild
 		my $bool_plperl = AddTransformModule(
 			'bool_plperl', 'contrib/bool_plperl',
 			'plperl',      'src/pl/plperl');
+		my $bytea_plperl = AddTransformModule(
+			'bytea_plperl', 'contrib/bytea_plperl',
+			'plperl',      'src/pl/plperl');
 		my $hstore_plperl = AddTransformModule(
 			'hstore_plperl', 'contrib/hstore_plperl',
 			'plperl',        'src/pl/plperl',
@@ -800,6 +803,7 @@ sub mkvcbuild
 		foreach my $f (@perl_embed_ccflags)
 		{
 			$bool_plperl->AddDefine($f);
+			$bytea_plperl->AddDefine($f);
 			$hstore_plperl->AddDefine($f);
 			$jsonb_plperl->AddDefine($f);
 		}