Thanks to visit codestin.com
Credit goes to github.com

Skip to content

Commit 4178de3

Browse files
bmomjianbmomjian
committed
Back out patch for plperl to handle OUT paramaters into arrays and
hashes. Was causing regression failures.
1 parent fb55af2 commit 4178de3

File tree

2 files changed

+21
-177
lines changed

2 files changed

+21
-177
lines changed

‎src/pl/plperl/plperl.c

Lines changed: 21 additions & 93 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
/**********************************************************************
22
* plperl.c - perl as a procedural language for PostgreSQL
33
*
4-
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.114 2006/08/11 19:42:35 momjian Exp $
4+
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.115 2006/08/12 04:16:45 momjian Exp $
55
*
66
**********************************************************************/
77

@@ -52,7 +52,6 @@ typedef struct plperl_proc_desc
5252
FmgrInfo result_in_func; /* I/O function and arg for result type */
5353
Oid result_typioparam;
5454
int nargs;
55-
int num_out_args; /* number of out arguments */
5655
FmgrInfo arg_out_func[FUNC_MAX_ARGS];
5756
bool arg_is_rowtype[FUNC_MAX_ARGS];
5857
SV *reference;
@@ -116,9 +115,6 @@ static SV *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc);
116115
static void plperl_init_shared_libs(pTHX);
117116
static HV *plperl_spi_execute_fetch_result(SPITupleTable *, int, int);
118117

119-
static SV *plperl_convert_to_pg_array(SV *src);
120-
static SV *plperl_transform_result(plperl_proc_desc *prodesc, SV *result);
121-
122118
/*
123119
* This routine is a crock, and so is everyplace that calls it. The problem
124120
* is that the cached form of plperl functions/queries is allocated permanently
@@ -408,12 +404,7 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
408404
(errcode(ERRCODE_UNDEFINED_COLUMN),
409405
errmsg("Perl hash contains nonexistent column \"%s\"",
410406
key)));
411-
412-
/* if value is ref on array do to pg string array conversion */
413-
if (SvTYPE(val) == SVt_RV &&
414-
SvTYPE(SvRV(val)) == SVt_PVAV)
415-
values[attn - 1] = SvPV(plperl_convert_to_pg_array(val), PL_na);
416-
else if (SvOK(val) && SvTYPE(val) != SVt_NULL)
407+
if (SvOK(val) && SvTYPE(val) != SVt_NULL)
417408
values[attn - 1] = SvPV(val, PL_na);
418409
}
419410
hv_iterinit(perlhash);
@@ -690,7 +681,12 @@ plperl_validator(PG_FUNCTION_ARGS)
690681
HeapTuple tuple;
691682
Form_pg_proc proc;
692683
char functyptype;
684+
int numargs;
685+
Oid *argtypes;
686+
char **argnames;
687+
char *argmodes;
693688
bool istrigger = false;
689+
int i;
694690

695691
/* Get the new function's pg_proc entry */
696692
tuple = SearchSysCache(PROCOID,
@@ -718,6 +714,18 @@ plperl_validator(PG_FUNCTION_ARGS)
718714
format_type_be(proc->prorettype))));
719715
}
720716

717+
/* Disallow pseudotypes in arguments (either IN or OUT) */
718+
numargs = get_func_arg_info(tuple,
719+
&argtypes, &argnames, &argmodes);
720+
for (i = 0; i < numargs; i++)
721+
{
722+
if (get_typtype(argtypes[i]) == 'p')
723+
ereport(ERROR,
724+
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
725+
errmsg("plperl functions cannot take type %s",
726+
format_type_be(argtypes[i]))));
727+
}
728+
721729
ReleaseSysCache(tuple);
722730

723731
/* Postpone body checks if !check_function_bodies */
@@ -1120,8 +1128,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
11201128
/* Return a perl string converted to a Datum */
11211129
char *val;
11221130

