* 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 $
*
**********************************************************************/
* 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;
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
}
/************************************************************
- * 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
************************************************************/
plperl_init_interp();
perl_parse(plperl_interp, plperl_init_shared_libs, 3, embedding, NULL);
perl_run(plperl_interp);
-
-
/************************************************************
* Initialize the proc and query hash tables
************************************************************/
}
-
/**********************************************************************
* plperl_call_handler - This is the only visible function
* of the PL interpreter. The PostgreSQL
Datum retval;
/************************************************************
- * Initialize interpreters on first call
+ * Initialize interpreter on first call
************************************************************/
if (plperl_firstcall)
plperl_init_all();
************************************************************/
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
else
retval = plperl_func_handler(fcinfo);
- plperl_call_level--;
-
return retval;
}
* 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;
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;
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.
PUTBACK;
FREETMPS;
LEAVE;
+
return subref;
}
* 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])
}
}
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;
retval = newSVsv(POPs);
-
PUTBACK;
FREETMPS;
LEAVE;
return retval;
-
-
}
+
/**********************************************************************
* plperl_func_handler() - Handler for regular function calls
**********************************************************************/
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
************************************************************/
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;
}
* 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;
OSDN Git Service
