Re: replicable problem with PL/Perl - Mailing list pgsql-sql

Rajesh Kumar Mallah <mallah@trade-india.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
onlyvisible 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
calledas 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
theRV 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
theRV 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
prodescstructure. 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
prodescstructure. 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
forregular function calls  **********************************************************************/
 
--- 420,433 ----      retval = newSVsv(POPs);      PUTBACK;     FREETMPS;     LEAVE;      return retval; } 
+  /**********************************************************************  * plperl_func_handler()        - Handler
forregular 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 ----