X-Git-Url: http://git.indexdata.com/?p=simpleserver-moved-to-github.git;a=blobdiff_plain;f=SimpleServer.xs;h=9e276217aeb2ed5525f2427a8c5959fbbaf7162e;hp=0f4d5ab2b9ae3c763bbbc309383e51350abc11b7;hb=c7145efffe9cfd830ba341d782e8b07ca0a6b40f;hpb=9c887fc97d778b4817ab59bea111f5377196d8b4

diff --git a/SimpleServer.xs b/SimpleServer.xs
index 0f4d5ab..9e27621 100644
--- a/SimpleServer.xs
+++ b/SimpleServer.xs
@@ -1,9 +1,8 @@
 /*
-
- * $Id: SimpleServer.xs,v 1.22 2004-05-11 12:56:37 adam Exp $ 
+ * $Id: SimpleServer.xs,v 1.26 2004-05-29 07:04:26 adam Exp $ 
  * ----------------------------------------------------------------------
  * 
- * Copyright (c) 2000, Index Data.
+ * Copyright (c) 2000-2004, Index Data.
  *
  * Permission to use, copy, modify, distribute, and sell this software and
  * its documentation, in whole or in part, for any purpose, is hereby granted,
@@ -28,10 +27,9 @@
  * OF THIS SOFTWARE.
  */
 
-
-
 #include "EXTERN.h"
 #include "perl.h"
+#include "proto.h"
 #include "embed.h"
 #include "XSUB.h"
 #include <yaz/backend.h>
@@ -52,6 +50,8 @@
 #define sv_undef PL_sv_undef
 #endif
 
+NMEM_MUTEX simpleserver_mutex;
+
 typedef struct {
 	SV *handle;
 
@@ -98,24 +98,66 @@ CV * simpleserver_sv2cv(SV *handler) {
     }
 }
 
+/* debuggin routine to check for destruction of Perl interpreters */
+#if 0
+int tst_clones(void)
+{
+    int i; 
+    PerlInterpreter *parent = PERL_GET_CONTEXT;
+    for (i = 0; i<500; i++)
+    {
+        PerlInterpreter *perl_interp = perl_clone(parent, 0);
+        PERL_SET_CONTEXT( perl_interp );
+	PL_perl_destruct_level = 2;
+        PERL_SET_CONTEXT( parent );
+        perl_destruct(perl_interp);
+        perl_free(perl_interp);
+    }
+    exit (0);
+}
+#endif
 
 int simpleserver_clone(void) {
-     PerlInterpreter *current = PERL_GET_CONTEXT;
-
-     if (!current) {
-         PerlInterpreter *perl_interp = perl_clone(root_perl_context, CLONEf_COPY_STACKS);
-         PERL_SET_CONTEXT( perl_interp );
+#ifdef USE_ITHREADS
+     nmem_mutex_enter(simpleserver_mutex);
+     if (1)
+     {
+         PerlInterpreter *current = PERL_GET_CONTEXT;
+
+	 /* if current is unset, then we're in a new thread with
+	  * no Perl interpreter for it. So we must create one .
+	  * This will only happen when threaded is used..
+	  */
+         if (!current) {
+             PerlInterpreter *perl_interp;
+             PERL_SET_CONTEXT( root_perl_context );
+             perl_interp = perl_clone(root_perl_context, 0);
+             PERL_SET_CONTEXT( perl_interp );
+         }
      }
+     nmem_mutex_leave(simpleserver_mutex);
+#endif
      return 0;
 }
 
 
 void simpleserver_free(void) {
-    PerlInterpreter *current_interp = PERL_GET_CONTEXT;
-
-    perl_destruct(current_interp);
-    perl_free(current_interp);
-    PERL_SYS_TERM();
+    nmem_mutex_enter(simpleserver_mutex);
+    if (1)
+    {
+        PerlInterpreter *current_interp = PERL_GET_CONTEXT;
+
+	/* If current Perl Interp is different from root interp, then
+	 * we're in threaded mode and we must destroy.. 
+	 */
+	if (current_interp != root_perl_context) {
+       	    PL_perl_destruct_level = 2;
+            PERL_SET_CONTEXT(root_perl_context);
+            perl_destruct(current_interp);
+            perl_free(current_interp);
+	}
+    }
+    nmem_mutex_leave(simpleserver_mutex);
 }
 
 
@@ -1256,33 +1298,30 @@ void bend_close(void *handle)
 	SV **temp;
 	CV* handler_cv = 0;
 
-	dSP;
-	ENTER;
-	SAVETMPS;
 
-	if (close_ref == NULL)
+	if (close_ref)
 	{
-		return;
-	}
-
-	href = newHV();
-	hv_store(href, "HANDLE", 6, zhandle->handle, 0);
+		dSP;
+		ENTER;
+		SAVETMPS;
+		href = newHV();
+		hv_store(href, "HANDLE", 6, zhandle->handle, 0);
 
-	PUSHMARK(sp);
+		PUSHMARK(sp);
 
-	XPUSHs(sv_2mortal(newRV((SV *)href)));
+		XPUSHs(sv_2mortal(newRV((SV *)href)));
 
-	PUTBACK;
+		PUTBACK;
 	
-	handler_cv = simpleserver_sv2cv( close_ref );
-	perl_call_sv( (SV *) handler_cv, G_SCALAR | G_DISCARD);
+		handler_cv = simpleserver_sv2cv( close_ref );
+		perl_call_sv( (SV *) handler_cv, G_SCALAR | G_DISCARD);
 	
-	SPAGAIN;
-
-	PUTBACK;
-	FREETMPS;
-	LEAVE;
+		SPAGAIN;
 
+		PUTBACK;
+		FREETMPS;
+		LEAVE;
+	}
 	xfree(handle);
 	simpleserver_free();
 	
@@ -1373,6 +1412,10 @@ start_server(...)
 		}
 		*argv_buf = NULL;
 		root_perl_context = PERL_GET_CONTEXT;
+		nmem_mutex_create(&simpleserver_mutex);
+#if 0
+		tst_clones();
+#endif
 		
 		RETVAL = statserv_main(items, argv, bend_init, bend_close);
 	OUTPUT: