54156 baggles ;; for hunchentoot (defmacro define-handler (name (&rest lambda-args) regex &body forms) (let* ((keys lambda-args) (named (loop until (or (when (eql (car keys) '&key) (pop keys)) (null keys)) collecting (pop keys))) (m0 (gensym "M0-")) (m1 (gensym "M1-")) (rn0 (gensym "RN0-")) (rn1 (gensym "RN1-")) (request-path (gensym "REQUEST-PATH-")) (request-query (gensym "REQUEST-QUERY-")) (key-vals (gensym "KEY-VALS-"))) `(defun ,name (request) (destructuring-bind (,request-path &optional ,request-query) (split-sequence:split-sequence #\? (request-uri request)) (multiple-value-bind (,m0 ,m1 ,rn0 ,rn1) (cl-ppcre:scan ,regex ,request-path) (declare (ignore ,m1)) (when ,m0 (let ((,key-vals (mapcan #'(lambda (k=v) (destructuring-bind (key &optional (val t)) (split-sequence:split-sequence #\= k=v) (list (intern (string-upcase key) (find-package '#:keyword)) val))) (split-sequence:split-sequence #\& ,request-query)))) (declare (ignorable ,key-vals)) (lambda () (let (,@(loop for i from 0 for arg in named collecting `(,arg (when (aref ,rn0 ,i) (subseq ,request-path (aref ,rn0 ,i) (aref ,rn1 ,i))))) (keys ,key-vals) ,@(loop for key in keys collecting `(,key (getf ,key-vals (intern (symbol-name ',key) (find-package '#:keyword)))))) ,@forms))))))))) ;;eg. like this (define-handler picpage (id dash title &key one three five) "/picpage/(\\d+)(-([^/?]+))?" (declare (optimize (debug 3))) (declare (ignore dash)) (with-template (title) (:p (esc (format nil "If this works, i'll be shocked. id is ~a; title is ~a; one is ~a; three is ~a; five is ~a" id title one three five))) (:p (esc (format nil "keys ~s; key one: ~s" keys (getf keys 'one)))))) 3409249286 #lispcafe