More work on a default encoding so that running through cffi-uffi,

[clsql.git] / sql / pool.lisp

diff --git a/sql/pool.lisp b/sql/pool.lisp
index abe159b9988172caa3acd6a2f59dd8f24b753a4f..a153c916707aba2a31ff2b7b0ceabc5f248a6939 100644 (file)
--- a/sql/pool.lisp
+++ b/sql/pool.lisp
@@ -35,7 +35,7 @@
 
 
 
-(defun acquire-from-pool (connection-spec database-type &optional pool encoding)
+(defun acquire-from-pool (connection-spec database-type &optional pool (encoding *default-encoding*))
   "Try to find a working database connection in the pool or create a new
 one if needed. This performs 1 query against the DB to ensure it's still
 valid. When possible (postgres, mssql) that query will be a reset
@@ -72,9 +72,9 @@ Disconnecting.~%"
                        :if-exists :new
                        :make-default nil
                         :encoding encoding)))
+     (setf (conn-pool conn) pool)
      (with-process-lock ((conn-pool-lock pool) "new conection")
-       (push conn (all-connections pool))
-       (setf (conn-pool conn) pool))
+       (push conn (all-connections pool)))
      conn)))
 
 (defun release-to-pool (database &optional (pool (conn-pool database)))
@@ -92,6 +92,7 @@ chance to do cleanup."
               (>= (length (free-connections pool))
                   *db-pool-max-free-connections*)))
      (%pool-force-disconnect database)
+
      (with-process-lock ((conn-pool-lock pool) "Remove extra Conn")
        (setf (all-connections pool)
              (delete database (all-connections pool)))))
@@ -135,15 +136,13 @@ to whether another thread is actively using them."
 (defun find-or-create-connection-pool (connection-spec database-type)
   "Find connection pool in hash table, creates a new connection pool
 if not found"
-  (with-process-lock (*db-pool-lock* "Find-or-create connection")
-    (let* ((key (list connection-spec database-type))
-          (conn-pool (gethash key *db-pool*)))
-      (unless conn-pool
-       (setq conn-pool (make-instance 'conn-pool
-                                      :connection-spec connection-spec
-                                      :pool-database-type database-type))
-       (setf (gethash key *db-pool*) conn-pool))
-      conn-pool)))
+  (let ((key (list connection-spec database-type)))
+    (with-process-lock (*db-pool-lock* "Find-or-create connection")
+      (or (gethash key *db-pool*)
+          (setf (gethash key *db-pool*)
+                (make-instance 'conn-pool
+                               :connection-spec connection-spec
+                               :pool-database-type database-type))))))
 
 (defun disconnect-pooled (&optional clear)
   "Disconnects all connections in the pool. When clear, also deletes