Skip to content

Commit 36058a3

Browse files
tglsfdctglsfdc
committed
Create contrib/bool_plperl to provide a bool transform for PL/Perl[U].
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
1 parent a652558 commit 36058a3

File tree

14 files changed

+502
-4
lines changed

14 files changed

+502
-4
lines changed

‎contrib/Makefile

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -75,9 +75,9 @@ ALWAYS_SUBDIRS += sepgsql
7575
endif
7676

7777
ifeq ($(with_perl),yes)
78-
SUBDIRS += hstore_plperl jsonb_plperl
78+
SUBDIRS += bool_plperl hstore_plperl jsonb_plperl
7979
else
80-
ALWAYS_SUBDIRS += hstore_plperl jsonb_plperl
80+
ALWAYS_SUBDIRS += bool_plperl hstore_plperl jsonb_plperl
8181
endif
8282

8383
ifeq ($(with_python),yes)

‎contrib/bool_plperl/.gitignore

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
# Generated subdirectories
2+
/log/
3+
/results/
4+
/tmp_check/

‎contrib/bool_plperl/Makefile

Lines changed: 39 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,39 @@
1+
# contrib/bool_plperl/Makefile
2+
3+
MODULE_big = bool_plperl
4+
OBJS = \
5+
$(WIN32RES) \
6+
bool_plperl.o
7+
PGFILEDESC = "bool_plperl - bool transform for plperl"
8+
9+
PG_CPPFLAGS = -I$(top_srcdir)/src/pl/plperl
10+
11+
EXTENSION = bool_plperlu bool_plperl
12+
DATA = bool_plperlu--1.0.sql bool_plperl--1.0.sql
13+
14+
REGRESS = bool_plperl bool_plperlu
15+
16+
ifdef USE_PGXS
17+
PG_CONFIG = pg_config
18+
PGXS := $(shell $(PG_CONFIG) --pgxs)
19+
include $(PGXS)
20+
else
21+
subdir = contrib/bool_plperl
22+
top_builddir = ../..
23+
include $(top_builddir)/src/Makefile.global
24+
include $(top_srcdir)/contrib/contrib-global.mk
25+
endif
26+
27+
# We must link libperl explicitly
28+
ifeq ($(PORTNAME), win32)
29+
# these settings are the same as for plperl
30+
override CPPFLAGS += -DPLPERL_HAVE_UID_GID -Wno-comment
31+
# ... see silliness in plperl Makefile ...
32+
SHLIB_LINK_INTERNAL += $(sort $(wildcard ../../src/pl/plperl/libperl*.a))
33+
else
34+
rpathdir = $(perl_archlibexp)/CORE
35+
SHLIB_LINK += $(perl_embed_ldflags)
36+
endif
37+
38+
# As with plperl we need to include the perl_includespec directory last.
39+
override CPPFLAGS := $(CPPFLAGS) $(perl_embed_ccflags) $(perl_includespec)

‎contrib/bool_plperl/bool_plperl--1.0.sql

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
/* contrib/bool_plperl/bool_plperl--1.0.sql */
2+
3+
-- complain if script is sourced in psql, rather than via CREATE EXTENSION
4+
\echo Use "CREATE EXTENSION bool_plperl" to load this file. \quit
5+
6+
CREATE FUNCTION bool_to_plperl(val internal) RETURNS internal
7+
LANGUAGE C STRICT IMMUTABLE
8+
AS 'MODULE_PATHNAME';
9+
10+
CREATE FUNCTION plperl_to_bool(val internal) RETURNS bool
11+
LANGUAGE C STRICT IMMUTABLE
12+
AS 'MODULE_PATHNAME';
13+
14+
CREATE TRANSFORM FOR bool LANGUAGE plperl (
15+
FROM SQL WITH FUNCTION bool_to_plperl(internal),
16+
TO SQL WITH FUNCTION plperl_to_bool(internal)
17+
);
18+
19+
COMMENT ON TRANSFORM FOR bool LANGUAGE plperl IS 'transform between bool and Perl';

‎contrib/bool_plperl/bool_plperl.c

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
#include "postgres.h"
2+
3+
#include "fmgr.h"
4+
#include "plperl.h"
5+
6+
7+
PG_MODULE_MAGIC;
8+
9+
PG_FUNCTION_INFO_V1(bool_to_plperl);
10+
11+
Datum
12+
bool_to_plperl(PG_FUNCTION_ARGS)
13+
{
14+
dTHX;
15+
bool in = PG_GETARG_BOOL(0);
16+
17+
return PointerGetDatum(in ? &PL_sv_yes : &PL_sv_no);
18+
}
19+
20+
21+
PG_FUNCTION_INFO_V1(plperl_to_bool);
22+
23+
Datum
24+
plperl_to_bool(PG_FUNCTION_ARGS)
25+
{
26+
dTHX;
27+
SV *in = (SV *) PG_GETARG_POINTER(0);
28+
29+
PG_RETURN_BOOL(SvTRUE(in));
30+
}

‎contrib/bool_plperl/bool_plperl.control

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
# bool_plperl extension
2+
comment = 'transform between bool and plperl'
3+
default_version = '1.0'
4+
module_pathname = '$libdir/bool_plperl'
5+
relocatable = true
6+
trusted = true
7+
requires = 'plperl'

‎contrib/bool_plperl/bool_plperlu--1.0.sql

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
/* contrib/bool_plperl/bool_plperlu--1.0.sql */
2+
3+
-- complain if script is sourced in psql, rather than via CREATE EXTENSION
4+
\echo Use "CREATE EXTENSION bool_plperlu" to load this file. \quit
5+
6+
CREATE FUNCTION bool_to_plperlu(val internal) RETURNS internal
7+
LANGUAGE C STRICT IMMUTABLE
8+
AS 'MODULE_PATHNAME', 'bool_to_plperl';
9+
10+
CREATE FUNCTION plperlu_to_bool(val internal) RETURNS bool
11+
LANGUAGE C STRICT IMMUTABLE
12+
AS 'MODULE_PATHNAME', 'plperl_to_bool';
13+
14+
CREATE TRANSFORM FOR bool LANGUAGE plperlu (
15+
FROM SQL WITH FUNCTION bool_to_plperlu(internal),
16+
TO SQL WITH FUNCTION plperlu_to_bool(internal)
17+
);
18+
19+
COMMENT ON TRANSFORM FOR bool LANGUAGE plperlu IS 'transform between bool and Perl';

‎contrib/bool_plperl/bool_plperlu.control

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
# bool_plperlu extension
2+
comment = 'transform between bool and plperlu'
3+
default_version = '1.0'
4+
module_pathname = '$libdir/bool_plperl'
5+
relocatable = true
6+
requires = 'plperlu'

‎contrib/bool_plperl/expected/bool_plperl.out

Lines changed: 97 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,97 @@
1+
CREATE EXTENSION bool_plperl CASCADE;
2+
NOTICE: installing required extension "plperl"
3+
--- test transforming from perl
4+
CREATE FUNCTION perl2int(int) RETURNS bool
5+
LANGUAGE plperl
6+
TRANSFORM FOR TYPE bool
7+
AS $$
8+
return shift;
9+
$$;
10+
CREATE FUNCTION perl2text(text) RETURNS bool
11+
LANGUAGE plperl
12+
TRANSFORM FOR TYPE bool
13+
AS $$
14+
return shift;
15+
$$;
16+
CREATE FUNCTION perl2undef() RETURNS bool
17+
LANGUAGE plperl
18+
TRANSFORM FOR TYPE bool
19+
AS $$
20+
return undef;
21+
$$;
22+
SELECT perl2int(1);
23+
perl2int
24+
----------
25+
t
26+
(1 row)
27+
28+
SELECT perl2int(0);
29+
perl2int
30+
----------
31+
f
32+
(1 row)
33+
34+
SELECT perl2text('foo');
35+
perl2text
36+
-----------
37+
t
38+
(1 row)
39+
40+
SELECT perl2text('');
41+
perl2text
42+
-----------
43+
f
44+
(1 row)
45+
46+
SELECT perl2undef() IS NULL AS p;
47+
p
48+
---
49+
t
50+
(1 row)
51+
52+
--- test transforming to perl
53+
CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void
54+
LANGUAGE plperl
55+
TRANSFORM FOR TYPE bool
56+
AS $$
57+
my ($x, $y, $z) = @_;
58+
59+
die("NULL mistransformed") if (defined($z));
60+
die("TRUE mistransformed to UNDEF") if (!defined($x));
61+
die("FALSE mistransformed to UNDEF") if (!defined($y));
62+
die("TRUE mistransformed") if (!$x);
63+
die("FALSE mistransformed") if ($y);
64+
$$;
65+
SELECT bool2perl (true, false, NULL);
66+
bool2perl
67+
-----------
68+
69+
(1 row)
70+
71+
--- test selecting bool through SPI
72+
CREATE FUNCTION spi_test() RETURNS void
73+
LANGUAGE plperl
74+
TRANSFORM FOR TYPE bool
75+
AS $$
76+
my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0];
77+
78+
die("TRUE mistransformed to UNDEF in SPI") if (!defined ($rv->{t}));
79+
die("FALSE mistransformed to UNDEF in SPI") if (!defined ($rv->{f}));
80+
die("NULL mistransformed in SPI") if (defined ($rv->{n}));
81+
die("TRUE mistransformed in SPI") if (!$rv->{t});
82+
die("FALSE mistransformed in SPI") if ($rv->{f});
83+
$$;
84+
SELECT spi_test();
85+
spi_test
86+
----------
87+
88+
(1 row)
89+
90+
DROP EXTENSION plperl CASCADE;
91+
NOTICE: drop cascades to 6 other objects
92+
DETAIL: drop cascades to function spi_test()
93+
drop cascades to extension bool_plperl
94+
drop cascades to function perl2int(integer)
95+
drop cascades to function perl2text(text)
96+
drop cascades to function perl2undef()
97+
drop cascades to function bool2perl(boolean,boolean,boolean)

