blob: e6e8661fe31a03d1f186a50c4bf648a8acfd0cae (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
;; SPDX-License-Identifier: EUPL-1.2
;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
(defpackage :ukkoclot/log
(:use :c2cl)
(:export :*output* :deflevel :log-error :log-warn :log-info :log-debug))
(in-package :ukkoclot/log)
(defparameter *output* *error-output*)
(defvar *max-name-length* 8)
(defvar *max-level-length* 4)
(defvar *levels* nil)
(defun get-levels ()
(unless *levels*
(setf *levels* (make-hash-table :test #'eq)))
*levels*)
(defun register-level (level value)
(setf (gethash level (get-levels)) value)
(let ((l (length (symbol-name level))))
(when (> l *max-level-length*)
(setf *max-level-length* l))))
(defun level-value (level)
(let ((value (gethash level (get-levels))))
(if value
value
(progn
(format *output* "UKKOLOG INTERNAL WARN: UNKNOWN LEVEL ~A" level)
1000))))
(defun level< (lhs rhs)
(< (level-value lhs) (level-value rhs)))
(defstruct (logger (:constructor make-logger%))
(name (error "No value given for NAME") :type keyword :read-only t)
(min-level :debug :type keyword)) ;TODO: Make this :info and make it configurable
(defun make-logger (name)
(let ((l (length (symbol-name name))))
(when (> l *max-name-length*)
(setf *max-name-length* l)))
(make-logger% :name name))
(defvar *package-loggers* nil)
(defun get-package-loggers ()
(unless *package-loggers*
(setf *package-loggers* (make-hash-table :test #'eq)))
*package-loggers*)
(defun get-package-logger (package)
(let* ((name (package-name package))
(name-sym (intern name :keyword))
(loggers (get-package-loggers))
(logger (gethash name-sym loggers)))
(unless logger
(setf logger (make-logger name-sym))
(setf (gethash name-sym loggers) logger))
logger))
(defun perform-log (package level fmt-str &rest args)
(let ((logger (get-package-logger package)))
(unless (level< level (logger-min-level logger))
(apply #'format *output*
(concatenate 'string "~&~v@A: ~v@A: " fmt-str "~%")
*max-name-length* (logger-name logger)
*max-level-length* level
args))))
(defmacro p (level fmt-str &rest args)
`(perform-log ,*package* ,level ,fmt-str ,@args))
(defmacro deflevel (name value)
`(progn
(register-level ,name ,value)
(defmacro ,(intern (concatenate 'string "LOG-" (symbol-name name))) (fmt-str &rest args)
`(p ,,name ,fmt-str ,@args))))
(deflevel :error 700)
(deflevel :warn 600)
(deflevel :info 500)
(deflevel :debug 400)
|
