On Tue, Nov 17, 2009 at 06:05:19PM -0500, Andrew Dunstan wrote:
>
>
> Alexey Klyukin wrote:
>>
>> I've noticed that the patch doesn't install current_call_data before calling
>> plperl_call_perl_func, although it saves and restores its previous value.
>> This breaks spi code, which relies on current_call_data->prodesc, i.e.:
>>
>> postgres=# DO $$ $result = spi_exec_query("select 1"); $$ LANGUAGE plperl;
>>
>
> Yeah, good catch. We need to lift some stuff out of
> plperl_func_handler(), because this code bypasses that. Not only setting
> the call_data but also connectin g to the SPI manager and maybe one or
> two other things.I kept thinking I had to test SPI, but I guess I hadn't ever done it. The attached takes care of such stuff, I think. >> Also, a call to to plperl_call_perl_func should be cast to void to avoid a >> possible compiler warning (although It doesn't emit one on my system): >> >> (void) plperl_call_perl_func(&desc, &fake_fcinfo); > > Right. I don't get the warning either, and didn't realize it could produce one. Thanks -- that change is also in the attached version. -- Joshua Tolley / eggyknap End Point Corporation http://www.endpoint.com
diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml
index 49631f2..ebcb608 100644
*** a/doc/src/sgml/plperl.sgml
--- b/doc/src/sgml/plperl.sgml
*************** CREATE FUNCTION <replaceable>funcname</r
*** 59,69 ****
# PL/Perl function body
$$ LANGUAGE plperl;
</programlisting>
The body of the function is ordinary Perl code. In fact, the PL/Perl
! glue code wraps it inside a Perl subroutine. A PL/Perl function must
! always return a scalar value. You can return more complex structures
! (arrays, records, and sets) by returning a reference, as discussed below.
! Never return a list.
</para>
<note>
--- 59,81 ----
# PL/Perl function body
$$ LANGUAGE plperl;
</programlisting>
+
+ PL/Perl also supports anonymous code blocks called with the
+ <xref linkend="sql-do" endterm="sql-do-title">
+ statement:
+
+ <programlisting>
+ DO $$
+ # PL/Perl function body
+ $$ LANGUAGE plperl;
+ </programlisting>
+
The body of the function is ordinary Perl code. In fact, the PL/Perl
! glue code wraps it inside a Perl subroutine. Anonymous code blocks cannot
! return a value; PL/Perl functions created with CREATE FUNCTION must always
! return a scalar value. You can return more complex structures (arrays,
! records, and sets) by returning a reference, as discussed below. Never
! return a list.
</para>
<note>
diff --git a/src/include/catalog/pg_pltemplate.h b/src/include/catalog/pg_pltemplate.h
index 5ef97df..8cdedb4 100644
*** a/src/include/catalog/pg_pltemplate.h
--- b/src/include/catalog/pg_pltemplate.h
*************** typedef FormData_pg_pltemplate *Form_pg_
*** 70,77 ****
DATA(insert ( "plpgsql" t t "plpgsql_call_handler" "plpgsql_inline_handler" "plpgsql_validator" "$libdir/plpgsql" _null_ ));
DATA(insert ( "pltcl" t t "pltcl_call_handler" _null_ _null_ "$libdir/pltcl" _null_ ));
DATA(insert ( "pltclu" f f "pltclu_call_handler" _null_ _null_ "$libdir/pltcl" _null_ ));
! DATA(insert ( "plperl" t t "plperl_call_handler" _null_ "plperl_validator" "$libdir/plperl" _null_ ));
! DATA(insert ( "plperlu" f f "plperl_call_handler" _null_ "plperl_validator" "$libdir/plperl" _null_ ));
DATA(insert ( "plpythonu" f f "plpython_call_handler" _null_ _null_ "$libdir/plpython" _null_ ));
#endif /* PG_PLTEMPLATE_H */
--- 70,77 ----
DATA(insert ( "plpgsql" t t "plpgsql_call_handler" "plpgsql_inline_handler" "plpgsql_validator" "$libdir/plpgsql" _null_ ));
DATA(insert ( "pltcl" t t "pltcl_call_handler" _null_ _null_ "$libdir/pltcl" _null_ ));
DATA(insert ( "pltclu" f f "pltclu_call_handler" _null_ _null_ "$libdir/pltcl" _null_ ));
! DATA(insert ( "plperl" t t "plperl_call_handler" "plperl_inline_handler" "plperl_validator" "$libdir/plperl" _null_ ));
! DATA(insert ( "plperlu" f f "plperl_call_handler" "plperl_inline_handler" "plperl_validator" "$libdir/plperl" _null_ ));
DATA(insert ( "plpythonu" f f "plpython_call_handler" _null_ _null_ "$libdir/plpython" _null_ ));
#endif /* PG_PLTEMPLATE_H */
diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile
index a3c3495..2c32850 100644
*** a/src/pl/plperl/GNUmakefile
--- b/src/pl/plperl/GNUmakefile
*************** OBJS = plperl.o spi_internal.o SPI.o
*** 38,45 ****
SHLIB_LINK = $(perl_embed_ldflags)
! REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl
! REGRESS = plperl plperl_trigger plperl_shared plperl_elog
# where to find psql for running the tests
PSQLDIR = $(bindir)
--- 38,45 ----
SHLIB_LINK = $(perl_embed_ldflags)
! REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl --load-language=plperlu
! REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperl_do
# where to find psql for running the tests
PSQLDIR = $(bindir)
diff --git a/src/pl/plperl/expected/plperl_do.out b/src/pl/plperl/expected/plperl_do.out
index ...a955581 .
*** a/src/pl/plperl/expected/plperl_do.out
--- b/src/pl/plperl/expected/plperl_do.out
***************
*** 0 ****
--- 1,7 ----
+ DO $$
+ $a = 'This is a test';
+ elog(NOTICE, $a);
+ $$ LANGUAGE plperl;
+ NOTICE: This is a test
+ DO $$ use Config; $$ LANGUAGE plperl;
+ ERROR: 'require' trapped by operation mask at line 1.
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 4ed4f59..9bb588b 100644
*** a/src/pl/plperl/plperl.c
--- b/src/pl/plperl/plperl.c
*************** static plperl_call_data *current_call_da
*** 144,149 ****
--- 144,150 ----
* Forward declarations
**********************************************************************/
Datum plperl_call_handler(PG_FUNCTION_ARGS);
+ Datum plperl_inline_handler(PG_FUNCTION_ARGS);
Datum plperl_validator(PG_FUNCTION_ARGS);
void _PG_init(void);
*************** plperl_modify_tuple(HV *hvTD, TriggerDat
*** 862,871 ****
/*
! * This is the only externally-visible part of the plperl call interface.
! * The Postgres function and trigger managers call it to execute a
! * perl function.
*/
PG_FUNCTION_INFO_V1(plperl_call_handler);
Datum
--- 863,877 ----
/*
! * There are three externally visible pieces to plperl: plperl_call_handler,
! * plperl_inline_handler, and plperl_validator. The first gets called to run
! * typical functions stored in pg_proc and created with CREATE FUNCTION as
! * schema objects. The second handles one-time, "inline" functions called with
! * the DO statement. Finally, the third validates a newly-created function at
! * the time of the CREATE FUNCTION call. The precise behavior of the validator
! * function may be modified by the check_function_bodies GUC.
*/
+
PG_FUNCTION_INFO_V1(plperl_call_handler);
Datum
*************** plperl_call_handler(PG_FUNCTION_ARGS)
*** 895,900 ****
--- 901,970 ----
return retval;
}
+ PG_FUNCTION_INFO_V1(plperl_inline_handler);
+
+ Datum
+ plperl_inline_handler(PG_FUNCTION_ARGS)
+ {
+ InlineCodeBlock *codeblock = (InlineCodeBlock *) DatumGetPointer(PG_GETARG_DATUM(0));
+ FunctionCallInfoData fake_fcinfo;
+ FmgrInfo flinfo;
+ plperl_proc_desc desc;
+ plperl_call_data *save_call_data = current_call_data;
+ bool oldcontext = trusted_context;
+
+ if (SPI_connect() != SPI_OK_CONNECT)
+ elog(ERROR, "could not connect to SPI manager");
+
+ MemSet(&fake_fcinfo, 0, sizeof(fake_fcinfo));
+ MemSet(&flinfo, 0, sizeof(flinfo));
+ MemSet(&desc, 0, sizeof(desc));
+ fake_fcinfo.flinfo = &flinfo;
+ flinfo.fn_oid = InvalidOid;
+ flinfo.fn_mcxt = CurrentMemoryContext;
+
+ desc.proname = "Do Inline Block";
+ desc.fn_readonly = false;
+
+ desc.lanpltrusted = codeblock->langIsTrusted;
+ check_interp(desc.lanpltrusted);
+
+ desc.fn_retistuple = false;
+ desc.fn_retisset = false;
+ desc.fn_retisarray = false;
+ desc.result_oid = VOIDOID;
+ desc.nargs = 0;
+
+ current_call_data = (plperl_call_data *) palloc0(sizeof(plperl_call_data));
+ current_call_data->fcinfo = &fake_fcinfo;
+ current_call_data->prodesc = &desc;
+
+ PG_TRY();
+ {
+
+ desc.reference = plperl_create_sub("DO Inline Block",
+ codeblock->source_text,
+ desc.lanpltrusted);
+
+ (void) plperl_call_perl_func(&desc, &fake_fcinfo);
+ }
+ PG_CATCH();
+ {
+ current_call_data = save_call_data;
+ restore_context(oldcontext);
+ PG_RE_THROW();
+ }
+ PG_END_TRY();
+
+ if (SPI_finish() != SPI_OK_FINISH)
+ elog(ERROR, "SPI_finish() failed");
+
+ current_call_data = save_call_data;
+ restore_context(oldcontext);
+
+ PG_RETURN_VOID();
+ }
+
/*
* This is the other externally visible function - it is called when CREATE
* FUNCTION is issued to validate the function being created/replaced.
*************** plperl_call_perl_trigger_func(plperl_pro
*** 1171,1178 ****
SV *td)
{
dSP;
! SV *retval;
! Trigger *tg_trigger;
int i;
int count;
--- 1241,1248 ----
SV *td)
{
dSP;
! SV *retval;
! Trigger *tg_trigger;
int i;
int count;
*************** plperl_func_handler(PG_FUNCTION_ARGS)
*** 1375,1381 ****
/* Restore the previous error callback */
error_context_stack = pl_error_context.previous;
!
if (array_ret == NULL)
SvREFCNT_dec(perlret);
--- 1445,1451 ----
/* Restore the previous error callback */
error_context_stack = pl_error_context.previous;
!
if (array_ret == NULL)
SvREFCNT_dec(perlret);
*************** hv_fetch_string(HV *hv, const char *key)
*** 2716,2724 ****
}
/*
! * Provide function name for PL/Perl execution errors
*/
! static void
plperl_exec_callback(void *arg)
{
char *procname = (char *) arg;
--- 2786,2794 ----
}
/*
! * Provide function name for PL/Perl execution errors
*/
! static void
plperl_exec_callback(void *arg)
{
char *procname = (char *) arg;
*************** plperl_exec_callback(void *arg)
*** 2727,2733 ****
}
/*
! * Provide function name for PL/Perl compilation errors
*/
static void
plperl_compile_callback(void *arg)
--- 2797,2803 ----
}
/*
! * Provide function name for PL/Perl compilation errors
*/
static void
plperl_compile_callback(void *arg)
diff --git a/src/pl/plperl/sql/plperl_do.sql b/src/pl/plperl/sql/plperl_do.sql
index ...35745dd .
*** a/src/pl/plperl/sql/plperl_do.sql
--- b/src/pl/plperl/sql/plperl_do.sql
***************
*** 0 ****
--- 1,6 ----
+ DO $$
+ $a = 'This is a test';
+ elog(NOTICE, $a);
+ $$ LANGUAGE plperl;
+
+ DO $$ use Config; $$ LANGUAGE plperl;
signature.asc
Description: Digital signature
