r11508: 25 Jan 2007 Kevin Rosenberg <kevin@rosenberg.net>
authorKevin M. Rosenberg <kevin@rosenberg.net>
Thu, 25 Jan 2007 06:14:01 +0000 (06:14 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Thu, 25 Jan 2007 06:14:01 +0000 (06:14 +0000)
        * sql/pool.lisp: Test pooled connection when popped from
        the pool to ensure the connection still works. Currently, implemented
        only for MySQL.

ChangeLog
clsql.asd
sql/pool.lisp

index 9e5fe34..516540a 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+25 Jan 2007  Kevin Rosenberg <kevin@rosenberg.net>
+       * sql/pool.lisp: Test pooled connection when popped from
+       the pool to ensure the connection still works. Currently, implemented
+       only for MySQL.
+
 17 Jan 2007  Kevin Rosenberg <kevin@rosenberg.net>
        * db-mysql/Makefile: Add potential mysql directories
 
index 20f29d5..35e172a 100644 (file)
--- a/clsql.asd
+++ b/clsql.asd
@@ -60,7 +60,7 @@ oriented interface."
                         ((:file "initialize")
                         (:file "database" :depends-on ("initialize"))
                         (:file "recording" :depends-on ("database"))
-                        (:file "pool"))
+                        (:file "pool" :depends-on ("database")))
                         :depends-on (base))
               (:module syntax
                        :pathname ""
index 6791a6e..f6c6c40 100644 (file)
 
 (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)
+                   (disconnect :database pconn :error nil)
+                   nil)
+                 (:no-error (res)
+                   (declare (ignore res))
+                   pconn)))
+              (t
+               pconn)))))
       (let ((conn (connect (connection-spec pool)
                           :database-type (pool-database-type pool)
                           :if-exists :new