Add connection pools support

cl-redis.asd

@@ -9,7 +9,7 @@
   :maintainer "Vsevolod Dyomkin <[email protected]>"
   :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")

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

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 |# ))