Re: replicable problem with PL/Perl

Rajesh Kumar Mallah <mallah(at)trade-india(dot)com> writes:
> if one pl/perl function raises an ERROR even other pl/perl
> functions stop working and keep rasing the previous error

> [ similar report last fall from John Worsley ]

I have applied the attached patch to fix these problems. (It's against
7.3 or current, but should be adaptable to 7.2 if you need to.) The
key point is to get rid of G_KEEPERR in the perl_call_sv function;
but it turns out that the setjmp/longjmp logic is broken too. Since the
latter wasn't doing anything particularly useful, I just diked it out.

regards, tom lane

*** src/pl/plperl/plperl.c.orig Sat Sep 21 14:39:26 2002
--- src/pl/plperl/plperl.c Sun Apr 20 17:15:34 2003
***************
*** 92,99 ****
* 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;

--- 92,97 ----
***************
*** 143,148 ****
--- 141,155 ----
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
***************
*** 155,170 ****
}

/************************************************************
- * 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();
--- 162,167 ----
***************
*** 202,209 ****
perl_parse(plperl_interp, plperl_init_shared_libs, 3, embedding, NULL);
perl_run(plperl_interp);

-
-
/************************************************************
* Initialize the proc and query hash tables
************************************************************/
--- 199,204 ----
***************
*** 212,218 ****
}


-
/**********************************************************************
* plperl_call_handler - This is the only visible function
* of the PL interpreter. The PostgreSQL
--- 207,212 ----
***************
*** 229,235 ****
Datum retval;

/************************************************************
! * Initialize interpreters on first call
************************************************************/
if (plperl_firstcall)
plperl_init_all();
--- 223,229 ----
Datum retval;

/************************************************************
! * Initialize interpreter on first call
************************************************************/
if (plperl_firstcall)
plperl_init_all();
***************
*** 239,248 ****
************************************************************/
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
--- 233,238 ----
***************
*** 261,268 ****
else
retval = plperl_func_handler(fcinfo);

- plperl_call_level--;
-
return retval;
}

--- 251,256 ----
***************
*** 272,284 ****
* create the anonymous subroutine whose text is in the SV.
* Returns the SV containing the RV to the closure.
**********************************************************************/
! static
! SV *
plperl_create_sub(char *s, bool trusted)
{
dSP;
!
! SV *subref = NULL;
int count;

ENTER;
--- 260,270 ----
* create the anonymous subroutine whose text is in the SV.
* Returns the SV containing the RV to the closure.
**********************************************************************/
! static SV *
plperl_create_sub(char *s, bool trusted)
{
dSP;
! SV *subref;
int count;

ENTER;
***************
*** 286,295 ****
--- 272,294 ----
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,307 ****
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.
--- 298,303 ----
***************
*** 324,329 ****
--- 320,326 ----
PUTBACK;
FREETMPS;
LEAVE;
+
return subref;
}

***************
*** 352,372 ****
* plperl_call_perl_func() - calls a perl function through the RV
* stored in the prodesc structure. massages the input parms properly
**********************************************************************/
! static
! SV *
plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo)
{
dSP;
-
SV *retval;
int i;
int count;

-
ENTER;
SAVETMPS;

! PUSHMARK(sp);
for (i = 0; i < desc->nargs; i++)
{
if (desc->arg_is_rel[i])
--- 349,366 ----
* plperl_call_perl_func() - calls a perl function through the RV
* stored in the prodesc structure. massages the input parms properly
**********************************************************************/
! static SV *
plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo)
{
dSP;
SV *retval;
int i;
int count;

ENTER;
SAVETMPS;

! PUSHMARK(SP);
for (i = 0; i < desc->nargs; i++)
{
if (desc->arg_is_rel[i])
***************
*** 401,407 ****
}
}
PUTBACK;
! count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL | G_KEEPERR);

SPAGAIN;

--- 395,403 ----
}
}
PUTBACK;
!
! /* Do NOT use G_KEEPERR here */
! count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL);

SPAGAIN;

***************
*** 424,439 ****

retval = newSVsv(POPs);

-
PUTBACK;
FREETMPS;
LEAVE;

return retval;
-
-
}

/**********************************************************************
* plperl_func_handler() - Handler for regular function calls
**********************************************************************/
--- 420,433 ----

retval = newSVsv(POPs);

PUTBACK;
FREETMPS;
LEAVE;

return retval;
}

+
/**********************************************************************
* plperl_func_handler() - Handler for regular function calls
**********************************************************************/
***************
*** 443,465 ****
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
************************************************************/
--- 437,446 ----
***************
*** 490,503 ****

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;
}

--- 471,476 ----