cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

util: add to property list - and other improvements for web/response:interaction cookie stuff

Browse source
This commit is contained in:
Helmut Merz 2024-08-30 19:40:58 +02:00
parent d934928a28
commit d52886ec15
3 changed files with 14 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
test/test-core.lisp
View file

@ -71,7 +71,10 @@
(== (util:rtrim '(1 2 nil 3 nil)) '(1 2 nil 3)) (== (util:rtrim '(1 2 nil 3 nil)) '(1 2 nil 3))
(== (util:to-keyword "hello-kitty") :hello-kitty) (== (util:to-keyword "hello-kitty") :hello-kitty)
(== (util:loop-plist '(:a "a" :b "b") k v collect (string-upcase k)) '("A" "B")) (== (util:loop-plist '(:a "a" :b "b") k v collect (string-upcase k)) '("A" "B"))
(== (util:plist-pairs '(:a "a" :b "b")) '((:a "a") (:b "b")))) (== (util:plist-pairs '(:a "a" :b "b")) '((:a "a") (:b "b")))
(let ((pl '(:a 0)))
(== (util:plist-add pl :b 1) '(:b 1 :a 0))
(== pl '(:b 1 :a 0))))
(deftest test-record () (deftest test-record ()
(let ((rec (make-instance 'shape:record :head '(:t1)))) (let ((rec (make-instance 'shape:record :head '(:t1))))

7
util/util.lisp
View file

@ -6,7 +6,8 @@
#+sbcl (:import-from :sb-ext #:add-package-local-nickname) #+sbcl (:import-from :sb-ext #:add-package-local-nickname)
(:export #:make-vars-format #:lg #:lgd #:lgi #:lgw (:export #:make-vars-format #:lg #:lgd #:lgi #:lgw
#:from-unix-time #:to-unix-time #:from-unix-time #:to-unix-time
#:rfill #:rtrim #:loop-plist #:filter-plist #:plist-pairs #:plist-equal #:rfill #:rtrim
#:loop-plist #:filter-plist #:plist-pairs #:plist-equal #:plist-add
#:flatten-str #:from-keyword #:to-keyword #:to-integer #:to-string #:flatten-str #:from-keyword #:to-keyword #:to-integer #:to-string
#:from-bytes #:to-bytes #:b64-decode #:b64-encode #:from-b64 #:to-b64 #:from-bytes #:to-bytes #:b64-decode #:b64-encode #:from-b64 #:to-b64
#:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
@ -64,6 +65,10 @@
(unless (equal (getf l2 k) v) (unless (equal (getf l2 k) v)
(return-from plist-equal nil))) (return-from plist-equal nil)))
t) t)
(defmacro plist-add (pl k v)
`(setf ,pl (cons ,k (cons ,v ,pl))))
;;;; strings, symbols, keywords, ... ;;;; strings, symbols, keywords, ...
(defun flatten-str (s &key (sep " ")) (defun flatten-str (s &key (sep " "))

11
web/response.lisp
View file

@ -15,18 +15,15 @@
;;;; server interaction - receive response message from action processing chain ;;;; server interaction - receive response message from action processing chain
;;; predefined action handlers / default actions ;;; predefined action handlers / default actions
(defun store-msg (ia msg) (defun render-msg (ia msg)
(push msg (messages ia))) (push msg (messages ia)))
(defun set-cookie (ia msg) (defun set-cookie (ia msg)
(let ((headers (headers (response ia)))) (util:plist-add (headers (response ia)) :set-cookie (message:data msg)))
(setf headers
(cons :set-cookie (cons (render-cookie (message:data msg)) headers)))
headers))
(defvar *interaction-default-actions* (defvar *interaction-default-actions*
(core:define-actions '(nil store-msg) (core:define-actions '((:web :set-cookie) set-cookie)
'((:web :set-cookie) set-cookie))) '(nil render-msg)))
;;; interaction class and methods ;;; interaction class and methods