mirrors/postgres
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Create contrib/bool_plperl to provide a bool transform for PL/Perl[U].

Browse Source 
plperl's default handling of bool arguments or results is not terribly
satisfactory, since Perl doesn't consider the string 'f' to be false.
Ideally we'd just fix that, but the backwards-compatibility hazard
would be substantial.  Instead, build a TRANSFORM module that can
be optionally applied to provide saner semantics.

Perhaps usefully, this is also about the minimum possible skeletal
example of a plperl transform module; so it might be a better starting
point for user-written transform modules than hstore_plperl or
jsonb_plperl.

Ivan Panchenko

Discussion: https://postgr.es/m/1583013317.881182688@f390.i.mail.ru
This commit is contained in:
Tom Lane 2020-03-06 17:11:23 -05:00
parent a6525588b7
commit 36058a3c55
14 changed files with 502 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
contrib/Makefile
View File

@ -75,9 +75,9 @@ ALWAYS_SUBDIRS += sepgsql
endif
ifeq ($(with_perl),yes)
SUBDIRS += hstore_plperl jsonb_plperl
SUBDIRS += bool_plperl hstore_plperl jsonb_plperl
else
ALWAYS_SUBDIRS += hstore_plperl jsonb_plperl
ALWAYS_SUBDIRS += bool_plperl hstore_plperl jsonb_plperl
endif
ifeq ($(with_python),yes)

4
contrib/bool_plperl/.gitignore vendored Normal file
View File

@ -0,0 +1,4 @@
# Generated subdirectories
/log/
/results/
/tmp_check/

39
contrib/bool_plperl/Makefile Normal file
View File

@ -0,0 +1,39 @@
# contrib/bool_plperl/Makefile
MODULE_big = bool_plperl
OBJS = \
$(WIN32RES) \
bool_plperl.o
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
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)

19
contrib/bool_plperl/bool_plperl--1.0.sql Normal file
View File

@ -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';

30
contrib/bool_plperl/bool_plperl.c Normal file
View File

@ -0,0 +1,30 @@
#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;
bool in = PG_GETARG_BOOL(0);
return PointerGetDatum(in ? &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));
}

7
contrib/bool_plperl/bool_plperl.control Normal file
View File

@ -0,0 +1,7 @@
# bool_plperl extension
comment = 'transform between bool and plperl'
default_version = '1.0'
module_pathname = '$libdir/bool_plperl'
relocatable = true
trusted = true
requires = 'plperl'

19
contrib/bool_plperl/bool_plperlu--1.0.sql Normal file
View File

