From root at common-lisp.net Mon Mar 1 14:21:52 2004 From: root at common-lisp.net (root) Date: Mon, 01 Mar 2004 09:21:52 -0500 Subject: [log4cl-cvs] CVS update: CVSROOT/config Message-ID: Update of /project/log4cl/cvsroot/CVSROOT In directory common-lisp.net:/tmp/log-CVSROOT Modified Files: config Log Message: fixing anon cvs Date: Mon Mar 1 09:21:52 2004 Author: root Index: CVSROOT/config diff -u CVSROOT/config:1.2 CVSROOT/config:1.3 --- CVSROOT/config:1.2 Wed Feb 18 09:19:09 2004 +++ CVSROOT/config Mon Mar 1 09:21:51 2004 @@ -0,0 +1,14 @@ +# Set this to "no" if pserver shouldn't check system users/passwords +#SystemAuth=no + +# Put CVS lock files in this directory rather than directly in the repository. +LockDir=/var/lock/log4cl + +# Set `TopLevelAdmin' to `yes' to create a CVS directory at the top +# level of the new working directory when using the `cvs checkout' +# command. +#TopLevelAdmin=no + +# Set `LogHistory' to `all' or `TOFEWGCMAR' to log all transactions to the +# history file, or a subset as needed (ie `TMAR' logs all write operations) +#LogHistory=TOFEWGCMAR From mbaringer at common-lisp.net Mon Mar 1 18:04:23 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 01 Mar 2004 13:04:23 -0500 Subject: [log4cl-cvs] CVS update: log4cl/appender.lisp Message-ID: Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv28354 Modified Files: appender.lisp Log Message: Uncomment the in-package form and remove the db and syslog appenders. Date: Mon Mar 1 13:04:23 2004 Author: mbaringer Index: log4cl/appender.lisp diff -u log4cl/appender.lisp:1.1.1.1 log4cl/appender.lisp:1.2 --- log4cl/appender.lisp:1.1.1.1 Fri Feb 20 03:59:58 2004 +++ log4cl/appender.lisp Mon Mar 1 13:04:23 2004 @@ -17,9 +17,7 @@ ;;;; ;;;; ************************************************************************* - -;;(in-package #:log4cl) - +(in-package #:log4cl) (defclass appender () ((name :initarg :name @@ -28,52 +26,40 @@ :accessor appender-layout)) (:documentation "Appender main class")) - (defmethod initialize-instance :after ((appender appender) &rest initargs) (declare (ignore initargs)) (with-slots (layout) appender (setf layout (make-instance 'simple-layout)))) - - ;; ---------- ;; Protocole ;; ---------- - (defgeneric log-msg (appender name level message) (:documentation "Log a message with the appropriate level")) - - ;; ------------------------------ ;; Appender to log to the console ;; ------------------------------ - (defclass console-appender (appender) () (:documentation "Console appender, is an appender which log message to the default exit")) - (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))) - - ;; ---------------------------- ;; Appender to log into a file ;; ---------------------------- - (defclass file-appender (appender) ((file :initarg :file :accessor file-appender-file)) (:documentation "Appender which log message in a file")) - (defmethod log-msg ((appender file-appender) name level message) "Log message into a file. If file exist, the message is append to it, or the appender create the file" @@ -83,13 +69,10 @@ :if-does-not-exist :create) (format stream "~A ~%" (format-log-message (appender-layout appender) name level message)))) - - ;; --------------------------- ;; File Appender with rolling ;; --------------------------- - (defclass rolling-file-appender (file-appender) ((max-size :initarg :max-size :initform 1000000 :accessor rolling-file-appender-max-size) @@ -98,7 +81,6 @@ (:documentation "Appender which log message in a file. There is a rolling with this file when the size of it is grater than a specify size")) - (defun copy-file (source target) "Copy a file" (with-open-file (in source :direction :input) @@ -108,11 +90,9 @@ until (= n 0) do (write-sequence buffer out :end n))))) - (defun make-archive-name (name number) "Create name of this archive file" (concatenate 'string name "." (format nil "~A" number))) - (defun make-archive (rolling-file-appender) "Make a copy of current log file, and incremente current number" @@ -127,7 +107,6 @@ (delete-file name) (setf (slot-value rolling-file-appender 'current) next-number))) - (defmethod log-msg :before ((appender rolling-file-appender) name level message) "Log message into a file. If size of the file is greater than the max size, we create an archive of the current file, and we create a new current file @@ -136,20 +115,16 @@ (file-length s)) (rolling-file-appender-max-size appender)) (make-archive appender))) - - ;; ------------------- ;; Daily Rolling File ;; ------------------- - (defclass daily-rolling-file-appender (file-appender) ((date-pattern :initform "%Y-%M-%D" :initarg :date-pattern :accessor daily-rolling-file-appender-pattern))) - (defmethod initialize-instance :after ((appender daily-rolling-file-appender) &rest initargs) (declare (ignore initargs)) (with-slots (file) appender @@ -159,8 +134,6 @@ "_" (file-namestring file))))) - - (defmethod log-msg :before ((appender daily-rolling-file-appender) name level message) "Log message into a file named by the current date. If log file is a previous date, a new file is created" @@ -174,14 +147,12 @@ "_" (file-namestring file))))))) - (defun extract-date-pattern (file) (let* ((name (file-namestring file)) (index (position #\_ name))) (when (not (null index)) (subseq name 0 index)))) - (defun make-date-pattern (date-pattern) (multiple-value-bind (second minute hour date month year day-of-week dst-p tz) @@ -191,70 +162,3 @@ (cons "M" (write-to-string month)) (cons "D" (write-to-string date))))) (replace-string date-pattern pattern)))) - - - - -;; --------------------- -;; Appender with syslog -;; --------------------- - -(defclass syslog-appender (appender) - ()) - -(defmethod log-msg ((appender syslog-appender) name level message) - "Log a message with Syslog" - (progn - (openlog name LOG_CONS LOG_LOCAL7) - (syslog LOG_INFO (format-log-message (appender-layout appender) "" level message)))) - - -;; ------------------------------ -;; Appender to log into database -;; ------------------------------ - - -(defclass db-appender (appender) - ((hostname :initarg :hostname - :accessor db-appender-hostname) - (username :initarg :username - :accessor db-appender-username) - (password :initarg :password - :accessor db-appender-password) - (database :initarg :database - :accessor db-appender-database) - (type :initarg :type - :accessor db-appender-type) - (table :initarg :table - :accessor db-appender-table)) - (:documentation "Database appender : Mysql, PostgreSQL")) - - -(defparameter *db-types* - '(("mysql" . :mysql) - ("postgresql" . :postgresql))) - - -(defmethod log-msg ((appender db-appender) name level message) - "Log a message with into a Mysql database - Table must have this structure : - id int(16) auto_increment Primary - level varchar(10) o Index - message varchar(255)" - (progn - (clsql:connect (list (db-appender-hostname appender) - (db-appender-database appender) - (db-appender-username appender) - (db-appender-password appender)) - :database-type (cdr assoc (db-appender-type appender) *db-types*) - :if-exists :old) - (let ((sql (format nil "INSERT INTO ~A (level,message) VALUES ('~A','~A')" - (db-appender-table appender) - level - (format-log-message (appender-layout appender) name level message)))) - (clsql:execute-command sql)))) - - - - - From mbaringer at common-lisp.net Mon Mar 1 18:05:57 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 01 Mar 2004 13:05:57 -0500 Subject: [log4cl-cvs] CVS update: log4cl/appender-db.lisp Message-ID: Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv7329 Added Files: appender-db.lisp Log Message: Initial version, simply contains code ripped from appender.lisp Date: Mon Mar 1 13:05:57 2004 Author: mbaringer From mbaringer at common-lisp.net Mon Mar 1 18:06:09 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 01 Mar 2004 13:06:09 -0500 Subject: [log4cl-cvs] CVS update: log4cl/appender-syslog.lisp Message-ID: Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv9664 Added Files: appender-syslog.lisp Log Message: Initial version, simply contains code ripped from appender.lisp Date: Mon Mar 1 13:06:09 2004 Author: mbaringer From mbaringer at common-lisp.net Mon Mar 1 18:07:13 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 01 Mar 2004 13:07:13 -0500 Subject: [log4cl-cvs] CVS update: log4cl/config.lisp Message-ID: Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv17660 Modified Files: config.lisp Log Message: Uncomment the in-package form. Date: Mon Mar 1 13:07:13 2004 Author: mbaringer Index: log4cl/config.lisp diff -u log4cl/config.lisp:1.1.1.1 log4cl/config.lisp:1.2 --- log4cl/config.lisp:1.1.1.1 Fri Feb 20 03:59:59 2004 +++ log4cl/config.lisp Mon Mar 1 13:07:13 2004 @@ -19,7 +19,7 @@ -;;(in-package #:log4cl) +(in-package #:log4cl) From mbaringer at common-lisp.net Mon Mar 1 18:07:37 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 01 Mar 2004 13:07:37 -0500 Subject: [log4cl-cvs] CVS update: log4cl/layout.lisp Message-ID: Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv19180 Modified Files: layout.lisp Log Message: Uncomment the in-package form. Date: Mon Mar 1 13:07:37 2004 Author: mbaringer Index: log4cl/layout.lisp diff -u log4cl/layout.lisp:1.1.1.1 log4cl/layout.lisp:1.2 --- log4cl/layout.lisp:1.1.1.1 Fri Feb 20 03:59:59 2004 +++ log4cl/layout.lisp Mon Mar 1 13:07:36 2004 @@ -18,7 +18,7 @@ ;;;; ************************************************************************* -;;(in-package #:log4cl) +(in-package #:log4cl) (defparameter *layouts* From mbaringer at common-lisp.net Mon Mar 1 18:13:10 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 01 Mar 2004 13:13:10 -0500 Subject: [log4cl-cvs] CVS update: log4cl/log4cl.asd Message-ID: Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv20842 Modified Files: log4cl.asd Log Message: Split into three systems, a core system and then one system for the db appender and one for the syslog appender. Date: Mon Mar 1 13:13:10 2004 Author: mbaringer Index: log4cl/log4cl.asd diff -u log4cl/log4cl.asd:1.1.1.1 log4cl/log4cl.asd:1.2 --- log4cl/log4cl.asd:1.1.1.1 Fri Feb 20 03:59:58 2004 +++ log4cl/log4cl.asd Mon Mar 1 13:13:10 2004 @@ -28,7 +28,7 @@ :name "log4cl" :author "Nicolas Lamirault " :version "0.3" - :licence "GNU General Public License" + :licence "Lisp Lesser GNU General Public License" :description "Log tool for Common Lisp" :properties (((#:author #:email) . "lam at perave.org") (#:date . "05/11/2003") @@ -37,13 +37,17 @@ ((#:albert #:docbook #:template) . "book") ((#:albert #:docbook #:baseurl) . "http://www.perave.org/tools/log4cl/") ((#:albert #:docbook #:bgcolor) . "white") - ((#:albert #:docbook #:textcolor) . "black") - ) + ((#:albert #:docbook #:textcolor) . "black")) :components ((:file "package") (:file "logger") (:file "appender") - (:file "layout")) - :depends-on (:uffi)) - + (:file "layout"))) - +(defsystem :log4cl.syslog + :components ((:file "appender-syslog" :depends-on ("cl-syslog")) + (:file "cl-syslog")) + :depends-on (:log4cl :uffi)) + +(defsystem :log4cl.db + :components ((:file "appender-db")) + :depends-on (:log4cl)) From mbaringer at common-lisp.net Mon Mar 1 18:14:17 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 01 Mar 2004 13:14:17 -0500 Subject: [log4cl-cvs] CVS update: log4cl/logger.lisp Message-ID: Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv6559 Modified Files: logger.lisp Log Message: Uncomment the in-package form. Date: Mon Mar 1 13:14:17 2004 Author: mbaringer Index: log4cl/logger.lisp diff -u log4cl/logger.lisp:1.1.1.1 log4cl/logger.lisp:1.2 --- log4cl/logger.lisp:1.1.1.1 Fri Feb 20 03:59:58 2004 +++ log4cl/logger.lisp Mon Mar 1 13:14:17 2004 @@ -18,7 +18,7 @@ ;;;; ************************************************************************* -;;(in-package #:log4cl) +(in-package #:log4cl) (defparameter *levels* '(:debug :info :warning :error :fatal)) From mbaringer at common-lisp.net Mon Mar 1 18:19:55 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 01 Mar 2004 13:19:55 -0500 Subject: [log4cl-cvs] CVS update: log4cl/package.lisp Message-ID: Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv16160 Modified Files: package.lisp Log Message: Remove :uffi from the log4cl package's use list. Date: Mon Mar 1 13:19:55 2004 Author: mbaringer Index: log4cl/package.lisp diff -u log4cl/package.lisp:1.1.1.1 log4cl/package.lisp:1.2 --- log4cl/package.lisp:1.1.1.1 Fri Feb 20 03:59:58 2004 +++ log4cl/package.lisp Mon Mar 1 13:19:54 2004 @@ -23,7 +23,7 @@ (defpackage #:log4cl - (:use #:cl #:uffi) + (:use #:cl) (:export ;; logger From mbaringer at common-lisp.net Mon Mar 1 18:26:45 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 01 Mar 2004 13:26:45 -0500 Subject: [log4cl-cvs] CVS update: log4cl/log4cl.asd Message-ID: Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv32131 Modified Files: log4cl.asd Log Message: Added tools.lisp to system def along with depends-on info. Date: Mon Mar 1 13:26:45 2004 Author: mbaringer Index: log4cl/log4cl.asd diff -u log4cl/log4cl.asd:1.2 log4cl/log4cl.asd:1.3 --- log4cl/log4cl.asd:1.2 Mon Mar 1 13:13:10 2004 +++ log4cl/log4cl.asd Mon Mar 1 13:26:45 2004 @@ -39,9 +39,10 @@ ((#:albert #:docbook #:bgcolor) . "white") ((#:albert #:docbook #:textcolor) . "black")) :components ((:file "package") - (:file "logger") - (:file "appender") - (:file "layout"))) + (:file "logger" :depends-on ("package")) + (:file "appender" :depends-on ("package" "tools")) + (:file "layout" :depends-on ("package" "tools")) + (:file "tools" :depends-on ("package")))) (defsystem :log4cl.syslog :components ((:file "appender-syslog" :depends-on ("cl-syslog")) From mbaringer at common-lisp.net Mon Mar 1 18:35:11 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 01 Mar 2004 13:35:11 -0500 Subject: [log4cl-cvs] CVS update: log4cl/appender.lisp Message-ID: Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv4097 Modified Files: appender.lisp Log Message: Supress warnings with (declare (ignore ...)) Date: Mon Mar 1 13:35:10 2004 Author: mbaringer Index: log4cl/appender.lisp diff -u log4cl/appender.lisp:1.2 log4cl/appender.lisp:1.3 --- log4cl/appender.lisp:1.2 Mon Mar 1 13:04:23 2004 +++ log4cl/appender.lisp Mon Mar 1 13:35:10 2004 @@ -111,6 +111,7 @@ "Log message into a file. If size of the file is greater than the max size, we create an archive of the current file, and we create a new current file for logging message" + (declare (ignore name level message)) (when (> (with-open-file (s (file-appender-file appender) :if-does-not-exist :create) (file-length s)) (rolling-file-appender-max-size appender)) @@ -137,6 +138,7 @@ (defmethod log-msg :before ((appender daily-rolling-file-appender) name level message) "Log message into a file named by the current date. If log file is a previous date, a new file is created" + (declare (ignore name level message)) (let ((pattern (make-date-pattern (daily-rolling-file-appender-pattern appender)))) (when (not (string-equal (extract-date-pattern (file-appender-file appender)) pattern)) From mbaringer at common-lisp.net Mon Mar 1 18:35:38 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 01 Mar 2004 13:35:38 -0500 Subject: [log4cl-cvs] CVS update: log4cl/layout.lisp Message-ID: Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv6720 Modified Files: layout.lisp Log Message: Don't bind unused values Date: Mon Mar 1 13:35:38 2004 Author: mbaringer Index: log4cl/layout.lisp diff -u log4cl/layout.lisp:1.2 log4cl/layout.lisp:1.3 --- log4cl/layout.lisp:1.2 Mon Mar 1 13:07:36 2004 +++ log4cl/layout.lisp Mon Mar 1 13:35:38 2004 @@ -178,7 +178,7 @@ (defun get-time () "Get current time" (multiple-value-bind - (second minute hour date month year day-of-week dst-p tz) + (second minute hour date month year) (get-decoded-time) (let ((date (format nil "~d/~2,'0d/~d ~2,'0d:~2,'0d:~2,'0d" From mbaringer at common-lisp.net Mon Mar 1 18:36:10 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Mon, 01 Mar 2004 13:36:10 -0500 Subject: [log4cl-cvs] CVS update: log4cl/tools.lisp Message-ID: Update of /project/log4cl/cvsroot/log4cl In directory common-lisp.net:/tmp/cvs-serv9280 Modified Files: tools.lisp Log Message: Uncomment in-package statement Date: Mon Mar 1 13:36:09 2004 Author: mbaringer Index: log4cl/tools.lisp diff -u log4cl/tools.lisp:1.1.1.1 log4cl/tools.lisp:1.2 --- log4cl/tools.lisp:1.1.1.1 Fri Feb 20 03:59:59 2004 +++ log4cl/tools.lisp Mon Mar 1 13:36:09 2004 @@ -19,7 +19,7 @@ -;;(in-package #:log4cl) +(in-package #:log4cl) From mbaringer at common-lisp.net Tue Mar 2 18:37:45 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Tue, 02 Mar 2004 13:37:45 -0500 Subject: [log4cl-cvs] CVS update: log4cl/appender.lisp Message-ID: 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 From mbaringer at common-lisp.net Thu Mar 4 11:36:32 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Thu, 04 Mar 2004 06:36:32 -0500 Subject: [log4cl-cvs] CVS update: log4cl/logger.lisp Message-ID: 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")) From nlamirault at common-lisp.net Fri Mar 5 15:06:50 2004 From: nlamirault at common-lisp.net (Nicolas Lamirault) Date: Fri, 05 Mar 2004 10:06:50 -0500 Subject: [log4cl-cvs] CVS update: log4cl/log4cl.cfg Message-ID: 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 at free.fr +# log4cl.appender.mail.to = lamix at free.fr +# log4cl.appender.mail.subject = [ Log4cl ] Alertes +# log4cl.appender.mail.items = 20 +# log4cl.appender.mail.layout = simple-layout From nlamirault at common-lisp.net Fri Mar 5 15:07:25 2004 From: nlamirault at common-lisp.net (Nicolas Lamirault) Date: Fri, 05 Mar 2004 10:07:25 -0500 Subject: [log4cl-cvs] CVS update: log4cl/config.lisp Message-ID: 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)) + From nlamirault at common-lisp.net Fri Mar 5 15:08:00 2004 From: nlamirault at common-lisp.net (Nicolas Lamirault) Date: Fri, 05 Mar 2004 10:08:00 -0500 Subject: [log4cl-cvs] CVS update: log4cl/appender-db.lisp Message-ID: 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) From nlamirault at common-lisp.net Fri Mar 5 15:08:27 2004 From: nlamirault at common-lisp.net (Nicolas Lamirault) Date: Fri, 05 Mar 2004 10:08:27 -0500 Subject: [log4cl-cvs] CVS update: log4cl/appender.lisp Message-ID: 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))) From nlamirault at common-lisp.net Fri Mar 5 15:09:34 2004 From: nlamirault at common-lisp.net (Nicolas Lamirault) Date: Fri, 05 Mar 2004 10:09:34 -0500 Subject: [log4cl-cvs] CVS update: log4cl/logger.lisp Message-ID: 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))) + , at 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)) From nlamirault at common-lisp.net Fri Mar 5 15:09:55 2004 From: nlamirault at common-lisp.net (Nicolas Lamirault) Date: Fri, 05 Mar 2004 10:09:55 -0500 Subject: [log4cl-cvs] CVS update: log4cl/package.lisp Message-ID: 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")) From nlamirault at common-lisp.net Fri Mar 5 15:10:31 2004 From: nlamirault at common-lisp.net (Nicolas Lamirault) Date: Fri, 05 Mar 2004 10:10:31 -0500 Subject: [log4cl-cvs] CVS update: log4cl/log4cl.asd Message-ID: 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 " + :author "Nicolas Lamirault " :version "0.3" :licence "Lisp Lesser GNU General Public License" :description "Log tool for Common Lisp" - :properties (((#:author #:email) . "lam at perave.org") + :properties (((#:author #:email) . "lam at 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)) From nlamirault at common-lisp.net Fri Mar 5 15:12:20 2004 From: nlamirault at common-lisp.net (Nicolas Lamirault) Date: Fri, 05 Mar 2004 10:12:20 -0500 Subject: [log4cl-cvs] CVS update: log4cl/appender-mail.lisp Message-ID: 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