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