;;;; Programmers: Kevin M. Rosenberg, Marc Battyani
;;;; Date Started: Apr 2002
;;;;
-;;;; $Id: pool.cl,v 1.3 2002/05/01 20:22:16 marc.battyani Exp $
+;;;; $Id: pool.cl,v 1.6 2002/05/13 16:55:07 marc.battyani Exp $
;;;;
;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(defun clear-conn-pool (pool)
(loop for conn across (all-connections pool)
- do (disconnect :database conn))
+ do (setf (conn-pool conn) nil)
+ (disconnect :database conn))
(setf (fill-pointer (free-connections pool)) 0)
(setf (fill-pointer (all-connections pool)) 0))
-(defun find-or-create-conn-pool (connection-spec database-type)
- "Find connection vector in hash table, creates a new conn-vector if not found"
+(defun find-or-create-connection-pool (connection-spec database-type)
+ "Find connection pool in hash table, creates a new connection pool if not found"
(let* ((key (list connection-spec database-type))
(conn-pool (gethash key *db-pool*)))
(unless conn-pool
conn-pool))
(defun acquire-from-pool (connection-spec database-type &optional pool)
- (unless pool (setf pool (find-or-create-conn-pool connection-spec database-type)))
+ (unless (typep pool 'conn-pool)
+ (setf pool (find-or-create-connection-pool connection-spec database-type)))
(acquire-from-conn-pool pool))
(defun release-to-pool (database)
(when clear (clrhash *db-pool*))
t)
-;;; with-db-from-pool is the macro you should use if you want to use pooled connections.
-;;; You can use it with a connection spec and database type or directly with a conn-pool.
-;;; When you give a conn-pool the connection spec and database type are ignored
-
-(defmacro with-db-from-pool ((db-var connection-spec database-type &optional conn-pool) &body body)
- "Evaluate the body in an environment, where `db-var' is bound to a
-database connection acquired from the connection pool
-The connection is automatically released to the connection pool on exit from the body.
-If a pool is given then the connection-spec database-type are ignored."
- `(let ((,db-var (acquire-from-pool ,connection-spec ,database-type ,conn-pool)))
- (unwind-protect
- (let ((,db-var ,db-var)) ,@body)
- (release-to-pool ,db-var))))