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

synchronization (2)

Browse Source
This commit is contained in:
Hans Dijkema
2026-04-20 16:58:30 +02:00
parent 0ba5449492
commit 584375cc40
1 changed files with 21 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
main.rkt
View File

@@ -13,6 +13,7 @@
sl-log-to-file&display
sl-set-log-level
sl-log-level
sl-sync
)
(define (iso-timestamp)
@@ -26,8 +27,15 @@
(date-second d))))
(define sync-count 0)
(define sync-sem (make-semaphore))
(define sync-sems (make-hash))
(define (sl-sync l topic)
(let ((sem (hash-ref sync-sems topic #f)))
(when (eq? sem #f)
(set! sem (make-semaphore))
(hash-set! sync-sems topic sem))
(log-message l 'fatal #f "@@SYNC@@" (list (iso-timestamp) topic))
(semaphore-wait sem)))
(define log-callbacks #f)
(set! log-callbacks '())
@@ -76,11 +84,17 @@
)
(when (string=? msg "@@SYNC@@")
(set! sync-count (- sync-count 1))
(semaphore-post sync-sem)
(set! msg "synchronization received")
(let ((sem (hash-ref sync-sems topic #f)))
(if (eq? sem #f)
(begin
(set! msg (format "Cannot synchronize on topic ~a" topic))
(set! level 'error))
(begin
(semaphore-post sem)
(set! msg (format "Synchronization received on topic ~a" topic))
(set! level 'info)
)
)))
(enqueue! log-queue (list topic level dt msg))
(unless (null? lc)
@@ -160,12 +174,7 @@
(define (warnn msg . args) (log 'warning msg args))
(define (errn msg . args) (log 'error 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)
)
)
(define (syncn) (sl-sync l 'id))
(log-to* receiver (λ () log-callbacks))
)
)