log4cl-cvs March 2004

log4cl-cvs@common-lisp.net

3 participants
23 discussions

[log4cl-cvs] CVS update: log4cl/appender-mail.lisp
by Nicolas Lamirault 05 Mar '04

05 Mar '04

Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv28354 Added Files: appender-mail.lisp Log Message: a new appender : send logs message by mail Date: Fri Mar 5 10:12:20 2004 Author: nlamirault

1 0

[log4cl-cvs] CVS update: log4cl/log4cl.asd
by Nicolas Lamirault 05 Mar '04

05 Mar '04

Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv19776 Modified Files: log4cl.asd Log Message: Update package Date: Fri Mar 5 10:10:31 2004 Author: nlamirault Index: log4cl/log4cl.asd diff -u log4cl/log4cl.asd:1.3 log4cl/log4cl.asd:1.4 --- log4cl/log4cl.asd:1.3 Mon Mar 1 13:26:45 2004 +++ log4cl/log4cl.asd Fri Mar 5 10:10:31 2004 @@ -26,16 +26,16 @@ (defsystem :log4cl :name "log4cl" - :author "Nicolas Lamirault <lam(a)perave.org>" + :author "Nicolas Lamirault <lam(a)tuxfamily.org>" :version "0.3" :licence "Lisp Lesser GNU General Public License" :description "Log tool for Common Lisp" - :properties (((#:author #:email) . "lam(a)perave.org") + :properties (((#:author #:email) . "lam(a)tuxfamily.org") (#:date . "05/11/2003") ((#:albert #:output-dir) . "doc/") ((#:albert #:formats) . ("docbook")) ((#:albert #:docbook #:template) . "book") - ((#:albert #:docbook #:baseurl) . "http://www.perave.org/tools/log4cl/") + ((#:albert #:docbook #:baseurl) . "") ((#:albert #:docbook #:bgcolor) . "white") ((#:albert #:docbook #:textcolor) . "black")) :components ((:file "package") @@ -52,3 +52,7 @@ (defsystem :log4cl.db :components ((:file "appender-db")) :depends-on (:log4cl)) + +(defsystem :log4cl.mail + :components ((:file "appender-mail")) + :depends-on (:log4cl :unetwork))

1 0

[log4cl-cvs] CVS update: log4cl/package.lisp
by Nicolas Lamirault 05 Mar '04

05 Mar '04

Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv10016 Modified Files: package.lisp Log Message: Update new macro, new functions Date: Fri Mar 5 10:09:55 2004 Author: nlamirault Index: log4cl/package.lisp diff -u log4cl/package.lisp:1.2 log4cl/package.lisp:1.3 --- log4cl/package.lisp:1.2 Mon Mar 1 13:19:54 2004 +++ log4cl/package.lisp Fri Mar 5 10:09:54 2004 @@ -28,6 +28,7 @@ ;; logger #:logger + #:with-logger #:set-level #:add-level @@ -56,12 +57,19 @@ #:daily-rolling-file-appender #:syslog-appender #:db-appender + #:mail-appender + #:log-msg ;; layout #:simple-layout #:pattern-layout #:html-layout - #:format-log-message) + #:format-log-message + + ;; config + #:load-config-file + #:parse-config + ) (:documentation "log4cl is a Common Lisp utility to logging"))

1 0

[log4cl-cvs] CVS update: log4cl/logger.lisp
by Nicolas Lamirault 05 Mar '04

05 Mar '04

Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv9184 Modified Files: logger.lisp Log Message: some modifications Date: Fri Mar 5 10:09:34 2004 Author: nlamirault Index: log4cl/logger.lisp diff -u log4cl/logger.lisp:1.3 log4cl/logger.lisp:1.4 --- log4cl/logger.lisp:1.3 Thu Mar 4 06:36:31 2004 +++ log4cl/logger.lisp Fri Mar 5 10:09:34 2004 @@ -51,6 +51,15 @@ +(defmacro with-logger ((logger &key name appenders level) &body body) + `(let ((,logger (make-instance 'logger + :name ,name + :appenders ,appenders + :level ,level))) + ,@body)) + + + ;; ------- ;; Levels ;; ------- @@ -96,10 +105,10 @@ (append levels (list new-level))) ((string-equal place "relative") (with-level logger level - (let ((rank (level-rank logger level))) - (append (subseq levels 0 rank) - (list new-level) - (subseq levels rank (length levels))))))) + (let ((rank (level-rank logger level))) + (append (subseq levels 0 rank) + (list new-level) + (subseq levels rank (length levels))))))) levels))) (setf (slot-value logger 'possible-levels) new-levels)))) @@ -137,8 +146,7 @@ "Remove an appender" (with-slots (appenders current-appender) logger (setf appenders (remove (appender-name appender) (logger-appenders logger) - :test #'string-equal - :key #'appender-name)) + :test #'string-equal :key #'appender-name)) (when (string-equal (logger-current-appender logger) (appender-name appender)) (setf current-appender (car (logger-appenders logger)))))) @@ -187,7 +195,7 @@ (level-name (symbol-name level))) (when (is-enabled-for logger level) (if (not (null appender-type)) - (with-appender (appender) logger appender-type + (with-appender (appender) logger (symbol-name appender-type) (log-msg appender name level-name message)) (mapc #'(lambda (app) (log-msg app name level-name message)) @@ -198,6 +206,11 @@ ;; ----------------------------------- ;; Predicat to know the current level ;; ----------------------------------- + + +(defmethod levelp ((logger logger) level) + "Predicat for level" + (not (null (member level (logger-possible-levels logger))))) (defmethod debugp ((logger logger))

1 0

[log4cl-cvs] CVS update: log4cl/appender.lisp
by Nicolas Lamirault 05 Mar '04

05 Mar '04

Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv26132 Modified Files: appender.lisp Log Message: Add network appender Date: Fri Mar 5 10:08:27 2004 Author: nlamirault Index: log4cl/appender.lisp diff -u log4cl/appender.lisp:1.4 log4cl/appender.lisp:1.5 --- log4cl/appender.lisp:1.4 Tue Mar 2 13:37:45 2004 +++ log4cl/appender.lisp Fri Mar 5 10:08:27 2004 @@ -21,6 +21,7 @@ (defclass appender () ((name :initarg :name + :initform nil :accessor appender-name) (layout :initarg :layout :accessor appender-layout)) @@ -28,8 +29,10 @@ (defmethod initialize-instance :after ((appender appender) &rest initargs) (declare (ignore initargs)) - (with-slots (layout) appender - (setf layout (make-instance 'simple-layout)))) + (with-slots (layout name) appender + (setf layout (make-instance 'simple-layout)) + (when (null name) + (setf name (type-of appender))))) ;; ---------- ;; Protocole @@ -167,3 +170,36 @@ (cons "M" (write-to-string month)) (cons "D" (write-to-string date))))) (replace-string date-pattern pattern)))) + + + +;; ----------------- +;; Network Appender +;; ----------------- + + +(defclass network-appender (appender) + ((server :initarg :server + :accessor network-appender-server) + (data :initarg :data + :initform '() + :accessor network-appender-data) + (items :initarg :size + :initform 10 + :accessor network-appender-items)) + (:documentation "Network appender bufferize logs message, and send them when size is over")) + + +(defmethod log-msg ((appender network-appender) name level message) + (setf (slot-value appender 'data) + (cons (format-log-message (appender-layout appender) name level message) + (network-appender-data appender)))) + + +(defun create-buffer (tokens) + "Create a paragrah from a list of string" + (apply #'concatenate 'string + (mapcar #'(lambda (token) + (let ((new-token (format nil "~A~%" token))) + (concatenate 'string new-token))) + tokens)))

1 0

[log4cl-cvs] CVS update: log4cl/appender-db.lisp
by Nicolas Lamirault 05 Mar '04

05 Mar '04

Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv24352 Modified Files: appender-db.lisp Log Message: Correct database type Date: Fri Mar 5 10:08:00 2004 Author: nlamirault Index: log4cl/appender-db.lisp diff -u log4cl/appender-db.lisp:1.1 log4cl/appender-db.lisp:1.2 --- log4cl/appender-db.lisp:1.1 Mon Mar 1 13:05:57 2004 +++ log4cl/appender-db.lisp Fri Mar 5 10:08:00 2004 @@ -53,7 +53,7 @@ (db-appender-database appender) (db-appender-username appender) (db-appender-password appender)) - :database-type (cdr assoc (db-appender-type appender) *db-types*) + :database-type (cdr (assoc (db-appender-type appender) *db-types* test #'string-equal)) :if-exists :old) (let ((sql (format nil "INSERT INTO ~A (level,message) VALUES ('~A','~A')" (db-appender-table appender)

1 0

[log4cl-cvs] CVS update: log4cl/config.lisp
by Nicolas Lamirault 05 Mar '04

05 Mar '04

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)) +

1 0

[log4cl-cvs] CVS update: log4cl/log4cl.cfg
by Nicolas Lamirault 05 Mar '04

05 Mar '04

Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv20601 Modified Files: log4cl.cfg Log Message: Modif fichier de conf Date: Fri Mar 5 10:06:50 2004 Author: nlamirault Index: log4cl/log4cl.cfg diff -u log4cl/log4cl.cfg:1.1.1.1 log4cl/log4cl.cfg:1.2 --- log4cl/log4cl.cfg:1.1.1.1 Fri Feb 20 03:59:59 2004 +++ log4cl/log4cl.cfg Fri Mar 5 10:06:50 2004 @@ -4,15 +4,14 @@ # un appender : CONSOLE_APP log4cl.appender.console-app = console-appender log4cl.appender.console-app.layout = pattern-layout -log4cl.appender.console-app.layout.pattern = [%t] %p %c - %m%n +log4cl.appender.console-app.pattern = [%t] %p %c - %m%n # nouvel appender : ROLLING-FILE-APPENDER log4cl.appender.file = rolling-file-appender log4cl.appender.file.file = /tmp/log4cl.log log4cl.appender.file.max-size = 100 log4cl.appender.file.layout = pattern-layout -log4cl.appender.file.layout.pattern = %d [%t] %-5p %c - %m%n - +log4cl.appender.file.pattern = %d [%t] %-5p %c - %m%n # nouvel appender : DB-APPENDER log4cl.appender.db = db-appender @@ -21,5 +20,14 @@ log4cl.appender.db.passwd = mangoule log4cl.appender.db.base = blog log4cl.appender.db.table = logs -log4cl.appender.db.table = mysql +log4cl.appender.db.type = mysql log4cl.appender.db.layout = simple-layout + +# nouvel appender : MAIL-APPENDER +# log4cl.appender.mail = mail-appender +# log4cl.appender.mail.server = free.fr +# log4cl.appender.mail.from = lamix(a)free.fr +# log4cl.appender.mail.to = lamix(a)free.fr +# log4cl.appender.mail.subject = [ Log4cl ] Alertes +# log4cl.appender.mail.items = 20 +# log4cl.appender.mail.layout = simple-layout

1 0

[log4cl-cvs] CVS update: log4cl/logger.lisp
by Marco Baringer 04 Mar '04

04 Mar '04

Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv3485 Modified Files: logger.lisp Log Message: Give the current-appender an initform to avoid unbound-slot errors. Date: Thu Mar 4 06:36:31 2004 Author: mbaringer Index: log4cl/logger.lisp diff -u log4cl/logger.lisp:1.2 log4cl/logger.lisp:1.3 --- log4cl/logger.lisp:1.2 Mon Mar 1 13:14:17 2004 +++ log4cl/logger.lisp Thu Mar 4 06:36:31 2004 @@ -36,6 +36,7 @@ (possible-levels :initform *levels* :reader logger-possible-levels) (current-appender :initarg :current-appender + :initform nil :accessor logger-current-appender) (parent :reader logger-parent)) (:documentation "Logger"))

1 0

[log4cl-cvs] CVS update: log4cl/appender.lisp
by Marco Baringer 02 Mar '04

02 Mar '04

Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv21500 Modified Files: appender.lisp Log Message: Create a generic stream-appender, console-appender is a sub class of this. Date: Tue Mar 2 13:37:45 2004 Author: mbaringer Index: log4cl/appender.lisp diff -u log4cl/appender.lisp:1.3 log4cl/appender.lisp:1.4 --- log4cl/appender.lisp:1.3 Mon Mar 1 13:35:10 2004 +++ log4cl/appender.lisp Tue Mar 2 13:37:45 2004 @@ -39,17 +39,20 @@ (:documentation "Log a message with the appropriate level")) ;; ------------------------------ -;; Appender to log to the console +;; Appender to a stream ;; ------------------------------ -(defclass console-appender (appender) - () - (:documentation "Console appender, is an appender which log message -to the default exit")) +(defclass stream-appender (appender) + ((log-stream :initarg :log-stream :accessor stream-appender-log-stream))) -(defmethod log-msg ((appender console-appender) name level message) - "Log a message to the standard output" - (format t " ~A ~%" (format-log-message (appender-layout appender) name level message))) +(defmethod log-msg ((appender stream-appender) name level message) + (format (stream-appender-log-stream appender) + " ~A ~%" + (format-log-message (appender-layout appender) name level message))) + +(defclass console-appender (stream-appender) + ((log-stream :initform *standard-output*)) + (:documentation "Console appender, is an appender which log message to the default exit")) ;; ---------------------------- ;; Appender to log into a file

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

log4cl-cvs March 2004