hans/simple-log
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

synchronization

Browse Source
This commit is contained in:
Hans Dijkema
2026-04-20 16:21:12 +02:00
parent 08c53184eb
commit f8d7b98c6b
1 changed files with 19 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
main.rkt
View File

@@ -25,6 +25,9 @@
(date-minute d) (date-minute d)
(date-second d)))) (date-second d))))
(define sync-count 0)
(define sync-sem (make-semaphore))
(define log-callbacks #f) (define log-callbacks #f)
(set! log-callbacks '()) (set! log-callbacks '())
@@ -72,6 +75,13 @@
(lc (log-callbacks)) (lc (log-callbacks))
) )
(when (string=? msg "@@SYNC@@")
(set! sync-count (- sync-count 1))
(semaphore-post sync-sem)
(set! msg "synchronization received")
(set! level 'info)
)
(enqueue! log-queue (list topic level dt msg)) (enqueue! log-queue (list topic level dt msg))
(unless (null? lc) (unless (null? lc)
(for-each (λ (log-entry) (for-each (λ (log-entry)
@@ -139,7 +149,7 @@
(define-syntax def-log2 (define-syntax def-log2
(syntax-rules () (syntax-rules ()
((_ id parent receiver log-callbacks dbgn infon warnn errn fataln) ((_ id parent receiver log-callbacks dbgn infon warnn errn fataln syncn)
(begin (begin
(define l (make-logger 'id parent)) (define l (make-logger 'id parent))
(define receiver (make-log-receiver l 'debug)) (define receiver (make-log-receiver l 'debug))
@@ -150,6 +160,12 @@
(define (warnn msg . args) (log 'warning msg args)) (define (warnn msg . args) (log 'warning msg args))
(define (errn msg . args) (log 'error msg args)) (define (errn msg . args) (log 'error msg args))
(define (fataln msg . args) (log 'fatal msg args)) (define (fataln msg . args) (log 'fatal msg args))
(define (syncn) (begin
(log-message l 'fatal #f "@@SYNC@@" (list (iso-timestamp) 'id))
(set! sync-count (+ sync-count 1))
(semaphore-wait sync-sem)
)
)
(log-to* receiver (λ () log-callbacks)) (log-to* receiver (λ () log-callbacks))
) )
) )
@@ -166,8 +182,9 @@
[warn-name (format-id #'id "warn-~a" #'prefix)] [warn-name (format-id #'id "warn-~a" #'prefix)]
[err-name (format-id #'id "err-~a" #'prefix)] [err-name (format-id #'id "err-~a" #'prefix)]
[fatal-name (format-id #'id "fatal-~a" #'prefix)] [fatal-name (format-id #'id "fatal-~a" #'prefix)]
[sync-name (format-id #'id "sync-~a" #'prefix)]
) )
#'(def-log2 id parent receiver log-callbacks dbg-name info-name warn-name err-name fatal-name) #'(def-log2 id parent receiver log-callbacks dbg-name info-name warn-name err-name fatal-name sync-name)
) )
) )
((_ id name) ((_ id name)