split response processing: prepare - finish

This commit is contained in:
Helmut Merz 2025-05-19 16:40:36 +02:00
parent c52d6adca7
commit 84ce2c9e3a

View file

@ -14,23 +14,20 @@
(in-package :scopes/web/response) (in-package :scopes/web/response)
;;;; server interaction - receive response message from action processing chain ;;;; predefined action handlers / default actions
;;; predefined action handlers / default actions
(defun render-msg (resp msg) (defun render-msg (resp msg)
(push msg (messages resp)) (if msg
(actor:stop resp) (push msg (messages resp)))
;(finish resp) (prepare resp)
) (finish resp))
(defun set-cookie (resp msg) (defun set-cookie (resp msg)
(util:plist-add (headers resp) (util:plist-add (headers resp)
:set-cookie (render-cookie (shape:data msg))) :set-cookie (render-cookie (shape:data msg)))
(actor:stop resp) (render-msg resp nil))
;(finish resp)
)
(defvar *interaction-default-actions* (defvar *default-actions*
(core:define-actions '((:response :set-cookie) set-cookie) (core:define-actions '((:response :set-cookie) set-cookie)
'(nil render-msg))) '(nil render-msg)))
@ -42,10 +39,9 @@
(defvar *html-response-class* nil) (defvar *html-response-class* nil)
;(defclass response (core:base-context) (defclass response (core:base-context actor:fg-actor)
(defclass response (core:base-context actor:fg-actor) ; actor:bg-actor
((context :reader context :initarg :context) ((context :reader context :initarg :context)
(core:actions :initform *interaction-default-actions*) (core:actions :initform *default-actions*)
(env :reader env :initarg :env) (env :reader env :initarg :env)
(messages :accessor messages :initform nil) (messages :accessor messages :initform nil)
(headers :accessor headers :initform nil) (headers :accessor headers :initform nil)
@ -93,19 +89,21 @@
(defun make-headers (resp) (defun make-headers (resp)
(cons :content-type (cons (ctype resp) (headers resp)))) (cons :content-type (cons (ctype resp) (headers resp))))
(defun prepare (resp)
(let ((headers (make-headers resp))
(rcode 200))
(setf (writer resp) (funcall (responder resp) (list rcode headers)))))
(defun finish (resp) (defun finish (resp)
(let* ((headers (make-headers resp))
(rcode 200)
(writer (funcall (responder resp) (list rcode headers))) )
(dolist (msg (messages resp)) (dolist (msg (messages resp))
(funcall writer (render-content resp msg))) (funcall (writer resp) (render-content resp msg)))
(funcall writer nil :close t))) (funcall (writer resp) nil :close t)
(actor:stop resp))
(defun render (resp) (defun render (resp)
#'(lambda (responder) #'(lambda (responder)
(setf (responder resp) responder) (setf (responder resp) responder)
(actor:start resp) (actor:start resp)))
(finish resp)))
(defun render-not-found(resp) (defun render-not-found(resp)
(list 404 '(:content-type "text/plain") '("Not found"))) (list 404 '(:content-type "text/plain") '("Not found")))