1123-
perlret = plperl_transform_result(prodesc, perlret);
1124-
11251131
if (prodesc->fn_retisarray && SvROK(perlret) &&
11261132
SvTYPE(SvRV(perlret)) == SVt_PVAV)
11271133
{
@@ -1250,6 +1256,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
12501256
char internal_proname[64];
12511257
int proname_len;
12521258
plperl_proc_desc *prodesc = NULL;
1259+
int i;
12531260
SV **svp;
12541261

12551262
/* We'll need the pg_proc tuple in any case... */
@@ -1312,12 +1319,6 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
13121319
Datum prosrcdatum;
13131320
bool isnull;
13141321
char *proc_source;
1315-
int i;
1316-
int numargs;
1317-
Oid *argtypes;
1318-
char **argnames;
1319-
char *argmodes;
1320-
13211322

13221323
/************************************************************
13231324
* Allocate a new procedure description block
@@ -1336,25 +1337,6 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
13361337
prodesc->fn_readonly =
13371338
(procStruct->provolatile != PROVOLATILE_VOLATILE);
13381339

1339-
1340-
/* Disallow pseudotypes in arguments (either IN or OUT) */
1341-
/* Count number of out arguments */
1342-
numargs = get_func_arg_info(procTup,
1343-
&argtypes, &argnames, &argmodes);
1344-
for (i = 0; i < numargs; i++)
1345-
{
1346-
if (get_typtype(argtypes[i]) == 'p')
1347-
ereport(ERROR,
1348-
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1349-
errmsg("plperl functions cannot take type %s",
1350-
format_type_be(argtypes[i]))));
1351-
1352-
if (argmodes && argmodes[i] == PROARGMODE_OUT)
1353-
prodesc->num_out_args++;
1354-
1355-
}
1356-
1357-
13581340
/************************************************************
13591341
* Lookup the pg_language tuple by Oid
13601342
************************************************************/
@@ -1694,8 +1676,6 @@ plperl_return_next(SV *sv)
16941676
fcinfo = current_call_data->fcinfo;
16951677
rsi = (ReturnSetInfo *) fcinfo->resultinfo;
16961678

