From: Kevin M. Rosenberg Date: Thu, 25 Jan 2007 06:14:01 +0000 (+0000) Subject: r11508: 25 Jan 2007 Kevin Rosenberg X-Git-Tag: v3.8.6~22 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=c1950032014682ed3b41a3bdf2934bff91c53740;ds=sidebyside r11508: 25 Jan 2007 Kevin Rosenberg * sql/pool.lisp: Test pooled connection when popped from the pool to ensure the connection still works. Currently, implemented only for MySQL. --- diff --git a/ChangeLog b/ChangeLog index 9e5fe34..516540a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +25 Jan 2007 Kevin Rosenberg + * 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 * db-mysql/Makefile: Add potential mysql directories diff --git a/clsql.asd b/clsql.asd index 20f29d5..35e172a 100644 --- 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 "" diff --git a/sql/pool.lisp b/sql/pool.lisp index 6791a6e..f6c6c40 100644 --- a/sql/pool.lisp +++ b/sql/pool.lisp @@ -33,8 +33,28 @@ (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