diff --git a/core/core.lisp b/core/core.lisp index 44b9d59..1352bce 100644 --- a/core/core.lisp +++ b/core/core.lisp @@ -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) diff --git a/logging.lisp b/logging.lisp index 758766c..9b1366c 100644 --- a/logging.lisp +++ b/logging.lisp @@ -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))) diff --git a/test/etc/config-web.lisp b/test/etc/config-web.lisp index 609aaeb..71695f2 100644 --- a/test/etc/config-web.lisp +++ b/test/etc/config-web.lisp @@ -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" diff --git a/web/server.lisp b/web/server.lisp index d6aca87..7638e86 100644 --- a/web/server.lisp +++ b/web/server.lisp @@ -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)))