mirror of
https://git.postgresql.org/git/postgresql.git
synced 2025-01-12 18:34:36 +08:00
Fix multiple causes of breakage in plperl's error handling.
This commit is contained in:
Tom Lane
parent
b40bc9eac6
commit
b5d0051ecf
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user