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