1697-
sv = plperl_transform_result(prodesc, sv);
1698-
16991679
if (!prodesc->fn_retisset)
17001680
ereport(ERROR,
17011681
(errcode(ERRCODE_SYNTAX_ERROR),
@@ -1773,16 +1753,7 @@ plperl_return_next(SV *sv)
17731753

17741754
if (SvOK(sv) && SvTYPE(sv) != SVt_NULL)
17751755
{
1776-
char *val;
1777-
SV *array_ret;
1778-
1779-
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV )
1780-
{
1781-
array_ret = plperl_convert_to_pg_array(sv);
1782-
sv = array_ret;
1783-
}
1784-
1785-
val = SvPV(sv, PL_na);
1756+
char *val = SvPV(sv, PL_na);
17861757

17871758
ret = InputFunctionCall(&prodesc->result_in_func, val,
17881759
prodesc->result_typioparam, -1);
@@ -2397,46 +2368,3 @@ plperl_spi_freeplan(char *query)
23972368

23982369
SPI_freeplan( plan);
23992370
}
2400-
2401-
/*
2402-
* If plerl result is hash and fce result is scalar, it's hash form of
2403-
* out argument. Then, transform it to scalar
2404-
*/
2405-
2406-
static SV *
2407-
plperl_transform_result(plperl_proc_desc *prodesc, SV *result)
2408-
{
2409-
bool exactly_one_field = false;
2410-
HV *hvr;
2411-
SV *val;
2412-
char *key;
2413-
I32 klen;
2414-
2415-
2416-
if (prodesc->num_out_args == 1 && SvOK(result)
2417-
&& SvTYPE(result) == SVt_RV && SvTYPE(SvRV(result)) == SVt_PVHV)
2418-
{
2419-
hvr = (HV *) SvRV(result);
2420-
hv_iterinit(hvr);
2421-
2422-
while ((val = hv_iternextsv(hvr, &key, &klen)))
2423-
{
2424-
if (exactly_one_field)
2425-
ereport(ERROR,
2426-
(errcode(ERRCODE_UNDEFINED_COLUMN),
2427-
errmsg("Perl hash contains nonexistent column \"%s\"",
2428-
key)));
2429-
exactly_one_field = true;
2430-
result = val;
2431-
}
2432-
2433-
if (!exactly_one_field)
2434-
ereport(ERROR,
2435-
(errcode(ERRCODE_UNDEFINED_COLUMN),
2436-
errmsg("Perl hash is empty")));
2437-
2438-
hv_iterinit(hvr);
2439-
}
2440-
2441-
return result;
2442-
}

‎src/pl/plperl/sql/plperl.sql

Lines changed: 0 additions & 84 deletions
Original file line numberDiff line numberDiff line change
@@ -337,87 +337,3 @@ CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF
337337
$$ LANGUAGE plperl;
338338
SELECT * from perl_spi_prepared_set(1,2);
339339

340-
---
341-
--- Some OUT and OUT array tests
342-
---
343-
344-
CREATE OR REPLACE FUNCTION test_out_params(OUT a varchar, OUT b varchar) AS $$
345-
return { a=> 'ahoj', b=>'svete'};
346-
$$ LANGUAGE plperl;
347-
SELECT '01' AS i, * FROM test_out_params();
348-
349-
CREATE OR REPLACE FUNCTION test_out_params_array(OUT a varchar[], OUT b varchar[]) AS $$
350-
return { a=> ['ahoj'], b=>['svete']};
351-
$$ LANGUAGE plperl;
352-
SELECT '02' AS i, * FROM test_out_params_array();
353-
354-
CREATE OR REPLACE FUNCTION test_out_params_set(OUT a varchar, out b varchar) RETURNS SETOF RECORD AS $$
355-
return_next { a=> 'ahoj', b=>'svete'};
356-
return_next { a=> 'ahoj', b=>'svete'};
357-
return_next { a=> 'ahoj', b=>'svete'};
358-
$$ LANGUAGE plperl;
359-
SELECT '03' AS I,* FROM test_out_params_set();
360-
361-
CREATE OR REPLACE FUNCTION test_out_params_set_array(OUT a varchar[], out b varchar[]) RETURNS SETOF RECORD AS $$
362-
return_next { a=> ['ahoj'], b=>['velky','svete']};
363-
return_next { a=> ['ahoj'], b=>['velky','svete']};
364-
return_next { a=> ['ahoj'], b=>['velky','svete']};
365-
$$ LANGUAGE plperl;
366-
SELECT '04' AS I,* FROM test_out_params_set_array();
367-
368-
369-
DROP FUNCTION test_out_params();
370-
DROP FUNCTION test_out_params_set();
371-
DROP FUNCTION test_out_params_array();
372-
DROP FUNCTION test_out_params_set_array();
373-
374-
-- one out argument can be returned as scalar or hash
375-
CREATE OR REPLACE FUNCTION test01(OUT a varchar) AS $$
376-
return 'ahoj';
377-
$$ LANGUAGE plperl ;
378-
SELECT '01' AS i,* FROM test01();
379-
380-
CREATE OR REPLACE FUNCTION test02(OUT a varchar[]) AS $$
381-
return {a=>['ahoj']};
382-
$$ LANGUAGE plperl;
383-
SELECT '02' AS i,a[1] FROM test02();
384-
385-
CREATE OR REPLACE FUNCTION test03(OUT a varchar[]) RETURNS SETOF varchar[] AS $$
386-
return_next { a=> ['ahoj']};
387-
return_next { a=> ['ahoj']};
388-
return_next { a=> ['ahoj']};
389-
$$ LANGUAGE plperl;
390-
SELECT '03' AS i,* FROM test03();
391-
392-
CREATE OR REPLACE FUNCTION test04() RETURNS SETOF VARCHAR[] AS $$
393-
return_next ['ahoj'];
394-
return_next ['ahoj'];
395-
$$ LANGUAGE plperl;
396-
SELECT '04' AS i,* FROM test04();
397-
398-
CREATE OR REPLACE FUNCTION test05(OUT a varchar) AS $$
399-
return {a=>'ahoj'};
400-
$$ LANGUAGE plperl;
401-
SELECT '05' AS i,a FROM test05();
402-
403-
CREATE OR REPLACE FUNCTION test06(OUT a varchar) RETURNS SETOF varchar AS $$
404-
return_next { a=> 'ahoj'};
405-
return_next { a=> 'ahoj'};
406-
return_next { a=> 'ahoj'};
407-
$$ LANGUAGE plperl;
408-
SELECT '06' AS i,* FROM test06();
409-
410-
CREATE OR REPLACE FUNCTION test07() RETURNS SETOF VARCHAR AS $$
411-
return_next 'ahoj';
412-
return_next 'ahoj';
413-
$$ LANGUAGE plperl;
414-
SELECT '07' AS i,* FROM test07();
415-
416-
DROP FUNCTION test01();
417-
DROP FUNCTION test02();
418-
DROP FUNCTION test03();
419-
DROP FUNCTION test04();
420-
DROP FUNCTION test05();
421-
DROP FUNCTION test06();
422-
DROP FUNCTION test07();
423-

0 commit comments

Comments
 (0)