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

core: add 'forward' action handler

Browse source
This commit is contained in:
Helmut Merz 2026-01-14 14:49:58 +01:00
parent 25d4301c75
commit 95127d94e8
3 changed files with 31 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
core/core.lisp
View file

@ -14,7 +14,7 @@
#:find-service #:run-services #:setup-services #:shutdown
#:base-context #:context #:add-action #:config #:mailbox #:name
#:handle-message
#:do-print #:echo))
#:do-print #:echo #:forward))
(in-package :scopes/core)
@ -141,6 +141,20 @@
(actor:send cust new-msg))
(util:lgw "customer missing" msg))))
(defun forward (ctx msg &key receivers (domain :scopes) (action :forward))
(unless receivers
(util:lgw "empty receivers list" msg)
(return-from forward))
(let* ((h (shape:head msg))
(new-msg (message:create `(,domain ,action ,@(cddr h))
:data (shape:data msg)
:customer (actor:customer msg))))
(dolist (rcvname receivers)
(let ((rcvr (find-service rcvname)))
(if (null rcvr)
(util:lgw "receiver not found" rcvname)
(actor:send (mailbox rcvr) new-msg))))))
(defun do-print (ctx msg)
(declare (ignore ctx))
(format t "~&~s~%" msg))

6
test/etc/config-core.lisp
View file

@ -11,3 +11,9 @@
(config:add :test-receiver :setup #'setup)
(config:add-action '(:test) #'check-message)
(config:add-action '(:scopes) #'check-message)
(config:add :forwarder :setup (core:make-setup))
(config:add-action '(:test)
(lambda (ctx msg)
(core:forward ctx msg :receivers '(:test-receiver))))

11
test/test-core.lisp
View file

@ -66,7 +66,8 @@
(test-util-async)
(test-actor)
(setf (receiver t:*test-suite*) (core:find-service :test-receiver))
(test-send))
(test-send)
(test-forwarder))
(core:shutdown)
(check-expected)
(t:show-result))))
@ -143,3 +144,11 @@
(== (core:name rcvr) :test-receiver)
(actor:send (core:mailbox rcvr) msg)
))
(deftest test-forwarder ()
(let ((rcvr (receiver t:*test-suite*))
(fwd (core:find-service :forwarder))
(msg (message:create '(:test :dummy) :data "dummy payload"))
(msg-exp (message:create '(:scopes :forward) :data "dummy payload")))
(expect rcvr msg-exp)
(actor:send (core:mailbox fwd) msg)))