Setup logging

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

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
     (($ <handler> description action)
-     (format #t "RUNNING HANDLER ~a~%" description)
+     (log-msg 'NOTICE "Running handler: " description)
      (action ctx))))

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 <logger>))
+        (handler (make <port-log> #: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))

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 <play>
@@ -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))

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
     (($ <task> 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))))))))