diff --git a/contrib/Makefile b/contrib/Makefile index 92184ed487..795f69cf64 100644 --- a/contrib/Makefile +++ b/contrib/Makefile @@ -75,9 +75,9 @@ ALWAYS_SUBDIRS += sepgsql endif ifeq ($(with_perl),yes) -SUBDIRS += hstore_plperl jsonb_plperl +SUBDIRS += hstore_plperl jsonb_plperl bool_plperl else -ALWAYS_SUBDIRS += hstore_plperl jsonb_plperl +ALWAYS_SUBDIRS += hstore_plperl jsonb_plperl bool_plperl endif ifeq ($(with_python),yes) diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml index e4769c0e38..79f781a4ce 100644 --- a/doc/src/sgml/plperl.sgml +++ b/doc/src/sgml/plperl.sgml @@ -55,7 +55,10 @@ syntax: -CREATE FUNCTION funcname (argument-types) RETURNS return-type AS $$ +CREATE FUNCTION funcname (argument-types) + RETURNS return-type + -- function attributes + AS $$ # PL/Perl function body $$ LANGUAGE plperl; @@ -347,6 +350,36 @@ SELECT * FROM perl_set(); + + By default, json and jsonb values are passed to + PL/Perl functions and procedures as text. For jsonb it is + possible to convert the values into internal Perl representation automatically + using the transforms, see and . + jsonb_plperl extension provides such transform for jsonb data type. + To enable the transform, create this extension and then specify + + TRANSFORM FOR TYPE jsonb + + in the CREATE FUNCTION statement. + + + + By default, boolean values are passed to plperl as text, namely 't' + for true and 'f' for false. + To transform these values into Perl true and false values, use the transform + provided by bool_plperl extension. + To enable the transform, create this extension and then specify + + TRANSFORM FOR TYPE bool + + in the CREATE FUNCTION statement. + + + + The above mentioned jsonb and bool transforms are applied for function arguments, + its return value and results of SPI database queries performed inside the function. + + If you wish to use the strict pragma with your code you have a few options. For temporary global use you can SET diff --git a/src/tools/msvc/Mkvcbuild.pm b/src/tools/msvc/Mkvcbuild.pm index 834c2c39d1..809a2bab0d 100644 --- a/src/tools/msvc/Mkvcbuild.pm +++ b/src/tools/msvc/Mkvcbuild.pm @@ -43,6 +43,7 @@ my $contrib_extrasource = { 'seg' => [ 'contrib/seg/segscan.l', 'contrib/seg/segparse.y' ], }; my @contrib_excludes = ( + 'bool_plperl', 'commit_ts', 'hstore_plperl', 'hstore_plpython', 'intagg', 'jsonb_plperl', 'jsonb_plpython', @@ -763,6 +764,9 @@ sub mkvcbuild } # Add transform modules dependent on plperl + my $bool_plperl = AddTransformModule( + 'bool_plperl', 'contrib/bool_plperl', + 'plperl', 'src/pl/plperl'); my $hstore_plperl = AddTransformModule( 'hstore_plperl', 'contrib/hstore_plperl', 'plperl', 'src/pl/plperl', @@ -773,6 +777,7 @@ sub mkvcbuild foreach my $f (@perl_embed_ccflags) { + $bool_plperl->AddDefine($f); $hstore_plperl->AddDefine($f); $jsonb_plperl->AddDefine($f); } diff --git a/contrib/bool_plperl/.gitignore b/contrib/bool_plperl/.gitignore new file mode 100644 index 0000000000..5dcb3ff972 --- /dev/null +++ b/contrib/bool_plperl/.gitignore @@ -0,0 +1,4 @@ +# Generated subdirectories +/log/ +/results/ +/tmp_check/ diff --git a/contrib/bool_plperl/Makefile b/contrib/bool_plperl/Makefile new file mode 100644 index 0000000000..e8c174613c --- /dev/null +++ b/contrib/bool_plperl/Makefile @@ -0,0 +1,39 @@ +# contrib/bool_plperl/Makefile + +MODULE_big = bool_plperl +OBJS = bool_plperl.o $(WIN32RES) +PGFILEDESC = "bool_plperl - bool transform for plperl" + +PG_CPPFLAGS = -I$(top_srcdir)/src/pl/plperl + +EXTENSION = bool_plperlu bool_plperl +DATA = bool_plperlu--1.0.sql bool_plperl--1.0.sql + +REGRESS = bool_plperl bool_plperlu + +SHLIB_LINK += $(filter -lm, $(LIBS)) + +ifdef USE_PGXS +PG_CONFIG = pg_config +PGXS := $(shell $(PG_CONFIG) --pgxs) +include $(PGXS) +else +subdir = contrib/bool_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/bool_plperl/bool_plperl--1.0.sql b/contrib/bool_plperl/bool_plperl--1.0.sql new file mode 100644 index 0000000000..00dc3b826f --- /dev/null +++ b/contrib/bool_plperl/bool_plperl--1.0.sql @@ -0,0 +1,19 @@ +/* contrib/bool_plperl/bool_plperl--1.0.sql */ + +-- complain if script is sourced in psql, rather than via CREATE EXTENSION +\echo Use "CREATE EXTENSION bool_plperl" to load this file. \quit + +CREATE FUNCTION bool_to_plperl(val internal) RETURNS internal +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME'; + +CREATE FUNCTION plperl_to_bool(val internal) RETURNS bool +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME'; + +CREATE TRANSFORM FOR bool LANGUAGE plperl ( + FROM SQL WITH FUNCTION bool_to_plperl(internal), + TO SQL WITH FUNCTION plperl_to_bool(internal) +); + +COMMENT ON TRANSFORM FOR bool LANGUAGE plperl IS 'transform between bool and Perl'; diff --git a/contrib/bool_plperl/bool_plperl.c b/contrib/bool_plperl/bool_plperl.c new file mode 100644 index 0000000000..6c94f1e02a --- /dev/null +++ b/contrib/bool_plperl/bool_plperl.c @@ -0,0 +1,27 @@ +#include "postgres.h" +#include "fmgr.h" +#include "plperl.h" + +PG_MODULE_MAGIC; + +PG_FUNCTION_INFO_V1(bool_to_plperl); + +Datum +bool_to_plperl(PG_FUNCTION_ARGS) +{ + dTHX; + return PointerGetDatum( + PG_GETARG_BOOL(0) ? &PL_sv_yes : &PL_sv_no + ); +} + + +PG_FUNCTION_INFO_V1(plperl_to_bool); + +Datum +plperl_to_bool(PG_FUNCTION_ARGS) +{ + dTHX; + SV *in = (SV *) PG_GETARG_POINTER(0); + PG_RETURN_BOOL( SvTRUE(in) ); +} diff --git a/contrib/bool_plperl/bool_plperl.control b/contrib/bool_plperl/bool_plperl.control new file mode 100644 index 0000000000..23cdb00d67 --- /dev/null +++ b/contrib/bool_plperl/bool_plperl.control @@ -0,0 +1,6 @@ +# jsonb_plperl extension +comment = 'transform between bool and plperl' +default_version = '1.0' +module_pathname = '$libdir/bool_plperl' +relocatable = true +requires = 'plperl' diff --git a/contrib/bool_plperl/bool_plperlu--1.0.sql b/contrib/bool_plperl/bool_plperlu--1.0.sql new file mode 100644 index 0000000000..9134d33014 --- /dev/null +++ b/contrib/bool_plperl/bool_plperlu--1.0.sql @@ -0,0 +1,19 @@ +/* contrib/json_plperl/bool_plperl--1.0.sql */ + +-- complain if script is sourced in psql, rather than via CREATE EXTENSION +\echo Use "CREATE EXTENSION bool_plperlu" to load this file. \quit + +CREATE FUNCTION bool_to_plperlu(val internal) RETURNS internal +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME', 'bool_to_plperl'; + +CREATE FUNCTION plperlu_to_bool(val internal) RETURNS bool +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME', 'plperl_to_bool'; + +CREATE TRANSFORM FOR bool LANGUAGE plperlu ( + FROM SQL WITH FUNCTION bool_to_plperlu(internal), + TO SQL WITH FUNCTION plperlu_to_bool(internal) +); + +COMMENT ON TRANSFORM FOR bool LANGUAGE plperlu IS 'transform between bool and Perl'; diff --git a/contrib/bool_plperl/bool_plperlu.control b/contrib/bool_plperl/bool_plperlu.control new file mode 100644 index 0000000000..c75b8b53ee --- /dev/null +++ b/contrib/bool_plperl/bool_plperlu.control @@ -0,0 +1,6 @@ +# jsonb_plperl extension +comment = 'transform between bool and plperlu' +default_version = '1.0' +module_pathname = '$libdir/bool_plperl' +relocatable = true +requires = 'plperlu' diff --git a/contrib/bool_plperl/expected/bool_plperl.out b/contrib/bool_plperl/expected/bool_plperl.out new file mode 100644 index 0000000000..475778c3d8 --- /dev/null +++ b/contrib/bool_plperl/expected/bool_plperl.out @@ -0,0 +1,110 @@ +CREATE EXTENSION bool_plperl CASCADE; +NOTICE: installing required extension "plperl" + --- test transforming from perl +CREATE FUNCTION perl2int(int) RETURNS bool +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; +CREATE FUNCTION perl2text(text) RETURNS bool +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; +CREATE FUNCTION perl2undef() RETURNS bool +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +return undef; +$$; +SELECT perl2int(1); + perl2int +---------- + t +(1 row) + +SELECT perl2int(0); + perl2int +---------- + f +(1 row) + +SELECT perl2text('foo'); + perl2text +----------- + t +(1 row) + +SELECT perl2text(''); + perl2text +----------- + f +(1 row) + +SELECT perl2undef() IS NULL AS p; + p +--- + t +(1 row) + + --- test transforming to perl +CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +my ($x, $y, $z) = @_; +if(defined($z)) { +die("NULL mistransformed"); +} +if(!defined($x)) { +die("TRUE mistransformed to UNDEF"); +} +if(!defined($y)) { +die("FALSE mistransformed to UNDEF"); +} +if(!$x) { +die("TRUE mistransformed"); +} +if($y) { +die("FALSE mistransformed"); +} +$$; +SELECT bool2perl (true, false, NULL); + bool2perl +----------- + +(1 row) + + --- test selecting bool through SPI +CREATE FUNCTION spi_test() RETURNS void +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0]; +if(! defined ($rv->{t})) { +die("TRUE mistransformed to UNDEF in SPI"); +} +if(! defined ($rv->{f})) { +die("FALSE mistransformed to UNDEF in SPI"); +} +if( defined ($rv->{n})) { +die("NULL mistransformed in SPI"); +} +if(! $rv->{t} ) { +die("TRUE mistransformed in SPI"); +} +if( $rv->{f} ) { +die("FALSE mistransformed in SPI"); +} +$$; +SELECT spi_test(); + spi_test +---------- + +(1 row) + +\set VERBOSITY terse \\ -- suppress cascade details +DROP EXTENSION plperl CASCADE; +NOTICE: drop cascades to 6 other objects diff --git a/contrib/bool_plperl/expected/bool_plperlu.out b/contrib/bool_plperl/expected/bool_plperlu.out new file mode 100644 index 0000000000..679e9ee011 --- /dev/null +++ b/contrib/bool_plperl/expected/bool_plperlu.out @@ -0,0 +1,110 @@ +CREATE EXTENSION bool_plperlu CASCADE; +NOTICE: installing required extension "plperlu" + --- test transforming from perl +CREATE FUNCTION perl2int(int) RETURNS bool +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; +CREATE FUNCTION perl2text(text) RETURNS bool +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; +CREATE FUNCTION perl2undef() RETURNS bool +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +return undef; +$$; +SELECT perl2int(1); + perl2int +---------- + t +(1 row) + +SELECT perl2int(0); + perl2int +---------- + f +(1 row) + +SELECT perl2text('foo'); + perl2text +----------- + t +(1 row) + +SELECT perl2text(''); + perl2text +----------- + f +(1 row) + +SELECT perl2undef() IS NULL AS p; + p +--- + t +(1 row) + + --- test transforming to perl +CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +my ($x, $y, $z) = @_; +if(defined($z)) { +die("NULL mistransformed"); +} +if(!defined($x)) { +die("TRUE mistransformed to UNDEF"); +} +if(!defined($y)) { +die("FALSE mistransformed to UNDEF"); +} +if(!$x) { +die("TRUE mistransformed"); +} +if($y) { +die("FALSE mistransformed"); +} +$$; +SELECT bool2perl (true, false, NULL); + bool2perl +----------- + +(1 row) + + --- test selecting bool through SPI +CREATE FUNCTION spi_test() RETURNS void +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0]; +if(! defined ($rv->{t})) { +die("TRUE mistransformed to UNDEF in SPI"); +} +if(! defined ($rv->{f})) { +die("FALSE mistransformed to UNDEF in SPI"); +} +if( defined ($rv->{n})) { +die("NULL mistransformed in SPI"); +} +if(! $rv->{t} ) { +die("TRUE mistransformed in SPI"); +} +if( $rv->{f} ) { +die("FALSE mistransformed in SPI"); +} +$$; +SELECT spi_test(); + spi_test +---------- + +(1 row) + +\set VERBOSITY terse \\ -- suppress cascade details +DROP EXTENSION plperlu CASCADE; +NOTICE: drop cascades to 6 other objects diff --git a/contrib/bool_plperl/sql/bool_plperl.sql b/contrib/bool_plperl/sql/bool_plperl.sql new file mode 100644 index 0000000000..8d1e4a6c2c --- /dev/null +++ b/contrib/bool_plperl/sql/bool_plperl.sql @@ -0,0 +1,83 @@ +CREATE EXTENSION bool_plperl CASCADE; + + --- test transforming from perl +CREATE FUNCTION perl2int(int) RETURNS bool +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; + +CREATE FUNCTION perl2text(text) RETURNS bool +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; + +CREATE FUNCTION perl2undef() RETURNS bool +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +return undef; +$$; + +SELECT perl2int(1); +SELECT perl2int(0); +SELECT perl2text('foo'); +SELECT perl2text(''); +SELECT perl2undef() IS NULL AS p; + + --- test transforming to perl +CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +my ($x, $y, $z) = @_; +if(defined($z)) { +die("NULL mistransformed"); +} +if(!defined($x)) { +die("TRUE mistransformed to UNDEF"); +} +if(!defined($y)) { +die("FALSE mistransformed to UNDEF"); +} +if(!$x) { +die("TRUE mistransformed"); +} +if($y) { +die("FALSE mistransformed"); +} +$$; + +SELECT bool2perl (true, false, NULL); + + --- test selecting bool through SPI + +CREATE FUNCTION spi_test() RETURNS void +LANGUAGE plperl +TRANSFORM FOR TYPE bool +AS $$ +my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0]; +if(! defined ($rv->{t})) { +die("TRUE mistransformed to UNDEF in SPI"); +} +if(! defined ($rv->{f})) { +die("FALSE mistransformed to UNDEF in SPI"); +} +if( defined ($rv->{n})) { +die("NULL mistransformed in SPI"); +} +if(! $rv->{t} ) { +die("TRUE mistransformed in SPI"); +} +if( $rv->{f} ) { +die("FALSE mistransformed in SPI"); +} +$$; + +SELECT spi_test(); + +\set VERBOSITY terse \\ -- suppress cascade details +DROP EXTENSION plperl CASCADE; diff --git a/contrib/bool_plperl/sql/bool_plperlu.sql b/contrib/bool_plperl/sql/bool_plperlu.sql new file mode 100644 index 0000000000..f7ce247988 --- /dev/null +++ b/contrib/bool_plperl/sql/bool_plperlu.sql @@ -0,0 +1,83 @@ +CREATE EXTENSION bool_plperlu CASCADE; + + --- test transforming from perl +CREATE FUNCTION perl2int(int) RETURNS bool +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; + +CREATE FUNCTION perl2text(text) RETURNS bool +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +return shift; +$$; + +CREATE FUNCTION perl2undef() RETURNS bool +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +return undef; +$$; + +SELECT perl2int(1); +SELECT perl2int(0); +SELECT perl2text('foo'); +SELECT perl2text(''); +SELECT perl2undef() IS NULL AS p; + + --- test transforming to perl +CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +my ($x, $y, $z) = @_; +if(defined($z)) { +die("NULL mistransformed"); +} +if(!defined($x)) { +die("TRUE mistransformed to UNDEF"); +} +if(!defined($y)) { +die("FALSE mistransformed to UNDEF"); +} +if(!$x) { +die("TRUE mistransformed"); +} +if($y) { +die("FALSE mistransformed"); +} +$$; + +SELECT bool2perl (true, false, NULL); + + --- test selecting bool through SPI + +CREATE FUNCTION spi_test() RETURNS void +LANGUAGE plperlu +TRANSFORM FOR TYPE bool +AS $$ +my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0]; +if(! defined ($rv->{t})) { +die("TRUE mistransformed to UNDEF in SPI"); +} +if(! defined ($rv->{f})) { +die("FALSE mistransformed to UNDEF in SPI"); +} +if( defined ($rv->{n})) { +die("NULL mistransformed in SPI"); +} +if(! $rv->{t} ) { +die("TRUE mistransformed in SPI"); +} +if( $rv->{f} ) { +die("FALSE mistransformed in SPI"); +} +$$; + +SELECT spi_test(); + +\set VERBOSITY terse \\ -- suppress cascade details +DROP EXTENSION plperlu CASCADE;