mirror of
https://git.postgresql.org/git/postgresql.git
synced 2024-12-27 08:39:28 +08:00
Back out patch for plperl to handle OUT paramaters into arrays and
hashes. Was causing regression failures.
This commit is contained in:
Bruce Momjian
parent
fb55af227e
commit
4178de3d43
@ -1,7 +1,7 @@
|
||||
/**********************************************************************
|
||||
* plperl.c - perl as a procedural language for PostgreSQL
|
||||
*
|
||||
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.114 2006/08/11 19:42:35 momjian Exp $
|
||||
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.115 2006/08/12 04:16:45 momjian Exp $
|
||||
*
|
||||
**********************************************************************/
|
||||
|
||||
@ -52,7 +52,6 @@ typedef struct plperl_proc_desc
|
||||
FmgrInfo result_in_func; /* I/O function and arg for result type */
|
||||
Oid result_typioparam;
|
||||
int nargs;
|
||||
int num_out_args; /* number of out arguments */
|
||||
FmgrInfo arg_out_func[FUNC_MAX_ARGS];
|
||||
bool arg_is_rowtype[FUNC_MAX_ARGS];
|
||||
SV *reference;
|
||||
@ -116,9 +115,6 @@ static SV *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc);
|
||||
static void plperl_init_shared_libs(pTHX);
|
||||
static HV *plperl_spi_execute_fetch_result(SPITupleTable *, int, int);
|
||||
|
||||
static SV *plperl_convert_to_pg_array(SV *src);
|
||||
static SV *plperl_transform_result(plperl_proc_desc *prodesc, SV *result);
|
||||
|
||||
/*
|
||||
* This routine is a crock, and so is everyplace that calls it. The problem
|
||||
* is that the cached form of plperl functions/queries is allocated permanently
|
||||
@ -408,12 +404,7 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
|
||||
(errcode(ERRCODE_UNDEFINED_COLUMN),
|
||||
errmsg("Perl hash contains nonexistent column \"%s\"",
|
||||
key)));
|
||||
|
||||
/* if value is ref on array do to pg string array conversion */
|
||||
if (SvTYPE(val) == SVt_RV &&
|
||||
SvTYPE(SvRV(val)) == SVt_PVAV)
|
||||
values[attn - 1] = SvPV(plperl_convert_to_pg_array(val), PL_na);
|
||||
else if (SvOK(val) && SvTYPE(val) != SVt_NULL)
|
||||
if (SvOK(val) && SvTYPE(val) != SVt_NULL)
|
||||
values[attn - 1] = SvPV(val, PL_na);
|
||||
}
|
||||
hv_iterinit(perlhash);
|
||||
@ -690,7 +681,12 @@ plperl_validator(PG_FUNCTION_ARGS)
|
||||
HeapTuple tuple;
|
||||
Form_pg_proc proc;
|
||||
char functyptype;
|
||||
int numargs;
|
||||
Oid *argtypes;
|
||||
char **argnames;
|
||||
char *argmodes;
|
||||
bool istrigger = false;
|
||||
int i;
|
||||
|
||||
/* Get the new function's pg_proc entry */
|
||||
tuple = SearchSysCache(PROCOID,
|
||||
@ -718,6 +714,18 @@ plperl_validator(PG_FUNCTION_ARGS)
|
||||
format_type_be(proc->prorettype))));
|
||||
}
|
||||
|
||||
/* Disallow pseudotypes in arguments (either IN or OUT) */
|
||||
numargs = get_func_arg_info(tuple,
|
||||
&argtypes, &argnames, &argmodes);
|
||||
for (i = 0; i < numargs; i++)
|
||||
{
|
||||
if (get_typtype(argtypes[i]) == 'p')
|
||||
ereport(ERROR,
|
||||
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
|
||||
errmsg("plperl functions cannot take type %s",
|
||||
format_type_be(argtypes[i]))));
|
||||
}
|
||||
|
||||
ReleaseSysCache(tuple);
|
||||
|
||||
/* Postpone body checks if !check_function_bodies */
|
||||
@ -1120,8 +1128,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
|
||||
/* Return a perl string converted to a Datum */
|
||||
char *val;
|
||||
|
||||
perlret = plperl_transform_result(prodesc, perlret);
|
||||
|
||||
if (prodesc->fn_retisarray && SvROK(perlret) &&
|
||||
SvTYPE(SvRV(perlret)) == SVt_PVAV)
|
||||
{
|
||||
@ -1250,6 +1256,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
|
||||
char internal_proname[64];
|
||||
int proname_len;
|
||||
plperl_proc_desc *prodesc = NULL;
|
||||
int i;
|
||||
SV **svp;
|
||||
|
||||
/* We'll need the pg_proc tuple in any case... */
|
||||
@ -1312,12 +1319,6 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
|
||||
Datum prosrcdatum;
|
||||
bool isnull;
|
||||
char *proc_source;
|
||||
int i;
|
||||
int numargs;
|
||||
Oid *argtypes;
|
||||
char **argnames;
|
||||
char *argmodes;
|
||||
|
||||
|
||||
/************************************************************
|
||||
* Allocate a new procedure description block
|
||||
@ -1336,25 +1337,6 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
|
||||
prodesc->fn_readonly =
|
||||
(procStruct->provolatile != PROVOLATILE_VOLATILE);
|
||||
|
||||
|
||||
/* Disallow pseudotypes in arguments (either IN or OUT) */
|
||||
/* Count number of out arguments */
|
||||
numargs = get_func_arg_info(procTup,
|
||||
&argtypes, &argnames, &argmodes);
|
||||
for (i = 0; i < numargs; i++)
|
||||
{
|
||||
if (get_typtype(argtypes[i]) == 'p')
|
||||
ereport(ERROR,
|
||||
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
|
||||
errmsg("plperl functions cannot take type %s",
|
||||
format_type_be(argtypes[i]))));
|
||||
|
||||
if (argmodes && argmodes[i] == PROARGMODE_OUT)
|
||||
prodesc->num_out_args++;
|
||||
|
||||
}
|
||||
|
||||
|
||||
/************************************************************
|
||||
* Lookup the pg_language tuple by Oid
|
||||
************************************************************/
|
||||
@ -1694,8 +1676,6 @@ plperl_return_next(SV *sv)
|
||||
fcinfo = current_call_data->fcinfo;
|
||||
rsi = (ReturnSetInfo *) fcinfo->resultinfo;
|
||||
|
||||
sv = plperl_transform_result(prodesc, sv);
|
||||
|
||||
if (!prodesc->fn_retisset)
|
||||
ereport(ERROR,
|
||||
(errcode(ERRCODE_SYNTAX_ERROR),
|
||||
@ -1773,16 +1753,7 @@ plperl_return_next(SV *sv)
|
||||
|
||||
if (SvOK(sv) && SvTYPE(sv) != SVt_NULL)
|
||||
{
|
||||
char *val;
|
||||
SV *array_ret;
|
||||
|
||||
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV )
|
||||
{
|
||||
array_ret = plperl_convert_to_pg_array(sv);
|
||||
sv = array_ret;
|
||||
}
|
||||
|
||||
val = SvPV(sv, PL_na);
|
||||
char *val = SvPV(sv, PL_na);
|
||||
|
||||
ret = InputFunctionCall(&prodesc->result_in_func, val,
|
||||
prodesc->result_typioparam, -1);
|
||||
@ -2397,46 +2368,3 @@ plperl_spi_freeplan(char *query)
|
||||
|
||||
SPI_freeplan( plan);
|
||||
}
|
||||
|
||||
/*
|
||||
* If plerl result is hash and fce result is scalar, it's hash form of
|
||||
* out argument. Then, transform it to scalar
|
||||
*/
|
||||
|
||||
static SV *
|
||||
plperl_transform_result(plperl_proc_desc *prodesc, SV *result)
|
||||
{
|
||||
bool exactly_one_field = false;
|
||||
HV *hvr;
|
||||
SV *val;
|
||||
char *key;
|
||||
I32 klen;
|
||||
|
||||
|
||||
if (prodesc->num_out_args == 1 && SvOK(result)
|
||||
&& SvTYPE(result) == SVt_RV && SvTYPE(SvRV(result)) == SVt_PVHV)
|
||||
{
|
||||
hvr = (HV *) SvRV(result);
|
||||
hv_iterinit(hvr);
|
||||
|
||||
while ((val = hv_iternextsv(hvr, &key, &klen)))
|
||||
{
|
||||
if (exactly_one_field)
|
||||
ereport(ERROR,
|
||||
(errcode(ERRCODE_UNDEFINED_COLUMN),
|
||||
errmsg("Perl hash contains nonexistent column \"%s\"",
|
||||
key)));
|
||||
exactly_one_field = true;
|
||||
result = val;
|
||||
}
|
||||
|
||||
if (!exactly_one_field)
|
||||
ereport(ERROR,
|
||||
(errcode(ERRCODE_UNDEFINED_COLUMN),
|
||||
errmsg("Perl hash is empty")));
|
||||
|
||||
hv_iterinit(hvr);
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
@ -337,87 +337,3 @@ CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF
|
||||
$$ LANGUAGE plperl;
|
||||
SELECT * from perl_spi_prepared_set(1,2);
|
||||
|
||||
---
|
||||
--- Some OUT and OUT array tests
|
||||
---
|
||||
|
||||
CREATE OR REPLACE FUNCTION test_out_params(OUT a varchar, OUT b varchar) AS $$
|
||||
return { a=> 'ahoj', b=>'svete'};
|
||||
$$ LANGUAGE plperl;
|
||||
SELECT '01' AS i, * FROM test_out_params();
|
||||
|
||||
CREATE OR REPLACE FUNCTION test_out_params_array(OUT a varchar[], OUT b varchar[]) AS $$
|
||||
return { a=> ['ahoj'], b=>['svete']};
|
||||
$$ LANGUAGE plperl;
|
||||
SELECT '02' AS i, * FROM test_out_params_array();
|
||||
|
||||
CREATE OR REPLACE FUNCTION test_out_params_set(OUT a varchar, out b varchar) RETURNS SETOF RECORD AS $$
|
||||
return_next { a=> 'ahoj', b=>'svete'};
|
||||
return_next { a=> 'ahoj', b=>'svete'};
|
||||
return_next { a=> 'ahoj', b=>'svete'};
|
||||
$$ LANGUAGE plperl;
|
||||
SELECT '03' AS I,* FROM test_out_params_set();
|
||||
|
||||
CREATE OR REPLACE FUNCTION test_out_params_set_array(OUT a varchar[], out b varchar[]) RETURNS SETOF RECORD AS $$
|
||||
return_next { a=> ['ahoj'], b=>['velky','svete']};
|
||||
return_next { a=> ['ahoj'], b=>['velky','svete']};
|
||||
return_next { a=> ['ahoj'], b=>['velky','svete']};
|
||||
$$ LANGUAGE plperl;
|
||||
SELECT '04' AS I,* FROM test_out_params_set_array();
|
||||
|
||||
|
||||
DROP FUNCTION test_out_params();
|
||||
DROP FUNCTION test_out_params_set();
|
||||
DROP FUNCTION test_out_params_array();
|
||||
DROP FUNCTION test_out_params_set_array();
|
||||
|
||||
-- one out argument can be returned as scalar or hash
|
||||
CREATE OR REPLACE FUNCTION test01(OUT a varchar) AS $$
|
||||
return 'ahoj';
|
||||
$$ LANGUAGE plperl ;
|
||||
SELECT '01' AS i,* FROM test01();
|
||||
|
||||
CREATE OR REPLACE FUNCTION test02(OUT a varchar[]) AS $$
|
||||
return {a=>['ahoj']};
|
||||
$$ LANGUAGE plperl;
|
||||
SELECT '02' AS i,a[1] FROM test02();
|
||||
|
||||
CREATE OR REPLACE FUNCTION test03(OUT a varchar[]) RETURNS SETOF varchar[] AS $$
|
||||
return_next { a=> ['ahoj']};
|
||||
return_next { a=> ['ahoj']};
|
||||
return_next { a=> ['ahoj']};
|
||||
$$ LANGUAGE plperl;
|
||||
SELECT '03' AS i,* FROM test03();
|
||||
|
||||
CREATE OR REPLACE FUNCTION test04() RETURNS SETOF VARCHAR[] AS $$
|
||||
return_next ['ahoj'];
|
||||
return_next ['ahoj'];
|
||||
$$ LANGUAGE plperl;
|
||||
SELECT '04' AS i,* FROM test04();
|
||||
|
||||
CREATE OR REPLACE FUNCTION test05(OUT a varchar) AS $$
|
||||
return {a=>'ahoj'};
|
||||
$$ LANGUAGE plperl;
|
||||
SELECT '05' AS i,a FROM test05();
|
||||
|
||||
CREATE OR REPLACE FUNCTION test06(OUT a varchar) RETURNS SETOF varchar AS $$
|
||||
return_next { a=> 'ahoj'};
|
||||
return_next { a=> 'ahoj'};
|
||||
return_next { a=> 'ahoj'};
|
||||
$$ LANGUAGE plperl;
|
||||
SELECT '06' AS i,* FROM test06();
|
||||
|
||||
CREATE OR REPLACE FUNCTION test07() RETURNS SETOF VARCHAR AS $$
|
||||
return_next 'ahoj';
|
||||
return_next 'ahoj';
|
||||
$$ LANGUAGE plperl;
|
||||
SELECT '07' AS i,* FROM test07();
|
||||
|
||||
DROP FUNCTION test01();
|
||||
DROP FUNCTION test02();
|
||||
DROP FUNCTION test03();
|
||||
DROP FUNCTION test04();
|
||||
DROP FUNCTION test05();
|
||||
DROP FUNCTION test06();
|
||||
DROP FUNCTION test07();
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user