Add content types, remove static hosting, add acceptors to handle

ご主人様
not manx 4 years ago
parent c8ad02cd2f
commit dfb589b458
Signed by: C-xC-c
GPG Key ID: F52ED472284EF2F4

@ -0,0 +1,9 @@
(in-package #:hunchenhelpers)
;; We use `hunchentoot:defconstant' because it works on SBCL
#.`(progn
,@(loop for (name . code) in
'((@plain . "text/plain")
(@json . "application/json"))
collect `(tbnl::defconstant ,name ,code)
collect `(export (quote ,name))))

@ -2,8 +2,9 @@
:description "A helper library for hunchentoot" :description "A helper library for hunchentoot"
:author "Manx <boku@plum.moe>" :author "Manx <boku@plum.moe>"
:license "GPLv3" :license "GPLv3"
:version "1.1.0" :version "1.2.0"
:serial t :serial t
:depends-on (:hunchentoot) :depends-on (:hunchentoot)
:Components ((:file "package") :Components ((:file "package")
(:file "content-types")
(:file "main"))) (:file "main")))

@ -6,34 +6,18 @@
:address "127.0.0.1" :address "127.0.0.1"
:error-template-directory "/var/www/err/" :error-template-directory "/var/www/err/"
:message-log-destination nil :message-log-destination nil
:access-log-destination nil) :access-log-destination nil
:document-root nil)
(:documentation "Because I hate writing code")) (:documentation "Because I hate writing code"))
(defmacro hunchenhost (func uri path &optional content-type)
`(push (,func ,uri ,path (or ,content-type ,tbnl:*default-content-type*)) tbnl:*dispatch-table*))
(defun host-file (uri path &optional content-type)
(hunchenhost tbnl:create-static-file-dispatcher-and-handler uri path content-type))
(defun host-dir (uri path &optional content-type)
(hunchenhost tbnl:create-folder-dispatcher-and-handler uri path content-type))
(defmacro config-item (thing &aux (item (gensym)))
"Get `thing' from the alist `config', error if it doesn't exist"
`(let ((,item (assoc ,thing (eval (read-from-string "config")))))
(when (atom ,item)
(error "No such config item"))
(cdr ,item)))
;; Stolen from stackoverflow ;; Stolen from stackoverflow
(defmacro method-path (methods path) (defmacro method-path (methods path)
"Expands to a predicate the returns true of the Hunchtoot request "Expands to a predicate the returns true of the Hunchtoot request
has a SCRIPT-NAME matching the PATH and METHOD in the list of METHODS. has a SCRIPT-NAME matching the PATH and METHOD in the list of METHODS.
You may pass a single method as a designator for the list containing You may pass a single method as a designator for the list containing
only that method." only that method."
(declare (declare (type (or keyword list) methods)
(type (or keyword list) methods) (type string path))
(type string path))
`(lambda (request) `(lambda (request)
(and (member (hunchentoot:request-method* request) (and (member (hunchentoot:request-method* request)
,(if (keywordp methods) ,(if (keywordp methods)
@ -56,16 +40,12 @@ handler.
`params' are the request parameters of the client `params' are the request parameters of the client
`body' is what is evaluated and returned to the client" `body' is what is evaluated and returned to the client"
(destructuring-bind (name method uri &optional content-type) (destructuring-bind (name method uri &key content-type (acceptor t)
&aux (uri (eval uri)))
request request
`(tbnl:define-easy-handler (,name :uri (method-path ,method ,uri)) `(tbnl:define-easy-handler (,name :uri (method-path ,method ,uri)
:acceptor-names (if (eq ,acceptor t) t (list ,acceptor)))
,params ,params
(when ,content-type (when ,content-type
(setf (tbnl:content-type* tbnl:*reply*) ,content-type)) (setf (tbnl:content-type* tbnl:*reply*) ,content-type))
,@body))) ,@body)))
(export '(host-file
host-dir
handle
acceptor
config-item))

@ -1,3 +1,7 @@
(defpackage #:hunchenhelpers (defpackage #:hunchenhelpers
(:nicknames #:toot) (:nicknames #:toot)
(:use #:cl)) (:use #:cl)
(:export #:host-file
#:host-dir
#:handle
#:acceptor))

Loading…
Cancel
Save