Based on this analysis, and problems with differing regression results
on different platforms, this attached patch has been reverted.
---------------------------------------------------------------------------
Andrew Dunstan wrote:
>
>
> I wrote:
> > Pavel Stehule wrote:
> >> Hello,
> >>
> >> I send two small patches. First does conversion from perl to
> >> postgresql array in OUT parameters. Second patch allow hash form
> >> output from procedures with one OUT argument.
> >>
> >
> > I will try to review these in the next 2 weeks unless someone beats me
> > to it.
> >
> >
>
> I have reviewed this lightly, as committed by Bruce, and have some
> concerns. Unfortunately, the deathof my main workstation has cost me
> much of the time I intended to use for a more thorough review, so there
> may well be more issues than are outlined here.
>
> First, it is completely undocumented.
>
> Second, this comment is at best confusing:
>
> /* if value is ref on array do to pg string array conversion */
>
>
> Third, it appears to assume that we will have names for all OUT params. But
> names are optional, as I understand it. Arguably, we should be treating the
> returns positionally, and thus return an arrayref when there are OYT params,
> not a hashref, and ignore the names - after all, all perl function args are
> nameless, in fact, even if you use a naming convention to refer to them.
>
> Fourth, I don't understand the change: "allow hash form output from
> procedures with one OUT argument." That seems very non-orthogonal, and I
> can't see any good reason for it.
>
> Lastly, if you look at the expected output as committed,it appears to have
> been prepared without being actually examined, for example:
>
>
> CREATE OR REPLACE FUNCTION test05(OUT a varchar) AS $$
> return {a=>'ahoj'};
> $$ LANGUAGE plperl;
> SELECT '05' AS i,a FROM test05();
> i | a
> ----+-----------------
> 05 | HASH(0x8558f9c)
> (1 row)
>
>
> what???
>
> And now that I look I see every buildfarm box broken on PLCheck. That's no
> surprise at all.
>
>
> The conversation regarding these features appears only to have started on
> July 28th, which was probably much too late given some of the issues. Unless
> we can solve these issues very fast I would be inclined to say this should be
> tabled for 8.3. I think this is a fairly good illustration of the danger of
> springing a feature, largely undiscussed, on the community just about freeze
> time.
>
> cheers
>
> andrew
>
>
>
>
>
--
Bruce Momjian [EMAIL PROTECTED]
EnterpriseDB http://www.enterprisedb.com
+ If your life is a hard drive, Christ can be your backup. +
Index: src/pl/plperl/plperl.c
===================================================================
RCS file: /cvsroot/pgsql/src/pl/plperl/plperl.c,v
retrieving revision 1.115
retrieving revision 1.116
diff -c -r1.115 -r1.116
*** src/pl/plperl/plperl.c 12 Aug 2006 04:16:45 -0000 1.115
--- src/pl/plperl/plperl.c 13 Aug 2006 02:37:11 -0000 1.116
***************
*** 1,7 ****
/**********************************************************************
* plperl.c - perl as a procedural language for PostgreSQL
*
! * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.115 2006/08/12 04:16:45 momjian Exp $
*
**********************************************************************/
--- 1,7 ----
/**********************************************************************
* plperl.c - perl as a procedural language for PostgreSQL
*
! * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.116 2006/08/13 02:37:11 momjian Exp $
*
**********************************************************************/
***************
*** 52,57 ****
--- 52,58 ----
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;
***************
*** 115,120 ****
--- 116,124 ----
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
***************
*** 404,410 ****
(errcode(ERRCODE_UNDEFINED_COLUMN),
errmsg("Perl hash contains nonexistent column \"%s\"",
key)));
! if (SvOK(val) && SvTYPE(val) != SVt_NULL)
values[attn - 1] = SvPV(val, PL_na);
}
hv_iterinit(perlhash);
--- 408,419 ----
(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)
values[attn - 1] = SvPV(val, PL_na);
}
hv_iterinit(perlhash);
***************
*** 681,692 ****
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,
--- 690,696 ----
***************
*** 714,731 ****
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 */
--- 718,723 ----
***************
*** 1128,1133 ****
--- 1120,1127 ----
/* 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)
{
***************
*** 1256,1262 ****
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... */
--- 1250,1255 ----
***************
*** 1319,1324 ****
--- 1312,1323 ----
Datum prosrcdatum;
bool isnull;
char *proc_source;
+ int i;
+ int numargs;
+ Oid *argtypes;
+ char **argnames;
+ char *argmodes;
+
/************************************************************
* Allocate a new procedure description block
***************
*** 1337,1342 ****
--- 1336,1360 ----
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
************************************************************/
***************
*** 1676,1681 ****
--- 1694,1701 ----
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),
***************
*** 1753,1759 ****
if (SvOK(sv) && SvTYPE(sv) != SVt_NULL)
{
! char *val = SvPV(sv, PL_na);
ret = InputFunctionCall(&prodesc->result_in_func, val,
prodesc->result_typioparam, -1);
--- 1773,1788 ----
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);
ret = InputFunctionCall(&prodesc->result_in_func, val,
prodesc->result_typioparam, -1);
***************
*** 2368,2370 ****
--- 2397,2442 ----
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;
+ }
Index: src/pl/plperl/expected/plperl.out
===================================================================
RCS file: /cvsroot/pgsql/src/pl/plperl/expected/plperl.out,v
retrieving revision 1.7
retrieving revision 1.8
diff -c -r1.7 -r1.8
*** src/pl/plperl/expected/plperl.out 5 Mar 2006 16:40:51 -0000 1.7
--- src/pl/plperl/expected/plperl.out 13 Aug 2006 02:37:11 -0000 1.8
***************
*** 468,470 ****
--- 468,579 ----
4
(2 rows)
+ ---
+ --- 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();
+ i | a | b
+ ----+------+-------
+ 01 | ahoj | svete
+ (1 row)
+
+ 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();
+ ERROR: array value must start with "{" or dimension information
+ 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();
+ i | a | b
+ ----+------+-------
+ 03 | ahoj | svete
+ 03 | ahoj | svete
+ 03 | ahoj | svete
+ (3 rows)
+
+ 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();
+ ERROR: error from Perl function: array value must start with "{" or dimension information at line 2.
+ 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();
+ i | a
+ ----+------
+ 01 | ahoj
+ (1 row)
+
+ CREATE OR REPLACE FUNCTION test02(OUT a varchar[]) AS $$
+ return {a=>['ahoj']};
+ $$ LANGUAGE plperl;
+ SELECT '02' AS i,a[1] FROM test02();
+ ERROR: array value must start with "{" or dimension information
+ 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();
+ ERROR: error from Perl function: array value must start with "{" or dimension information at line 2.
+ CREATE OR REPLACE FUNCTION test04() RETURNS SETOF VARCHAR[] AS $$
+ return_next ['ahoj'];
+ return_next ['ahoj'];
+ $$ LANGUAGE plperl;
+ SELECT '04' AS i,* FROM test04();
+ ERROR: error from Perl function: array value must start with "{" or dimension information at line 2.
+ CREATE OR REPLACE FUNCTION test05(OUT a varchar) AS $$
+ return {a=>'ahoj'};
+ $$ LANGUAGE plperl;
+ SELECT '05' AS i,a FROM test05();
+ i | a
+ ----+-----------------
+ 05 | HASH(0x8558f9c)
+ (1 row)
+
+ 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();
+ i | a
+ ----+-----------------
+ 06 | HASH(0x8559230)
+ 06 | HASH(0x8559230)
+ 06 | HASH(0x8559230)
+ (3 rows)
+
+ CREATE OR REPLACE FUNCTION test07() RETURNS SETOF VARCHAR AS $$
+ return_next 'ahoj';
+ return_next 'ahoj';
+ $$ LANGUAGE plperl;
+ SELECT '07' AS i,* FROM test07();
+ i | test07
+ ----+--------
+ 07 | ahoj
+ 07 | ahoj
+ (2 rows)
+
+ DROP FUNCTION test01();
+ DROP FUNCTION test02();
+ DROP FUNCTION test03();
+ DROP FUNCTION test04();
+ DROP FUNCTION test05();
+ DROP FUNCTION test06();
+ DROP FUNCTION test07();
Index: src/pl/plperl/sql/plperl.sql
===================================================================
RCS file: /cvsroot/pgsql/src/pl/plperl/sql/plperl.sql,v
retrieving revision 1.9
retrieving revision 1.10
diff -c -r1.9 -r1.10
*** src/pl/plperl/sql/plperl.sql 12 Aug 2006 04:16:45 -0000 1.9
--- src/pl/plperl/sql/plperl.sql 13 Aug 2006 02:37:11 -0000 1.10
***************
*** 337,339 ****
--- 337,423 ----
$$ 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();
+
---------------------------(end of broadcast)---------------------------
TIP 2: Don't 'kill -9' the postmaster
