3333 * ENHANCEMENTS, OR MODIFICATIONS.
3434 *
3535 * IDENTIFICATION
36- * $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.35 2002/09/21 18:39:26 tgl Exp $
36+ * $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.36 2003/04/20 21:15:34 tgl Exp $
3737 *
3838 **********************************************************************/
3939
@@ -92,8 +92,6 @@ typedef struct plperl_proc_desc
9292 * Global data
9393 **********************************************************************/
9494static int plperl_firstcall = 1 ;
95- static int plperl_call_level = 0 ;
96- static int plperl_restart_in_progress = 0 ;
9795static PerlInterpreter * plperl_interp = NULL ;
9896static HV * plperl_proc_hash = NULL ;
9997
@@ -143,6 +141,15 @@ plperl_init_all(void)
143141if (!plperl_firstcall )
144142return ;
145143
144+ /************************************************************
145+ * Free the proc hash table
146+ ************************************************************/
147+ if (plperl_proc_hash != NULL )
148+ {
149+ hv_undef (plperl_proc_hash );
150+ SvREFCNT_dec ((SV * )plperl_proc_hash );
151+ plperl_proc_hash = NULL ;
152+ }
146153
147154/************************************************************
148155 * Destroy the existing Perl interpreter
@@ -154,16 +161,6 @@ plperl_init_all(void)
154161plperl_interp = NULL ;
155162}
156163
157- /************************************************************
158- * Free the proc hash table
159- ************************************************************/
160- if (plperl_proc_hash != NULL )
161- {
162- hv_undef (plperl_proc_hash );
163- SvREFCNT_dec ((SV * )plperl_proc_hash );
164- plperl_proc_hash = NULL ;
165- }
166-
167164/************************************************************
168165 * Now recreate a new Perl interpreter
169166 ************************************************************/
@@ -202,8 +199,6 @@ plperl_init_interp(void)
202199perl_parse (plperl_interp ,plperl_init_shared_libs ,3 ,embedding ,NULL );
203200perl_run (plperl_interp );
204201
205-
206-
207202/************************************************************
208203 * Initialize the proc and query hash tables
209204 ************************************************************/
@@ -212,7 +207,6 @@ plperl_init_interp(void)
212207}
213208
214209
215-
216210/**********************************************************************
217211 * plperl_call_handler- This is the only visible function
218212 * of the PL interpreter. The PostgreSQL
@@ -229,7 +223,7 @@ plperl_call_handler(PG_FUNCTION_ARGS)
229223Datum retval ;
230224
231225/************************************************************
232- * Initializeinterpreters on first call
226+ * Initializeinterpreter on first call
233227 ************************************************************/
234228if (plperl_firstcall )
235229plperl_init_all ();
@@ -239,10 +233,6 @@ plperl_call_handler(PG_FUNCTION_ARGS)
239233 ************************************************************/
240234if (SPI_connect ()!= SPI_OK_CONNECT )
241235elog (ERROR ,"plperl: cannot connect to SPI manager" );
242- /************************************************************
243- * Keep track about the nesting of Perl-SPI-Perl-... calls
244- ************************************************************/
245- plperl_call_level ++ ;
246236
247237/************************************************************
248238 * Determine if called as function or trigger and
@@ -261,8 +251,6 @@ plperl_call_handler(PG_FUNCTION_ARGS)
261251else
262252retval = plperl_func_handler (fcinfo );
263253
264- plperl_call_level -- ;
265-
266254return retval ;
267255}
268256
@@ -272,24 +260,35 @@ plperl_call_handler(PG_FUNCTION_ARGS)
272260 *create the anonymous subroutine whose text is in the SV.
273261 *Returns the SV containing the RV to the closure.
274262 **********************************************************************/
275- static
276- SV *
263+ static SV *
277264plperl_create_sub (char * s ,bool trusted )
278265{
279266dSP ;
280-
281- SV * subref = NULL ;
267+ SV * subref ;
282268int count ;
283269
284270ENTER ;
285271SAVETMPS ;
286272PUSHMARK (SP );
287273XPUSHs (sv_2mortal (newSVpv (s ,0 )));
288274PUTBACK ;
275+ /*
276+ * G_KEEPERR seems to be needed here, else we don't recognize compile
277+ * errors properly. Perhaps it's because there's another level of eval
278+ * inside mksafefunc?
279+ */
289280count = perl_call_pv ((trusted ?"mksafefunc" :"mkunsafefunc" ),
290281G_SCALAR |G_EVAL |G_KEEPERR );
291282SPAGAIN ;
292283
284+ if (count != 1 )
285+ {
286+ PUTBACK ;
287+ FREETMPS ;
288+ LEAVE ;
289+ elog (ERROR ,"plperl: didn't get a return item from mksafefunc" );
290+ }
291+
293292if (SvTRUE (ERRSV ))
294293{
295294POPs ;
@@ -299,9 +298,6 @@ plperl_create_sub(char *s, bool trusted)
299298elog (ERROR ,"creation of function failed: %s" ,SvPV (ERRSV ,PL_na ));
300299}
301300
302- if (count != 1 )
303- elog (ERROR ,"creation of function failed - no return from mksafefunc" );
304-
305301/*
306302 * need to make a deep copy of the return. it comes off the stack as a
307303 * temporary.
@@ -324,6 +320,7 @@ plperl_create_sub(char *s, bool trusted)
324320PUTBACK ;
325321FREETMPS ;
326322LEAVE ;
323+
327324return subref ;
328325}
329326
@@ -352,21 +349,18 @@ plperl_init_shared_libs(pTHX)
352349 * plperl_call_perl_func()- calls a perl function through the RV
353350 *stored in the prodesc structure. massages the input parms properly
354351 **********************************************************************/
355- static
356- SV *
352+ static SV *
357353plperl_call_perl_func (plperl_proc_desc * desc ,FunctionCallInfo fcinfo )
358354{
359355dSP ;
360-
361356SV * retval ;
362357int i ;
363358int count ;
364359
365-
366360ENTER ;
367361SAVETMPS ;
368362
369- PUSHMARK (sp );
363+ PUSHMARK (SP );
370364for (i = 0 ;i < desc -> nargs ;i ++ )
371365{
372366if (desc -> arg_is_rel [i ])
@@ -401,7 +395,9 @@ plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo)
401395}
402396}
403397PUTBACK ;
404- count = perl_call_sv (desc -> reference ,G_SCALAR |G_EVAL |G_KEEPERR );
398+
399+ /* Do NOT use G_KEEPERR here */
400+ count = perl_call_sv (desc -> reference ,G_SCALAR |G_EVAL );
405401
406402SPAGAIN ;
407403
@@ -424,16 +420,14 @@ plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo)
424420
425421retval = newSVsv (POPs );
426422
427-
428423PUTBACK ;
429424FREETMPS ;
430425LEAVE ;
431426
432427return retval ;
433-
434-
435428}
436429
430+
437431/**********************************************************************
438432 * plperl_func_handler()- Handler for regular function calls
439433 **********************************************************************/
@@ -443,23 +437,10 @@ plperl_func_handler(PG_FUNCTION_ARGS)
443437plperl_proc_desc * prodesc ;
444438SV * perlret ;
445439Datum retval ;
446- sigjmp_buf save_restart ;
447440
448441/* Find or compile the function */
449442prodesc = compile_plperl_function (fcinfo -> flinfo -> fn_oid , false);
450443
451- /* Set up error handling */
452- memcpy (& save_restart ,& Warn_restart ,sizeof (save_restart ));
453-
454- if (sigsetjmp (Warn_restart ,1 )!= 0 )
455- {
456- memcpy (& Warn_restart ,& save_restart ,sizeof (Warn_restart ));
457- plperl_restart_in_progress = 1 ;
458- if (-- plperl_call_level == 0 )
459- plperl_restart_in_progress = 0 ;
460- siglongjmp (Warn_restart ,1 );
461- }
462-
463444/************************************************************
464445 * Call the Perl function
465446 ************************************************************/
@@ -490,14 +471,6 @@ plperl_func_handler(PG_FUNCTION_ARGS)
490471
491472SvREFCNT_dec (perlret );
492473
493- memcpy (& Warn_restart ,& save_restart ,sizeof (Warn_restart ));
494- if (plperl_restart_in_progress )
495- {
496- if (-- plperl_call_level == 0 )
497- plperl_restart_in_progress = 0 ;
498- siglongjmp (Warn_restart ,1 );
499- }
500-
501474return retval ;
502475}
503476
@@ -734,7 +707,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
734707 * plperl_build_tuple_argument() - Build a string for a ref to a hash
735708 * from all attributes of a given tuple
736709 **********************************************************************/
737- static SV *
710+ static SV *
738711plperl_build_tuple_argument (HeapTuple tuple ,TupleDesc tupdesc )
739712{
740713int i ;