diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/endpoint.lisp | 34 | ||||
| -rw-r--r-- | src/protocol.lisp | 28 |
2 files changed, 50 insertions, 12 deletions
diff --git a/src/endpoint.lisp b/src/endpoint.lisp index 8189572..eeb536e 100644 --- a/src/endpoint.lisp +++ b/src/endpoint.lisp @@ -373,17 +373,24 @@ the ;." 1. in path extractors 2. in query parameters 3. in the request body." - (let ((extracted-args - (process-extractors class)) - (params-args - (extract-initargs args (http:get-parameters*))) - (body-args - (extract-initargs args (collect-body class)))) - (apply #'make-instance class + (debug-print :instantiate-endpoint (class-name class) args) + (let* ((extracted-args + (process-extractors class)) + + (params-args + (extract-initargs args (http:get-parameters*))) + + (body-args + (extract-initargs args (collect-body class))) + + (collected-args (apply-slot-value-mappers class (reduce #'merge-plists - (list extracted-args params-args body-args)))))) + (list extracted-args params-args body-args))))) + + (debug-print :initargs-collected collected-args) + (apply #'make-instance class collected-args))) (defun build-handler (class) "Create a hunchentoot dispatch function that instantiates and handles @@ -397,9 +404,14 @@ the ;." (content-type (content-type class))) (lambda () - (check-request-compliance class) - (setf (http:content-type*) content-type) - (handle (instantiate-endpoint class init-slots))))) + (let ((*debug-indent* 0)) + (debug-print + (http:request-method*) + (http:request-uri*) + :dispatched-on (class-name class)) + (check-request-compliance class) + (setf (http:content-type*) content-type) + (handle (instantiate-endpoint class init-slots)))))) (defun create-class-dispatcher (class) "Creates a function that dispatches a handler function if a request diff --git a/src/protocol.lisp b/src/protocol.lisp index 31934f4..dfee2e6 100644 --- a/src/protocol.lisp +++ b/src/protocol.lisp @@ -5,8 +5,29 @@ (defvar *debugging* nil "If T, the debugger will be evoked.") +(defvar *debug-indent* nil + "If an integer, debug print will print this many spaces before printing the debug message. It will then increment the count. + +The debug indent is bound when request handling starts.") + +(defvar *debug-lock* nil + "Whens set, use this to ensure that writing to the debug stream doesn't +interleave writes across threads") + (defun toggle-debugging () - (setf *debugging* (not *debugging*))) + (setf + *debug-lock* (bt:make-lock) + *debugging* (not *debugging*))) + +(declaim (inline debug-print)) +(defun debug-print (&rest objects) + (when *debugging* + (bt:with-lock-held (*debug-lock*) + (write-string "DEBUG: " *error-output*) + (loop :repeat (or *debug-indent* 0) + :do (write-char #\space *error-output*)) + (format *error-output* "~{~s ~}~%" objects) + (when *debug-indent* (incf *debug-indent* 2))))) (define-condition protocol-error (error) ((raw-request @@ -175,6 +196,11 @@ successfully. This method should return data to be sent back to the client and MUST be implemented for every endpoint class.") + (:method :around ((endpoint t)) + (debug-print :handle endpoint) + (prog1 (call-next-method) + (debug-print))) + (:method :before ((endpoint t)) ;; The default before method checks that the endpoint is ;; authenticated, authorized, default, each of these is T. |