From aabaf4f5932f59de2fed48bbba7339807a1f04bd Mon Sep 17 00:00:00 2001 From: "okbob@github.com" Date: Tue, 30 Jan 2024 10:31:00 +0100 Subject: [PATCH v2] Add bytea transformation for plperl --- contrib/Makefile | 4 +- contrib/bytea_plperl/.gitignore | 4 ++ contrib/bytea_plperl/Makefile | 39 ++++++++++++++ contrib/bytea_plperl/bytea_plperl--1.0.sql | 19 +++++++ contrib/bytea_plperl/bytea_plperl.c | 44 ++++++++++++++++ contrib/bytea_plperl/bytea_plperl.control | 7 +++ contrib/bytea_plperl/bytea_plperlu--1.0.sql | 19 +++++++ contrib/bytea_plperl/bytea_plperlu.control | 6 +++ .../bytea_plperl/expected/bytea_plperl.out | 49 ++++++++++++++++++ .../bytea_plperl/expected/bytea_plperlu.out | 49 ++++++++++++++++++ contrib/bytea_plperl/meson.build | 51 +++++++++++++++++++ contrib/bytea_plperl/sql/bytea_plperl.sql | 31 +++++++++++ contrib/bytea_plperl/sql/bytea_plperlu.sql | 31 +++++++++++ contrib/meson.build | 1 + doc/src/sgml/plperl.sgml | 16 ++++++ 15 files changed, 368 insertions(+), 2 deletions(-) create mode 100644 contrib/bytea_plperl/.gitignore create mode 100644 contrib/bytea_plperl/Makefile create mode 100644 contrib/bytea_plperl/bytea_plperl--1.0.sql create mode 100644 contrib/bytea_plperl/bytea_plperl.c create mode 100644 contrib/bytea_plperl/bytea_plperl.control create mode 100644 contrib/bytea_plperl/bytea_plperlu--1.0.sql create mode 100644 contrib/bytea_plperl/bytea_plperlu.control create mode 100644 contrib/bytea_plperl/expected/bytea_plperl.out create mode 100644 contrib/bytea_plperl/expected/bytea_plperlu.out create mode 100644 contrib/bytea_plperl/meson.build create mode 100644 contrib/bytea_plperl/sql/bytea_plperl.sql create mode 100644 contrib/bytea_plperl/sql/bytea_plperlu.sql diff --git a/contrib/Makefile b/contrib/Makefile index da4e2316a3..56c628df00 100644 --- a/contrib/Makefile +++ b/contrib/Makefile @@ -77,9 +77,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/.gitignore b/contrib/bytea_plperl/.gitignore new file mode 100644 index 0000000000..5dcb3ff972 --- /dev/null +++ b/contrib/bytea_plperl/.gitignore @@ -0,0 +1,4 @@ +# Generated subdirectories +/log/ +/results/ +/tmp_check/ 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..5a0c58d8ab --- /dev/null +++ b/contrib/bytea_plperl/bytea_plperl.c @@ -0,0 +1,44 @@ +/* + * 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; + char *ptr; + SV *in; + + in = (SV *) PG_GETARG_POINTER(0); + + 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..99fe3aadce --- /dev/null +++ b/contrib/bytea_plperl/expected/bytea_plperl.out @@ -0,0 +1,49 @@ +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) + +CREATE FUNCTION plperl_bytea_overload() RETURNS bytea LANGUAGE plperl + TRANSFORM FOR TYPE bytea + AS $$ + package StringOverload { use overload '""' => sub { "stuff" }; } + return bless {}, "StringOverload"; + $$; +SELECT encode(plperl_bytea_overload(), 'escape') string; + string +-------- + stuff +(1 row) + +DROP EXTENSION plperl CASCADE; +NOTICE: drop cascades to 4 other objects +DETAIL: drop cascades to extension bytea_plperl +drop cascades to function cat_bytea(bytea) +drop cascades to function perl_inverse_bytes(bytea) +drop cascades to function plperl_bytea_overload() diff --git a/contrib/bytea_plperl/expected/bytea_plperlu.out b/contrib/bytea_plperl/expected/bytea_plperlu.out new file mode 100644 index 0000000000..6402685036 --- /dev/null +++ b/contrib/bytea_plperl/expected/bytea_plperlu.out @@ -0,0 +1,49 @@ +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) + +CREATE FUNCTION plperlu_bytea_overload() RETURNS bytea LANGUAGE plperlu + TRANSFORM FOR TYPE bytea + AS $$ + package StringOverload { use overload '""' => sub { "stuff" }; } + return bless {}, "StringOverload"; + $$; +SELECT encode(plperlu_bytea_overload(), 'escape') string; + string +-------- + stuff +(1 row) + +DROP EXTENSION plperlu CASCADE; +NOTICE: drop cascades to 4 other objects +DETAIL: drop cascades to extension bytea_plperlu +drop cascades to function cat_bytea(bytea) +drop cascades to function perlu_inverse_bytes(bytea) +drop cascades to function plperlu_bytea_overload() 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..0836290244 --- /dev/null +++ b/contrib/bytea_plperl/sql/bytea_plperl.sql @@ -0,0 +1,31 @@ +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); + +CREATE FUNCTION plperl_bytea_overload() RETURNS bytea LANGUAGE plperl + TRANSFORM FOR TYPE bytea + AS $$ + package StringOverload { use overload '""' => sub { "stuff" }; } + return bless {}, "StringOverload"; + $$; + +SELECT encode(plperl_bytea_overload(), 'escape') string; + +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..4bbd697f32 --- /dev/null +++ b/contrib/bytea_plperl/sql/bytea_plperlu.sql @@ -0,0 +1,31 @@ +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); + +CREATE FUNCTION plperlu_bytea_overload() RETURNS bytea LANGUAGE plperlu + TRANSFORM FOR TYPE bytea + AS $$ + package StringOverload { use overload '""' => sub { "stuff" }; } + return bless {}, "StringOverload"; + $$; + +SELECT encode(plperlu_bytea_overload(), 'escape') string; + +DROP EXTENSION plperlu CASCADE; diff --git a/contrib/meson.build b/contrib/meson.build index c12dc906ca..7fe53fafeb 100644 --- a/contrib/meson.build +++ b/contrib/meson.build @@ -22,6 +22,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 @@ (). + + 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: -- 2.39.2