[log4cl-cvs] CVS update: log4cl/config.lisp
Nicolas Lamirault
nlamirault at common-lisp.net
Fri Mar 5 15:07:25 UTC 2004
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)
, at 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))
+
More information about the Log4cl-cvs
mailing list