‎contrib/bool_plperl/expected/bool_plperlu.out

Lines changed: 97 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,97 @@
1+
CREATE EXTENSION bool_plperlu CASCADE;
2+
NOTICE: installing required extension "plperlu"
3+
--- test transforming from perl
4+
CREATE FUNCTION perl2int(int) RETURNS bool
5+
LANGUAGE plperlu
6+
TRANSFORM FOR TYPE bool
7+
AS $$
8+
return shift;
9+
$$;
10+
CREATE FUNCTION perl2text(text) RETURNS bool
11+
LANGUAGE plperlu
12+
TRANSFORM FOR TYPE bool
13+
AS $$
14+
return shift;
15+
$$;
16+
CREATE FUNCTION perl2undef() RETURNS bool
17+
LANGUAGE plperlu
18+
TRANSFORM FOR TYPE bool
19+
AS $$
20+
return undef;
21+
$$;
22+
SELECT perl2int(1);
23+
perl2int
24+
----------
25+
t
26+
(1 row)
27+
28+
SELECT perl2int(0);
29+
perl2int
30+
----------
31+
f
32+
(1 row)
33+
34+
SELECT perl2text('foo');
35+
perl2text
36+
-----------
37+
t
38+
(1 row)
39+
40+
SELECT perl2text('');
41+
perl2text
42+
-----------
43+
f
44+
(1 row)
45+
46+
SELECT perl2undef() IS NULL AS p;
47+
p
48+
---
49+
t
50+
(1 row)
51+
52+
--- test transforming to perl
53+
CREATE FUNCTION bool2perl(bool, bool, bool) RETURNS void
54+
LANGUAGE plperlu
55+
TRANSFORM FOR TYPE bool
56+
AS $$
57+
my ($x, $y, $z) = @_;
58+
59+
die("NULL mistransformed") if (defined($z));
60+
die("TRUE mistransformed to UNDEF") if (!defined($x));
61+
die("FALSE mistransformed to UNDEF") if (!defined($y));
62+
die("TRUE mistransformed") if (!$x);
63+
die("FALSE mistransformed") if ($y);
64+
$$;
65+
SELECT bool2perl (true, false, NULL);
66+
bool2perl
67+
-----------
68+
69+
(1 row)
70+
71+
--- test selecting bool through SPI
72+
CREATE FUNCTION spi_test() RETURNS void
73+
LANGUAGE plperlu
74+
TRANSFORM FOR TYPE bool
75+
AS $$
76+
my $rv = spi_exec_query('SELECT true t, false f, NULL n')->{rows}->[0];
77+
78+
die("TRUE mistransformed to UNDEF in SPI") if (!defined ($rv->{t}));
79+
die("FALSE mistransformed to UNDEF in SPI") if (!defined ($rv->{f}));
80+
die("NULL mistransformed in SPI") if (defined ($rv->{n}));
81+
die("TRUE mistransformed in SPI") if (!$rv->{t});
82+
die("FALSE mistransformed in SPI") if ($rv->{f});
83+
$$;
84+
SELECT spi_test();
85+
spi_test
86+
----------
87+
88+
(1 row)
89+
90+
DROP EXTENSION plperlu CASCADE;
91+
NOTICE: drop cascades to 6 other objects
92+
DETAIL: drop cascades to function spi_test()
93+
drop cascades to extension bool_plperlu
94+
drop cascades to function perl2int(integer)
95+
drop cascades to function perl2text(text)
96+
drop cascades to function perl2undef()
97+
drop cascades to function bool2perl(boolean,boolean,boolean)

0 commit comments

Comments
 (0)
pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy