On 4/15/07, Victor Kryukov < victor.kryukov@gmail.com> wrote:

Hello list,

I want to accomplish the following: every time a lisp error happens,
the whole backtrace and some additional information is sent to my mail
account.  The question is, what is the best way to do it with
Hunchentoot? (I do know how to send email messages from lisp with the
help of mel-base).

The second question is: how do you use CLSQL thread-safely with
Hunchentoot / SBCL? SBCL don't provide thread properties, so my first
solution[1] was to create a hash-table and to assign each thread a
connection, to check from every thread whether it already has a
connection, and then to clean that hash-table periodically, closing
connections for dead threads. That worked pretty well, but I was
afraid of exhausting limit of database threads somehow, so I switched
to the second solution.

The second solution[2] is to open new connection every time I need to
save something to database or read something from it, and to close it
right after that. That of course solves connection limit problem
(unless I have very many users simultaneously, which is not expected
in the near term), however it's much slower.

Anybody can share his/her strategy?

Best regards,
Victor.

[1] http://paste.lisp.org/display/39787
(defparameter *database-mutex* (sb-thread:make-mutex :name "database lock"))
(defparameter *threads-connection* (make-hash-table))

(defun setup-connection ()
   (connect '("localhost" "lj" "victor" "victor")
          :database-type :postgresql :if-exists :new))

(defun db ()
  (handler-case
      (sb-thread:with-mutex (*database-mutex*)
       (or (gethash sb-thread:*current-thread* *threads-connection*)
           (setf (gethash sb-thread:*current-thread* *threads-connection*)
                 (setup-connection))))
    (error () (progn
               (close-old-connections)
               (db)))))

(defun close-old-connections ()
  (maphash #'(lambda (thread connection)
              (unless (sb-thread:thread-alive-p thread)
                (clsql:disconnect :database connection)
                (remhash thread *threads-connection*)))
          *threads-connection*))

(let ((old-select (symbol-function 'clsql:select)))
    (defun select (&rest args)
     (let ((*default-database* (db)))
       (apply old-select args))))

(let ((old-insert-records (symbol-function 'insert-records)))
    (defun insert-records (&rest args)
     (apply old-insert-records :database (db) args)))

[2] http://paste.lisp.org/display/39787#1
(defun db ()
  (connect *connection-spec*
           :database-type :postgresql :if-exists :new))

(let ((old-select (symbol-function 'clsql:select)))
   (defun select (&rest args)
     (let ((clsql:*default-database* (db)))
       (prog1
           (apply old-select args)
         (disconnect :database clsql:*default-database*)))))

(let ((old-insert-records (symbol-function 'insert-records)))
   (defun insert-records (&rest args)
     (let ((db (db)))
       (prog1
           (apply old-insert-records :database db args)
         (disconnect :database db)))))

--
Yours Sincerely,
Victor Kryukov
_______________________________________________
tbnl-devel site list
tbnl-devel@common-lisp.net
http://common-lisp.net/mailman/listinfo/tbnl-devel