From 875ce167e93f856cab8ed87e1b7e48164df56ce0 Mon Sep 17 00:00:00 2001 From: Ray Miller Date: Fri, 10 Jan 2025 17:22:44 +0000 Subject: [PATCH] Setup logging --- modules/ordo/action/filesystem.scm | 1 + modules/ordo/handler.scm | 3 ++- modules/ordo/logger.scm | 24 ++++++++++++++++++++++++ modules/ordo/play.scm | 9 +++++++-- modules/ordo/task.scm | 9 ++++++--- 5 files changed, 40 insertions(+), 6 deletions(-) create mode 100644 modules/ordo/logger.scm diff --git a/modules/ordo/action/filesystem.scm b/modules/ordo/action/filesystem.scm index 12a940a..eaac534 100644 --- a/modules/ordo/action/filesystem.scm +++ b/modules/ordo/action/filesystem.scm @@ -1,6 +1,7 @@ (define-module (ordo action filesystem) #:use-module (ice-9 binary-ports) #:use-module (ice-9 match) + #:use-module (logging logger) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) ; list utils #:use-module (srfi srfi-26) ; cut diff --git a/modules/ordo/handler.scm b/modules/ordo/handler.scm index a7ddf41..ab7ec91 100644 --- a/modules/ordo/handler.scm +++ b/modules/ordo/handler.scm @@ -1,5 +1,6 @@ (define-module (ordo handler) #:use-module (ice-9 match) + #:use-module (logging logger) #:use-module (srfi srfi-1) ; list utils #:use-module (srfi srfi-9) ; records #:use-module (srfi srfi-26) ; cut @@ -21,5 +22,5 @@ (define (run-handler ctx h) (match h (($ description action) - (format #t "RUNNING HANDLER ~a~%" description) + (log-msg 'NOTICE "Running handler: " description) (action ctx)))) diff --git a/modules/ordo/logger.scm b/modules/ordo/logger.scm new file mode 100644 index 0000000..fd0c206 --- /dev/null +++ b/modules/ordo/logger.scm @@ -0,0 +1,24 @@ +(define-module (ordo logger) + #:use-module (oop goops) + #:use-module ((srfi srfi-1) #:select (take-while drop-while)) + #:use-module ((srfi srfi-26) #:select (cut)) + #:use-module (logging logger) + #:use-module (logging port-log) + #:export (setup-logging + shutdown-logging)) + +(define log-levels '(TRACE DEBUG INFO NOTICE WARN ERROR)) + +(define* (setup-logging #:key (level 'INFO)) + (let ((logger (make )) + (handler (make #:port (current-error-port)))) + (for-each (cut disable-log-level! handler <>) + (take-while (negate (cut equal? level <>)) log-levels)) + (add-handler! logger handler) + (set-default-logger! logger) + (open-log! logger))) + +(define (shutdown-logging) + (flush-log) ; since no args, it uses the default + (close-log!) ; ditto + (set-default-logger! #f)) diff --git a/modules/ordo/play.scm b/modules/ordo/play.scm index c04be7a..87f1ae9 100644 --- a/modules/ordo/play.scm +++ b/modules/ordo/play.scm @@ -1,6 +1,7 @@ (define-module (ordo play) #:use-module (oop goops) #:use-module (ice-9 match) + #:use-module (logging logger) #:use-module (srfi srfi-1) ; list utils #:use-module (srfi srfi-9) ; records #:use-module (srfi srfi-26) ; cut @@ -8,6 +9,7 @@ #:use-module (ordo context) #:use-module (ordo task) #:use-module (ordo handler) + #:use-module (ordo logger) #:export (play run-play)) (define-record-type @@ -57,7 +59,9 @@ (make-play description connection (fold (match-lambda* (((k . v) accum) (alist-cons k v accum))) '() vars) tasks handlers)) (define (run-play play) - (format #t "RUNNING PLAY ~a~%" (play-description play)) + ;; TODO move logging setup and shutdown to a higher level when we implement playbook etc. + (setup-logging) + (log-msg 'NOTICE "Running play: " (play-description play)) (call-with-connection (play-connection play) (lambda (c) @@ -68,4 +72,5 @@ (when (context-triggered? ctx name) (run-handler ctx handler)))) (play-handlers play))))) - (format #t "COMPLETED PLAY ~a~%" (play-description play))) + (log-msg 'NOTICE "Completed play: " (play-description play)) + (shutdown-logging)) diff --git a/modules/ordo/task.scm b/modules/ordo/task.scm index fa3f694..e1db8e0 100644 --- a/modules/ordo/task.scm +++ b/modules/ordo/task.scm @@ -1,5 +1,6 @@ (define-module (ordo task) #:use-module (ice-9 match) + #:use-module (logging logger) #:use-module (srfi srfi-1) ; list utils #:use-module (srfi srfi-9) ; records #:use-module (srfi srfi-26) ; cut @@ -29,11 +30,13 @@ (match t (($ description condition action register triggers) (if (not (condition ctx)) - (format #t "SKIPPING TASK ~a (precondition not met)~%" description) + (log-msg 'NOTICE "Skipping task: " description " (precondition not met)") (begin - (format #t "RUNNING TASK ~a~%" description) + (log-msg 'NOTICE "Running task: " description) (let ((result (action ctx))) (when register + (log-msg 'INFO "Registering result " register) (register-context-var! ctx register result)) - (when triggers + (when (and triggers (not (null? triggers))) + (log-msg 'INFO "Scheduling triggers " triggers) (add-context-triggers! ctx triggers))))))))