diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index 299e389405..e4ad4102ac 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -33,7 +33,7 @@ * ENHANCEMENTS, OR MODIFICATIONS. * * IDENTIFICATION - * $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.35 2002/09/21 18:39:26 tgl Exp $ + * $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.36 2003/04/20 21:15:34 tgl Exp $ * **********************************************************************/ @@ -92,8 +92,6 @@ typedef struct plperl_proc_desc * Global data **********************************************************************/ static int plperl_firstcall = 1; -static int plperl_call_level = 0; -static int plperl_restart_in_progress = 0; static PerlInterpreter *plperl_interp = NULL; static HV *plperl_proc_hash = NULL; @@ -143,6 +141,15 @@ plperl_init_all(void) if (!plperl_firstcall) return; + /************************************************************ + * Free the proc hash table + ************************************************************/ + if (plperl_proc_hash != NULL) + { + hv_undef(plperl_proc_hash); + SvREFCNT_dec((SV *) plperl_proc_hash); + plperl_proc_hash = NULL; + } /************************************************************ * Destroy the existing Perl interpreter @@ -154,16 +161,6 @@ plperl_init_all(void) plperl_interp = NULL; } - /************************************************************ - * Free the proc hash table - ************************************************************/ - if (plperl_proc_hash != NULL) - { - hv_undef(plperl_proc_hash); - SvREFCNT_dec((SV *) plperl_proc_hash); - plperl_proc_hash = NULL; - } - /************************************************************ * Now recreate a new Perl interpreter ************************************************************/ @@ -202,8 +199,6 @@ plperl_init_interp(void) perl_parse(plperl_interp, plperl_init_shared_libs, 3, embedding, NULL); perl_run(plperl_interp); - - /************************************************************ * Initialize the proc and query hash tables ************************************************************/ @@ -212,7 +207,6 @@ plperl_init_interp(void) } - /********************************************************************** * plperl_call_handler - This is the only visible function * of the PL interpreter. The PostgreSQL @@ -229,7 +223,7 @@ plperl_call_handler(PG_FUNCTION_ARGS) Datum retval; /************************************************************ - * Initialize interpreters on first call + * Initialize interpreter on first call ************************************************************/ if (plperl_firstcall) plperl_init_all(); @@ -239,10 +233,6 @@ plperl_call_handler(PG_FUNCTION_ARGS) ************************************************************/ if (SPI_connect() != SPI_OK_CONNECT) elog(ERROR, "plperl: cannot connect to SPI manager"); - /************************************************************ - * Keep track about the nesting of Perl-SPI-Perl-... calls - ************************************************************/ - plperl_call_level++; /************************************************************ * Determine if called as function or trigger and @@ -261,8 +251,6 @@ plperl_call_handler(PG_FUNCTION_ARGS) else retval = plperl_func_handler(fcinfo); - plperl_call_level--; - return retval; } @@ -272,13 +260,11 @@ plperl_call_handler(PG_FUNCTION_ARGS) * create the anonymous subroutine whose text is in the SV. * Returns the SV containing the RV to the closure. **********************************************************************/ -static -SV * +static SV * plperl_create_sub(char *s, bool trusted) { dSP; - - SV *subref = NULL; + SV *subref; int count; ENTER; @@ -286,10 +272,23 @@ plperl_create_sub(char *s, bool trusted) PUSHMARK(SP); XPUSHs(sv_2mortal(newSVpv(s, 0))); PUTBACK; + /* + * G_KEEPERR seems to be needed here, else we don't recognize compile + * errors properly. Perhaps it's because there's another level of eval + * inside mksafefunc? + */ count = perl_call_pv((trusted ? "mksafefunc" : "mkunsafefunc"), G_SCALAR | G_EVAL | G_KEEPERR); SPAGAIN; + if (count != 1) + { + PUTBACK; + FREETMPS; + LEAVE; + elog(ERROR, "plperl: didn't get a return item from mksafefunc"); + } + if (SvTRUE(ERRSV)) { POPs; @@ -299,9 +298,6 @@ plperl_create_sub(char *s, bool trusted) elog(ERROR, "creation of function failed: %s", SvPV(ERRSV, PL_na)); } - if (count != 1) - elog(ERROR, "creation of function failed - no return from mksafefunc"); - /* * need to make a deep copy of the return. it comes off the stack as a * temporary. @@ -324,6 +320,7 @@ plperl_create_sub(char *s, bool trusted) PUTBACK; FREETMPS; LEAVE; + return subref; } @@ -352,21 +349,18 @@ plperl_init_shared_libs(pTHX) * plperl_call_perl_func() - calls a perl function through the RV * stored in the prodesc structure. massages the input parms properly **********************************************************************/ -static -SV * +static SV * plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo) { dSP; - SV *retval; int i; int count; - ENTER; SAVETMPS; - PUSHMARK(sp); + PUSHMARK(SP); for (i = 0; i < desc->nargs; i++) { if (desc->arg_is_rel[i]) @@ -401,7 +395,9 @@ plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo) } } PUTBACK; - count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL | G_KEEPERR); + + /* Do NOT use G_KEEPERR here */ + count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL); SPAGAIN; @@ -424,16 +420,14 @@ plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo) retval = newSVsv(POPs); - PUTBACK; FREETMPS; LEAVE; return retval; - - } + /********************************************************************** * plperl_func_handler() - Handler for regular function calls **********************************************************************/ @@ -443,23 +437,10 @@ plperl_func_handler(PG_FUNCTION_ARGS) plperl_proc_desc *prodesc; SV *perlret; Datum retval; - sigjmp_buf save_restart; /* Find or compile the function */ prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false); - /* Set up error handling */ - memcpy(&save_restart, &Warn_restart, sizeof(save_restart)); - - if (sigsetjmp(Warn_restart, 1) != 0) - { - memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart)); - plperl_restart_in_progress = 1; - if (--plperl_call_level == 0) - plperl_restart_in_progress = 0; - siglongjmp(Warn_restart, 1); - } - /************************************************************ * Call the Perl function ************************************************************/ @@ -490,14 +471,6 @@ plperl_func_handler(PG_FUNCTION_ARGS) SvREFCNT_dec(perlret); - memcpy(&Warn_restart, &save_restart, sizeof(Warn_restart)); - if (plperl_restart_in_progress) - { - if (--plperl_call_level == 0) - plperl_restart_in_progress = 0; - siglongjmp(Warn_restart, 1); - } - return retval; } @@ -734,7 +707,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger) * plperl_build_tuple_argument() - Build a string for a ref to a hash * from all attributes of a given tuple **********************************************************************/ -static SV * +static SV * plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc) { int i;