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);
}
