cl-log.1.0.1/000775 000000 001751 00000000000 12060355661 012463 5ustar00rootndl000000 000000 cl-log.1.0.1/cl-log-test.asd000444 000000 001751 00000000570 12060355661 015304 0ustar00rootndl000000 000000 ;; $Id: //info.ravenbrook.com/user/ndl/lisp/cl-log/cl-log.1.0.1/cl-log-test.asd#1 $ (in-package asdf) (defsystem :cl-log-test :depends-on (:cl-log :eos) :description "Test suite for CL-LOG - the general purpose logging utility" :version "0.1.0" :author "Nick Barnes " :licence "Public Domain" :components ((:file "cl-log-test"))) cl-log.1.0.1/cl-log-test.lisp000444 000000 001751 00000045724 12060355661 015516 0ustar00rootndl000000 000000 ;; $Id: //info.ravenbrook.com/user/ndl/lisp/cl-log/cl-log.1.0.1/cl-log-test.lisp#1 $ (defpackage "COM.RAVENBROOK.COMMON-LISP-LOG.TEST" (:nicknames "CL-LOG-TEST") (:use :common-lisp :eos "COM.RAVENBROOK.COMMON-LISP-LOG") (:export "RUN!" "LOG-TESTS")) (in-package "COM.RAVENBROOK.COMMON-LISP-LOG.TEST") ;; CL-LOG-TEST.LISP ;; Nick Barnes, Ravenbrook Limited, 2012-05-15 ;; ;; 1. INTRODUCTION ;; ;; This is a test suite for Nick Levine's CL-LOG logging utility. ;; ;; See end for copyright and license. ;; To use: #|| The test quite is (or: will soon be) available via Quicklisp: CL-USER > (ql:quickload :cl-log-test) Alternatively: first load the EOS unit test framework and then compile pkg.lisp, cl-log.lisp, and this file: CL-USER> (ql:quickload :eos) ;; [stuff] CL-USER> (in-package :cl-log-test) Run the tests thus: CL-LOG-TEST> (run! 'log-tests) .............................................................................................. Did 94 checks. Pass: 94 (100%) Skip: 0 ( 0%) Fail: 0 ( 0%) NIL CL-LOG-TEST> ||# (def-suite log-tests :description "Unit tests for cl-log.") (in-suite log-tests) ;;; a partial-order of categories. ;;; ;;; cat1 ;;; cat2 cat2b ;;; cat3 cat3b ;;; catjoin (defvar *test-categories* '((:cat1 nil) (:cat2 (or :cat1)) (:cat3 (or :cat2 :cat3)) (:cat2b (or :cat1 :cat2b)) (:cat3b (or :cat2b :cat3b)) (:catjoin (or :cat3 :cat3b)))) (defun random-category () (car (nth (random (length *test-categories*)) *test-categories*))) ;;; a test-messenger simply collects all the messages sent to its log ;;; manager, and can reproduce them as a list. (defclass test-messenger (base-messenger) ((messages :initform nil))) (defmethod messenger-send-message ((messenger test-messenger) (message base-message)) (push message (slot-value messenger 'messages))) (defmethod test-messenger-messages ((self test-messenger)) (reverse (slot-value self 'messages))) ;;; COLLECTING-MESSAGES returns all the messages sent to MANAGER ;;; (default: the current global log manager) matching FILTER ;;; (default: nil, i.e. all messages) during the execution of BODY. (defmacro collecting-messages ((&key manager filter) &body body) (let ((messenger-var (gensym "MESSENGER-")) (messenger-name-var (gensym "MESSENGER-NAME-")) (manager-var (gensym "MANAGER-"))) `(let* ((,manager-var (or ,manager (log-manager))) (,messenger-var (start-messenger 'test-messenger :category ,filter :name ',messenger-name-var :manager ,manager-var))) (unwind-protect (progn ,@body (test-messenger-messages ,messenger-var)) (stop-messenger ,messenger-var))))) ;;; Macro to establish a simple partial order of logging categories, ;;; run a test, and then tear down the categories. This is done in ;;; the category set SET, or in the category set of the current log ;;; manager (if SET is null). (defmacro with-categories ((set) &body body) (let* ((set-sym (gensym "CATEGORY-SET-")) (set-part (when set (list set-sym))) (defcategories (loop for (cat def) in *test-categories* collect `(defcategory ,cat ,def ,@set-part)))) `(let ((,set-sym ,set)) (unwind-protect (progn ,@defcategories ,@body) (clear-categories ,@set-part))))) (test categories "Set up and tear down simple log categories." (with-categories (nil) (pass))) (test category-set "Set up and tear down simple categories in a category-set." (let ((my-categories (make-instance 'category-set))) (with-categories (my-categories) (pass)))) (test simple-log-once "The most basic logging test: log something to the current log manager." (log-message :warning :warning) (pass)) (test make-messenger "Can we make a messenger?" (rebinding-log-manager (nil) (is (null (collecting-messages () t))))) (test log-to-messenger "Do log messages go to a messenger?" (let ((messages (rebinding-log-manager (nil) (collecting-messages () (log-message :warning :warning))))) (is (= (length messages) 1)))) (test log-description "Test that log descriptions and arguments get to the messenger." (let* ((desc (format nil "~R" (random 1000))) (args (loop for i upto (random 100) collect (random-category) collect (random 10))) (messages (rebinding-log-manager (nil) (collecting-messages () (log-message :spong desc args))))) (is (= (length messages) 1) (equal (message-description (car messages)) desc) (equal (message-arguments (car messages)) args)))) (test log-to-messenger-category "Do log messages keep their category and order en route to a messenger?" (let* ((category-list (loop for i upto 100 collect (random-category))) (messages (rebinding-log-manager (nil) (collecting-messages () (loop for cat in category-list do (log-message cat nil)))))) (is (equal category-list (mapcar 'message-category messages))))) (test multiple-messengers "Do log messages go to more than one messenger?" (let* ((messages-1) (messages-2 (rebinding-log-manager (nil) (collecting-messages () (setf messages-1 (collecting-messages () (log-message :warning :warning))))))) (is (equal messages-1 messages-2)) (is (= (length messages-1) 1)) (is (eq (message-category (car messages-1)) :warning)))) (test many-messages-multi-messengers "Sending several log messages to several messengers." (let* ((category-list (loop for i upto 100 collect (random-category))) (messages-1) (messages-2 (rebinding-log-manager (nil) (collecting-messages () (setf messages-1 (collecting-messages () (loop for cat in category-list do (log-message cat nil)))))))) (is (equal category-list (mapcar 'message-category messages-1))) (is (equal messages-1 messages-2)))) (defun log-n-of-each (times) (dotimes (i times) (log-message :cat1 "1" i) (log-message :cat2 "2" i) (log-message :cat3 "3" i) (log-message :catjoin "join" i) (log-message :cat2b "2b" i) (log-message :cat3b "3b" i))) (test simple-filter "Do messenger filters work? Also tests that message descriptions and arguments make it through." (let* ((messages-3b) (messages-2 (rebinding-log-manager (nil) (with-categories (nil) (collecting-messages (:filter :cat2) (setf messages-3b (collecting-messages (:filter :cat3b) (log-n-of-each 3)))))))) (is (equal (mapcar 'message-category messages-2) '(:cat1 :cat2 :cat1 :cat2 :cat1 :cat2))) (is (equal (mapcar 'message-description messages-2) '("1" "2" "1" "2" "1" "2"))) (is (equal (mapcar 'message-arguments messages-2) '((0) (0) (1) (1) (2) (2)))) (is (equal (mapcar 'message-category messages-3b) '(:cat1 :cat2b :cat3b :cat1 :cat2b :cat3b :cat1 :cat2b :cat3b ))) (is (equal (mapcar 'message-description messages-3b) '("1" "2b" "3b" "1" "2b" "3b" "1" "2b" "3b"))) (is (equal (mapcar 'message-arguments messages-3b) '((0) (0) (0) (1) (1) (1) (2) (2) (2)))))) (test combi-filter "Complex messenger filters." (let* ((messages (rebinding-log-manager (nil) (with-categories (nil) (collecting-messages (:filter '(and :catjoin (not :cat1) (not :cat2b))) (log-n-of-each 1)))))) (is (equal (mapcar 'message-category messages) '(:cat2 :cat3 :catjoin :cat3b))))) (test combi-filter-2 "Complex messenger filters again." (let* ((messages (rebinding-log-manager (nil) (with-categories (nil) (collecting-messages (:filter '(or (and :cat3 (not :cat2)) :cat3b)) (log-n-of-each 1)))))) (is (equal (mapcar 'message-category messages) '(:cat1 :cat3 :cat2b :cat3b))))) (test ring "Ring messenger test." (rebinding-log-manager (nil) (let ((messenger (start-messenger 'ring-messenger :length 10))) (loop for i upto 1000 do (log-message :warning i)) (is (= (length (ring-messenger-messages messenger)) 10)) ;; 991 + 992 + ... + 1000 = 9900 + 10*11/2 = 9955 (is (= (apply '+ (mapcar 'message-description (ring-messenger-messages messenger))) 9955))))) (test manager-exists "Is there always a log manager?" (is (log-manager)) (is (typep (log-manager) 'log-manager))) (test clear-manager "Is there even a log manager when we have set it to nil?" (setf (log-manager) (make-instance 'log-manager)) (is (log-manager)) (is (typep (log-manager) 'log-manager)) (is (= (length (log-manager-messengers (log-manager))) 0))) (test rebound-manager-to-nil "Is there a log manager when we have rebound it to nil?" (rebinding-log-manager (nil) (is (log-manager)) (is (typep (log-manager) 'log-manager)) (is (= (length (log-manager-messengers (log-manager))) 0)))) ;;; weirdly, if I write (is (collecting-messages ... )) in a test, ;;; I get a syntax error. So I've lifted this out. (defun log-enabled (&key manager) (collecting-messages (:manager manager) (log-message :warning nil))) (test manager-switch "Can we switch between two log-managers?" (let ((manager-1 (make-instance 'log-manager)) (manager-2 (make-instance 'log-manager))) (is (not (eq manager-1 manager-2))) (setf (log-manager) manager-2) (is (eq (log-manager) manager-2)) (setf (log-manager) manager-1) (is (eq (log-manager) manager-1)) (rebinding-log-manager (manager-1) (is (eq (log-manager) manager-1)) (rebinding-log-manager (manager-2) (is (eq (log-manager) manager-2))) (is (eq (log-manager) manager-1))))) (test log-manager-message "Does log-manager-message direct messages correctly?" (let ((manager-1 (make-instance 'log-manager)) (manager-2 (make-instance 'log-manager)) (messages-1) (messages-2)) (setf messages-1 (collecting-messages (:manager manager-1) (setf messages-2 (collecting-messages (:manager manager-2) (log-manager-message manager-1 :warning :foo 3 4) (log-manager-message manager-2 :critical :bar 5 6))))) (is (eq (length messages-1) 1)) (is (eq (message-category (car messages-1)) :warning)) (is (eq (message-description (car messages-1)) :foo)) (is (equal (message-arguments (car messages-1)) '(3 4))) (is (eq (message-category (car messages-2)) :critical)) (is (eq (message-description (car messages-2)) :bar)) (is (equal (message-arguments (car messages-2)) '(5 6))))) (test setf-log-manager "Does setting (log-manager) direct messages correctly?" (let ((manager-1 (make-instance 'log-manager)) (manager-2 (make-instance 'log-manager)) (messages-1) (messages-2)) (setf messages-1 (collecting-messages (:manager manager-1) (setf messages-2 (collecting-messages (:manager manager-2) (setf (log-manager) manager-1) (log-message :warning :foo 3 4) (setf (log-manager) manager-2) (log-message :critical :bar 5 6))))) (is (eq (length messages-1) 1)) (is (eq (message-category (car messages-1)) :warning)) (is (eq (message-description (car messages-1)) :foo)) (is (equal (message-arguments (car messages-1)) '(3 4))) (is (eq (message-category (car messages-2)) :critical)) (is (eq (message-description (car messages-2)) :bar)) (is (equal (message-arguments (car messages-2)) '(5 6))))) (test rebinding-manager "Does rebinding-log-manager direct messages correctly?" (let ((manager-1 (make-instance 'log-manager)) (manager-2 (make-instance 'log-manager)) (messages-1) (messages-2)) (setf messages-1 (collecting-messages (:manager manager-1) (setf messages-2 (collecting-messages (:manager manager-2) (setf (log-manager) manager-1) (log-message :warning :foo 3 4) (rebinding-log-manager (manager-2) (log-message :critical :bar 5 6)))))) (is (eq (length messages-1) 1)) (is (eq (message-category (car messages-1)) :warning)) (is (eq (message-description (car messages-1)) :foo)) (is (equal (message-arguments (car messages-1)) '(3 4))) (is (eq (message-category (car messages-2)) :critical)) (is (eq (message-description (car messages-2)) :bar)) (is (equal (message-arguments (car messages-2)) '(5 6))))) (test disabled-manager "Can we disable logging?" (setf (log-manager) (make-instance 'log-manager)) ;; new manager isn't disabled ... (is (log-enabled)) (is (null (logging-disabled (log-manager)))) ;; but with-logging-disabled makes it so ... (with-logging-disabled (is (logging-disabled (log-manager))) (is (null (log-enabled))) ;; ... unless we tweak the knob by hand ... (setf (logging-disabled (log-manager)) nil) (is (null (logging-disabled (log-manager)))) (is (log-enabled)) ;; ... either way. (setf (logging-disabled (log-manager)) t) (is (logging-disabled (log-manager))) (is (null (log-enabled)))) ;;; When we come back out of with-logging-disabled, ;;; logging works again ... (is (log-enabled)) (is (null (logging-disabled (log-manager)))) ;;; but setting the disabled flag with setf disables it ... (setf (logging-disabled (log-manager)) t) (is (logging-disabled (log-manager))) (is (null (log-enabled))) ;;; ... and it stays disabled as we pass through a ;;; with-logging-disabled section ... (with-logging-disabled (is (logging-disabled (log-manager))) (is (null (log-enabled)))) (is (logging-disabled (log-manager))) (is (null (log-enabled))) ;;; until we reset it by hand ... (setf (logging-disabled (log-manager)) nil) (is (null (logging-disabled (log-manager)))) (is (log-enabled))) (test with-log-manager-disabled "Can we disable an individual log manager independently?" (let ((manager-1 (make-instance 'log-manager)) (manager-2 (make-instance 'log-manager)) (messages-1) (messages-2)) (setf messages-1 (collecting-messages (:manager manager-1) (setf messages-2 (collecting-messages (:manager manager-2) (log-manager-message manager-1 :foo nil) (log-manager-message manager-2 :bar nil) (with-log-manager-disabled (manager-2) (log-manager-message manager-1 :qux nil) (log-manager-message manager-2 :quux nil)) (with-log-manager-disabled (manager-1) (log-manager-message manager-1 :baz nil) (log-manager-message manager-2 :spong nil)))))) (is (equal (mapcar 'message-category messages-1) '(:foo :qux))) (is (equal (mapcar 'message-category messages-2) '(:bar :spong))))) (test category-satisfies "Test the basic behaviour of category-satisfies. See also the combi-filters tests." (clear-categories) (is (category-satisfies :foo :foo)) (is (not (category-satisfies :foo :bar))) ;; with our usual test categories, test some basic satisfaction criteria (with-categories (nil) (is (category-satisfies :cat1 :cat2)) (is (not (category-satisfies :cat2 :cat1))) (is (category-satisfies :cat1 :cat2b)) (is (not (category-satisfies :cat2 :cat2b))) (is (category-satisfies :cat1 :catjoin)) (is (category-satisfies :cat2 :catjoin)) (is (not (category-satisfies :catjoin :cat1))) (is (category-satisfies :cat2b :catjoin))) ;;; does clear-categories get rid? (clear-categories) (is (not (category-satisfies :cat1 :cat2))) (is (not (category-satisfies :cat2 :cat1))) ;;; How about if we have different log managers with different categories? (let* ((manager-1 (make-instance 'log-manager)) (cat-set (make-instance 'category-set)) (manager-2 (make-instance 'log-manager :categories cat-set))) ;; some categories for my new category set. (defcategory :meltdown nil cat-set) (defcategory :alarm (or :alarm :meltdown) cat-set) (defcategory :cat2 (or :cat2 :alarm) cat-set) (defcategory :cat3 (or :cat3 :alarm) cat-set) (defcategory :cat4 (or :cat2 :cat3) cat-set) (with-categories ((log-manager-category-set manager-1)) (is (category-satisfies :cat2 :cat3)) (is (not (category-satisfies :cat2 :cat3 :manager manager-2))) (is (category-satisfies :cat3 :cat4 :manager manager-2)) (is (category-satisfies :cat2b :cat3b :manager manager-1))))) (test text-messenger "Test text-stream-messengers" (let ((s (make-string-output-stream)) (m (make-instance 'log-manager :message-class 'formatted-message))) (start-messenger 'text-stream-messenger :manager m :stream s) (dotimes (i 100) (log-manager-message m :warning "The square of ~d is ~d" i (* i i))) (is (= 100 (count #\Newline (get-output-stream-string s)))))) ;; A. REFERENCES ;; ;; ;; B. HISTORY ;; ;; 2012-05-15 NB Created. ;; ;; ;; C. COPYRIGHT ;; ;; This file copyright (c) 2012 Nick Barnes (nb@ravenbrook.com) ;; Permission is hereby granted, free of charge, to any person ;; obtaining a copy of this software and associated documentation ;; files (the "Software"), to deal in the Software without ;; restriction, including without limitation the rights to use, copy, ;; modify, merge, publish, distribute, sublicense, and/or sell copies ;; of the Software, and to permit persons to whom the Software is ;; furnished to do so, subject to the following conditions: ;; The above copyright notice and this permission notice shall be ;; included in all copies or substantial portions of the Software. ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT ;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, ;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, ;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER ;; DEALINGS IN THE SOFTWARE. cl-log.1.0.1/cl-log.asd000444 000000 001751 00000000555 12060355661 014332 0ustar00rootndl000000 000000 ;; $Id: //info.ravenbrook.com/user/ndl/lisp/cl-log/cl-log.1.0.1/cl-log.asd#1 $ (in-package asdf) (defsystem :cl-log :description "CL-LOG - a general purpose logging utility" :version "1.0.1" :author "Nick Levine " :licence "Public Domain" :components ((:file "pkg") (:file "cl-log" :depends-on ("pkg")))) cl-log.1.0.1/cl-log.lisp000444 000000 001751 00000050350 12060355661 014530 0ustar00rootndl000000 000000 ;; $Id: //info.ravenbrook.com/user/ndl/lisp/cl-log/cl-log.1.0.1/cl-log.lisp#1 $ (in-package "COM.RAVENBROOK.COMMON-LISP-LOG") ;; CL-LOG.LISP ;; Nick Levine, Ravenbrook Limited, 2007-05-15 ;; ;; 1. INTRODUCTION ;; ;; This is a general purpose logging utility, loosely modelled in some ;; respects after Gary King's "Log5" . ;; ;; Developed on LispWorks. Also tested on ACL. ;; ;; See end for copyright and license. ;; Example: #|| (defcategory :critical) (defcategory :error (or :error :critical)) (defcategory :warning (or :warning :error)) (defcategory :notice (or :notice :warning)) (defcategory :info (or :info :notice)) (defcategory :debug (or :debug :info)) (setf (log-manager) (make-instance 'log-manager)) (start-messenger 'ring-messenger :name 'demo :length 10 :filter '(and :info (not :error))) (dolist (z '(:critical :error :warning :notice :info :debug)) (log-message z z)) ;; Show that we logged everything which was at least :info provided it wasn't also at least :error (loop for message in (ring-messenger-messages (car (log-manager-messengers (log-manager)))) when message collect (message-description message)) ||# (defparameter *cl-log-release* "1.0.1") ;; 2. UTILITIES (defmacro orf (location form &environment env) (multiple-value-bind (vars values new setter getter) (get-setf-expansion location env) (when (cdr new) (error "Can't work with setf-expansion for ~s - ~d values from setter ~s" location (length new) new)) (let ((current (car new))) `(let* (,@(mapcar 'list vars values) (,current ,getter)) (or ,current (progn (setf ,current ,form) ,setter)))))) (defmacro when-let (binding &body body) (destructuring-bind (var val) binding `(let ((,var ,val)) (when ,var ,@body)))) #+#:not-in-use (defmacro when-let* (bindings &body body) (if bindings `(when-let ,(car bindings) (when-let* ,(cdr bindings) ,@body)) `(progn ,@body))) ;; 3. LOG-MANAGER (defclass log-object () ()) (defclass log-manager (log-object) ((messengers :accessor log-manager-messengers :initform nil) (disabled :accessor logging-disabled-var :initform (gensym)) (message-class :accessor log-manager-message-class :initarg :message-class :initform 'base-message) (message-id :accessor log-manager-id :initform 0) ; for debugging - id of latest message (category-set :accessor log-manager-category-set :initarg :categories) (category-cache :reader category-cache :initform nil) (cache-version :accessor cache-version) (first-time :reader log-manager-first-time :initform (first-time-for-log-manager)))) (defvar *log-manager* nil) (defun log-manager () (orf *log-manager* (make-instance 'log-manager))) (defmethod initialize-instance :after ((self log-manager) &key disabled categories) (setf (logging-disabled self) disabled) (unless categories (setf (log-manager-category-set self) (if *log-manager* (log-manager-category-set *log-manager*) (make-instance 'category-set)))) ;; for the first log manager. (invalidate-log-manager self)) (defun first-time-for-log-manager () (- (* (get-universal-time) internal-time-units-per-second) (get-internal-real-time))) (defmethod logging-disabled ((self log-manager)) (symbol-value (logging-disabled-var self))) (defmethod (setf logging-disabled) (new-value (self log-manager)) (setf (symbol-value (logging-disabled-var self)) new-value)) (defmacro with-logging-disabled (&body body) `(progv `(,(logging-disabled-var (log-manager))) '(t) ,@body)) (defmacro with-log-manager-disabled ((manager) &body body) `(progv `(,(logging-disabled-var ,manager)) '(t) ,@body)) (defmethod (setf log-manager-messengers) :after (new-value (self log-manager)) (declare (ignore new-value)) (invalidate-log-manager self)) (defmethod (setf log-manager-category-set) :after (new-value (self log-manager)) (declare (ignore new-value)) (invalidate-log-manager self)) (defmethod category-cache :before ((self log-manager)) (when (< (cache-version self) (category-set-version (log-manager-category-set self))) (invalidate-log-manager self))) (defmethod invalidate-log-manager ((self log-manager)) (let ((cache (orf (slot-value self 'category-cache) (make-hash-table :test 'equal)))) (clrhash cache) (setf (cache-version self) (category-set-version (log-manager-category-set self))))) ;; There is always a log manager, even when there are no log ;; messengers, etc. This means that there is always a default ;; category-set and so on, so (for example) client code from earlier ;; versions of cl-log can begin with (defcategory ...) (defun (setf log-manager) (new-manager) (unless (typep new-manager 'log-manager) (error "New log-manager is not a log-manager: ~s" new-manager)) (when-let (previous *log-manager*) (dolist (messenger (log-manager-messengers previous)) (stop-messenger messenger))) (setf *log-manager* new-manager) new-manager) (defmacro rebinding-log-manager ((log-manager) &body body) (let ((log-manager-var (gensym "LOG-MANAGER-"))) `(let ((,log-manager-var ,log-manager)) (unless (typep ,log-manager-var '(or log-manager null)) (error "New log-manager is neither null nor a log-manager: ~s" ,log-manager-var)) (when ,log-manager-var (setf (slot-value ,log-manager-var 'category-cache) nil) (invalidate-log-manager ,log-manager-var)) (let ((*log-manager* (or ,log-manager-var (make-instance 'log-manager)))) ,@body)))) ;; 4. MESSAGE ;; Warning: the fraction will be self-consistent but not externally consistent: the fraction ;; won't be zero when the univeral-time changes. (If we wanted this we'd have to wait for it, ;; and we still might not get to it spot-on.) (defstruct (timestamp (:constructor construct-timestamp (universal-time fraction))) (universal-time nil :read-only t) (fraction nil :read-only t)) (defun make-timestamp (log-manager) (let* ((first-time (log-manager-first-time log-manager)) (this-time (+ first-time (get-internal-real-time)))) (multiple-value-bind (univeral-time fraction) (floor this-time internal-time-units-per-second) (construct-timestamp univeral-time fraction)))) (defmethod print-object ((self timestamp) stream) (if *print-escape* (print-unreadable-object (self stream :type t :identity t) (let ((*print-escape* nil)) (print-object self stream))) (format stream #.(format nil "~~d.~~~d,'0d" (ceiling (log internal-time-units-per-second 10))) (timestamp-universal-time self) (timestamp-fraction self)))) (defclass base-message (log-object) ((id :reader message-id ) ; see initialize-instance (timestamp :reader message-timestamp :initarg :timestamp) (category :reader message-category :initarg :category) (description :reader message-description :initarg :description) (arguments :reader message-arguments :initarg :arguments))) (defmethod initialize-instance :after ((self base-message) &key manager timestamp) (unless timestamp (error "Message with no timestamp: ~s" self)) (let ((manager (or manager (log-manager)))) (setf (slot-value self 'id) (incf (log-manager-id manager))))) (defmethod print-object ((self base-message) stream) (print-unreadable-object (self stream :type t :identity t) (format stream "~d" (message-id self)))) (defclass formatted-message (base-message) ((text :accessor formatted-message-text :initform nil))) (defmethod message-text ((self formatted-message)) (orf (formatted-message-text self) (format-message self))) (defmethod format-message ((self formatted-message)) (format nil "~a ~a ~?~&" (message-timestamp self) (message-category self) (message-description self) (message-arguments self))) ;; 5. MESSENGER (defclass base-messenger (log-object) ((manager :reader messenger-manager :initarg :manager :initform (log-manager)) (name :reader messenger-name :initarg :name :initform nil) (filter :reader messenger-category :initarg :category :reader messenger-filter :initarg :filter :initform nil))) (defmethod print-object ((self base-messenger) stream) (print-unreadable-object (self stream :type t :identity t) (when-let (name (messenger-name self)) (format stream "~a" name)))) (defmethod initialize-instance :after ((self base-messenger) &key name) (when (typep name 'base-messenger) (error "It really doesn't help using one messenger ~s to name another ~s" name self))) (defun start-messenger (class &rest initargs &key name manager &allow-other-keys) (when-let (previous (find-messenger name :manager manager)) (stop-messenger previous)) (let ((messenger (apply 'make-instance class initargs))) (push messenger (log-manager-messengers (or manager (log-manager)))) messenger)) (defmethod stop-messenger ((self base-messenger) &key) (let* ((manager (messenger-manager self)) (messengers (log-manager-messengers manager))) (when (find self messengers) (setf (log-manager-messengers manager) (remove self messengers))))) (defmethod stop-messenger (name &key manager) (let ((messenger (find-messenger name :manager manager))) (if messenger (stop-messenger messenger) (error "Messenger named ~s not found" name)))) (defun find-messenger (name &key manager) (find name (log-manager-messengers (or manager (log-manager))) :key 'messenger-name :test 'equalp)) (defun category-messengers (category &key manager) (let* ((manager (or manager (log-manager) ;; shouldn't ever fall through here, but just in case: (return-from category-messengers nil))) (cache (category-cache manager))) (unless (logging-disabled manager) (multiple-value-bind (satisfies presentp) (gethash category cache) (if presentp satisfies (setf (gethash category cache) (loop for messenger in (log-manager-messengers manager) when (category-satisfies category (messenger-filter messenger) :manager manager) collect messenger))))))) ;; Does the supplied category match the filter? ;; The filter is either a keyword or a logical combination ;; of keywords held together with AND, OR and NOT. ;; The supplied category is either a keyword or a list of keywords in ;; which case the implicit combination is AND. ;; [I am unconvinced that there's anything other than unnecessary complexity ;; to be gained from category being more general than this.] ;; [Although the code doesn't enforce keywords, I am suggesting this to allow for future ;; expansion, e.g. supplying funcallables.] ;; (category-satisfies '(:this :that) '(or :this :that)) => T ; needed either, got both, so satisfied (defun category-satisfies (supplied filter &key manager) (unless (listp supplied) (setf supplied (list supplied))) (in-category-satisfies (or manager (log-manager)) supplied filter supplied)) (defun in-category-satisfies (manager supplied filter expanded) (typecase filter (null t) (atom (let ((expansion (unless (find filter expanded) (expand-category filter :set (log-manager-category-set manager))))) (if expansion (in-category-satisfies manager supplied expansion (cons filter expanded)) (not (null (find filter supplied)))))) (t (ecase (car filter) ((and) (every (lambda (r) (in-category-satisfies manager supplied r expanded)) (cdr filter))) ((or) (some (lambda (r) (in-category-satisfies manager supplied r expanded)) (cdr filter))) ((not) (if (cddr filter) (error "(Sub)category NOT with more than one 'argument': ~s" filter) (not (in-category-satisfies manager supplied (cadr filter) expanded)))))))) (defun send-message (log-manager messengers category description arguments) (let* ((message (make-instance (log-manager-message-class log-manager) :timestamp (make-timestamp log-manager) :category category :description description :arguments arguments))) (loop for messenger in messengers do (messenger-send-message messenger message)))) (defmethod messenger-send-message ((messenger base-messenger) message) (error "Messenger ~s of class ~s has not specialised ~s for message ~s of class ~s" messenger (class-of messenger) 'messenger-send-message message (class-of message))) ;; 5.1. Ring-Messenger ;; ;; A simple example messenger. We define a ring structure and a class ;; ring-messenger which will remember the last N log-messages cheaply. ;; We have specialised messenger-send-message as required. We have ;; not specialised stop-messenger as doing so is optional and in this ;; case there's nothing to do. (defstruct (ring (:constructor construct-ring (name ring length))) name ring length) (defmethod print-object ((self ring) stream) (print-unreadable-object (self stream :type t :identity t) (format stream "~(~a~) (~d)" (ring-name self) (ring-length self)))) (defun make-ring (name length) (let ((ring (make-list length))) (setf (cdr (last ring)) ring) (construct-ring name ring length))) (defun ring-push (thing ring) (setf (car (setf (ring-ring ring) (cdr (ring-ring ring)))) thing)) (defun ring-list (ring) (loop repeat (ring-length ring) for x in (cdr (ring-ring ring)) collect x)) (defclass ring-messenger (base-messenger) ((ring :reader ring-messenger-ring))) (defmethod initialize-instance :after ((self ring-messenger) &key name length) (setf (slot-value self 'ring) (make-ring name length))) (defmethod print-object ((self ring-messenger) stream) (print-unreadable-object (self stream :type t :identity t) (format stream "~(~a~)" (ring-name (ring-messenger-ring self))))) (defmethod messenger-send-message ((messenger ring-messenger) (message base-message)) (ring-push message (ring-messenger-ring messenger))) (defmethod ring-messenger-messages ((self ring-messenger)) (remove nil (ring-list (ring-messenger-ring self)))) ;; 5.2. Text-Stream-Messenger (defclass text-stream-messenger (base-messenger) ((stream :reader text-stream-messenger-stream :initarg :stream) (closed :accessor text-stream-messenger-closed :initform nil))) (defmethod messenger-send-message ((messenger text-stream-messenger) (message formatted-message)) (let ((ostream (text-stream-messenger-stream messenger))) (handler-bind (;; Trap race condition where thread A starts a logging operation and lists this as one of ;; its messengers, thread B stops the messenger, and then thread A attempts to complete its ;; logging operation by writing to ostream (now closed). The alternatives would be to halt ;; preemption (application-specific and maybe costly) or to handle all logging operations in ;; a dedicated thread (also application-specific and maybe costly). (serious-condition (lambda (condition) (declare (ignore condition)) (when (text-stream-messenger-closed messenger) (return-from messenger-send-message))))) (write-string (message-text message) ostream)) (ignore-errors (force-output ostream)))) (defmethod stop-messenger :before ((self text-stream-messenger) &key) (let ((stream (text-stream-messenger-stream self))) (setf (text-stream-messenger-closed self) t) (ignore-errors (force-output stream)) (close stream))) ;; 5.3 Text-File-Messenger (defclass text-file-messenger (text-stream-messenger) ((file :reader text-file-messenger-file :initarg :filename))) (defmethod initialize-instance :after ((self text-file-messenger) &key filename (external-format :default) &allow-other-keys) (setf (slot-value self 'stream) (open filename :direction :output :element-type :default :if-does-not-exist :create :if-exists :append :external-format external-format))) ;; 6. CATEGORY (defclass category-set (log-object) ((categories :accessor category-set-categories :initform (make-hash-table :test 'eq)) (version :accessor category-set-version :initform 0))) (defun expand-category (category &key set) (or (gethash category (category-set-categories (or set (log-manager-category-set (log-manager))))) category)) ;; (defcategory :debug (or :debug :info)) will work. ;; Note that (defcategory :critical) doesn't have any effect other than to make your code clearer. (defmacro defcategory (category &optional expands-as set) `(defcategory-fn ',category ',expands-as ,set)) (defun defcategory-fn (category expands-as &optional set) (let ((set (or set (log-manager-category-set (log-manager))))) (setf (gethash category (category-set-categories set)) expands-as) (incf (category-set-version set))) category) (defmacro undefcategory (category &optional set) `(undefcategory-fn ',category ,set)) (defun undefcategory-fn (category &optional set) (let ((set (or set (log-manager-category-set (log-manager))))) (remhash category (category-set-categories set)) (incf (category-set-version set))) nil) (defun clear-categories (&optional set) (let ((set (or set (log-manager-category-set (log-manager))))) (clrhash (category-set-categories set)) (incf (category-set-version set))) nil) ;; 7. LOG-MESSAGE ;; By making this a macro we can defer evaluation of description and arguments until we know ;; that the message will be sent somewhere. The idea is to make :wombat logging very cheap when ;; :wombat logging isn't enabled (defmacro log-manager-message (manager category description &rest arguments) (if (member :no-logging *features*) `(values) (let ((category-var (gensym "CATEGORY-")) (manager-var (gensym "MANAGER-")) (messengers-var (gensym "MESSENGERS-"))) `(let ((,category-var ,category) (,manager-var ,manager)) (when-let (,messengers-var (category-messengers ,category-var :manager ,manager-var)) ; null when logging-disabled is set (send-message ,manager-var ,messengers-var ,category-var ,description (list ,@arguments))) nil)))) (defmacro log-message (category description &rest arguments) `(log-manager-message (log-manager) ,category ,description ,@arguments)) ;; A. REFERENCES ;; ;; ;; B. HISTORY ;; ;; 2007-05-15 Created. ;; ;; ;; C. COPYRIGHT ;; ;; This file copyright (c) 2007 - 2009 Nick Levine (ndl@ravenbrook.com). ;; ;; Portions copyright (c) 2012 Nick Barnes (nb@ravenbrook.com). ;; ;; Log5 copyright (c) 2007 Gary Warren King (gwking@metabang.com) ;; Permission is hereby granted, free of charge, to any person ;; obtaining a copy of this software and associated documentation ;; files (the "Software"), to deal in the Software without ;; restriction, including without limitation the rights to use, copy, ;; modify, merge, publish, distribute, sublicense, and/or sell copies ;; of the Software, and to permit persons to whom the Software is ;; furnished to do so, subject to the following conditions: ;; The above copyright notice and this permission notice shall be ;; included in all copies or substantial portions of the Software. ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT ;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, ;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, ;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER ;; DEALINGS IN THE SOFTWARE. cl-log.1.0.1/doc/000775 000000 001751 00000000000 12060355661 013230 5ustar00rootndl000000 000000 cl-log.1.0.1/pkg.lisp000444 000000 001751 00000015431 12060355661 014135 0ustar00rootndl000000 000000 ;; $Id: //info.ravenbrook.com/user/ndl/lisp/cl-log/cl-log.1.0.1/pkg.lisp#1 $ (in-package "CL-USER") ;; PKG.LISP ;; Nick Levine, Ravenbrook Limited, 2007-05-23 ;; ;; 1. INTRODUCTION ;; ;; This is the package definition for the cl-log library. ;; ;; See end for copyright and license. ;; 2. PACKAGE (defpackage "COM.RAVENBROOK.COMMON-LISP-LOG" (:nicknames "CL-LOG") (:use "COMMON-LISP") (:export "*CL-LOG-RELEASE*" ;; manager "LOG-MANAGER" ; [setfable] the current log-manager; also log-manager class eg (setf (log-manager) (make-instance 'log-manager)) "REBINDING-LOG-MANAGER" ; macro which gives local binding for value of (log-manager) "LOG-MANAGER-MESSENGERS" ; [setfable] messengers of the given manager "LOG-MANAGER-MESSAGE-CLASS" ; [setfable] in case you change your mind about the class you specified before "LOG-MANAGER-CATEGORY-SET" ; [setfable] the category definitions this log manager knows about "LOGGING-DISABLED" ; [setfable] (setf (logging-disabled (log-manager)) t) turns logging off "WITH-LOGGING-DISABLED" ; macro, disables logging while in lexical scope -- be careful about using this in tandem with (setf logging-disabled) "WITH-LOG-MANAGER-DISABLED" ; macro, disables this manager while in lexical scope -- be careful about using this in tandem with (setf logging-disabled) "INVALIDATE-LOG-MANAGER" ; this is called when categories or messengers are changed. you might want to write :after methods on this ;; timestamp "TIMESTAMP" "MAKE-TIMESTAMP" ; (make-timestamp (log-manager)) if you ever wanted a timestamp of your own to take home and play with "TIMESTAMP-UNIVERSAL-TIME" ; universal-time at which timestamp was created "TIMESTAMP-FRACTION" ; fraction of a second (using internal-time-units-per-second) ;; message "BASE-MESSAGE" ; base class for messages "MESSAGE-TIMESTAMP" ; some readers... "MESSAGE-CATEGORY" ; "MESSAGE-DESCRIPTION" ; "MESSAGE-ARGUMENTS" ; "FORMATTED-MESSAGE" ; class for messages which will be formatted to a stream "MESSAGE-TEXT" ; lazy invocation of format-message "FORMAT-MESSAGE" ; method on formatted-message goes (format nil "~a ~a ~?~&" timestamp category description arguments). Feel free to specialise. ;; messenger ;; ** Every messenger class must define a method on messenger-send-message ** "BASE-MESSENGER" ; base class for messengers "MESSENGER-FILTER" ; reader "MESSENGER-MANAGER" ; reader "MESSENGER-NAME" ; reader - note that start-messenger will remove any previous messenger with the same name in this log manager "MESSENGER-CATEGORY" ; deprecated reader; use messenger-filter. "START-MESSENGER" ; (start-messenger 'text-file-messenger :filename "...") adds the new messenger to the current (or specified) log-manager "STOP-MESSENGER" ; remove this messenger (or messenger with this name) from current (or specified) log-manager; this method may be specialised. "FIND-MESSENGER" ; find messenger with given name. "MESSENGER-SEND-MESSAGE" ; (defmethod messenger-send-message messenger message) actually logs this message; this method needs specialising. "RING-MESSENGER" ; (make-instance 'ring-messenger :length 50) "RING-MESSENGER-MESSAGES" "TEXT-STREAM-MESSENGER" ; class for messengers for which formatted text will be sent to an output stream. "TEXT-STREAM-MESSENGER-STREAM" ; reader - stream to which output is sent. "TEXT-FILE-MESSENGER" ; subclass of text-stream-messenger where output is to file. "TEXT-FILE-MESSENGER-FILE" ; reader - file to which the output goes ;; category "CATEGORY-SET" ; class of sets of categories "DEFCATEGORY" ; (defcategory :debug (or :debug :info)) defines a new category. The expansion looks recursive but that's handled for you. Takes optional third argument of a category-set. "DEFCATEGORY-FN" ; (defcategory-fn (my-category-keyword) '(or :debug :info)) for runtime use. "UNDEFCATEGORY" ; (undefcategory :debug) removes one category from the current category set (or from the optional second argument, a category-set). "UNDEFCATEGORY-FN" ; (undefcategory-fn (my-category-keyword)) for runtime use. "CLEAR-CATEGORIES" ; (clear-categories) wipes the current (or specified) set of categories. "CATEGORY-SATISFIES" ; Does this category match that filter? (category-satisfies :error (and :info (not :error))) => nil ;; log-message "LOG-MESSAGE" ; (log-message ) e.g. (log-message :debug "Frob ~a happened" (car frobs)) ; category always evaluated, other parameters only evaluated if category matches at least one messenger "LOG-MANAGER-MESSAGE" ; (log-message ) Just like log-message, but uses ; to dispatch the message. )) ;; A. REFERENCES ;; ;; ;; B. HISTORY ;; ;; 2007-05-23 Created. ;; ;; ;; C. COPYRIGHT ;; ;; This file copyright (c) 2007 - 2009 Nick Levine (ndl@ravenbrook.com) ;; Log5 copyright (c) 2007 Gary Warren King (gwking@metabang.com) ;; Permission is hereby granted, free of charge, to any person ;; obtaining a copy of this software and associated documentation ;; files (the "Software"), to deal in the Software without ;; restriction, including without limitation the rights to use, copy, ;; modify, merge, publish, distribute, sublicense, and/or sell copies ;; of the Software, and to permit persons to whom the Software is ;; furnished to do so, subject to the following conditions: ;; The above copyright notice and this permission notice shall be ;; included in all copies or substantial portions of the Software. ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT ;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, ;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, ;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER ;; DEALINGS IN THE SOFTWARE. cl-log.1.0.1/doc/index.txt000444 000000 001751 00000056531 12060355661 015106 0ustar00rootndl000000 000000 CL-LOG.LISP - A general purpose logging utility for Common Lisp Nick Levine and Nick Barnes Ravenbrook Limited ndl@ravenbrook.com, nb@ravenbrook.com Last updated 2012-05-15 Contents: 1. Introduction 2. Examples 3. Obtaining and installing CL-LOG 4. The log-manager 5. Timestamps 6. Categories 7. Messages 8. Messengers 1. INTRODUCTION CL-LOG is a general purpose logging utility, loosely modelled in some respects after Gary King's "Log5" . Its features include: * logging to several destinations at once, via "messengers", * each messenger is tailored to accept some log messages and reject others, and this tailoring can be changed on-the-fly, * very rapid processing of messages which are rejected by all messengers, * support for messengers which cl:format text to a stream, * support for messengers which do not invoke cl:format, * timestamps in theory accurate to internal-time-units-per-second. Typically, logging utilities only support the one, simple paradigm of formatting objects to a text-stream. Removing this restriction allows you to: * log random objects instead of plain text, * generate internationalized log messages, * create specialised binary logs, * base the test-suite of complex applications around logging. Logging is controlled by the following classes: log-manager, base-messenger, base-message, category-set; any of these might be specialised by your application. Whether or not a messenger will accept a given message is controlled by "categories" of messages and "filters" of messengers; these are logical combinations of atoms (typically keywords). The source code for CL-LOG is very nearly the same length as this documentation. You might find it less work to read the code instead. CL-LOG has an MIT-style license, a copy of which will be found at the end of this document. 2. EXAMPLES 2.1. Getting started -- simple logging to a text file There is a two-step setup and then you're ready to go. First, create your log-manager and configure it for formatted messages: (in-package cl-log) (setf (log-manager) (make-instance 'log-manager :message-class 'formatted-message)) Next, instantiate a messenger and point it at your output file: (start-messenger 'text-file-messenger :filename "/tmp/log.txt") We didn't give this messenger a filter, and this means it'll accept all messages. OK, we're ready to go. (log-message :warning "Logging system poorly understood") (log-message :coffee "Levels replenished") The output file now contains something like: 3390537223.453 WARNING Logging system poorly understood 3390537225.218 COFFEE Levels replenished That's all there is to it. Where to go next? Consider using categories (start with sections 6.1 and 6.4) to allow control over how much gets logged, and consider making the formatted output prettier by specialising the class formatted-message and defining a method on format-message (see section 7.3). 2.2. Logging to a ring, using categories When analysing a bug, you often want to review recent activity. A ring log is ideal for this: it keeps the most recent messages. Let's define some categories: in this example they're going to annotate the severities of situations which we wish to log. They range from "critical" at one end of the scale to "debug" at the other. (defcategory :critical) (defcategory :error (or :error :critical)) (defcategory :warning (or :warning :error)) (defcategory :notice (or :notice :warning)) (defcategory :info (or :info :notice)) (defcategory :debug (or :debug :info)) Note the recursive inclusion: a messenger with the :debug filter will accept either :debug or :info messages, and so it'll accept either :debug, :info or :notice, and so on. It's quite safe to define a category in terms of itself. Next we fire up the log-manager: (setf (log-manager) (make-instance 'log-manager)) If you'd already run the file-logging example above, note that resetting (log-manager) will automatically stop the previous log-manager's messenger(s). The final step before we're ready to start logging is to create at least one messenger. The ring-messenger class records messages as raw objects, always retaining the most recent :length (in this case, 10) of them. (start-messenger 'ring-messenger :length 10 :filter '(and :info (not :error))) The :filter initarg above specifies that this messenger will only accept messages which are of category :info but not of category :error. Using the defcategory forms above, we can think of this as equivalent to (or :info :notice :warning). Calculating whether a message satisfies a combination like this isn't "for free", but the results are cached and so provided you don't keep redefining your categories (thousands of times per second, say) you'll get excellent performance no matter how complicated the combinations are. OK, let's log some messages. The first argument, always evaluated, to the log-message macro is the category of this message. The remaining arguments are only evaluated if the message is accepted by at least one messenger. In this toy example, we fire off half a dozen messages using the category of each as its contents: (dolist (z '(:critical :error :warning :notice :info :debug)) (log-message z z)) Now let's show that we logged everything which was at least :info provided it wasn't also at least :error (loop for message in (ring-messenger-messages (car (log-manager-messengers (log-manager)))) when message collect (message-description message)) => (:WARNING :NOTICE :INFO) 2.3. Advanced example: use in a library Suppose you're writing a library for others to use. The library clients might already be using cl-log, and/or might want to use other third-party libraries which also use it. You don't want your categories, your messengers, and so on to be a problem for them. Enter the "category set": (setf *my-categories* (make-instance 'category-set)) (defcategory :meltdown () *my-categories*) (defcategory :emergency (or :emergency :meltdown) *my-categories*) (defcategory :alarm (or :alarm :emergency) *my-categories*) (defcategory :warning (or :warning :alarm) *my-categories*) (defcategory :cake () *my-categories*) (defcategory :tea () *my-categories*) (defcategory :break (or :break :tea :cake) *my-categories*) (defcategory :siren (or :siren :break :alarm) *my-categories*) (setf *my-log-manager* (make-instance 'log-manager :categories *my-categories*)) Note that the category set is the third argument to defcategory, so when you want to specify it, you cannot omit the second (expansion) argument, although you can set it to nil - as for :meltdown, :cake, and :tea above. All the relevant methods allow you to specify a log manager: (start-messenger 'ring-messenger :manager *my-log-manager* :length 10 :filter '(and :info (not :error))) And messages can be directed to a specific log manager: (log-manager-message *my-log-manager* :warning "John's birthday") 3. OBTAINING AND INSTALLING CL-LOG 3.1. Quicklisp CL-LOG is available via Quicklisp: CL-USER > (ql:quickload :cl-log) To load "cl-log": Load 1 ASDF system: cl-log ; Loading "cl-log" [package com.ravenbrook.common-lisp-log]... (:CL-LOG) CL-USER > 3.2. Direct download CL-LOG can also be downloaded directly from http://www.nicklevine.org/cl-log/ The source is in two lisp files: pkg.lisp and cl-log.lisp; compile and load them in that order. There's also an asdf file (cl-log.asd). 3.3. Packages The package of any lisp symbol referenced in this document can be determined by selecting the first of the following which is applicable to that symbol: 1. the symbol's package is explicitly qualified; 2. the symbol belongs to the COMMON-LISP package; 3. if neither of the above applies then the symbol belongs to and is exported from the COM.RAVENBROOK.COMMON-LISP-LOG package. The COM.RAVENBROOK.COMMON-LISP-LOG package has nickname CL-LOG. Its use-list is the system default. The version of CL-LOG can be determined from the value of *CL-LOG-RELEASE*. This is release 0.1.0. 4. THE LOG-MANAGER 4.1. Global accessor log-manager (log-manager) (setf (log-manager) ...) There is always a current global log manager. The system starts up with a log manager with no messengers. (log-manager) returns the current global log manager; (setf (log-manager) x) sets it. The new value must be of type log-manager. If the old log manager had any messengers then they will be stopped, by calling stop-messenger on each of them. Make a temporary switch of the global log-manager with this macro: (rebinding-log-manager ((log-manager) &body body)) Make a temporary switch to a new empty log-manager thus: (rebinding-log-manager (nil) ;; some code ) 4.2. Class log-manager (defclass log-manager ...) This is the class of log-managers. You might or might not want to subclass it. Accessors on log-manager: (log-manager-messengers log-manager) (setf (log-manager-messengers log-manager) ...) The messengers of a log-manager. Typically you won't ever need to set this directly - see start-messenger and stop-messenger. (log-manager-message-class log-manager) (setf (log-manager-message-class log-manager) ...) A designator for the class of messages which the log manager will create. The log-manager class has initarg :message-class which will be sufficient for most uses. The message class defaults to 'base-message. (log-manager-category-set log-manager) (setf (log-manager-category-set log-manager) ...) The category-set of the log manager. Initialized with the :categories initarg, or from the current (log-manager) otherwise. (logging-disabled log-manager) (setf (logging-disabled log-manager) ...) Used to disable and re-enable logging globally. 4.3. Disabling the log manager In addition to the logging-disabled setter above, there's the following macro: (with-logging-disabled &body body) Logging is disabled (for the current log manager) in the lexical scope of this form and returned to its previous state on exit, irrespective of any intervening calls to (setf logging-disabled). It's just like a variable binding. If you want to disable a specific manager: (with-log-manager-disabled (manager) &body body) 4.4. Invalidating the log manager The generic-function invalidate-log-manager is called after categories are defined or undefined, and after log-manager-messengers is reset (e.g. after calling start-messenger or stop-messenger). You can depend on invalidate-log-manager being called before the next relevant log-message operation completes, but you cannot depend on exactly when this will be or how many times it will be called. (So, for instance, in this version of CL-LOG, several calls to defcategory with no intervening log-message will only cause invalidate-log-manager to be called once). CL-LOG supplies the primary method: (invalidate-log-manager (log-manager log-manager)) You might want to define :after methods on this (for example, to close resources used by a subclass of log-manager). Note: this method doesn't actually "invalidate" the log manager, in the sense of disabling it. It invalidates the log manager's cache of the mapping from categories to messengers. 5. TIMESTAMPS Every message is automatically given a timestamp (provided it's been accepted by at least one messenger). (defstruct (timestamp ...) ...) You can subclass this using defstruct with :include, should you see the need. (make-timestamp (log-manager)) Use this if you ever want a timestamp of your own to take home and play with. The timestamp has two readers: (timestamp-universal-time ts) (timestamp-fraction ts) The fraction is in internal-time-units-per-second. Warning: there's no obvious way in Common Lisp to tell what the current fractional value of the universal-time is. CL-LOG's timestamps add the universal-time when the log-manager was instantiated to the change in (get-internal-real-time) since then. This means that timestamps will be self-consistent but not externally consistent: the fraction will be zero when the timestamp-universal-time changes but probably won't be zero when the system's univeral-time changes. 6. CATEGORIES 6.1. Messages, messengers and category-satisfies Every message has a set of categories, specified by the first argument to log-message or the second argument to log-manager-message. It may be either an atom or a list of atoms (meaning: all these categories apply to this message). Every messenger has a filter, specified when the messenger is instantiated, which defines the message categories which that messenger will accept. The messenger's filter cannot be changed, but you can use defcategory / defcategory-fn (see below) to tailor on-the-fly how message categories and messenger filters are related. A messenger's filter is either null (meaning: accept all messages), or an atom (meaning: accept messages in this category), or a list starting with one of AND, OR and NOT (meaning: a logical combination of filters). It's suggested that the atoms should be keywords; this version of CL-LOG doesn't enforce that but it leaves space for future expansions in which (e.g.) funcallables might have some meaning. The function category-satisfies is called to determine whether its first argument (a message category or list of categories) "satisfies" its second argument (a messenger filter): ;; needed either, got both, so satisfied (category-satisfies '(:this :that) '(or :this :that)) => T (category-satisfies :error (and :info (not :error))) => NIL 6.2. defcategory The macro defcategory is used to define the expansions for messengers' filters. For example, given: (defcategory :interesting (or :important :urgent)) we have not only (category-satisfies :interesting :interesting) => T but also ;; this message is urgent -- will it be accepted by a messenger ;; which expects its messages to be interesting? (category-satisfies :urgent :interesting) => T These expansions only affect the messengers' filters (and not the categories of the messages): ;; this message is interesting -- will it be accepted by a ;; messenger which expects its messages to be urgent? (category-satisfies :interesting :urgent) => NIL 6.3. Advanced defcategory For clarity, you can also define a category without an expansion, as in the example at the start of this document: (defcategory :critical) This has no semantic meaning (and although it will overwrite a previous expansion for :critical, it's clearer for you to use undefcategory). It might make your code more readable. Note that you can define a category in terms of itself: (defcategory :warning (or :warning :error)) This is quite safe. It means the same as: (defcategory :warning :error) - the messenger will accept either warnings or errors. This last use came to me as I was writing this document. It's an interesting quirk but I don't much care for it as it really doesn't read well. 6.4. defcategory-fn The defcategory macro expands into calls to the function defcategory-fn. This function may be useful if you wish to change the filter of one or more messengers on the fly. For example, you might do this by setting the filter of the messenger(s) to be :log-level and defining (defun (setf log-level) (new-value) (defcategory-fn :log-level new-value)) All your application has to do is to (setf (log-level) :warning) or whatever, for all :log-level messengers to respond to warnings. 6.5. Undefining categories The macro undefcategory removes the expansion of a category. Example: (undefcategory :debug) This expands to a call to undefcategory-fn, analogously to defcategory-fn. The function (clear-categories) undefines all category expansions. 6.6. Advanced use: category sets A category set is an object managing a set of categories. This allows you to separate your categories from those which any other module in the system might be using. An empty category set can be made with: (make-instance 'category-set) A log manager has a category set (log-manager-category-set log-manager). Ordinarily, a newly-created log manager will share the category set of the current log manager. The defcategory macro can take a category set as an optional argument, thus: (defcategory :error (or :error :critical) my-category-set) If no category set is specified, the category set of the current log manager is used. Thus in ordinary use, there will be a single category set, which is shared between all log managers, and which manages all the categories. However, for advanced use it is possible to create a new category set (make-instance 'category-set), to populate that set with categories by using the set argument to defcategory or defcategory-fn, and to make a log-manager using that set (by creating it with the :categories initarg, or by (setf (log-manager-category-set log-manager) ...). The undefcategory macro, the undefcategory-fn, and the clear-categories function all also take an optional set argument. 7. MESSAGES 7.1. log-message The macro log-message is used to send messages. (log-message category description &rest arguments) The category, always evaluated, is compared using category-satisfies with the filter of each messenger to determine which if any messenger(s) will accept the message. The results of this comparison are cached, so next time you log a message with this category the lookup will be fast. Provided at least one messenger accepts the message, a message object is instantiated and given a fresh timestamp and the category; the description and arguments are evaluated and set into the message. The class of this object is determined by (log-manager-message-class (log-manager)). For advanced use, you can send a message to any log manager, not just the global log manager: (log-manager-message manager category description &rest arguments) 7.2. Class base-message This is the root class for messages. The following readers are provided: message-timestamp message-category message-description message-arguments 7.3. Class formatted-message This subclass of base-message is for messages which will be formatted to a text stream. The following reader is provided: message-text This value is generated (lazily) by calling the generic function format-message whose primary method is defined thus: (defmethod format-message ((self formatted-message)) (format nil "~a ~a ~?~&" (message-timestamp self) (message-category self) (message-description self) (message-arguments self))) You probably want to specialise this. 8. MESSENGERS 8.1. Class base-messenger This is the root class for messengers. To instantiate and activate a messenger, call start-messenger. (start-messenger class &rest initargs &key manager name &allow-other-keys) To deactivate a messenger, call stop-messenger. This generic function will accept either a messenger (i.e. the object returned by start-messenger) or the name of a messenger. There are two methods on stop-messenger (defmethod stop-messenger ((self base-messenger) &key)) (defmethod stop-messenger (name &key manager) and you're free to add more. Only one messenger with a given name (equalp) may be started in any given manager at any one time. Starting a new messenger in a manager with an name of an existing messenger in that manager will automatically stop the old one. The function call (find-messenger name &key manager) returns the messenger (if any) with the given name. The following readers are provided for instances of base-messenger: messenger-manager (initarg :manager) messenger-name (initarg :name) messenger-filter (initarg :filter) For backwards compatibility, messenger-category and initarg :category are synonymous with messenger-filter and :filter respectively. 8.2. Generic function messenger-send-message This generic function is called once for each messenger which has accepted any given message. It defines what the messengers will actually do with their messages. (defgeneric messenger-send-message (messenger message)) Three methods are provided. The first (defmethod messenger-send-message ((messenger base-messenger) message)) signals an error. The other two are specialised on ring-messenger (section 8.3) and text-stream-messenger (section 8.4) respectively. If your messenger doesn't inherit from one of these two classes, you'll have to define a method on messenger-send-message. 8.3. Class ring-messenger This subclass of base-messenger allows you to specify -- via the :length initarg -- how many messages you wish to keep. It retains this number of messages (as raw objects) and is thus designed to give cheap access to your application's recent actions. Retrieve the messages with the accessor ring-messenger-messages. The message class base-message is sufficient for ring-messengers. This class is dead useful in error handlers. 8.4. Class text-stream-messenger This subclass of base-messenger handles the output of log messages as formatted text to a stream. Specify this stream with the :stream initarg (associated reader text-stream-messenger-stream). You'll need messages of class formatted-message (section 7.3) in order to use text-stream-messengers. The method on messenger-send-message specialised on these two classes looks a little bit like this. (defmethod messenger-send-message ((messenger text-stream-messenger) (message formatted-message)) (let ((ostream (text-stream-messenger-stream messenger))) (write-string (message-text message) ostream))) Calling stop-messenger on a text-stream-messenger will automatically close the associated stream. 8.5. Class text-file-messenger This subclass of text-stream-messenger supports output to a text-file. Specify the file with the :filename initarg (associated reader text-file-messenger-file). COPYRIGHT This file copyright (c) 2007 - 2012 Nick Levine (ndl@ravenbrook.com) and Nick Barnes (nb@ravenbrook.com). Log5 copyright (c) 2007 Gary Warren King (gwking@metabang.com) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. $Id: //info.ravenbrook.com/user/ndl/lisp/cl-log/cl-log.1.0.1/doc/index.txt#1 $