On Wed, Nov 18, 2009 at 12:38:00PM +0200, Alexey Klyukin wrote: > Yes, current_call_data can't be allocate in the SPI memory context, since > it's used to extract the result after SPI_finish is called, although it > doesn't lead to problems here since no result is returned. Anyway, I'd move > SPI_connect after the current_call_data initialization. > > I also noticed that no error context is set in the inline handler, not sure > whether it really useful except for the sake of consistency, but in case it > is - here is the patch:
Makes sense on both counts. Thanks for the help. How does the attached look? -- 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 ...86337f3 .
*** a/src/pl/plperl/expected/plperl_do.out
--- b/src/pl/plperl/expected/plperl_do.out
***************
*** 0 ****
--- 1,9 ----
+ DO $$
+ $a = 'This is a test';
+ elog(NOTICE, $a);
+ $$ LANGUAGE plperl;
+ NOTICE: This is a test
+ CONTEXT: PL/Perl anonymous code block
+ DO $$ use Config; $$ LANGUAGE plperl;
+ ERROR: 'require' trapped by operation mask at line 1.
+ CONTEXT: PL/Perl anonymous code block
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 4ed4f59..88b73f3 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);
*************** static SV *plperl_create_sub(char *pron
*** 164,169 ****
--- 165,171 ----
static SV *plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo);
static void plperl_compile_callback(void *arg);
static void plperl_exec_callback(void *arg);
+ static void plperl_inline_callback(void *arg);
/*
* This routine is a crock, and so is everyplace that calls it. The problem
*************** 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
--- 864,878 ----
/*
! * 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 ****
--- 902,980 ----
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;
+ ErrorContextCallback pl_error_context;
+
+ /* Set a callback for error reporting */
+ pl_error_context.callback = plperl_inline_callback;
+ pl_error_context.previous = error_context_stack;
+ pl_error_context.arg = (Datum) 0;
+ error_context_stack = &pl_error_context;
+
+ 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;
+
+ if (SPI_connect() != SPI_OK_CONNECT)
+ elog(ERROR, "could not connect to SPI manager");
+
+ 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();
+ {
+ error_context_stack = pl_error_context.previous;
+ 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");
+
+ error_context_stack = pl_error_context.previous;
+ 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;
--- 1251,1258 ----
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);
--- 1455,1461 ----
/* 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;
--- 2796,2804 ----
}
/*
! * 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)
--- 2807,2813 ----
}
/*
! * Provide function name for PL/Perl compilation errors
*/
static void
plperl_compile_callback(void *arg)
*************** plperl_compile_callback(void *arg)
*** 2736,2738 ****
--- 2816,2827 ----
if (procname)
errcontext("compilation of PL/Perl function \"%s\"", procname);
}
+
+ /*
+ * Error context for the inline handler
+ */
+ static void
+ plperl_inline_callback(void *arg)
+ {
+ errcontext("PL/Perl anonymous code block");
+ }
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
