summaryrefslogtreecommitdiffstats
path: root/contrib/hstore_plperl
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-05-04 12:17:33 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-05-04 12:17:33 +0000
commit5e45211a64149b3c659b90ff2de6fa982a5a93ed (patch)
tree739caf8c461053357daa9f162bef34516c7bf452 /contrib/hstore_plperl
parentInitial commit. (diff)
downloadpostgresql-15-5e45211a64149b3c659b90ff2de6fa982a5a93ed.tar.xz
postgresql-15-5e45211a64149b3c659b90ff2de6fa982a5a93ed.zip
Adding upstream version 15.5.upstream/15.5
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'contrib/hstore_plperl')
-rw-r--r--contrib/hstore_plperl/.gitignore4
-rw-r--r--contrib/hstore_plperl/Makefile41
-rw-r--r--contrib/hstore_plperl/expected/create_transform.out75
-rw-r--r--contrib/hstore_plperl/expected/hstore_plperl.out67
-rw-r--r--contrib/hstore_plperl/expected/hstore_plperlu.out151
-rw-r--r--contrib/hstore_plperl/hstore_plperl--1.0.sql17
-rw-r--r--contrib/hstore_plperl/hstore_plperl.c155
-rw-r--r--contrib/hstore_plperl/hstore_plperl.control6
-rw-r--r--contrib/hstore_plperl/hstore_plperlu--1.0.sql17
-rw-r--r--contrib/hstore_plperl/hstore_plperlu.control6
-rw-r--r--contrib/hstore_plperl/sql/create_transform.sql49
-rw-r--r--contrib/hstore_plperl/sql/hstore_plperl.sql60
-rw-r--r--contrib/hstore_plperl/sql/hstore_plperlu.sql125
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;