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

provide shutdown for root service, calling shutdown for all child services

Browse source
This commit is contained in:
Helmut Merz 2024-06-25 17:35:35 +02:00
parent 0f23d62ad6
commit c3f4c20a75
3 changed files with 19 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
config.lisp
View file

@ -6,7 +6,8 @@
(:use :common-lisp) (:use :common-lisp)
(:export #:base #:root #:*root* (:export #:base #:root #:*root*
#:env-data #:env-keys #:env-prefix #:env-path #:env-data #:env-keys #:env-prefix #:env-path
#:actions #:add #:add-action #:children #:env-slots #:name #:setup #:parent)) #:actions #:add #:add-action #:children #:env-slots
#:name #:setup #:parent #:shutdown))
(in-package :scopes/config) (in-package :scopes/config)
@ -60,6 +61,7 @@
(name :reader name :initarg :name) (name :reader name :initarg :name)
(parent :reader parent :initarg :parent) (parent :reader parent :initarg :parent)
(setup :reader setup :initarg :setup :initform #'(lambda (cfg))) (setup :reader setup :initarg :setup :initform #'(lambda (cfg)))
(shutdown :reader shutdown :initarg :shutdown :initform #'(lambda (ctx)))
(actions :accessor actions :initarg :actions :initform nil))) (actions :accessor actions :initarg :actions :initform nil)))
(defmethod initialize-instance :after ((cfg base) &key parent &allow-other-keys) (defmethod initialize-instance :after ((cfg base) &key parent &allow-other-keys)

11
core/core.lisp
View file

@ -3,9 +3,10 @@
(defpackage :scopes/core (defpackage :scopes/core
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:config :scopes/config) (:local-nicknames (:config :scopes/config)
(:message :scopes/core/message)) (:message :scopes/core/message)
(:alx :alexandria))
(:export #:*root* #:default-setup #:find-service #:setup-services (:export #:*root* #:default-setup #:find-service #:setup-services
#:context #:add-action #:config #:name #:send #:context #:add-action #:config #:name #:send #:shutdown
#:printer)) #:printer))
(in-package :scopes/core) (in-package :scopes/core)
@ -45,7 +46,7 @@
((config :reader config :initarg :config) ((config :reader config :initarg :config)
(name :reader name :initarg :name) (name :reader name :initarg :name)
(actions :accessor actions :initform nil) (actions :accessor actions :initform nil)
(services :initform (make-hash-table)))) (services :reader services :initform (make-hash-table))))
(defun default-setup (cfg &optional (cls 'context)) (defun default-setup (cfg &optional (cls 'context))
(make-instance cls :config cfg :name (config:name cfg))) (make-instance cls :config cfg :name (config:name cfg)))
@ -60,6 +61,10 @@
(dolist (c (config:children cfg)) (dolist (c (config:children cfg))
(add-service *root* c))) (add-service *root* c)))
(defun shutdown ()
(dolist (ctx (alx:hash-table-values (services *root*)))
(funcall (config:shutdown (config ctx)) ctx)))
(defun add-action (ctx pat hdlr) (defun add-action (ctx pat hdlr)
(let* ((acts (actions ctx)) (let* ((acts (actions ctx))
(act (find-action pat acts))) (act (find-action pat acts)))

13
test/test-core.lisp
View file

@ -53,11 +53,14 @@
(t:*test-suite* (make-instance 'test-suite :name "core"))) (t:*test-suite* (make-instance 'test-suite :name "core")))
(log4cl:log-config :sane :daily (t:test-path "scopes-test.log" "log")) (log4cl:log-config :sane :daily (t:test-path "scopes-test.log" "log"))
(load (t:test-path "config-core" "etc")) (load (t:test-path "config-core" "etc"))
(core:setup-services *config*) (unwind-protect
(setf (receiver t:*test-suite*) (core:find-service :test-receiver)) (progn
(test-send) (core:setup-services *config*)
(check-expected) (setf (receiver t:*test-suite*) (core:find-service :test-receiver))
(t:show-result))) (test-send))
(core:shutdown)
(check-expected)
(t:show-result))))
(deftest test-send () (deftest test-send ()
(let ((rcvr (receiver t:*test-suite*)) (let ((rcvr (receiver t:*test-suite*))