>Friday, 14 July 2023, 23:27 +03:00 от Tom Lane <t...@sss.pgh.pa.us>:
> 
>=?UTF-8?B?SXZhbiBQYW5jaGVua28=?= < w...@mail.ru > writes:
>> Четверг, 6 июля 2023, 14:48 +03:00 от Peter Eisentraut <  
>> pe...@eisentraut.org >:
>>> If the transform deals with a built-in type, then they should just be
>>> added to the respective pl extension directly.
>
>> The new extension bytea_plperl can be easily moved into plperl now, but what 
>> should be do with the existing ones, namely jsonb_plperl and bool_plperl ?
>> If we leave them where they are, it would be hard to explain why some 
>> transforms are inside plperl while other ones live separately. If we move 
>> them into plperl also, wouldn’t it break some compatibility?
>
>It's kind of a mess, indeed. But I think we could make plperl 1.1
>contain the additional transforms and just tell people they have
>to drop the obsolete extensions before they upgrade to 1.1.
>Fortunately, it doesn't look like functions using a transform
>have any hard dependency on the transform, so "drop extension
>jsonb_plperl" followed by "alter extension plperl update" should
>work without cascading to all your plperl functions.
>
>Having said that, we'd still be in the position of having to
>explain why some transforms are packaged with plperl and others
>not. The distinction between built-in and contrib types might
>be obvious to us hackers, but I bet a lot of users see it as
>pretty artificial. So maybe the existing packaging design is
>fine and we should just look for a way to reduce the code
>duplication.
The code duplication between different transforms is not in C code, but mostly 
in copy-pasted Makefile, *.control, *.sql and meson-build. These files could be 
generated from some universal templates. But, keeping in mind Windows 
compatibility and presence of three build system, this hardly looks like a 
simplification.
Probably at present time it would be better to keep the existing code 
duplication until plperl 1.1.
Nevertheless, dealing with code duplication is a wider task than the bytea 
transform, so let me suggest to keep this extension in the present form. If we 
decide what to do with the duplication, it would be another patch.

The mesonified and rebased version of the transform patch is attached.
>
>regards, tom lane
> 
Regards, Ivan
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/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..7ff16040c9
--- /dev/null
+++ b/contrib/bytea_plperl/bytea_plperl.c
@@ -0,0 +1,36 @@
+/*
+ * contrib/bytea_plperl/bytea_plperl.c
+ */
+
+#include "postgres.h"
+
+#include "fmgr.h"
+#include "plperl.h"
+#include "varatt.h"
+
+PG_MODULE_MAGIC;
+
+PG_FUNCTION_INFO_V1(bytea_to_plperl);
+PG_FUNCTION_INFO_V1(plperl_to_bytea);
+
+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 ));
+}
+
+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/meson.build b/contrib/bytea_plperl/meson.build
new file mode 100644
index 0000000000..3c438c2175
--- /dev/null
+++ b/contrib/bytea_plperl/meson.build
@@ -0,0 +1,51 @@
+# Copyright (c) 2023, PostgreSQL Global Development Group
+
+if not perl_dep.found()
+  subdir_done()
+endif
+
+bytea_plperl_sources = files(
+  'bytea_plperl.c',
+)
+
+if host_system == 'windows'
+  bytea_plperl_sources += rc_lib_gen.process(win32ver_rc, extra_args: [
+    '--NAME', 'bytea_plperl',
+    '--FILEDESC', 'bytea_plperl - bytea transform for plperl',])
+endif
+
+bytea_plperl = shared_module('bytea_plperl',
+  bytea_plperl_sources,
+  include_directories: [plperl_inc],
+  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 += bytea_plperl
+
+install_data(
+  'bytea_plperl.control',
+  'bytea_plperl--1.0.sql',
+  kwargs: contrib_data_args,
+)
+
+install_data(
+  'bytea_plperlu.control',
+  'bytea_plperlu--1.0.sql',
+  kwargs: contrib_data_args,
+)
+
+
+tests += {
+  'name': 'bytea_plperl',
+  'sd': meson.current_source_dir(),
+  'bd': meson.current_build_dir(),
+  'regress': {
+    'sql': [
+      'bytea_plperl',
+      'bytea_plperlu',
+    ],
+  },
+}
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/contrib/meson.build b/contrib/meson.build
index bd4a57c43c..10524d9323 100644
--- a/contrib/meson.build
+++ b/contrib/meson.build
@@ -17,6 +17,7 @@ subdir('basebackup_to_shell')
 subdir('bool_plperl')
 subdir('btree_gin')
 subdir('btree_gist')
+subdir('bytea_plperl')
 subdir('citext')
 subdir('cube')
 subdir('dblink')
diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml
index 25b1077ad7..eea293eaec 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; -- or bool_plperlu for PL/PerlU
+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 9e05eb91b1..ec0a3f8097 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',
@@ -791,6 +791,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',
@@ -802,6 +805,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);
 		}

Reply via email to