csys: now without dispatcher loop - send is directly submitting the selected action
This commit is contained in:
parent
6cef655707
commit
5ff08dcde6
3 changed files with 13 additions and 24 deletions
|
@ -10,42 +10,32 @@
|
||||||
(:shape :scopes/shape)
|
(:shape :scopes/shape)
|
||||||
(:util :scopes/util)
|
(:util :scopes/util)
|
||||||
(:alx :alexandria))
|
(:alx :alexandria))
|
||||||
(:export #:*dispatcher* #:setup #:start #:shutdown
|
(:export #:*dispatcher* #:setup #:send
|
||||||
#:printer
|
#:printer
|
||||||
))
|
))
|
||||||
|
|
||||||
(in-package :scopes/csys)
|
(in-package :scopes/csys)
|
||||||
|
|
||||||
|
(defun send (msg)
|
||||||
|
(handle-message msg))
|
||||||
|
|
||||||
(defvar *dispatcher* nil)
|
(defvar *dispatcher* nil)
|
||||||
|
|
||||||
(defun setup (&optional (cfg config:*root*))
|
(defun setup (&optional (cfg config:*root*))
|
||||||
(setf *dispatcher* (make-instance 'core:context :config cfg))
|
(setf *dispatcher* (make-instance 'core:context :config cfg))
|
||||||
(setf (core:mailbox *dispatcher*) (async:make-mb))
|
|
||||||
(dolist (a (config:actions cfg))
|
(dolist (a (config:actions cfg))
|
||||||
(core:add-action *dispatcher* (car a) (cadr a))))
|
(core:add-action *dispatcher* (car a) (cadr a))))
|
||||||
|
|
||||||
(defun start ()
|
|
||||||
(async:init)
|
|
||||||
(actor:start (core:mailbox *dispatcher*)
|
|
||||||
(lambda (msg) (funcall #'handle-message msg))
|
|
||||||
:foreground t))
|
|
||||||
|
|
||||||
(defun handle-message (msg)
|
(defun handle-message (msg)
|
||||||
(let ((hdlrs (core:select msg (core:actions *dispatcher*))))
|
(let ((hdlrs (core:select msg (core:actions *dispatcher*))))
|
||||||
(if hdlrs
|
(if hdlrs
|
||||||
(mapcar #'(lambda (hdlr) (run-action hdlr msg)) hdlrs)
|
(mapcar #'(lambda (hdlr) (run-action hdlr msg)) hdlrs)
|
||||||
(util:lgw "no action selected" msg)))
|
(util:lgw "no action selected" msg))))
|
||||||
nil)
|
|
||||||
|
|
||||||
(defun run-action (job msg)
|
(defun run-action (job msg)
|
||||||
(let ((ch (async:make-ch)))
|
(let ((ch (async:make-ch)))
|
||||||
(async:submit-task ch (lambda () (funcall job msg)))))
|
(async:submit-task ch (lambda () (funcall job msg)))))
|
||||||
|
|
||||||
(defun shutdown (msg &optional (delay 0.1))
|
|
||||||
(sleep delay)
|
|
||||||
(format t "~&*** shutdown ~a~%" msg)
|
|
||||||
(actor:stop (core:mailbox *dispatcher*)))
|
|
||||||
|
|
||||||
;;;; example behaviors / actions
|
;;;; example behaviors / actions
|
||||||
|
|
||||||
(defun printer (msg)
|
(defun printer (msg)
|
||||||
|
|
|
@ -5,7 +5,6 @@
|
||||||
(config:root)
|
(config:root)
|
||||||
|
|
||||||
(config:add-action '(:test) #'csys:printer)
|
(config:add-action '(:test) #'csys:printer)
|
||||||
(config:add-action '(:stop) #'csys:shutdown)
|
|
||||||
|
|
||||||
(config:add :logger :class 'logging:config
|
(config:add :logger :class 'logging:config
|
||||||
:loglevel (config:from-env :loglevel :info)
|
:loglevel (config:from-env :loglevel :info)
|
||||||
|
|
|
@ -21,19 +21,19 @@
|
||||||
;;;; test runner
|
;;;; test runner
|
||||||
|
|
||||||
(defun run ()
|
(defun run ()
|
||||||
|
(async:init)
|
||||||
(let* ((t:*test-suite* (make-instance 't:test-suite :name "csys")))
|
(let* ((t:*test-suite* (make-instance 't:test-suite :name "csys")))
|
||||||
(load (t:test-path "config-csys" "etc"))
|
(load (t:test-path "config-csys" "etc"))
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
(progn
|
(progn
|
||||||
(test-basic))
|
(test-nodispatch))
|
||||||
(async:finish)
|
(async:finish)
|
||||||
(t:show-result))))
|
(t:show-result))))
|
||||||
|
|
||||||
(deftest test-basic ()
|
(deftest test-nodispatch ()
|
||||||
(csys:setup)
|
(csys:setup)
|
||||||
(!= csys:*dispatcher* nil)
|
(csys:send (message:create '(:test 1)))
|
||||||
(actor:send (core:mailbox csys:*dispatcher*) (message:create '(:test)))
|
(csys:send (message:create '(:test 2)))
|
||||||
(actor:send (core:mailbox csys:*dispatcher*) (message:create '(:stop)))
|
(csys:send (message:create '(:test 3)))
|
||||||
;(actor:stop (core:mailbox csys:*dispatcher*))
|
(csys:send (message:create '(:test 4)))
|
||||||
(csys:start)
|
)
|
||||||
)
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue