Skip to content

Commit 06fb610

Browse files
tglsfdctglsfdc
committed
Make plperl work with OUT parameters.
1 parent 943178f commit 06fb610

File tree

3 files changed

+90
-19
lines changed

3 files changed

+90
-19
lines changed

‎src/pl/plperl/plperl.c

+12-19
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@
3333
* ENHANCEMENTS, OR MODIFICATIONS.
3434
*
3535
* IDENTIFICATION
36-
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.70 2005/03/29 00:17:20 tgl Exp $
36+
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.71 2005/04/01 19:34:06 tgl Exp $
3737
*
3838
**********************************************************************/
3939

@@ -409,21 +409,16 @@ plperl_trigger_build_args(FunctionCallInfo fcinfo)
409409
* NB: copy the result if needed for any great length of time
410410
*/
411411
static TupleDesc
412-
get_function_tupdesc(Oid result_type, ReturnSetInfo *rsinfo)
412+
get_function_tupdesc(FunctionCallInfo fcinfo)
413413
{
414-
if (result_type == RECORDOID)
415-
{
416-
/* We must get the information from call context */
417-
if (!rsinfo || !IsA(rsinfo, ReturnSetInfo) ||
418-
rsinfo->expectedDesc == NULL)
419-
ereport(ERROR,
420-
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
421-
errmsg("function returning record called in context "
422-
"that cannot accept type record")));
423-
return rsinfo->expectedDesc;
424-
}
425-
else /* ordinary composite type */
426-
return lookup_rowtype_tupdesc(result_type, -1);
414+
TupleDesc result;
415+
416+
if (get_call_result_type(fcinfo, NULL, &result) != TYPEFUNC_COMPOSITE)
417+
ereport(ERROR,
418+
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
419+
errmsg("function returning record called in context "
420+
"that cannot accept type record")));
421+
return result;
427422
}
428423

429424
/**********************************************************************
@@ -897,8 +892,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
897892

898893
/* Cache a copy of the result's tupdesc and attinmeta */
899894
oldcontext = MemoryContextSwitchTo(funcctx->multi_call_memory_ctx);
900-
tupdesc = get_function_tupdesc(prodesc->result_oid,
901-
(ReturnSetInfo *) fcinfo->resultinfo);
895+
tupdesc = get_function_tupdesc(fcinfo);
902896
tupdesc = CreateTupleDescCopy(tupdesc);
903897
funcctx->attinmeta = TupleDescGetAttInMetadata(tupdesc);
904898
MemoryContextSwitchTo(oldcontext);
@@ -1003,8 +997,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
1003997
/*
1004998
* XXX should cache the attinmeta data instead of recomputing
1005999
*/
1006-
td = get_function_tupdesc(prodesc->result_oid,
1007-
(ReturnSetInfo *) fcinfo->resultinfo);
1000+
td = get_function_tupdesc(fcinfo);
10081001
/* td = CreateTupleDescCopy(td); */
10091002
attinmeta = TupleDescGetAttInMetadata(td);
10101003

‎src/pl/plperl/test/test.expected

+55
Original file line numberDiff line numberDiff line change
@@ -222,6 +222,61 @@ SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
222222
3 | Hello | PL/Perl
223223
(3 rows)
224224

225+
CREATE OR REPLACE FUNCTION
226+
perl_out_params(f1 out integer, f2 out text, f3 out text) AS $$
227+
return {f2 => 'hello', f1 => 1, f3 => 'world'};
228+
$$ LANGUAGE plperl;
229+
SELECT perl_out_params();
230+
perl_out_params
231+
-----------------
232+
(1,hello,world)
233+
(1 row)
234+
235+
SELECT * FROM perl_out_params();
236+
f1 | f2 | f3
237+
----+-------+-------
238+
1 | hello | world
239+
(1 row)
240+
241+
SELECT (perl_out_params()).f2;
242+
f2
243+
-------
244+
hello
245+
(1 row)
246+
247+
CREATE OR REPLACE FUNCTION
248+
perl_out_params_set(out f1 integer, out f2 text, out f3 text)
249+
RETURNS SETOF record AS $$
250+
return [
251+
{ f1 => 1, f2 => 'Hello', f3 => 'World' },
252+
{ f1 => 2, f2 => 'Hello', f3 => 'PostgreSQL' },
253+
{ f1 => 3, f2 => 'Hello', f3 => 'PL/Perl' }
254+
];
255+
$$ LANGUAGE plperl;
256+
SELECT perl_out_params_set();
257+
perl_out_params_set
258+
----------------------
259+
(1,Hello,World)
260+
(2,Hello,PostgreSQL)
261+
(3,Hello,PL/Perl)
262+
(3 rows)
263+
264+
SELECT * FROM perl_out_params_set();
265+
f1 | f2 | f3
266+
----+-------+------------
267+
1 | Hello | World
268+
2 | Hello | PostgreSQL
269+
3 | Hello | PL/Perl
270+
(3 rows)
271+
272+
SELECT (perl_out_params_set()).f3;
273+
f3
274+
------------
275+
World
276+
PostgreSQL
277+
PL/Perl
278+
(3 rows)
279+
225280
CREATE TYPE footype AS (x INTEGER, y INTEGER);
226281
CREATE OR REPLACE FUNCTION foo_good() RETURNS SETOF footype AS $$
227282
return [

‎src/pl/plperl/test/test_queries.sql

+23
Original file line numberDiff line numberDiff line change
@@ -135,6 +135,29 @@ SELECT perl_record_set();
135135
SELECT * FROM perl_record_set();
136136
SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
137137

138+
CREATE OR REPLACE FUNCTION
139+
perl_out_params(f1 out integer, f2 out text, f3 out text) AS $$
140+
return {f2 => 'hello', f1 => 1, f3 => 'world'};
141+
$$ LANGUAGE plperl;
142+
143+
SELECT perl_out_params();
144+
SELECT * FROM perl_out_params();
145+
SELECT (perl_out_params()).f2;
146+
147+
CREATE OR REPLACE FUNCTION
148+
perl_out_params_set(out f1 integer, out f2 text, out f3 text)
149+
RETURNS SETOF record AS $$
150+
return [
151+
{ f1 => 1, f2 => 'Hello', f3 => 'World' },
152+
{ f1 => 2, f2 => 'Hello', f3 => 'PostgreSQL' },
153+
{ f1 => 3, f2 => 'Hello', f3 => 'PL/Perl' }
154+
];
155+
$$ LANGUAGE plperl;
156+
157+
SELECT perl_out_params_set();
158+
SELECT * FROM perl_out_params_set();
159+
SELECT (perl_out_params_set()).f3;
160+
138161
--
139162
-- Check behavior with erroneous return values
140163
--

0 commit comments

Comments
 (0)