[elephant-cvs] CVS elephant/src/db-bdb

[ieslick]

Update of /project/elephant/cvsroot/elephant/src/db-bdb
In directory clnet:/tmp/cvs-serv12259

Modified Files:
	bdb-controller.lisp 
Log Message:
Updated bdb controller with shell-kill patch by aycan.irican at core.gen.tr

--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp	2006/06/19 00:47:24	1.9
+++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp	2006/07/21 16:28:17	1.10
@@ -168,20 +168,29 @@
   (when (find-package :port)
     (pushnew :port *features*)))
 
-(defmethod start-deadlock-detector ((ctrlr bdb-store-controller) &key (type :oldest) (time 0.1) log)
+(defun launch-background-program (directory program &key (args nil))
+  "Launch a program in a specified directory - not all shell interfaces
+   or OS's support this"
+  #+(and allegro (not mswindows)) 
+    (apply #'excl:run-shell-command (funcall #'vector directory program)
+	   args)
+  #-(and allegro (not mswindows))
+    nil)
+
+(defmethod start-deadlock-detector ((ctrl bdb-store-controller) &key (type :oldest) (time 0.1) log)
   #+port
   (multiple-value-bind (str errstr pid)
-      (port:run-prog (namestring 
-		      (make-pathname :directory "/usr/local/BerkeleyDB.4.3/bin/"
-				     :name "db_deadlock"))
-		     :args `("-a" ,(lookup-deadlock-type type)
-				  "-t" ,(format nil "~D" time)
-				  ,@(when log
-				      (list "-L" (format nil "~A" log))))
-		     :wait nil)
+      (launch-background-program 
+       (second (controller-spec ctrl))
+       (namestring 
+	(make-pathname :directory '(:ABSOLUTE "usr" "local" "BerkeleyDB.4.3" "bin")
+		       :name "db_deadlock"))
+       :args `("-a" ,(lookup-deadlock-type type)
+		    "-t" ,(format nil "~D" time)
+		    ,@(when log (list "-L" (format nil "~A" log)))))
     (declare (ignore errstr))
-    (setf (controller-deadlock-pid ctrlr) pid)
-    (setf (controller-deadlock-input ctrlr) str)))
+    (setf (controller-deadlock-pid ctrl) pid)
+    (setf (controller-deadlock-input ctrl) str)))
 			
 (defmethod stop-deadlock-detector ((ctrl bdb-store-controller))
   (when (controller-deadlock-pid ctrl)
@@ -192,9 +201,9 @@
     (setf (controller-deadlock-input ctrl) nil)))
   
 (defmethod shell-kill (pid)
-  #+allegro (sys:reap-os-subprocess :pid pid :wait t)
-  #+(port (not allegro)) (port:run-prog "kill" :wait t :args (list "-9" (format nil "~A" pid)))
-  )
+   #+allegro (sys:reap-os-subprocess :pid pid :wait t)
+   #+(and (not allegro) port) (port:run-prog "kill" :wait t :args (list "-9" (format nil "~A" pid)))
+   #+(and sbcl linux) (sb-ext:process-kill "/bin/kill" (list "-9" (format nil "~A" pid))))
 
 ;;
 ;; Persistent slot protocol