diff --git a/cl-redis.asd b/cl-redis.asd index 8c22c5b..d92dc78 100644 --- a/cl-redis.asd +++ b/cl-redis.asd @@ -9,7 +9,7 @@ :maintainer "Vsevolod Dyomkin " :licence "MIT" :description "A fast and robust Common Lisp client for Redis" - :depends-on (#:rutils #:cl-ppcre #:usocket #:flexi-streams) + :depends-on (#:rutils #:cl-ppcre #:usocket #:flexi-streams #:bordeaux-threads) :serial t :components ((:file "package") (:file "float") diff --git a/connection.lisp b/connection.lisp index 0e7b6ad..abcbd58 100644 --- a/connection.lisp +++ b/connection.lisp @@ -193,4 +193,68 @@ transparently reopen it." (invoke-restart :reconnect)))) ,@body))) + +;;; Connection pools + +(defvar *min-pool-size* 5 + "The mininum amount of connection that will be initial into connection pool.") +(defvar *max-pool-size* nil + "The maxinum amount of connection that will be kept in a single pool, or NIL for no maximum.") + +(defvar *connection-pools* (make-hash-table :test 'equal) + "Maps pool specifiers to lists of pooled connections.") + +(defvar *pool-lock* + (bordeaux-threads:make-lock "connection-pool-lock") + "A lock to prevent multiple threads from messing with the connection +pool at the same time.") + +(defmacro with-pool-lock (&body body) + "Aquire a lock for the pool when evaluating body \(if thread support +is present)." + `(bordeaux-threads:with-lock-held (*pool-lock*) ,@body)) + +(defun get-from-pool (&optional (group "default")) + "Get a database connection from the specified pool, returns nil if +no connection was available." + (with-pool-lock + (pop (gethash group *connection-pools*)))) + +(defun return-to-pool (connection &optional (group "default")) + "Return the database connection to the specified pool." + (macrolet ((the-pool () + '(gethash group *connection-pools* ()))) + (when (connection-open-p connection) + (with-pool-lock + (if (or (not *max-pool-size*) (< (length (the-pool)) *max-pool-size*)) + (push connection (the-pool)) + (if (connection-open-p connection) + (close-connection connection))))) + (values))) + +(defun clear-connection-pool () + "Disconnect and remove all connections in the connection pool." + (with-pool-lock + (maphash + (lambda (group connections) + (declare (ignore group)) + (dolist (conn connections) + (close-connection conn))) + *connection-pools*) + (setf *connection-pools* (make-hash-table :test 'equal)) + (values))) + +(defun init-connection-pool (&key (host #(127 0 0 1)) (port 6379) auth (count *min-pool-size*)) + "Initial connection pool." + (dotimes (index count t) + (let ((*connection* nil)) + (connect :host host :port port :auth auth) + (return-to-pool *connection*)))) + +(defmacro with-connection-in-pool (&body body) + "Evaluate BOTY with the connection pop from connection pool." + `(let ((*connection* (get-from-pool))) + (unwind-protect (progn ,@body) + (return-to-pool *connection*)))) + ;;; end diff --git a/package.lisp b/package.lisp index 8f7b6f1..6f2a2cc 100644 --- a/package.lisp +++ b/package.lisp @@ -35,7 +35,16 @@ #:redis-error-reply #:redis-connection-error - #:with-pipelining)) + #:with-pipelining + + #:*min-pool-size* + #:*max-pool-size* + #:*connection-pools* + #:get-from-pool + #:return-to-pool + #:clear-connection-pool + #:init-connection-pool + #:with-connection-in-pool)) (defpackage #:red (:use #| nothing |# ))