diff options
| author | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2011-12-23 23:03:05 +0100 |
|---|---|---|
| committer | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2011-12-23 23:03:05 +0100 |
| commit | 3b97d53de6b73b41d2153f74aa8c1961a75441ae (patch) | |
| tree | f3210998f59d7d2d44565da1d1b565515512119d | |
| parent | 9522e35b0db9850796f5f995103c4d4e13cc23e3 (diff) | |
Actually make the decoupled design work.
| -rw-r--r-- | mulkcms-hunchentoot.lisp | 40 | ||||
| -rw-r--r-- | 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*) |