diff options
author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-05-04 12:15:05 +0000 |
---|---|---|
committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-05-04 12:15:05 +0000 |
commit | 46651ce6fe013220ed397add242004d764fc0153 (patch) | |
tree | 6e5299f990f88e60174a1d3ae6e48eedd2688b2b /contrib/hstore_plperl | |
parent | Initial commit. (diff) | |
download | postgresql-14-46651ce6fe013220ed397add242004d764fc0153.tar.xz postgresql-14-46651ce6fe013220ed397add242004d764fc0153.zip |
Adding upstream version 14.5.upstream/14.5upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'contrib/hstore_plperl')
-rw-r--r-- | contrib/hstore_plperl/.gitignore | 4 | ||||
-rw-r--r-- | contrib/hstore_plperl/Makefile | 41 | ||||
-rw-r--r-- | contrib/hstore_plperl/expected/create_transform.out | 75 | ||||
-rw-r--r-- | contrib/hstore_plperl/expected/hstore_plperl.out | 67 | ||||
-rw-r--r-- | contrib/hstore_plperl/expected/hstore_plperlu.out | 151 | ||||
-rw-r--r-- | contrib/hstore_plperl/hstore_plperl--1.0.sql | 17 | ||||
-rw-r--r-- | contrib/hstore_plperl/hstore_plperl.c | 155 | ||||
-rw-r--r-- | contrib/hstore_plperl/hstore_plperl.control | 6 | ||||
-rw-r--r-- | contrib/hstore_plperl/hstore_plperlu--1.0.sql | 17 | ||||
-rw-r--r-- | contrib/hstore_plperl/hstore_plperlu.control | 6 | ||||
-rw-r--r-- | contrib/hstore_plperl/sql/create_transform.sql | 49 | ||||
-rw-r--r-- | contrib/hstore_plperl/sql/hstore_plperl.sql | 60 | ||||
-rw-r--r-- | contrib/hstore_plperl/sql/hstore_plperlu.sql | 125 |
13 files changed, 773 insertions, 0 deletions
diff --git a/contrib/hstore_plperl/.gitignore b/contrib/hstore_plperl/.gitignore new file mode 100644 index 0000000..5dcb3ff --- /dev/null +++ b/contrib/hstore_plperl/.gitignore @@ -0,0 +1,4 @@ +# Generated subdirectories +/log/ +/results/ +/tmp_check/ diff --git a/contrib/hstore_plperl/Makefile b/contrib/hstore_plperl/Makefile new file mode 100644 index 0000000..9065f16 --- /dev/null +++ b/contrib/hstore_plperl/Makefile @@ -0,0 +1,41 @@ +# contrib/hstore_plperl/Makefile + +MODULE_big = hstore_plperl +OBJS = \ + $(WIN32RES) \ + hstore_plperl.o +PGFILEDESC = "hstore_plperl - hstore transform for plperl" + + +EXTENSION = hstore_plperl hstore_plperlu +DATA = hstore_plperl--1.0.sql hstore_plperlu--1.0.sql + +REGRESS = hstore_plperl hstore_plperlu create_transform +EXTRA_INSTALL = contrib/hstore + +ifdef USE_PGXS +PG_CPPFLAGS = -I$(includedir_server)/extension +PG_CONFIG = pg_config +PGXS := $(shell $(PG_CONFIG) --pgxs) +include $(PGXS) +else +PG_CPPFLAGS = -I$(top_srcdir)/src/pl/plperl -I$(top_srcdir)/contrib +subdir = contrib/hstore_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/hstore_plperl/expected/create_transform.out b/contrib/hstore_plperl/expected/create_transform.out new file mode 100644 index 0000000..dc72395 --- /dev/null +++ b/contrib/hstore_plperl/expected/create_transform.out @@ -0,0 +1,75 @@ +-- general regression test for transforms +DROP EXTENSION IF EXISTS hstore CASCADE; +NOTICE: extension "hstore" does not exist, skipping +DROP EXTENSION IF EXISTS plperl CASCADE; +NOTICE: extension "plperl" does not exist, skipping +DROP EXTENSION IF EXISTS hstore_plperl CASCADE; +NOTICE: extension "hstore_plperl" does not exist, skipping +CREATE EXTENSION hstore; +CREATE EXTENSION plperl; +CREATE FUNCTION hstore_to_plperl(val internal) RETURNS internal +LANGUAGE C STRICT IMMUTABLE +AS '$libdir/hstore_plperl'; +CREATE FUNCTION plperl_to_hstore(val internal) RETURNS hstore +LANGUAGE C STRICT IMMUTABLE +AS '$libdir/hstore_plperl'; +CREATE TRANSFORM FOR foo LANGUAGE plperl (FROM SQL WITH FUNCTION hstore_to_plperl(internal), TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- fail +ERROR: type "foo" does not exist +CREATE TRANSFORM FOR hstore LANGUAGE foo (FROM SQL WITH FUNCTION hstore_to_plperl(internal), TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- fail +ERROR: language "foo" does not exist +CREATE TRANSFORM FOR hstore LANGUAGE plperl (FROM SQL WITH FUNCTION hstore_out(hstore), TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- fail +ERROR: return data type of FROM SQL function must be internal +CREATE TRANSFORM FOR hstore LANGUAGE plperl (FROM SQL WITH FUNCTION internal_in(cstring), TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- fail +ERROR: first argument of transform function must be type internal +CREATE TRANSFORM FOR hstore LANGUAGE plperl (FROM SQL WITH FUNCTION hstore_to_plperl(internal), TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- ok +CREATE TRANSFORM FOR hstore LANGUAGE plperl (FROM SQL WITH FUNCTION hstore_to_plperl(internal), TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- fail +ERROR: transform for type hstore language "plperl" already exists +CREATE OR REPLACE TRANSFORM FOR hstore LANGUAGE plperl (FROM SQL WITH FUNCTION hstore_to_plperl(internal), TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- ok +CREATE OR REPLACE TRANSFORM FOR hstore LANGUAGE plperl (FROM SQL WITH FUNCTION hstore_to_plperl(internal)); -- ok +CREATE OR REPLACE TRANSFORM FOR hstore LANGUAGE plperl (TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- ok +COMMENT ON TRANSFORM FOR hstore LANGUAGE plperl IS 'test'; +DROP TRANSFORM IF EXISTS FOR fake_type LANGUAGE plperl; +NOTICE: type "fake_type" does not exist, skipping +DROP TRANSFORM IF EXISTS FOR hstore LANGUAGE fake_lang; +NOTICE: transform for type hstore language "fake_lang" does not exist, skipping +DROP TRANSFORM FOR foo LANGUAGE plperl; +ERROR: type "foo" does not exist +DROP TRANSFORM FOR hstore LANGUAGE foo; +ERROR: language "foo" does not exist +DROP TRANSFORM FOR hstore LANGUAGE plperl; +DROP TRANSFORM IF EXISTS FOR hstore LANGUAGE plperl; +NOTICE: transform for type hstore language "plperl" does not exist, skipping +DROP FUNCTION hstore_to_plperl(val internal); +DROP FUNCTION plperl_to_hstore(val internal); +CREATE EXTENSION hstore_plperl; +\dx+ hstore_plperl + Objects in extension "hstore_plperl" + Object description +-------------------------------------- + function hstore_to_plperl(internal) + function plperl_to_hstore(internal) + transform for hstore language plperl +(3 rows) + +ALTER EXTENSION hstore_plperl DROP TRANSFORM FOR hstore LANGUAGE plperl; +\dx+ hstore_plperl +Objects in extension "hstore_plperl" + Object description +------------------------------------- + function hstore_to_plperl(internal) + function plperl_to_hstore(internal) +(2 rows) + +ALTER EXTENSION hstore_plperl ADD TRANSFORM FOR hstore LANGUAGE plperl; +\dx+ hstore_plperl + Objects in extension "hstore_plperl" + Object description +-------------------------------------- + function hstore_to_plperl(internal) + function plperl_to_hstore(internal) + transform for hstore language plperl +(3 rows) + +DROP EXTENSION hstore CASCADE; +NOTICE: drop cascades to extension hstore_plperl +DROP EXTENSION plperl CASCADE; diff --git a/contrib/hstore_plperl/expected/hstore_plperl.out b/contrib/hstore_plperl/expected/hstore_plperl.out new file mode 100644 index 0000000..1ab09a9 --- /dev/null +++ b/contrib/hstore_plperl/expected/hstore_plperl.out @@ -0,0 +1,67 @@ +CREATE EXTENSION hstore_plperl CASCADE; +NOTICE: installing required extension "hstore" +NOTICE: installing required extension "plperl" +SELECT transforms.udt_schema, transforms.udt_name, + routine_schema, routine_name, + group_name, transform_type +FROM information_schema.transforms JOIN information_schema.routines + USING (specific_catalog, specific_schema, specific_name) +ORDER BY 1, 2, 5, 6; + udt_schema | udt_name | routine_schema | routine_name | group_name | transform_type +------------+----------+----------------+------------------+------------+---------------- + public | hstore | public | hstore_to_plperl | plperl | FROM SQL + public | hstore | public | plperl_to_hstore | plperl | TO SQL +(2 rows) + +-- test perl -> hstore +CREATE FUNCTION test2() RETURNS hstore +LANGUAGE plperl +TRANSFORM FOR TYPE hstore +AS $$ +$val = {a => 1, b => 'boo', c => undef}; +return $val; +$$; +SELECT test2(); + test2 +--------------------------------- + "a"=>"1", "b"=>"boo", "c"=>NULL +(1 row) + +-- test perl -> hstore[] +CREATE FUNCTION test2arr() RETURNS hstore[] +LANGUAGE plperl +TRANSFORM FOR TYPE hstore +AS $$ +$val = [{a => 1, b => 'boo', c => undef}, {d => 2}]; +return $val; +$$; +SELECT test2arr(); + test2arr +-------------------------------------------------------------- + {"\"a\"=>\"1\", \"b\"=>\"boo\", \"c\"=>NULL","\"d\"=>\"2\""} +(1 row) + +-- check error cases +CREATE OR REPLACE FUNCTION test2() RETURNS hstore +LANGUAGE plperl +TRANSFORM FOR TYPE hstore +AS $$ +return 42; +$$; +SELECT test2(); +ERROR: cannot transform non-hash Perl value to hstore +CONTEXT: PL/Perl function "test2" +CREATE OR REPLACE FUNCTION test2() RETURNS hstore +LANGUAGE plperl +TRANSFORM FOR TYPE hstore +AS $$ +return [1, 2]; +$$; +SELECT test2(); +ERROR: cannot transform non-hash Perl value to hstore +CONTEXT: PL/Perl function "test2" +DROP FUNCTION test2(); +DROP FUNCTION test2arr(); +DROP EXTENSION hstore_plperl; +DROP EXTENSION hstore; +DROP EXTENSION plperl; diff --git a/contrib/hstore_plperl/expected/hstore_plperlu.out b/contrib/hstore_plperl/expected/hstore_plperlu.out new file mode 100644 index 0000000..d719d29 --- /dev/null +++ b/contrib/hstore_plperl/expected/hstore_plperlu.out @@ -0,0 +1,151 @@ +CREATE EXTENSION hstore_plperlu CASCADE; +NOTICE: installing required extension "hstore" +NOTICE: installing required extension "plperlu" +SELECT transforms.udt_schema, transforms.udt_name, + routine_schema, routine_name, + group_name, transform_type +FROM information_schema.transforms JOIN information_schema.routines + USING (specific_catalog, specific_schema, specific_name) +ORDER BY 1, 2, 5, 6; + udt_schema | udt_name | routine_schema | routine_name | group_name | transform_type +------------+----------+----------------+-------------------+------------+---------------- + public | hstore | public | hstore_to_plperlu | plperlu | FROM SQL + public | hstore | public | plperlu_to_hstore | plperlu | TO SQL +(2 rows) + +-- test hstore -> perl +CREATE FUNCTION test1(val hstore) RETURNS int +LANGUAGE plperlu +TRANSFORM FOR TYPE hstore +AS $$ +use Data::Dumper; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Indent = 0; +elog(INFO, Dumper($_[0])); +return scalar(keys %{$_[0]}); +$$; +SELECT test1('aa=>bb, cc=>NULL'::hstore); +INFO: $VAR1 = {'aa' => 'bb','cc' => undef}; + test1 +------- + 2 +(1 row) + +CREATE FUNCTION test1none(val hstore) RETURNS int +LANGUAGE plperlu +AS $$ +use Data::Dumper; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Indent = 0; +elog(INFO, Dumper($_[0])); +return scalar(keys %{$_[0]}); +$$; +SELECT test1none('aa=>bb, cc=>NULL'::hstore); +INFO: $VAR1 = '"aa"=>"bb", "cc"=>NULL'; + test1none +----------- + 0 +(1 row) + +CREATE FUNCTION test1list(val hstore) RETURNS int +LANGUAGE plperlu +TRANSFORM FOR TYPE hstore +AS $$ +use Data::Dumper; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Indent = 0; +elog(INFO, Dumper($_[0])); +return scalar(keys %{$_[0]}); +$$; +SELECT test1list('aa=>bb, cc=>NULL'::hstore); +INFO: $VAR1 = {'aa' => 'bb','cc' => undef}; + test1list +----------- + 2 +(1 row) + +-- test hstore[] -> perl +CREATE FUNCTION test1arr(val hstore[]) RETURNS int +LANGUAGE plperlu +TRANSFORM FOR TYPE hstore +AS $$ +use Data::Dumper; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Indent = 0; +elog(INFO, Dumper($_[0]->[0], $_[0]->[1])); +return scalar(keys %{$_[0]}); +$$; +SELECT test1arr(array['aa=>bb, cc=>NULL'::hstore, 'dd=>ee']); +INFO: $VAR1 = {'aa' => 'bb','cc' => undef};$VAR2 = {'dd' => 'ee'}; + test1arr +---------- + 2 +(1 row) + +-- test as part of prepare/execute +CREATE FUNCTION test3() RETURNS void +LANGUAGE plperlu +TRANSFORM FOR TYPE hstore +AS $$ +use Data::Dumper; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Indent = 0; + +$rv = spi_exec_query(q{SELECT 'aa=>bb, cc=>NULL'::hstore AS col1}); +elog(INFO, Dumper($rv->{rows}[0]->{col1})); + +$val = {a => 1, b => 'boo', c => undef}; +$plan = spi_prepare(q{SELECT $1::text AS col1}, "hstore"); +$rv = spi_exec_prepared($plan, {}, $val); +elog(INFO, Dumper($rv->{rows}[0]->{col1})); +$$; +SELECT test3(); +INFO: $VAR1 = {'aa' => 'bb','cc' => undef}; +INFO: $VAR1 = '"a"=>"1", "b"=>"boo", "c"=>NULL'; + test3 +------- + +(1 row) + +-- test trigger +CREATE TABLE test1 (a int, b hstore); +INSERT INTO test1 VALUES (1, 'aa=>bb, cc=>NULL'); +SELECT * FROM test1; + a | b +---+------------------------ + 1 | "aa"=>"bb", "cc"=>NULL +(1 row) + +CREATE FUNCTION test4() RETURNS trigger +LANGUAGE plperlu +TRANSFORM FOR TYPE hstore +AS $$ +use Data::Dumper; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Indent = 0; +elog(INFO, Dumper($_TD->{new})); +if ($_TD->{new}{a} == 1) { + $_TD->{new}{b} = {a => 1, b => 'boo', c => undef}; +} + +return "MODIFY"; +$$; +CREATE TRIGGER test4 BEFORE UPDATE ON test1 FOR EACH ROW EXECUTE PROCEDURE test4(); +UPDATE test1 SET a = a; +INFO: $VAR1 = {'a' => '1','b' => {'aa' => 'bb','cc' => undef}}; +SELECT * FROM test1; + a | b +---+--------------------------------- + 1 | "a"=>"1", "b"=>"boo", "c"=>NULL +(1 row) + +DROP TABLE test1; +DROP FUNCTION test1(hstore); +DROP FUNCTION test1none(hstore); +DROP FUNCTION test1list(hstore); +DROP FUNCTION test1arr(hstore[]); +DROP FUNCTION test3(); +DROP FUNCTION test4(); +DROP EXTENSION hstore_plperlu; +DROP EXTENSION hstore; +DROP EXTENSION plperlu; diff --git a/contrib/hstore_plperl/hstore_plperl--1.0.sql b/contrib/hstore_plperl/hstore_plperl--1.0.sql new file mode 100644 index 0000000..af743c8 --- /dev/null +++ b/contrib/hstore_plperl/hstore_plperl--1.0.sql @@ -0,0 +1,17 @@ +/* contrib/hstore_plperl/hstore_plperl--1.0.sql */ + +-- complain if script is sourced in psql, rather than via CREATE EXTENSION +\echo Use "CREATE EXTENSION hstore_plperl" to load this file. \quit + +CREATE FUNCTION hstore_to_plperl(val internal) RETURNS internal +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME'; + +CREATE FUNCTION plperl_to_hstore(val internal) RETURNS hstore +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME'; + +CREATE TRANSFORM FOR hstore LANGUAGE plperl ( + FROM SQL WITH FUNCTION hstore_to_plperl(internal), + TO SQL WITH FUNCTION plperl_to_hstore(internal) +); diff --git a/contrib/hstore_plperl/hstore_plperl.c b/contrib/hstore_plperl/hstore_plperl.c new file mode 100644 index 0000000..417b721 --- /dev/null +++ b/contrib/hstore_plperl/hstore_plperl.c @@ -0,0 +1,155 @@ +#include "postgres.h" + +#include "fmgr.h" +#include "hstore/hstore.h" +#include "plperl.h" +#include "plperl_helpers.h" + +PG_MODULE_MAGIC; + +extern void _PG_init(void); + +/* Linkage to functions in hstore module */ +typedef HStore *(*hstoreUpgrade_t) (Datum orig); +static hstoreUpgrade_t hstoreUpgrade_p; +typedef int (*hstoreUniquePairs_t) (Pairs *a, int32 l, int32 *buflen); +static hstoreUniquePairs_t hstoreUniquePairs_p; +typedef HStore *(*hstorePairs_t) (Pairs *pairs, int32 pcount, int32 buflen); +static hstorePairs_t hstorePairs_p; +typedef size_t (*hstoreCheckKeyLen_t) (size_t len); +static hstoreCheckKeyLen_t hstoreCheckKeyLen_p; +typedef size_t (*hstoreCheckValLen_t) (size_t len); +static hstoreCheckValLen_t hstoreCheckValLen_p; + + +/* + * Module initialize function: fetch function pointers for cross-module calls. + */ +void +_PG_init(void) +{ + /* Asserts verify that typedefs above match original declarations */ + AssertVariableIsOfType(&hstoreUpgrade, hstoreUpgrade_t); + hstoreUpgrade_p = (hstoreUpgrade_t) + load_external_function("$libdir/hstore", "hstoreUpgrade", + true, NULL); + AssertVariableIsOfType(&hstoreUniquePairs, hstoreUniquePairs_t); + hstoreUniquePairs_p = (hstoreUniquePairs_t) + load_external_function("$libdir/hstore", "hstoreUniquePairs", + true, NULL); + AssertVariableIsOfType(&hstorePairs, hstorePairs_t); + hstorePairs_p = (hstorePairs_t) + load_external_function("$libdir/hstore", "hstorePairs", + true, NULL); + AssertVariableIsOfType(&hstoreCheckKeyLen, hstoreCheckKeyLen_t); + hstoreCheckKeyLen_p = (hstoreCheckKeyLen_t) + load_external_function("$libdir/hstore", "hstoreCheckKeyLen", + true, NULL); + AssertVariableIsOfType(&hstoreCheckValLen, hstoreCheckValLen_t); + hstoreCheckValLen_p = (hstoreCheckValLen_t) + load_external_function("$libdir/hstore", "hstoreCheckValLen", + true, NULL); +} + + +/* These defines must be after the module init function */ +#define hstoreUpgrade hstoreUpgrade_p +#define hstoreUniquePairs hstoreUniquePairs_p +#define hstorePairs hstorePairs_p +#define hstoreCheckKeyLen hstoreCheckKeyLen_p +#define hstoreCheckValLen hstoreCheckValLen_p + + +PG_FUNCTION_INFO_V1(hstore_to_plperl); + +Datum +hstore_to_plperl(PG_FUNCTION_ARGS) +{ + dTHX; + HStore *in = PG_GETARG_HSTORE_P(0); + int i; + int count = HS_COUNT(in); + char *base = STRPTR(in); + HEntry *entries = ARRPTR(in); + HV *hv; + + hv = newHV(); + + for (i = 0; i < count; i++) + { + const char *key; + SV *value; + + key = pnstrdup(HSTORE_KEY(entries, base, i), + HSTORE_KEYLEN(entries, i)); + value = HSTORE_VALISNULL(entries, i) ? newSV(0) : + cstr2sv(pnstrdup(HSTORE_VAL(entries, base, i), + HSTORE_VALLEN(entries, i))); + + (void) hv_store(hv, key, strlen(key), value, 0); + } + + return PointerGetDatum(newRV((SV *) hv)); +} + + +PG_FUNCTION_INFO_V1(plperl_to_hstore); + +Datum +plperl_to_hstore(PG_FUNCTION_ARGS) +{ + dTHX; + SV *in = (SV *) PG_GETARG_POINTER(0); + HV *hv; + HE *he; + int32 buflen; + int32 i; + int32 pcount; + HStore *out; + Pairs *pairs; + + /* Dereference references recursively. */ + while (SvROK(in)) + in = SvRV(in); + + /* Now we must have a hash. */ + if (SvTYPE(in) != SVt_PVHV) + ereport(ERROR, + (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), + errmsg("cannot transform non-hash Perl value to hstore"))); + hv = (HV *) in; + + pcount = hv_iterinit(hv); + + pairs = palloc(pcount * sizeof(Pairs)); + + i = 0; + while ((he = hv_iternext(hv))) + { + char *key = sv2cstr(HeSVKEY_force(he)); + SV *value = HeVAL(he); + + pairs[i].key = pstrdup(key); + pairs[i].keylen = hstoreCheckKeyLen(strlen(pairs[i].key)); + pairs[i].needfree = true; + + if (!SvOK(value)) + { + pairs[i].val = NULL; + pairs[i].vallen = 0; + pairs[i].isnull = true; + } + else + { + pairs[i].val = pstrdup(sv2cstr(value)); + pairs[i].vallen = hstoreCheckValLen(strlen(pairs[i].val)); + pairs[i].isnull = false; + } + + i++; + } + + pcount = hstoreUniquePairs(pairs, pcount, &buflen); + out = hstorePairs(pairs, pcount, buflen); + PG_RETURN_POINTER(out); +} diff --git a/contrib/hstore_plperl/hstore_plperl.control b/contrib/hstore_plperl/hstore_plperl.control new file mode 100644 index 0000000..16277f6 --- /dev/null +++ b/contrib/hstore_plperl/hstore_plperl.control @@ -0,0 +1,6 @@ +# hstore_plperl extension +comment = 'transform between hstore and plperl' +default_version = '1.0' +module_pathname = '$libdir/hstore_plperl' +relocatable = true +requires = 'hstore,plperl' diff --git a/contrib/hstore_plperl/hstore_plperlu--1.0.sql b/contrib/hstore_plperl/hstore_plperlu--1.0.sql new file mode 100644 index 0000000..7c3bc86 --- /dev/null +++ b/contrib/hstore_plperl/hstore_plperlu--1.0.sql @@ -0,0 +1,17 @@ +/* contrib/hstore_plperl/hstore_plperlu--1.0.sql */ + +-- complain if script is sourced in psql, rather than via CREATE EXTENSION +\echo Use "CREATE EXTENSION hstore_plperlu" to load this file. \quit + +CREATE FUNCTION hstore_to_plperlu(val internal) RETURNS internal +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME', 'hstore_to_plperl'; + +CREATE FUNCTION plperlu_to_hstore(val internal) RETURNS hstore +LANGUAGE C STRICT IMMUTABLE +AS 'MODULE_PATHNAME', 'plperl_to_hstore'; + +CREATE TRANSFORM FOR hstore LANGUAGE plperlu ( + FROM SQL WITH FUNCTION hstore_to_plperlu(internal), + TO SQL WITH FUNCTION plperlu_to_hstore(internal) +); diff --git a/contrib/hstore_plperl/hstore_plperlu.control b/contrib/hstore_plperl/hstore_plperlu.control new file mode 100644 index 0000000..c8d43b4 --- /dev/null +++ b/contrib/hstore_plperl/hstore_plperlu.control @@ -0,0 +1,6 @@ +# hstore_plperlu extension +comment = 'transform between hstore and plperlu' +default_version = '1.0' +module_pathname = '$libdir/hstore_plperl' +relocatable = true +requires = 'hstore,plperlu' diff --git a/contrib/hstore_plperl/sql/create_transform.sql b/contrib/hstore_plperl/sql/create_transform.sql new file mode 100644 index 0000000..d0a12ad --- /dev/null +++ b/contrib/hstore_plperl/sql/create_transform.sql @@ -0,0 +1,49 @@ +-- general regression test for transforms + +DROP EXTENSION IF EXISTS hstore CASCADE; +DROP EXTENSION IF EXISTS plperl CASCADE; +DROP EXTENSION IF EXISTS hstore_plperl CASCADE; + +CREATE EXTENSION hstore; +CREATE EXTENSION plperl; + +CREATE FUNCTION hstore_to_plperl(val internal) RETURNS internal +LANGUAGE C STRICT IMMUTABLE +AS '$libdir/hstore_plperl'; + +CREATE FUNCTION plperl_to_hstore(val internal) RETURNS hstore +LANGUAGE C STRICT IMMUTABLE +AS '$libdir/hstore_plperl'; + +CREATE TRANSFORM FOR foo LANGUAGE plperl (FROM SQL WITH FUNCTION hstore_to_plperl(internal), TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- fail +CREATE TRANSFORM FOR hstore LANGUAGE foo (FROM SQL WITH FUNCTION hstore_to_plperl(internal), TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- fail +CREATE TRANSFORM FOR hstore LANGUAGE plperl (FROM SQL WITH FUNCTION hstore_out(hstore), TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- fail +CREATE TRANSFORM FOR hstore LANGUAGE plperl (FROM SQL WITH FUNCTION internal_in(cstring), TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- fail + +CREATE TRANSFORM FOR hstore LANGUAGE plperl (FROM SQL WITH FUNCTION hstore_to_plperl(internal), TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- ok +CREATE TRANSFORM FOR hstore LANGUAGE plperl (FROM SQL WITH FUNCTION hstore_to_plperl(internal), TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- fail +CREATE OR REPLACE TRANSFORM FOR hstore LANGUAGE plperl (FROM SQL WITH FUNCTION hstore_to_plperl(internal), TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- ok +CREATE OR REPLACE TRANSFORM FOR hstore LANGUAGE plperl (FROM SQL WITH FUNCTION hstore_to_plperl(internal)); -- ok +CREATE OR REPLACE TRANSFORM FOR hstore LANGUAGE plperl (TO SQL WITH FUNCTION plperl_to_hstore(internal)); -- ok + +COMMENT ON TRANSFORM FOR hstore LANGUAGE plperl IS 'test'; + +DROP TRANSFORM IF EXISTS FOR fake_type LANGUAGE plperl; +DROP TRANSFORM IF EXISTS FOR hstore LANGUAGE fake_lang; +DROP TRANSFORM FOR foo LANGUAGE plperl; +DROP TRANSFORM FOR hstore LANGUAGE foo; +DROP TRANSFORM FOR hstore LANGUAGE plperl; +DROP TRANSFORM IF EXISTS FOR hstore LANGUAGE plperl; + +DROP FUNCTION hstore_to_plperl(val internal); +DROP FUNCTION plperl_to_hstore(val internal); + +CREATE EXTENSION hstore_plperl; +\dx+ hstore_plperl +ALTER EXTENSION hstore_plperl DROP TRANSFORM FOR hstore LANGUAGE plperl; +\dx+ hstore_plperl +ALTER EXTENSION hstore_plperl ADD TRANSFORM FOR hstore LANGUAGE plperl; +\dx+ hstore_plperl + +DROP EXTENSION hstore CASCADE; +DROP EXTENSION plperl CASCADE; diff --git a/contrib/hstore_plperl/sql/hstore_plperl.sql b/contrib/hstore_plperl/sql/hstore_plperl.sql new file mode 100644 index 0000000..ad1db7e --- /dev/null +++ b/contrib/hstore_plperl/sql/hstore_plperl.sql @@ -0,0 +1,60 @@ +CREATE EXTENSION hstore_plperl CASCADE; + +SELECT transforms.udt_schema, transforms.udt_name, + routine_schema, routine_name, + group_name, transform_type +FROM information_schema.transforms JOIN information_schema.routines + USING (specific_catalog, specific_schema, specific_name) +ORDER BY 1, 2, 5, 6; + + +-- test perl -> hstore +CREATE FUNCTION test2() RETURNS hstore +LANGUAGE plperl +TRANSFORM FOR TYPE hstore +AS $$ +$val = {a => 1, b => 'boo', c => undef}; +return $val; +$$; + +SELECT test2(); + + +-- test perl -> hstore[] +CREATE FUNCTION test2arr() RETURNS hstore[] +LANGUAGE plperl +TRANSFORM FOR TYPE hstore +AS $$ +$val = [{a => 1, b => 'boo', c => undef}, {d => 2}]; +return $val; +$$; + +SELECT test2arr(); + +-- check error cases +CREATE OR REPLACE FUNCTION test2() RETURNS hstore +LANGUAGE plperl +TRANSFORM FOR TYPE hstore +AS $$ +return 42; +$$; + +SELECT test2(); + +CREATE OR REPLACE FUNCTION test2() RETURNS hstore +LANGUAGE plperl +TRANSFORM FOR TYPE hstore +AS $$ +return [1, 2]; +$$; + +SELECT test2(); + + +DROP FUNCTION test2(); +DROP FUNCTION test2arr(); + + +DROP EXTENSION hstore_plperl; +DROP EXTENSION hstore; +DROP EXTENSION plperl; diff --git a/contrib/hstore_plperl/sql/hstore_plperlu.sql b/contrib/hstore_plperl/sql/hstore_plperlu.sql new file mode 100644 index 0000000..c714b35 --- /dev/null +++ b/contrib/hstore_plperl/sql/hstore_plperlu.sql @@ -0,0 +1,125 @@ +CREATE EXTENSION hstore_plperlu CASCADE; + +SELECT transforms.udt_schema, transforms.udt_name, + routine_schema, routine_name, + group_name, transform_type +FROM information_schema.transforms JOIN information_schema.routines + USING (specific_catalog, specific_schema, specific_name) +ORDER BY 1, 2, 5, 6; + + +-- test hstore -> perl +CREATE FUNCTION test1(val hstore) RETURNS int +LANGUAGE plperlu +TRANSFORM FOR TYPE hstore +AS $$ +use Data::Dumper; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Indent = 0; +elog(INFO, Dumper($_[0])); +return scalar(keys %{$_[0]}); +$$; + +SELECT test1('aa=>bb, cc=>NULL'::hstore); + +CREATE FUNCTION test1none(val hstore) RETURNS int +LANGUAGE plperlu +AS $$ +use Data::Dumper; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Indent = 0; +elog(INFO, Dumper($_[0])); +return scalar(keys %{$_[0]}); +$$; + +SELECT test1none('aa=>bb, cc=>NULL'::hstore); + +CREATE FUNCTION test1list(val hstore) RETURNS int +LANGUAGE plperlu +TRANSFORM FOR TYPE hstore +AS $$ +use Data::Dumper; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Indent = 0; +elog(INFO, Dumper($_[0])); +return scalar(keys %{$_[0]}); +$$; + +SELECT test1list('aa=>bb, cc=>NULL'::hstore); + + +-- test hstore[] -> perl +CREATE FUNCTION test1arr(val hstore[]) RETURNS int +LANGUAGE plperlu +TRANSFORM FOR TYPE hstore +AS $$ +use Data::Dumper; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Indent = 0; +elog(INFO, Dumper($_[0]->[0], $_[0]->[1])); +return scalar(keys %{$_[0]}); +$$; + +SELECT test1arr(array['aa=>bb, cc=>NULL'::hstore, 'dd=>ee']); + + +-- test as part of prepare/execute +CREATE FUNCTION test3() RETURNS void +LANGUAGE plperlu +TRANSFORM FOR TYPE hstore +AS $$ +use Data::Dumper; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Indent = 0; + +$rv = spi_exec_query(q{SELECT 'aa=>bb, cc=>NULL'::hstore AS col1}); +elog(INFO, Dumper($rv->{rows}[0]->{col1})); + +$val = {a => 1, b => 'boo', c => undef}; +$plan = spi_prepare(q{SELECT $1::text AS col1}, "hstore"); +$rv = spi_exec_prepared($plan, {}, $val); +elog(INFO, Dumper($rv->{rows}[0]->{col1})); +$$; + +SELECT test3(); + + +-- test trigger +CREATE TABLE test1 (a int, b hstore); +INSERT INTO test1 VALUES (1, 'aa=>bb, cc=>NULL'); +SELECT * FROM test1; + +CREATE FUNCTION test4() RETURNS trigger +LANGUAGE plperlu +TRANSFORM FOR TYPE hstore +AS $$ +use Data::Dumper; +$Data::Dumper::Sortkeys = 1; +$Data::Dumper::Indent = 0; +elog(INFO, Dumper($_TD->{new})); +if ($_TD->{new}{a} == 1) { + $_TD->{new}{b} = {a => 1, b => 'boo', c => undef}; +} + +return "MODIFY"; +$$; + +CREATE TRIGGER test4 BEFORE UPDATE ON test1 FOR EACH ROW EXECUTE PROCEDURE test4(); + +UPDATE test1 SET a = a; +SELECT * FROM test1; + + +DROP TABLE test1; + +DROP FUNCTION test1(hstore); +DROP FUNCTION test1none(hstore); +DROP FUNCTION test1list(hstore); +DROP FUNCTION test1arr(hstore[]); +DROP FUNCTION test3(); +DROP FUNCTION test4(); + + +DROP EXTENSION hstore_plperlu; +DROP EXTENSION hstore; +DROP EXTENSION plperlu; |