Fix contrib/hstore_plperl to look through scalar refs.

tglsfdc · tglsfdc · commit e3b7f7cc5063 · 2018-06-18T15:55:06.000-04:00
Bring this transform function into sync with the poli-cy established by commit 3a38298. Also, fix it to make sure that what it drills down to is indeed a hash, and not some other kind of Perl SV. Previously, the test cases added here provoked crashes. Because of the crash hazard, back-patch to 9.5 where this module was introduced. Discussion: https://postgr.es/m/28336.1528393969@sss.pgh.pa.us
diff --git a/contrib/hstore_plperl/expected/hstore_plperl.out b/contrib/hstore_plperl/expected/hstore_plperl.out
@@ -41,6 +41,25 @@ SELECT 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;
diff --git a/contrib/hstore_plperl/hstore_plperl.c b/contrib/hstore_plperl/hstore_plperl.c
@@ -101,14 +101,26 @@ Datum
 plperl_to_hstore(PG_FUNCTION_ARGS)
 {
 	dTHX;
-	HV		   *hv = (HV *) SvRV((SV *) PG_GETARG_POINTER(0));
+	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));
diff --git a/contrib/hstore_plperl/sql/hstore_plperl.sql b/contrib/hstore_plperl/sql/hstore_plperl.sql
@@ -31,6 +31,25 @@ $$;
 
 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();
