sbcl stuff
This commit is contained in:
Ian Keane
parent
1d1dbc34df
commit
5d91dbb667
335 changed files with 119806 additions and 1 deletions
|
|
@ -0,0 +1,19 @@
|
|||
Copyright (c) 2014 Lyon Bros. Enterprises, LLC
|
||||
|
||||
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.
|
||||
|
|
@ -0,0 +1,82 @@
|
|||
Vom - A tiny logging library for Common Lisp
|
||||
============================================
|
||||
|
||||
Vom is a logging library for lisp. It's goal is to be useful and small. It does
|
||||
not provide a lot of features as other loggers do, but has a small codebase
|
||||
that's easy to understand and use.
|
||||
|
||||
## Documentation
|
||||
|
||||
Logging is done by calling one of the logging macros:
|
||||
|
||||
- emerg
|
||||
- alert
|
||||
- crit
|
||||
- error
|
||||
- warn
|
||||
- notice
|
||||
- info
|
||||
- debug
|
||||
- debug1
|
||||
- debug2
|
||||
- debug3
|
||||
- debug4
|
||||
|
||||
Each of these is a macro defined as such:
|
||||
|
||||
```lisp
|
||||
(defmacro notice (format-str &rest args) ...)
|
||||
```
|
||||
|
||||
They are used almost exactly like `format` (but without specifying the stream):
|
||||
|
||||
```lisp
|
||||
(vom:error "there was a problem setting up your database: ~a" error)
|
||||
```
|
||||
|
||||
### Configuration
|
||||
|
||||
You can set a global logging level:
|
||||
|
||||
```lisp
|
||||
;; set the default loglevel such that only errors (or higher) get logged
|
||||
(vom:config t :error)
|
||||
```
|
||||
|
||||
or you can set per-package loglevels:
|
||||
|
||||
```lisp
|
||||
(vom:config :my-package :notice)
|
||||
```
|
||||
|
||||
In the above examples, any unconfigured package will have the loglevel of
|
||||
`:error`, but the package `my-package` will log anything that's a `:notice` or
|
||||
above.
|
||||
|
||||
### \*log-stream\*
|
||||
|
||||
The stream that vom logs to by default. This defaults to `t` (aka
|
||||
`*standard-output*`)
|
||||
|
||||
### \*log-hook\*
|
||||
|
||||
This is a function of 3 arguments that takes a log level, a package keyword
|
||||
name, and that package's configured log level and returns one or more streams as
|
||||
multiple values that the log entry will be logged to:
|
||||
|
||||
```lisp
|
||||
;; example: this hook logs the request to multiple streams if we're getting a
|
||||
;; log entry from the "particle-accelerator" package
|
||||
(setf vom:*log-hook*
|
||||
(lambda (level package package-level)
|
||||
(declare (ignore level package-level))
|
||||
(if (eq package :particle-accelerator)
|
||||
(values t *my-file-log-stream* *another-stream*)
|
||||
t)))
|
||||
```
|
||||
|
||||
## License
|
||||
|
||||
MIT. Do what you want with it. Just give me credit. Or I'll come to your house
|
||||
for two weeks and eat your food and sleep on your couch and use your toothbrush.
|
||||
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
(asdf:defsystem vom
|
||||
:author "Andrew Danger Lyon <orthecreedence@gmail.com>"
|
||||
:license "MIT"
|
||||
:version "0.1.4"
|
||||
:description "A tiny logging utility."
|
||||
:components ((:file "vom")))
|
||||
|
|
@ -0,0 +1,204 @@
|
|||
(defpackage :vom
|
||||
;; DON'T use :cl, otherwise most of the implementations bitch about using
|
||||
;; error and warn functions
|
||||
(:use)
|
||||
;; import everything from cl that we actually need. while obnoxious, it makes
|
||||
;; sure vom runs smoothly on most (all?) implementations.
|
||||
(:import-from #:cl
|
||||
#:t #:nil
|
||||
#:defpackage #:in-package #:*package* #:package-name #:find-package
|
||||
#:eval-when
|
||||
#:eval
|
||||
#:lambda #:defun #:multiple-value-list #:defmacro
|
||||
#:return-from
|
||||
#:defvar #:defparameter
|
||||
#:declare #:optimize #:type #:ignore
|
||||
#:keyword #:integer
|
||||
#:assert
|
||||
#:member
|
||||
#:macro-function
|
||||
#:documentation
|
||||
#:let #:let* #:progn #:multiple-value-bind
|
||||
#:&rest #:&key
|
||||
#:if #:when #:unless #:cond
|
||||
#:loop #:dolist
|
||||
#:car #:cdr #:cddr
|
||||
#:write-sequence #:format
|
||||
#:get-universal-time
|
||||
#:get-decoded-time
|
||||
#:string #:string-downcase #:make-string #:concatenate
|
||||
#:symbolp
|
||||
#:intern
|
||||
#:setf #:getf
|
||||
#:max #:min
|
||||
#:eq
|
||||
#:+ #:- #:> #:< #:<= #:>=
|
||||
#:apply #:funcall
|
||||
#:append #:list #:length
|
||||
#:make-synonym-stream)
|
||||
(:shadow #:error
|
||||
#:warn
|
||||
#:debug)
|
||||
(:export #:config
|
||||
#:*log-stream*
|
||||
#:*log-hook*
|
||||
#:*config*
|
||||
#:*time-formatter*
|
||||
#:*log-formatter*
|
||||
|
||||
#:emerg
|
||||
#:alert
|
||||
#:crit
|
||||
#:error
|
||||
#:warn
|
||||
#:notice
|
||||
#:info
|
||||
#:debug
|
||||
#:debug1
|
||||
#:debug2
|
||||
#:debug3
|
||||
#:debug4))
|
||||
(in-package :vom)
|
||||
|
||||
;; define our *levels* and *max-level-name-length* before the define-level macro
|
||||
;; is defined (so it can access them)
|
||||
(eval-when (:load-toplevel :compile-toplevel)
|
||||
(defparameter *levels* '(:off 0)
|
||||
"Holds the log level mappings (keyword -> value).")
|
||||
|
||||
(defparameter *max-level-name-length* 0
|
||||
"Holds the number of characters in the longest log-level name."))
|
||||
|
||||
(defvar *config* '(t :warn)
|
||||
"Holds the logging config as a plist. Holds package -> level mappings, using
|
||||
T as the default (used if logging from a package that hasn't been
|
||||
configured).")
|
||||
|
||||
(defvar *log-stream* (make-synonym-stream 'cl:*standard-output*)
|
||||
"Holds the default stream we're logging to.")
|
||||
|
||||
(defvar *log-hook*
|
||||
(lambda (log-level package-keyword package-log-level)
|
||||
(declare (ignore log-level package-keyword package-log-level))
|
||||
*log-stream*)
|
||||
"Holds a function that, given a log-level, a package name, and the effective
|
||||
log-level for that package, returns one or more (via (values ...)) streams
|
||||
that this log will be sent to.")
|
||||
|
||||
(defvar *package-level-cache* nil
|
||||
"A cache that holds package alias -> package loglevel values for quick lookup.")
|
||||
|
||||
(defparameter *time-formatter*
|
||||
(lambda ()
|
||||
(multiple-value-bind (second minute hour)
|
||||
(get-decoded-time)
|
||||
(format nil "~2,'0D:~2,'0D:~2,'0D" hour minute second)))
|
||||
"A function of 0 args that returns the current time in the desired format.")
|
||||
|
||||
(defparameter *log-formatter*
|
||||
(lambda (format-str level-str package-keyword args)
|
||||
(let* ((format-str (concatenate 'string "~a<~a> [~a] ~a - " format-str "~%")))
|
||||
(apply 'format
|
||||
(append (list
|
||||
nil
|
||||
format-str)
|
||||
(list
|
||||
(make-string (- *max-level-name-length* (length level-str))
|
||||
:initial-element #\space)
|
||||
level-str
|
||||
(funcall *time-formatter*)
|
||||
(string-downcase (string package-keyword)))
|
||||
args))))
|
||||
"A function that takes a format string (user-supplied), a level string (eg
|
||||
'notice' or 'error'), a keyword of the current package, and a list of args
|
||||
the user supplied with the format string and returns a string of the log line
|
||||
we want logged.")
|
||||
|
||||
(defun config (package-keyword level-name)
|
||||
"Configure the log level for a package (or use t for the package name to set
|
||||
the default log level). The log level is given as a keyword."
|
||||
(assert (member level-name *levels*))
|
||||
(clear-level-cache)
|
||||
(cond ((eq package-keyword t)
|
||||
(setf (getf *config* t) level-name))
|
||||
((symbolp package-keyword)
|
||||
(let* ((name (find-package package-keyword))
|
||||
(package-name (string (if name
|
||||
(package-name name)
|
||||
package-keyword))))
|
||||
(setf (getf *config* (intern package-name :keyword)) level-name)))))
|
||||
|
||||
(defun find-package-level (package-keyword)
|
||||
"Given package keyword (doesn't have to be an exact match, can be an alias),
|
||||
find the configured loglevel of that package.
|
||||
|
||||
This caches the package->level connection in *package-level-cache*."
|
||||
(declare (optimize (cl:speed 3) (cl:safety 0) (cl:debug 0))
|
||||
(type keyword package-keyword))
|
||||
(let ((cached (getf *package-level-cache* package-keyword)))
|
||||
(when cached (return-from find-package-level cached))
|
||||
(let* ((package (find-package package-keyword))
|
||||
(package-name (when package
|
||||
(intern (package-name package) :keyword)))
|
||||
(package-level (getf *config* package-name))
|
||||
(package-level (if package-level
|
||||
package-level
|
||||
(getf *config* t)))
|
||||
(package-level-value (getf *levels* package-level 0)))
|
||||
(setf (getf *package-level-cache* package-keyword) package-level-value)
|
||||
package-level-value)))
|
||||
|
||||
(defun clear-level-cache ()
|
||||
"Clears the package loglevel cache."
|
||||
(setf *package-level-cache* nil))
|
||||
|
||||
(defun do-log (level-name log-level package-keyword format-str &rest args)
|
||||
"The given data to the current *log-stream* stream."
|
||||
(declare (optimize (cl:speed 3) (cl:safety 0) (cl:debug 0))
|
||||
(type keyword level-name package-keyword)
|
||||
(type integer log-level)
|
||||
(type string format-str)
|
||||
(type list args))
|
||||
(let* ((package-level-value (find-package-level package-keyword)))
|
||||
(when (<= log-level package-level-value)
|
||||
(let* ((level-str (string level-name))
|
||||
(logline (funcall *log-formatter* format-str level-str package-keyword args))
|
||||
(log-streams (multiple-value-list
|
||||
(funcall *log-hook*
|
||||
log-level
|
||||
package-keyword
|
||||
package-level-value))))
|
||||
(dolist (stream log-streams)
|
||||
(write-sequence logline (if (eq stream t)
|
||||
cl:*standard-output*
|
||||
stream))
|
||||
(cl:finish-output stream))))))
|
||||
|
||||
(defmacro define-level (name level-value)
|
||||
"Define a log level."
|
||||
(let ((macro-name (intern (format nil "LOG-~a" (string name))))
|
||||
(log-sym (intern (string name))))
|
||||
`(progn
|
||||
(setf (getf *levels* ,name) ,level-value)
|
||||
(defmacro ,macro-name (format-str &rest args)
|
||||
,(format nil "Log output to the ~s log level (~a)" name level-value)
|
||||
(let ((pkg (intern (package-name *package*) :keyword)))
|
||||
`(do-log ,,name ,,level-value ,pkg ,format-str ,@args)))
|
||||
(setf (documentation ',log-sym 'cl:function) (documentation ',macro-name 'cl:function))
|
||||
(setf (macro-function ',log-sym) (macro-function ',macro-name))
|
||||
(setf *max-level-name-length* (max *max-level-name-length*
|
||||
(length (string ,name)))))))
|
||||
|
||||
(define-level :emerg 1)
|
||||
(define-level :alert 2)
|
||||
(define-level :crit 3)
|
||||
(define-level :error 4)
|
||||
(define-level :warn 5)
|
||||
(define-level :notice 6)
|
||||
(define-level :info 7)
|
||||
(define-level :debug 8)
|
||||
(define-level :debug1 9)
|
||||
(define-level :debug2 10)
|
||||
(define-level :debug3 11)
|
||||
(define-level :debug4 12)
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue