From 71a7c39292eef91d732c0b98e3939032c5ae338b Mon Sep 17 00:00:00 2001 From: Uko Kokņevičs Date: Sun, 12 Oct 2025 23:27:25 +0300 Subject: Replace my simple logging implementation with log4cl --- src/bot/impl.lisp | 11 +++---- src/config.lisp | 2 +- src/db.lisp | 13 ++++---- src/inline-bots.lisp | 5 ++-- src/log.lisp | 85 ---------------------------------------------------- src/main.lisp | 13 ++++---- 6 files changed, 24 insertions(+), 105 deletions(-) delete mode 100644 src/log.lisp (limited to 'src') diff --git a/src/bot/impl.lisp b/src/bot/impl.lisp index 85f4496..652e2f7 100644 --- a/src/bot/impl.lisp +++ b/src/bot/impl.lisp @@ -1,10 +1,11 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/bot/impl - (:use :c2cl :iterate :ukkoclot/config :ukkoclot/log) + (:use :c2cl :iterate :ukkoclot/config) (:import-from :anaphora :aand :acond :it) (:import-from :cl+ssl) (:import-from :dex) + (:import-from :log) (:import-from :ukkoclot/strings :lisp->snake-case) (:local-nicknames (:jzon :com.inuoe.jzon)) @@ -17,7 +18,7 @@ (defgeneric parse-value (type json) (:documentation "Parse value of TYPE from the parsed JSON") (:method (type json) - (log-error "I don't know how to parse simple type ~A!" type) + (log:error "I don't know how to parse simple type ~A!" type) (error "I don't know how to parse simple type ~A!" type)) (:method ((type (eql 'boolean)) json) (check-type json boolean) @@ -100,9 +101,9 @@ ((gethash "ok" hash) (parse-value type (gethash "result" hash))) ((aand (gethash "parameters" hash) (gethash "retry_after" it)) - (log-info "Should sleep for ~A seconds" it) + (log:info "Should sleep for ~A seconds" it) (sleep it) - (log-info "Good morning!") + (log:info "Good morning!") (do-call% bot method uri type args-encoded)) (t (error "TG error ~A: ~A ~:A" (gethash "error_code" hash) @@ -112,5 +113,5 @@ (defun do-call (bot method path type args) (let ((uri (concatenate 'string (bot-base-uri bot) path)) (args-encoded (fixup-args args))) - (log-debug "~A .../~A ~S" method path args-encoded) + (log:debug "~A .../~A ~S" method path args-encoded) (do-call% bot method uri type args-encoded))) diff --git a/src/config.lisp b/src/config.lisp index 86a0f33..17c5c73 100644 --- a/src/config.lisp +++ b/src/config.lisp @@ -1,7 +1,7 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/config - (:use :c2cl :ukkoclot/hash-tables :ukkoclot/log) + (:use :c2cl :ukkoclot/hash-tables) (:export :config-load :config-merge :config-p diff --git a/src/db.lisp b/src/db.lisp index 9b646d2..5d08e6a 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -1,7 +1,8 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/db - (:use :c2cl :sqlite :ukkoclot/log) + (:use :c2cl :sqlite) + (:import-from :log) (:export :get-inline-bot-type :set-inline-bot-type :with-db)) (in-package :ukkoclot/db) @@ -39,24 +40,24 @@ (unless current-ver (setf current-ver 0)) (cond - ((= current-ver +target-version+) (log-info "Database is up to date")) + ((= current-ver +target-version+) (log:info "Database is up to date")) ((> current-ver +target-version+) - (log-error "Database has a higher version than supported?") + (log:error "Database has a higher version than supported?") (error "Corrupted Database")) (t - (log-info "Updating database from version ~A to ~A" current-ver +target-version+) + (log:info "Updating database from version ~A to ~A" current-ver +target-version+) (loop while (< current-ver +target-version+) do (with-transaction db - (log-info "Updating database step from ~A" current-ver) + (log:info "Updating database step from ~A" current-ver) (incf current-ver) (upgrade-step db current-ver) (execute-non-query db "INSERT OR REPLACE INTO version(id, version) VALUES (0, ?)" current-ver))) - (log-info "Database updating complete :)"))))) + (log:info "Database updating complete :)"))))) (defun upgrade-step (db new-version) (case new-version diff --git a/src/inline-bots.lisp b/src/inline-bots.lisp index 3ed85e9..3c6b7c4 100644 --- a/src/inline-bots.lisp +++ b/src/inline-bots.lisp @@ -1,7 +1,8 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/inline-bots - (:use :c2cl :ukkoclot/bot :ukkoclot/config :ukkoclot/log :ukkoclot/tg-types) + (:use :c2cl :ukkoclot/bot :ukkoclot/config :ukkoclot/tg-types) + (:import-from :log) (:local-nicknames (:db :ukkoclot/db)) (:export :blacklist-inline-bot :on-inline-bot :whitelist-inline-bot)) (in-package :ukkoclot/inline-bots) @@ -17,7 +18,7 @@ (if (eq ty :whitelisted) t (progn - (log-info "Deleting an unallowed inline bot message from ~A ~A" + (log:info "Deleting an unallowed inline bot message from ~A ~A" (user-username via) (user-id via)) (try-delete-message bot msg) diff --git a/src/log.lisp b/src/log.lisp deleted file mode 100644 index e6e8661..0000000 --- a/src/log.lisp +++ /dev/null @@ -1,85 +0,0 @@ -;; SPDX-License-Identifier: EUPL-1.2 -;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs -(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) diff --git a/src/main.lisp b/src/main.lisp index f31cd7c..f90bfb3 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -2,8 +2,9 @@ ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/main (:nicknames :ukkoclot) - (:use :c2cl :ukkoclot/bot :ukkoclot/config :ukkoclot/inline-bots :ukkoclot/log :ukkoclot/tg-types) + (:use :c2cl :ukkoclot/bot :ukkoclot/config :ukkoclot/inline-bots :ukkoclot/tg-types) (:import-from :anaphora :acond :awhen :it) + (:import-from :log) (:import-from :ukkoclot/bot :make-bot :bot-power-on :fixup-value) (:import-from :ukkoclot/db :with-db) (:import-from :ukkoclot/strings :escape-xml :is-tg-whitespace-str :starts-with :starts-with-ignore-case) @@ -24,12 +25,12 @@ (unwind-protect (let ((config (config-load #P"config.default.lisp"))) (config-merge config #P"config.lisp") - (log-info "Starting up ~A" (config-bot-name config)) + (log:info "Starting up ~A" (config-bot-name config)) (with-db (db (config-db-path config)) (let ((bot (make-bot config db))) ;; TODO: Catch fatal errors & report them (wrapped-main bot config)))) - (log-info "We're done!"))) + (log:info "We're done!"))) (defun wrapped-main (bot config) (when *in-prod* @@ -81,7 +82,7 @@ :callback-query-id (callback-query-id cb) :text "OK")) (t - (log-info "Unrecognised callback query data: ~A" data) + (log:info "Unrecognised callback query data: ~A" data) (answer-callback-query bot :callback-query-id (callback-query-id cb) :text "Unallowed callback query, don't press the button again" @@ -215,7 +216,7 @@ (defun on-text-command (bot msg text cmd) (let ((simple-cmd (simplify-cmd bot cmd))) - (log-debug "text-command: ~A AKA ~A" cmd simple-cmd) + (log:debug "text-command: ~A AKA ~A" cmd simple-cmd) ;; TODO: Replace this cond with a nicer dispatch. Something like string-case? (acond ((equal simple-cmd "chatid") @@ -246,7 +247,7 @@ Send time: ...")) ))) (defun report-error (bot evt err) - (log-error "While handling ~A: ~A" evt err) + (log:error "While handling ~A: ~A" evt err) (let ((msg (format nil "~A while handling ~&
~A
" (escape-xml (format nil "~A" err)) (escape-xml (format nil "~A" evt))))) -- cgit v1.2.3