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

work in progress: csys: create sensor upon first send of :csys message.

Browse source
This commit is contained in:
Helmut Merz 2025-06-18 15:37:25 +02:00
parent 2aaf8a482d
commit 3ccf33393e
4 changed files with 29 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
core/message.lisp
View file

@ -24,8 +24,7 @@
(defmethod print-object ((msg message) stream) (defmethod print-object ((msg message) stream)
;(shape:print-slots msg stream 'shape:head 'actor:customer 'shape:data) ;(shape:print-slots msg stream 'shape:head 'actor:customer 'shape:data)
(format stream "#<message ~a ~a ~a>" (format stream "#<message ~a ~a ~a>"
(shape:head msg) (actor:customer msg) (shape:data msg)) (shape:head msg) (actor:customer msg) (shape:data msg)))
)
(defmethod actor:content ((msg message)) (defmethod actor:content ((msg message))
(list (shape:head-plist msg) (shape:data msg))) (list (shape:head-plist msg) (shape:data msg)))

31
csys/csys.lisp
View file

@ -10,22 +10,29 @@
(:shape :scopes/shape) (:shape :scopes/shape)
(:util :scopes/util) (:util :scopes/util)
(:alx :alexandria)) (:alx :alexandria))
(:export #:*dispatcher* #:printer #:setup #:send (:export #:printer #:send
)) #:*sensors*))
(in-package :scopes/csys) (in-package :scopes/csys)
(defun send (msg) (defvar *sensors* (make-hash-table :test #'equal))
(let ((hdlrs (core:select msg (core:actions core:*root*))))
(if hdlrs
;(mapcar #'(lambda (hdlr) (run-action hdlr msg)) hdlrs)
(let ((tsks (mapcar (lambda (hdlr) (actor:create hdlr)) hdlrs)))
(dolist (tsk tsks) (actor:send tsk msg)))
(util:lgw "no action selected" msg))))
(defun run-action (job msg) (defun send (msg)
(let ((mb (async:make-task job))) (dolist (sn (find-create-sensors msg))
(async:submit-task mb (lambda () (funcall job msg))))) (actor:send sn msg)))
(defun find-create-sensors (msg)
(let* ((key (cddr (shape:head msg)))
(sns (gethash key *sensors*)))
(format t "~&~a ~a" key sns)
(or sns
(let* ((mx (message:create
(list :csys :sensor (shape:head-value msg :class))))
(hdlrs (core:select mx (core:actions core:*root*))))
(if hdlrs
(let ((tsks (mapcar #'actor:create hdlrs)))
(setf (gethash key *sensors*) tsks))
(util:lgw "no action selected" msg))))))
;;;; example behaviors / actions ;;;; example behaviors / actions

3
test/etc/config-csys.lisp
View file

@ -4,7 +4,8 @@
(config:root) (config:root)
(config:add-action '(:test) #'csys:printer) (config:add-action '(:csys :sensor :log) #'csys:printer)
;(config:add-action '(:test) #'csys:printer)
(config:add :logger :class 'logging:config (config:add :logger :class 'logging:config
:loglevel (config:from-env :loglevel :info) :loglevel (config:from-env :loglevel :info)

14
test/test-csys.lisp
View file

@ -22,7 +22,8 @@
(defun run () (defun run ()
(async:init) (async:init)
(let* ((t:*test-suite* (make-instance 't:test-suite :name "csys"))) (let* ((t:*test-suite* (make-instance 't:test-suite :name "csys"))
(csys:*sensors* (make-hash-table :test #'equal)))
(load (t:test-path "config-csys" "etc")) (load (t:test-path "config-csys" "etc"))
(unwind-protect (unwind-protect
(progn (progn
@ -32,10 +33,9 @@
(deftest test-nodispatch () (deftest test-nodispatch ()
(core:setup-services) (core:setup-services)
;(csys:setup) (csys:send (message:create '(:csys :add :log :s1) :data 1))
(csys:send (message:create '(:test :add :op :n1) :data 1)) (csys:send (message:create '(:csys :add :log :s1) :data 3))
(csys:send (message:create '(:test :add :op :n1) :data 3)) (csys:send (message:create '(:csys :sub :log :s2) :data 4))
(csys:send (message:create '(:test :sub :op :n2) :data 4)) (csys:send (message:create '(:csys :add :log :s2) :data 5))
(csys:send (message:create '(:test :add :op :n2) :data 5)) (sleep 0.1)
(sleep 0.2)
) )