X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fpool.lisp;h=1ac0a37b5b550374c0a55d0fd58b60feae0a220a;hp=b0e228f2be7b297d57a714b5e028cb23b457c91c;hb=1b07d2fd927cf8f1943ac0a0b8c980d1dc707076;hpb=8a8ee2d7d791b7a3efaed06420802a925d16fca3

diff --git a/sql/pool.lisp b/sql/pool.lisp
index b0e228f..1ac0a37 100644
--- a/sql/pool.lisp
+++ b/sql/pool.lisp
@@ -33,11 +33,32 @@
 
 (defun acquire-from-conn-pool (pool)
   (or (with-process-lock ((conn-pool-lock pool) "Acquire from pool")
-	(and (plusp (length (free-connections pool)))
-	     (vector-pop (free-connections pool))))
+	(when (plusp (length (free-connections pool)))
+          (let ((pconn (vector-pop (free-connections pool))))
+            ;; test if connection still valid.
+            ;; Currently, on supported on MySQL
+            (cond
+              ((eq :mysql (database-type pconn))
+               (handler-case
+                   (database-query "SHOW ERRORS LIMIT 1" pconn nil nil)
+                 (error (e)
+                   ;; we could check for error type 2006 for "SERVER GONE AWAY",
+                   ;; but, it's safer just to disconnect the pooled conn for any error
+                   (warn "Database connection ~S had an error when attempted to be acquired from the pool:
+  ~S
+Disconnecting.~%"
+                         pconn e)
+                   (ignore-errors (database-disconnect :database pconn))
+                   nil)
+                 (:no-error (res fields)
+                   (declare (ignore res fields))
+                   pconn)))
+              (t
+               pconn)))))
       (let ((conn (connect (connection-spec pool)
 			   :database-type (pool-database-type pool)
-			   :if-exists :new)))
+			   :if-exists :new
+                           :make-default nil)))
 	(with-process-lock ((conn-pool-lock pool) "Acquire from pool")
 	  (vector-push-extend conn (all-connections pool))
 	  (setf (conn-pool conn) pool))
@@ -52,7 +73,8 @@
   (with-process-lock ((conn-pool-lock pool) "Clear pool")
     (loop for conn across (all-connections pool)
 	  do (setf (conn-pool conn) nil)
-	  (disconnect :database conn))
+	  ;; disconnect may error if remote side closed connection
+	  (ignore-errors (disconnect :database conn)))
     (setf (fill-pointer (free-connections pool)) 0)
     (setf (fill-pointer (all-connections pool)) 0))
   nil)