Skip to content
This repository
Browse code

Make add :this-console and :stream to (log:config) and make it more

consistent

* src/appender.lisp (property-alist fixed-stream-appender): Added :stream
* src/configurator.lisp (log-config): Added :this-console and :stream,
simplified logic so that daily/console/this-console/stream option by
itself simply adds new appender, without removing any, and only :sane
option removes appenders
(show-logger-settings): Fix to use pretty printing in property list, so that
properties that wrap (like two way streams) still have vertical lines correctly
  • Loading branch information...
commit 651ce10556badf673041ac0aacf2fd4cc43334ac 1 parent 2fa484c
Max Mikhanosha authored

Showing 2 changed files with 133 additions and 95 deletions. Show diff stats Hide diff stats

  1. +4 0 src/appender.lisp
  2. +129 95 src/configurator.lisp
4 src/appender.lisp
@@ -83,6 +83,10 @@ ADD-WATCH-TOKEN"))
83 83 ((stream :initarg :stream :accessor appender-stream))
84 84 (:documentation "Appender that writes message to the stream in STREAM slot"))
85 85
  86 +(defmethod property-alist ((instance fixed-stream-appender))
  87 + (append (call-next-method)
  88 + '((:stream stream :symbol-value))))
  89 +
86 90 (defclass console-appender (stream-appender) ()
87 91 (:documentation "A stream appender that writes messages to
88 92 *debug-io* stream. The *debug-io* is late-binding, that is its the
224 src/configurator.lisp
@@ -44,86 +44,94 @@ appender"
44 44
45 45 (LOG-CONFIG [LOGGER-IDENTIFIER] OPTION1 OPTION2...)
46 46
47   -Logger can be one of:
  47 +LOGGER-IDENTIFIER can be one of:
48 48
49   -- Logger instance ie result of (make-logger) expansion, or any form
  49 +* Logger instance ie result of (make-logger) expansion, or any form
50 50 that returns a logger.
51 51
52   -- A list of logger categories, basically a shortcut for (MAKE-LOGGER
53   - '(CAT1 CAT2 CAT3))
  52 +* A list of logger categories, basically a shortcut for (MAKE-LOGGER
  53 + '(CAT1 CAT2 CAT3)). An error will be given if logger does not exist. If you want
  54 + to ensure logger is created, even if it did not exist before, use
  55 + (LOG-CONFIG (MAKE-LOGGER ...) ...)
54 56
55 57 If not specified, default logger will be root logger
56 58
57 59 Valid options can be:
58 60
59   - Option | Description
60   --------------|---------------------------------------------------------------
61   - :INFO | Or any other keyword identifying a log level, which can be
62   - :DEBUG | shortened to its shortest unambiguous prefix, such as :D
63   --------------|---------------------------------------------------------------
64   - :CLEAR | Removes log level and appenders from any child loggers,
65   - | appenders are not removed from non-additive loggers
66   --------------|---------------------------------------------------------------
67   - :ALL | Changes :CLEAR to remove appenders from non-additive
68   - | loggers
69   --------------|---------------------------------------------------------------
70   - :SANE | Removes logger appenders, adds console appender with
71   - | pattern layout that makes messages look like this:
72   - |
73   - | : [11:22:25] INFO {category.name} - message
74   --------------|---------------------------------------------------------------
75   - :OWN | For :SANE and :DAILY makes logger non-additive
76   - | otherwise additive flag will be set
77   --------------|---------------------------------------------------------------
78   - :DAILY FILE | Adds file appender logging to the named file, which will
79   - | be rolled over every midnight into FILE.YYYYMMDD; Removes any
80   - | other other appenders that subclass FILE-APPENDER-BASE from
81   - | the logger. If :SANE is also specified, all logger appenders
82   - | are removed, but console appender is not added
83   --------------|---------------------------------------------------------------
84   - :CONSOLE | Forces adding of console appender if :DAILY was specified
85   --------------|---------------------------------------------------------------
86   - :PATTERN | For :SANE option uses specified conversion pattern instead
87   - STRING | of default one
88   --------------|---------------------------------------------------------------
89   - :TWOLINE | Changes default pattern layout to print user log message
90   - | log message on 2nd line after the headers
91   --------------|---------------------------------------------------------------
92   - :SELF | Used for debugging LOG4CL itself. Instead of root logger,
93   - | make default logger LOG4CL:SELF and remember all arguments
94   - | in the variable *SELF-LOG-CONFIG*, so that they are restored
95   - | even on (CLEAR-LOGGING-CONFIGURATION). Automatically assumes
96   - | :OWN making the LOG4CL-IMPL:SELF logger non-additive
97   --------------|---------------------------------------------------------------
98   - :PROPERTIES | Configure with PROPERTY-CONFIGURATOR by parsing specified
99   - FILE | properties file
100   --------------|---------------------------------------------------------------
101   - :WATCH | Used with :PROPERTIES, uses watcher thread to check
102   - | properites file modification time, and reloads if it changes
103   --------------|---------------------------------------------------------------
104   - :IMMEDIATE- | Used with :SANE, :DAILY or :CONSOLE to create new appenders
105   - FLUSH | with :IMMEDIATE-FLUSH T option, which prevents automatic
106   - | startup of hierarchy watcher thread, which is used for
107   - | auto-flushing.
108   --------------|---------------------------------------------------------------
  61 + Option | Description
  62 +---------------|---------------------------------------------------------------
  63 + :INFO | Or any other keyword identifying a log level, which can be
  64 + :DEBUG | shortened to its shortest unambiguous prefix, such as :D
  65 +---------------|---------------------------------------------------------------
  66 + :CLEAR | Removes log level and appenders from any child loggers,
  67 + | appenders are not removed from non-additive loggers
  68 +---------------|---------------------------------------------------------------
  69 + :ALL | Changes :CLEAR to remove appenders from non-additive
  70 + | loggers
  71 +---------------|---------------------------------------------------------------
  72 + :SANE | Removes logger appenders, adds console appender with
  73 + | pattern layout that makes messages look like this:
  74 + |
  75 + | [11:22:25] INFO {category.name} - message
  76 + |
  77 + | If used with :DAILY then console appender is not added, unless
  78 + | :CONSOLE or :THIS-CONSOLE is explicitly used
  79 +---------------|---------------------------------------------------------------
  80 + :DAILY FILE | Adds file appender logging to the named file, which will
  81 + | be rolled over every midnight into FILE.YYYYMMDD; Removes any
  82 + | other FILE-APPENDER-BASE'ed appenders from the logger
  83 +---------------|---------------------------------------------------------------
  84 + :CONSOLE | Adds CONSOLE-APPENDER to the logger. Console appender logs
  85 + | into the *DEBUG-IO* at the call site.
  86 + |
  87 + :THIS-CONSOLE | Adds FIXED-STREAM-APPENDER to the logger, with :stream argument
  88 + | taken from the current value of *DEBUG-IO*
  89 +---------------|---------------------------------------------------------------
  90 +:STREAM stream | Adds FIXED-STREAM-APPENDER logging to specified stream
  91 +---------------|---------------------------------------------------------------
  92 + :PATTERN | For any new appenders added, specifies the conversion pattern for the
  93 + | PATTERN-LAYOUT
  94 +---------------|---------------------------------------------------------------
  95 + :TWOLINE | Changes default pattern layout to print user log message
  96 + or :2LINE | log message on 2nd line after the headers
  97 +---------------|---------------------------------------------------------------
  98 + :PROPERTIES | Configure with PROPERTY-CONFIGURATOR by parsing specified
  99 + FILE | properties file
  100 +---------------|---------------------------------------------------------------
  101 + :WATCH | Used with :PROPERTIES, uses watcher thread to check
  102 + | properties file modification time, and reloads if it changes
  103 +---------------|---------------------------------------------------------------
  104 + :IMMEDIATE- | Used with :SANE, :DAILY or :CONSOLE to create new appenders
  105 + FLUSH | with :IMMEDIATE-FLUSH T option, which prevents automatic
  106 + | startup of hierarchy watcher thread, which is used for
  107 + | auto-flushing.
  108 +---------------|---------------------------------------------------------------
  109 + :OWN | For :SANE and :DAILY makes logger non-additive
  110 + | otherwise additive flag will be set
  111 +---------------|---------------------------------------------------------------
109 112
110 113 Examples:
111 114
112   - - (LOG-CONFIG :D) :: Changes root logger level to debug
  115 +* (LOG-CONFIG :D) -- Changes root logger level to debug
113 116
114   - - (LOG-CONFIG :SANE) :: Changes root logger level to info, removes its
115   - appenders, adds console appender with pattern layout
  117 +* (LOG-CONFIG :SANE) -- Changes root logger level to info, removes its
  118 + appenders, adds console appender with pattern layout
116 119
117   - - (LOG-CONFIG :SANE :WARN :CLEAR :ALL) :: Changes root logger level to
118   - warnings, removes its appenders, adds console appender with
119   - pattern layout; then resets all child loggers log levels, and
120   - removes their appenders.
  120 +* (LOG-CONFIG :SANE :THIS-CONSOLE) -- Same as above but adds fixed
  121 + stream appender logging to current value of *DEBUG-IO* instead of
  122 + regular console appender..
121 123
122   - - (LOG-CONFIG (MAKE-LOGGER :FOOBAR) :SANE :OWN :D :DAILY
123   - \"debug.log\") :: Configures the specified logger with debug log
124   - level, logging into file debug.log which will be rolled over
125   - daily, and makes it non-additive ie any messages will not be
126   - propagated to logger parents.
  124 +* (LOG-CONFIG :WARN :SANE :CLEAR :ALL) -- Changes root logger level to
  125 + warnings, removes its appenders, adds console appender with pattern
  126 + layout; then resets all child loggers log levels, and removes their
  127 + appenders.
  128 +
  129 +* (LOG-CONFIG (MAKE-LOGGER :FOOBAR) :SANE :OWN :D :DAILY \"debug.log\")
  130 +
  131 + Configures the specified logger with debug log level, logging into
  132 + file debug.log which will be rolled over daily, and makes it
  133 + non-additive ie any messages will not be propagated to logger
  134 + parents.
127 135 "
128 136 (let ((logger nil)
129 137 sane clear all own daily pattern
@@ -131,7 +139,10 @@ Examples:
131 139 orig-args
132 140 self appenders
133 141 immediate-flush
134   - properties watch)
  142 + properties watch
  143 + this-console
  144 + stream)
  145 + (declare (type (or null stream) stream))
135 146 (cond ((logger-p (car args))
136 147 (setq logger (pop args)))
137 148 ((consp (car args))
@@ -158,6 +169,8 @@ Examples:
158 169 (:immediate-flush (setq immediate-flush t))
159 170 ((:twoline :two-line) (setq twoline t))
160 171 (:console (setq console t))
  172 + (:this-console (setq this-console t
  173 + console t))
161 174 (:watch (setq watch t))
162 175 (:daily
163 176 (setq daily (or (pop args)
@@ -165,6 +178,11 @@ Examples:
165 178 (:properties
166 179 (setq properties (or (pop args)
167 180 (log4cl-error ":PROPERTIES missing argument"))))
  181 + (:stream
  182 + (setq stream (or (pop args)
  183 + (log4cl-error ":STREAM missing argument"))
  184 + console t
  185 + this-console t))
168 186 (:pattern
169 187 (setq pattern (or (pop args)
170 188 (log4cl-error ":PATTERN missing argument"))))
@@ -178,8 +196,8 @@ Examples:
178 196 (t (log4cl-error
179 197 "Don't know what do with argument ~S" arg))))))))
180 198 (or logger (setq logger *root-logger*))
181   - (or level sane clear daily properties own
182   - (log4cl-error "A log level or one of :SANE :CLEAR :OWN :DAILY or :PROPERTIES must be specified"))
  199 + (or level sane clear daily properties own console
  200 + (log4cl-error "A log level or one of :SANE :CLEAR :OWN :DAILY :CONSOLE or :PROPERTIES must be specified"))
183 201 (or (not properties)
184 202 (not (or sane daily pattern console level))
185 203 (log4cl-error ":PROPERTIES can't be used with :SANE :DAILY :PATTERN or log level"))
@@ -194,7 +212,7 @@ Examples:
194 212 logger))
195 213 (when own
196 214 (set-additivity logger nil nil))
197   - (when (or daily sane)
  215 + (when (or daily sane console)
198 216 (let ((default-pattern "[%D{%H:%M:%S}] [%P] <%c{}{}{:downcase}> - %m%n")
199 217 (twoline-pattern "[%D{%H:%M:%S}] [%-5P] <%c{}{}{:downcase}>%n *%I{>} %m%n"))
200 218 (setq layout (make-instance 'pattern-layout
@@ -202,21 +220,28 @@ Examples:
202 220 (or pattern
203 221 (if twoline twoline-pattern
204 222 default-pattern)))))
205   - (cond
206   - (daily (if sane (remove-all-appenders-internal logger nil)
207   - (dolist (a (logger-appenders logger))
208   - (when (or (typep a 'file-appender-base)
209   - (and console (typep a 'console-appender)))
210   - (remove-appender-internal logger a nil))))
211   - (push (make-instance 'daily-file-appender
212   - :name-format daily
213   - :backup-name-format (format nil "~a.%Y%m%d" daily)
214   - :layout layout)
215   - appenders))
216   - (t (remove-all-appenders-internal logger nil)))
217   - (when (or console (and sane (not daily)))
218   - (push (make-instance 'console-appender :layout layout)
219   - appenders))
  223 + (if sane (remove-all-appenders-internal logger nil))
  224 + ;; create daily appender
  225 + (when daily
  226 + (dolist (a (logger-appenders logger))
  227 + (when (typep a 'file-appender-base)
  228 + (remove-appender-internal logger a nil)))
  229 + (push (make-instance 'daily-file-appender
  230 + :name-format daily
  231 + :backup-name-format (format nil "~a.%Y%m%d" daily)
  232 + :layout layout)
  233 + appenders))
  234 + ;; create console appender
  235 + (when (or (and sane (not daily))
  236 + console)
  237 + (push
  238 + (if this-console
  239 + (make-instance 'fixed-stream-appender
  240 + :stream (or stream *debug-io*)
  241 + :layout layout)
  242 + (make-instance 'console-appender :layout layout))
  243 + appenders))
  244 + ;; now add all of them to the logger
220 245 (dolist (a appenders)
221 246 (when immediate-flush
222 247 (setf (slot-value a 'immediate-flush) t))
@@ -226,7 +251,9 @@ Examples:
226 251 (configure (make-instance 'property-configurator) properties
227 252 :auto-reload watch))
228 253 (when self
229   - ;; This is special adhoc case of configuring the LOG4CL-iMPL:SELF
  254 + ;; This is special adhoc case of configuring the LOG4CL-iMPL:SELF. We need
  255 + ;; special processing, because we want self-logging to survive
  256 + ;; the (clear-logging-configuration), which is done doing tests
230 257 (let ((config (cons :own
231 258 ;; we don't remember these
232 259 (remove-if (lambda (x)
@@ -352,15 +379,22 @@ Example output:
352 379 (print-one-logger l))))
353 380 (pop indents)))
354 381 (print-properties (obj)
355   - (let* ((props (property-alist obj))
356   - (name-width (loop for prop in props maximize
357   - (length (format nil "~s" (car prop))))))
358   - (loop for (initarg slot nil) in props
359   - do (print-indent)
360   - do (format t "~v<~(~s~)~;~> ~s~%"
361   - name-width
362   - initarg
363   - (slot-value obj slot)))))
  382 + (let* ((prop-alist (property-alist obj))
  383 + (name-width (loop for prop in prop-alist maximize
  384 + (length (format nil "~s" (first prop)))))
  385 + (indent (with-output-to-string (*standard-output*)
  386 + (print-indent)))
  387 + (*print-pretty* t))
  388 + (loop
  389 + for (initarg slot nil) in prop-alist
  390 + do (pprint-logical-block (nil nil :per-line-prefix indent)
  391 + (pprint-indent :block 0)
  392 + (write initarg :case :downcase)
  393 + (pprint-tab :section-relative 1 (1+ name-width))
  394 + (pprint-newline :miser)
  395 + (pprint-indent :block 0)
  396 + (write (slot-value obj slot)))
  397 + do (terpri))))
364 398 (print-one-appender (a)
365 399 ;; empty line for spacing
366 400 (print-indent) (terpri)

0 comments on commit 651ce10

Please sign in to comment.
Something went wrong with that request. Please try again.