On Mon, Dec 04, 2006 at 08:52:40AM -0800, Cyrus Harmon wrote:

Edi,

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 compatible way by allowing the dispatchers in *dispatch-table* to be conses (or objects of an appropriately defined class) which would be examined as necessary, or just funcalled as they are presently, in the event that the dispatcher is just a lambda. This would facilitate debugging and modifying the dispatch table.

Why not make a dispatcher that does exactly what you want, and put it first in *dispatch-table*? Then you can have all kinds of non-default behavior, with no modifications to hunchentbnl. :)

Zach

Cyrus Harmon wrote:

extend the dispatch table to provide metadata for each dispatcher

Quick way: you can use the documentation strings of the dispatchers to hold arbitrary metadata. You can usually put all kinds of stuff in a 'documentation string', in spite of its name, and get away with it.

http://www.lisp.org/HyperSpec/Body/stagenfun_doc_umentationcp.html

But! "Conforming programs should not depend for their correct behavior on the presence of those documentation strings. An implementation is permitted to discard documentation strings at any time..."

So here's a standards-compliant way: put all your metadata into a global hash-table indexed on the dispatchers themselves.

In either case I suggest writing your own create-...-dispatcher helper functions to populate the metadata.

Toby

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