From 3b97d53de6b73b41d2153f74aa8c1961a75441ae Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Fri, 23 Dec 2011 23:03:05 +0100
Subject: Actually make the decoupled design work.

---
 mulkcms-hunchentoot.lisp | 40 +++++++++++++++++++++-------------------
 mulkcms.lisp             |  2 +-
 2 files changed, 22 insertions(+), 20 deletions(-)

diff --git a/mulkcms-hunchentoot.lisp b/mulkcms-hunchentoot.lisp
index 9f123d0..5a134ac 100644
--- a/mulkcms-hunchentoot.lisp
+++ b/mulkcms-hunchentoot.lisp
@@ -32,25 +32,27 @@
     (multiple-value-bind
           (mulkcms::*user-name* mulkcms::*password*)
         (hunchentoot:authorization)
-      (let ((result (mulkcms::find-request-handler relative-path
-                                                   (append (get-parameters*)
-                                                           (post-parameters*))
-                                                   (header-in* :accept-language))))
-        (typecase result
-          (cons
-           (when-let (content-type (getf result :content-type))
-             (setf (hunchentoot:content-type*) content-type))
-           (when-let (headers (getf result :headers))
-             (dolist (header headers)
-               (setf (hunchentoot:header-out (car header))
-                     (cdr header))))
-           (when-let (return-code (getf result :return-code))
-             (setf (hunchentoot:return-code*) return-code)
-             ;;(hunchentoot:abort-request-handler)
-             )
-           (getf result :body))
-          (t
-           result))))))
+      (let ((handler (mulkcms::find-request-handler relative-path
+                                                    (append (get-parameters*)
+                                                            (post-parameters*))
+                                                    (header-in* :accept-language))))
+        (lambda ()
+          (let ((result (funcall handler)))
+            (typecase result
+              (cons
+               (when-let (content-type (getf result :content-type))
+                 (setf (hunchentoot:content-type*) content-type))
+               (when-let (headers (getf result :headers))
+                 (dolist (header headers)
+                   (setf (hunchentoot:header-out (car header))
+                         (cdr header))))
+               (when-let (return-code (getf result :return-code))
+                 (setf (hunchentoot:return-code*) return-code)
+                 ;;(hunchentoot:abort-request-handler)
+                 )
+               (getf result :body))
+              (t
+               result))))))))
 
 (defun setup-handlers ()
   (setq *dispatch-table*
diff --git a/mulkcms.lisp b/mulkcms.lisp
index 708f517..e6a0b0b 100644
--- a/mulkcms.lisp
+++ b/mulkcms.lisp
@@ -2,7 +2,7 @@
 
 (defparameter *database-connection-spec*
   (list *database-name* *database-user* *database-password* *database-host*
-        :pooled-p t :use-ssl :try))
+        :pooled-p t :use-ssl :no))
 
 (defvar *requested-characteristics*)
 (defvar *propagated-params*)
-- 
cgit v1.2.3