@ -0,0 +1,19 @@
/* contrib/bool_plperl/bool_plperlu--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';

6
contrib/bool_plperl/bool_plperlu.control Normal file
View File

@ -0,0 +1,6 @@
# bool_plperlu extension
comment = 'transform between bool and plperlu'
default_version = '1.0'
module_pathname = '$libdir/bool_plperl'
relocatable = true
requires = 'plperlu'

97
contrib/bool_plperl/expected/bool_plperl.out Normal file
View File

@ -0,0 +1,97 @@
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) = @_;
die("NULL mistransformed") if (defined($z));
die("TRUE mistransformed to UNDEF") if (!defined($x));
die("FALSE mistransformed to UNDEF") if (!defined($y));
die("TRUE mistransformed") if (!$x);
die("FALSE mistransformed") if ($y);
$$;
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];
die("TRUE mistransformed to UNDEF in SPI") if (!defined ($rv->{t}));
die("FALSE mistransformed to UNDEF in SPI") if (!defined ($rv->{f}));
die("NULL mistransformed in SPI") if (defined ($rv->{n}));
die("TRUE mistransformed in SPI") if (!$rv->{t});
die("FALSE mistransformed in SPI") if ($rv->{f});
$$;
SELECT spi_test();
spi_test
----------
(1 row)
DROP EXTENSION plperl CASCADE;
NOTICE: drop cascades to 6 other objects
DETAIL: drop cascades to function spi_test()
drop cascades to extension bool_plperl
drop cascades to function perl2int(integer)
drop cascades to function perl2text(text)
drop cascades to function perl2undef()
drop cascades to function bool2perl(boolean,boolean,boolean)

97
contrib/bool_plperl/expected/bool_plperlu.out Normal file
View File

@ -0,0 +1,97 @@
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) = @_;
die("NULL mistransformed") if (defined($z));
die("TRUE mistransformed to UNDEF") if (!defined($x));
die("FALSE mistransformed to UNDEF") if (!defined($y));
die("TRUE mistransformed") if (!$x);
die("FALSE mistransformed") if ($y);
$$;
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];
die("TRUE mistransformed to UNDEF in SPI") if (!defined ($rv->{t}));
die("FALSE mistransformed to UNDEF in SPI") if (!defined ($rv->{f}));
die("NULL mistransformed in SPI") if (defined ($rv->{n}));
die("TRUE mistransformed in SPI") if (!$rv->{t});
die("FALSE mistransformed in SPI") if ($rv->{f});
$$;
SELECT spi_test();
spi_test
----------
(1 row)
DROP EXTENSION plperlu CASCADE;
NOTICE: drop cascades to 6 other objects
DETAIL: drop cascades to function spi_test()
drop cascades to extension bool_plperlu
drop cascades to function perl2int(integer)
drop cascades to function perl2text(text)
drop cascades to function perl2undef()
drop cascades to function bool2perl(boolean,boolean,boolean)

66
contrib/bool_plperl/sql/bool_plperl.sql Normal file
View File

@ -0,0 +1,66 @@
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) = @_;
die("NULL mistransformed") if (defined($z));
die("TRUE mistransformed to UNDEF") if (!defined($x));
die("FALSE mistransformed to UNDEF") if (!defined($y));
die("TRUE mistransformed") if (!$x);
die("FALSE mistransformed") if ($y);
$$;
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];
die("TRUE mistransformed to UNDEF in SPI") if (!defined ($rv->{t}));
die("FALSE mistransformed to UNDEF in SPI") if (!defined ($rv->{f}));
die("NULL mistransformed in SPI") if (defined ($rv->{n}));
die("TRUE mistransformed in SPI") if (!$rv->{t});
die("FALSE mistransformed in SPI") if ($rv->{f});
$$;
SELECT spi_test();
DROP EXTENSION plperl CASCADE;

66
contrib/bool_plperl/sql/bool_plperlu.sql Normal file
View File

@ -0,0 +1,66 @@
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) = @_;
die("NULL mistransformed") if (defined($z));
die("TRUE mistransformed to UNDEF") if (!defined($x));
die("FALSE mistransformed to UNDEF") if (!defined($y));
die("TRUE mistransformed") if (!$x);
die("FALSE mistransformed") if ($y);
$$;
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];
die("TRUE mistransformed to UNDEF in SPI") if (!defined ($rv->{t}));
die("FALSE mistransformed to UNDEF in SPI") if (!defined ($rv->{f}));
die("NULL mistransformed in SPI") if (defined ($rv->{n}));
die("TRUE mistransformed in SPI") if (!$rv->{t});
die("FALSE mistransformed in SPI") if ($rv->{f});
$$;
SELECT spi_test();
DROP EXTENSION plperlu CASCADE;

47
doc/src/sgml/plperl.sgml
View File

@ -55,8 +55,11 @@
syntax:
<programlisting>
CREATE FUNCTION <replaceable>funcname</replaceable> (<replaceable>argument-types</replaceable>) RETURNS <replaceable>return-type</replaceable> AS $$
# PL/Perl function body
CREATE FUNCTION <replaceable>funcname</replaceable> (<replaceable>argument-types</replaceable>)
RETURNS <replaceable>return-type</replaceable>
-- function attributes can go here
AS $$
# PL/Perl function body goes here
$$ LANGUAGE plperl;
</programlisting>
@ -188,6 +191,39 @@ $$ LANGUAGE plperl;
escape binary data for a return value of type <type>bytea</type>.
</para>
<para>
One case that is particularly important is boolean values. As just
stated, the default behavior for <type>bool</type> values is that they
are passed to Perl as text, thus either <literal>'t'</literal>
or <literal>'f'</literal>. This is problematic, since Perl will not
treat <literal>'f'</literal> as false! It is possible to improve matters
by using a <quote>transform</quote> (see
<xref linkend="sql-createtransform"/>). Suitable transforms are provided
by the <filename>bool_plperl</filename> extension. To use it, install
the extension:
<programlisting>
CREATE EXTENSION bool_plperl; -- or bool_plperlu for PL/PerlU
</programlisting>
Then use the <literal>TRANSFORM</literal> function attribute for a
PL/Perl function that takes or returns <type>bool</type>, for example:
<programlisting>
CREATE FUNCTION perl_and(bool, bool) RETURNS bool
TRANSFORM FOR TYPE bool
AS $$
my ($a, $b) = @_;
return $a &amp;&amp; $b;
$$ LANGUAGE plperl;
</programlisting>
When this transform is applied, <type>bool</type> arguments will be seen
by Perl as being <literal>1</literal> or empty, thus properly true or
false. If the function result is type <type>bool</type>, it will be true
or false according to whether Perl would evaluate the returned value as
true.
Similar transformations are also performed for boolean query arguments
and results of SPI queries performed inside the function
(<xref linkend="plperl-database"/>).
</para>
<para>
Perl can return <productname>PostgreSQL</productname> arrays as
references to Perl arrays. Here is an example:
@ -382,6 +418,13 @@ use strict;
commands will accept any string that is acceptable input format
for the function's declared return type.
</para>
<para>
If this behavior is inconvenient for a particular case, it can be
improved by using a transform, as already illustrated
for <type>bool</type> values. Several examples of transform modules
are included in the <productname>PostgreSQL</productname> distribution.
</para>
</sect1>
<sect1 id="plperl-builtins">

5
src/tools/msvc/Mkvcbuild.pm
View File

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