provide code for supplying and selecting default-actions (like (:system :stop))
This commit is contained in:
parent
012999fc22
commit
9dbc637955
4 changed files with 21 additions and 10 deletions
|
@ -46,13 +46,14 @@
|
|||
((config :reader config :initarg :config)
|
||||
(name :reader name :initarg :name)
|
||||
(actions :accessor actions :initform nil)
|
||||
(default-actions :reader default-actions :initform nil)
|
||||
(services :reader services :initform (make-hash-table))))
|
||||
|
||||
(defun default-setup (cfg &optional (cls 'context))
|
||||
(make-instance cls :config cfg :name (config:name cfg)))
|
||||
|
||||
(defun find-service (name)
|
||||
(with-slots (services) *root*
|
||||
(defun find-service (name &optional (parent *root*))
|
||||
(with-slots (services) parent
|
||||
(when services
|
||||
(gethash name services))))
|
||||
|
||||
|
@ -84,13 +85,21 @@
|
|||
|
||||
(defgeneric send (rcvr msg)
|
||||
(:method ((rcvr context) msg)
|
||||
(let* ((acts (actions rcvr))
|
||||
(hdlrs (select msg acts)))
|
||||
(if hdlrs
|
||||
(dolist (hdlr hdlrs)
|
||||
(funcall hdlr rcvr msg))
|
||||
(handle-message rcvr msg)))
|
||||
|
||||
(defgeneric handle-message (ctx msg)
|
||||
(:method ((ctx context) msg)
|
||||
(if (not (do-actions ctx msg))
|
||||
(if (not (do-actions ctx msg #'default-actions))
|
||||
(log:warn "no action selected for ~s" msg)))))
|
||||
|
||||
(defun do-actions (ctx msg &optional (acts #'actions))
|
||||
(let ((hdlrs (select msg (funcall acts ctx))))
|
||||
(when hdlrs
|
||||
(dolist (hdlr hdlrs)
|
||||
(funcall hdlr ctx msg))
|
||||
t)))
|
||||
|
||||
;;;; simple printer service
|
||||
|
||||
(defun do-print (ctx msg)
|
||||
|
|
|
@ -17,7 +17,7 @@
|
|||
(defun setup(cfg)
|
||||
(let ((loglevel (config:from-env :loglevel (loglevel cfg)))
|
||||
(logfile (config:from-env :logfile (logfile cfg)))
|
||||
(pat "%&%<%I%;<;;>;-5p [%D{%H:%M:%S}] %g{}{}{:downcase}:%2.2N%C{1}{}{:downcase} - %:_%m%>%n")
|
||||
(pat "%&%<%I%;<;;>;-5p [%D{%H:%M:%S}] %g{}{}{:downcase}:%2.2N%c{1}{}{:downcase} - %:_%m%>%n")
|
||||
params)
|
||||
(if (stringp loglevel)
|
||||
(setf loglevel (util:to-keyword loglevel)))
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
(config:add :logger :class 'logging:config
|
||||
:loglevel :info
|
||||
:logfile (t:test-path "scopes-test.log" "log")
|
||||
:console t)
|
||||
:console nil)
|
||||
|
||||
(config:add :server :class 'server:config
|
||||
:port "8899"
|
||||
|
|
|
@ -23,6 +23,8 @@
|
|||
|
||||
(defun app (ctx env)
|
||||
;(print env)
|
||||
(log:info "request: ~a ~a" (getf env :request-method) (getf env :request-uri))
|
||||
(log:info "headers: ~s" (alx:hash-table-plist (getf env :headers)))
|
||||
(funcall (select-app ctx env)))
|
||||
|
||||
(defun start (ctx)
|
||||
|
@ -33,7 +35,7 @@
|
|||
:address (address cfg)
|
||||
;:server :woo
|
||||
:silent t))
|
||||
(log:info "server started on port ~a." (port cfg))))
|
||||
(log:info "port: ~a." (port cfg))))
|
||||
|
||||
(defun stop (ctx)
|
||||
(clack:stop (listener ctx)))
|
||||
|
|
Loading…
Add table
Reference in a new issue