Location via proxy:   [ UP ]  
[Report a bug]   [Manage cookies]                
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)