Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv23159
Modified Files: config.lisp Log Message: Modif load file config
Date: Fri Mar 5 10:07:25 2004 Author: nlamirault
Index: log4cl/config.lisp diff -u log4cl/config.lisp:1.2 log4cl/config.lisp:1.3 --- log4cl/config.lisp:1.2 Mon Mar 1 13:07:13 2004 +++ log4cl/config.lisp Fri Mar 5 10:07:25 2004 @@ -29,14 +29,11 @@ "rolling-file-appender" "daily-rolling-file-appender" "syslog-appender" - "db-appender")) + "db-appender" + ))
-(defun load-config-file (file) - "Create configuration based on log4cl configuration file" - (cl-ini:parse-conf-file file)) -
(defun extract-root-values (root-config) @@ -54,14 +51,86 @@ (length appender-config)))
-(defmacro with-value ((value) config appender token &body body) - `(let* ((,value (cl-ini:get-value ,config - :section "general" - :parameter (concatenate 'string - "log4cl.appender." - ,appender - ,token)))) +(defmacro with-config-params (params config appender tokens &body body) + "Macro to get some config parameters" + `(let ,(mapcar #'(lambda (param-name token) + `(,param-name (cl-ini:get-value ,config + :section "general" + :parameter (concatenate 'string + "log4cl.appender." + ,appender + "." + ;;(symbol-name ',param-name))))) + ,token)))) + params tokens) ,@body)) + + + +(defun set-layout-type (config appender-name layout) + "Create a layout from configuration" + ;;(format t "{{{ ~A }} ~%" layout) + (cond ((string-equal layout "pattern-layout") + (with-config-params (pattern) config appender-name ("layout.pattern") + (make-instance 'pattern-layout :format pattern))) + ((string-equal layout "simple-layout") + (make-instance 'simple-layout)) + ((string-equal layout "html-layout") + (make-instance 'html-layout)))) + + +(defun set-appender-type (config appender-name appender-type layout-type) + "Create an appender from configuration" + (cond ((string-equal appender-type "console-appender") + (make-instance 'console-appender + :name appender-name + :layout layout-type)) + ((or (string-equal appender-type "file-appender") + (string-equal appender-type "rolling-file-appender") + (string-equal appender-type "daily-rolling-file-appender")) + (with-config-params (file) config appender-name ("file") + (cond ((string-equal appender-type "file-appender") + (make-instance 'file-appender + :name appender-name + :layout layout-type + :file file)) + ((string-equal appender-type "rolling-file-appender") + (with-config-params (size) config appender-name ("max-size") + (make-instance 'rolling-file-appender + :name appender-name + :layout layout-type + :file file + :max-size (read-from-string size))))))) + ((string-equal appender-type "db-appender") + (with-config-params (host user passwd base table type) + config + appender-name + ("host" "user" "passwd" "base" "table" "type") + (make-instance 'db-appender + :name appender-name + :layout layout-type + :hostname host + :username user + :password passwd + :database base + :type type + :table table))) + ((string-equal appender-type "mail-appender") + (with-config-params (server from to subject items) + config + appender-name + ("server" "from" "to" "subject" "items") + (make-instance 'mail-appender + :name appender-name + :layout layout-type + :server server + :from from + :to to + :subject subject + :items (read-from-string items)))))) + + +
(defun parse-config (config) "Log4cl configuration" @@ -83,63 +152,25 @@ (mapc #'(lambda (appender-data) ;;(format t "<~A> : <~A> ~%" (car appender-data) (cdr appender-data)) (when (member (cdr appender-data) *appenders-type* :test #'string-equal) - (with-value (layout-type) config (car appender-data) ".layout" + ;;(format t "### ~A ## ~%" (cdr appender-data)) + (with-config-params (layout) config (car appender-data) ("layout") + ;;(format t "---> ~A ## ~%" layout) (let* ((appender-name (car appender-data)) (appender-type (cdr appender-data)) - (layout - (cond ((string-equal layout-type "pattern-layout") - (with-value (pattern) config appender-name ".layout.pattern" - (make-instance 'pattern-layout :format pattern))) - ((string-equal layout-type "simple-layout") - (make-instance 'simple-layout)) - ((string-equal layout-type "html-layout") - (make-instance 'html-layout)))) - (appender - (cond ((string-equal appender-type "console-appender") - (make-instance 'console-appender - :name appender-name - :layout layout)) - ((or (string-equal appender-type "file-appender") - (string-equal appender-type "rolling-file-appender") - (string-equal appender-type "daily-rolling-file-appender")) - (with-value (file) config appender-name ".file" - (cond ((string-equal appender-type "file-appender") - (make-instance 'file-appender - :name appender-name - :layout layout - :file file)) - ((string-equal appender-type "rolling-file-appender") - (with-value (size) config appender-name ".max-size" - (make-instance 'rolling-file-appender - :name appender-name - :layout layout - :file file - :max-size (read-from-string size))))))) - ((string-equal appender-type "db-appender") - (with-value (host) config appender-name ".host" - (with-value (user) config appender-name ".user" - (with-value (passwd) config appender-name ".passwd" - (with-value (base) config appender-name ".base" - (with-value (table) config appender-name ".table" - (with-value (type) config appender-name ".type" - (make-instance 'db-appender - :name appender-name - :layout layout - :hostname host - :username user - :password passwd - :database base - :type type - :table table)))))))))) -;; (format t "~A -> ~% ~A> ~% ~A> ~%" -;; appender-type (type-of layout) (type-of appender)) - (add-appender logger appender))))) + (layout-type (set-layout-type config appender-name layout)) + (appender (set-appender-type config appender-name appender-type layout-type))) + ;;(format t "~A -> ~% ~A> ~% ~A> ~%" + ;;appender-type (type-of layout) (type-of appender)) + (add-appender logger appender))))) appenders) logger))))
- +(defun load-config-file (file) + "Create configuration based on log4cl configuration file" + (cl-ini:parse-conf-file file)) +