Cyrus Harmon ch-tbnl@bobobeach.com writes:
First of all, thanks for hunchentoot! I'm still getting used to it, but it seems great so far. But I do have a request. Would it be possible (and advisable) to extend the dispatch table to provide some metadata for each dispatcher? this could even be done in a backward
first, i am rather new to lisp, but perhaps my additions / changes to the hunchentoot:*dispatch-table* are useful or interesting for someone.
(Please excuse the mixture of tbnl / hunchentoot naming in the following code)
some stuff could propably be done better, much better :) feel free to criticise :)
and finally: thanks to Edi and all the other people in the lisp-community, that produces so wonderful things like hunchentoot! :)
;; I wanted a *dispatch-table*, so that I can add, remove or update the ;; dispatch-functions while a hunchentoot-server is running. ;; ;; f.e. my dispatch-table looks like:
;; CL-USER> hunchentoot:*dispatch-table* ;; (("/web/log" #<CLOSURE # {B4A5515}>) ;; ("/web/error.html" #<CLOSURE # {B4792ED}>) ;; ("/web/index.html" #<CLOSURE # {B4776E5}>) ;; ("/web/style.css" #<CLOSURE # {B4755E5}>) ;; ("default" #<FUNCTION HUNCHENTOOT:DEFAULT-DISPATCHER>))
;; i redefined the method. Both types of entries should work (plain ;; function, as in the "original" hunchentoot and my "new" entries ;; '("somestring" #function)). The "somestring" is later used to identify ;; the dispatch function.
;;; Redefined original hunchentoot:dispatch-request (defmethod dispatch-request (dispatch-table) "Dispatches *REQUEST* based upon rules in the DISPATCH-TABLE. This method provides the default tbnl/hunchentoot behavior." (loop for dispatcher in dispatch-table for action = (if (typep dispatcher 'list) (funcall (cadr dispatcher) *request*) (funcall dispatcher *request*)) when action return (funcall action) finally (setf (return-code *reply*) +http-not-found+)))
;; and use the following functions to work with the "new" dispatch-table
(defun safe-assoc-string (item list) (loop for i in list when (if (and (listp i) (stringp (car i))) (string= (car i) item)) return i))
(defun add-dispatcher (path function) "adds dispatcher to tbnl:*dispatch-table*" (if (safe-assoc-string path hunchentoot:*dispatch-table*) ;;there is already a dispatcher with that identifier (setf (cadr (safe-assoc-string path tbnl:*dispatch-table*)) function) ;;create a new entry (push (list path function) tbnl:*dispatch-table*)))
(defun add-dispatcher-prefix (path function) "convient way to construct a dispatcher with prefix." in a lambda to call the statistic writer before." (add-dispatcher path (funcall #'tbnl:create-prefix-dispatcher path #'(lambda () ;; (write-statistic tbnl:*request*) ; my statistics function (funcall function)))))
(defun remove-dispatcher (path) "remove a dispatch-entry by their path" (setf tbnl:*dispatch-table* (remove (assoc path tbnl:*dispatch-table* :test #'string=) tbnl:*dispatch-table*)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; additionally i made the following macros, so that i simply have to evaluate f.e. ;; ;; (defweb "/my/page.html" ;; (bla ;; (bla ....))) ;; ;; or for webpages that need parameters ;; ;; (defweb* "/my/page.html" (firstparameter secondparameter) ;; (bla ;; (setf firstparameter 'new-value) ;; (...))) ;; ;; and the function that listen at the path "/my/page.html" is created or updated ;; ;; ;; the macros (and some condition-stuff i use):
(define-condition web-error (error) ((message :initarg :message :reader message)))
(defmacro error-page (fehler) `(tbnl:redirect (format nil "/web/error.html?fehler=~A" (tbnl:url-encode ,fehler))))
(defmacro defweb (path &body body) "constructs a defun + entry into tbnl:*dispatch-table*" (let ((funcn (read-from-string path))) `(progn (defun ,funcn () (handler-case (progn ,@body) (web-error (fehler) (web:error-page (message fehler))))) (compile (quote ,funcn)) (add-dispatcher-prefix ,path (function ,funcn)))))
(defmacro defweb* (path parameters &body body) "constructs a defun + entry into tbnl:*dispatch-table* and prepares local variables coresponding to the parameters.
f.e. (web:defweb* "/web/test" (a) (format nil "~A" a))
it is also possible to prepare a conversion of the variable. Put the definition in extra brackets.
f.e. (web:defweb* "/web/test" ((a #'parse-integer)) (format nil "type of a ~A" (type-of a))) " (let ((funcn (read-from-string (string path)))) `(progn (defun ,funcn ,(if parameters (append '(&aux ) (loop for i in parameters collect (if (listp i) `(,(car i) (funcall ,(cadr i) (tbnl:parameter ,(string-downcase (string (car i)))))) `(,i (tbnl:parameter ,(string-downcase (string i)))))))) (handler-case (progn ,@body) (web-error (fehler) (web:error-page (message fehler))))) (compile (quote ,funcn)) (add-dispatcher-prefix ,path (function ,funcn)) ',funcn)))
best regards
okflo