parent
f0bfb5af2e
commit
77acae992e
@ -1,26 +1,63 @@
|
|||||||
(in-package :hunchenhelpers)
|
(in-package #:hunchenhelpers)
|
||||||
|
|
||||||
(defun hunchenhost (func uri path &optional content-type)
|
(defclass acceptor (hunchentoot:easy-acceptor)
|
||||||
(let ((thing (if (null content-type)
|
()
|
||||||
(funcall func uri path)
|
(:default-initargs
|
||||||
(funcall func uri path content-type))))
|
:address "127.0.0.1"
|
||||||
(push thing tbnl:*dispatch-table*)))
|
:error-template-directory "/var/www/err/"
|
||||||
|
:message-log-destination nil
|
||||||
|
:access-log-destination nil)
|
||||||
|
(: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)
|
(defun host-file (uri path &optional content-type)
|
||||||
(hunchenhost 'tbnl:create-static-file-dispatcher-and-handler uri path content-type))
|
(hunchenhost tbnl:create-static-file-dispatcher-and-handler uri path content-type))
|
||||||
|
|
||||||
(defun host-dir (uri path &optional content-type)
|
(defun host-dir (uri path &optional content-type)
|
||||||
(hunchenhost 'tbnl:create-folder-dispatcher-and-handler uri path content-type))
|
(hunchenhost tbnl:create-folder-dispatcher-and-handler uri path content-type))
|
||||||
|
|
||||||
|
;; Stolen from stackoverflow
|
||||||
|
(defmacro method-path (methods path)
|
||||||
|
"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.
|
||||||
|
You may pass a single method as a designator for the list containing
|
||||||
|
only that method."
|
||||||
|
(declare
|
||||||
|
(type (or keyword list) methods)
|
||||||
|
(type string path))
|
||||||
|
`(lambda (request)
|
||||||
|
(and (member (hunchentoot:request-method* request)
|
||||||
|
,(if (keywordp methods)
|
||||||
|
`'(,methods)
|
||||||
|
`',methods))
|
||||||
|
(string= (hunchentoot:script-name* request)
|
||||||
|
,path))))
|
||||||
|
|
||||||
(defmacro handle (method uri content-type params &body body)
|
(defmacro handle (request params &body body)
|
||||||
"Creates an easy handles for a specific HTTP request method. If the
|
"Creates an easy handles for a specific HTTP request method. If the
|
||||||
method provided sent from the client isn't correct, return 404 and
|
method provided sent from the client isn't correct, return 404 and
|
||||||
stop processing the request.
|
stop processing the request.
|
||||||
|
|
||||||
(handle :get (uri-fun :uri \"/path/to/page\"/) @content-type (args) (body))"
|
`request' should have a symbol `name', keyword or list of keywords
|
||||||
`(tbnl:define-easy-handler ,uri ,params
|
`method' and a string `uri'. One may also pass keyword arguments
|
||||||
(unless (eq ,method (tbnl:request-method*))
|
`content-type', a string of the content type returned and list of
|
||||||
(setf (tbnl:return-code*) tbnl:+http-method-not-allowed+)
|
`acceptor', hunchentoot acceptor class that should listen for this
|
||||||
(tbnl:abort-request-handler))
|
handler.
|
||||||
(setf (tbnl:content-type* tbnl:*reply*) ,content-type)
|
|
||||||
,@body))
|
`params' are the request parameters of the client
|
||||||
|
|
||||||
|
`body' is what is evaluated and returned to the client"
|
||||||
|
(destructuring-bind (name method uri &optional content-type)
|
||||||
|
request
|
||||||
|
`(tbnl:define-easy-handler (,name :uri (method-path ,method ,uri))
|
||||||
|
,params
|
||||||
|
(when ,content-type
|
||||||
|
(setf (tbnl:content-type* tbnl:*reply*) ,content-type))
|
||||||
|
,@body)))
|
||||||
|
|
||||||
|
(export '(host-file
|
||||||
|
host-dir
|
||||||
|
handle
|
||||||
|
acceptor))
|
||||||
|
@ -1,6 +1,3 @@
|
|||||||
(defpackage #:hunchenhelpers
|
(defpackage #:hunchenhelpers
|
||||||
(:nicknames :henh)
|
(:nicknames :henh)
|
||||||
(:use :cl :hunchentoot)
|
(:use #:cl))
|
||||||
(:export
|
|
||||||
:host-file :host-dir
|
|
||||||
:handle))
|
|
||||||
|
Loading…
Reference in new issue