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; (). + + Normally the bytea arguments are seen by Perl as strings in hex format (see + ). + If the transform defined by the bytea_plperl extension is used, they are + passed and returned as native Perl octet strings, see example below: + +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; + + + + Perl can return PostgreSQL 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); }