X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fpool.cl;h=f4d965c01faac49e91257cd7d7fa76c89c3c22dc;hp=bf790a46c58b6dae9034ef5204c52f44ea572a6f;hb=998937376fa6f9ce29bd3c7954fb0ebca91c37d7;hpb=1785177d3364ad0ad8917193b5b00310ef88105e diff --git a/sql/pool.cl b/sql/pool.cl index bf790a4..f4d965c 100644 --- a/sql/pool.cl +++ b/sql/pool.cl @@ -7,7 +7,7 @@ ;;;; 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.8 2002/09/17 17:16:43 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -43,12 +43,13 @@ (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 @@ -59,7 +60,8 @@ 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) @@ -75,16 +77,3 @@ (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))))