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