diff --git a/main.rkt b/main.rkt index 300458b..d81e603 100644 --- a/main.rkt +++ b/main.rkt @@ -83,53 +83,63 @@ (l (hash-ref log-hash level 6))) (>= l ll))) -(define logger-thread - (thread - (λ () (let loop () - (let* ((v (sync log-queue)) - (level (vector-ref v 0)) - (msg (vector-ref v 1)) - (data (vector-ref v 2)) - (dt (car data)) - (topic (cadr data)) - (lc log-callbacks) - ) +(define logger-thread #f) - (when (string=? msg "@@SYNC@@") - (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) +(when (eq? logger-thread #f) + (set! logger-thread + (thread + (λ () (let loop () + (let* ((v (sync log-queue)) + (level (vector-ref v 0)) + (msg (vector-ref v 1)) + (data (vector-ref v 2)) + (dt (car data)) + (topic (cadr data)) + (lc log-callbacks) + ) + + (when (string=? msg "@@SYNC@@") + (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) + ) + ))) + + (if (null? lc) + (begin + (enqueue! buffer-queue (list topic level dt msg)) + (let loop () + (when (> (queue-length buffer-queue) max-log-queue-len) + (dequeue! buffer-queue) + (loop))) + ) + (begin + (when (> (queue-length buffer-queue) 0) + (for-each (λ (log-entry) + (when (needs-logging (cadr log-entry)) + (for-each (λ (e) + (let ((callback (cdr e))) + (apply callback log-entry))) + lc))) + (queue->list buffer-queue)) + (set! buffer-queue (make-queue))) + (when (needs-logging level) + (for-each (λ (e) + (let ((callback (cdr e))) + (callback topic level dt msg))) + lc)) + ) ) - ))) - (if (null? lc) - (enqueue! buffer-queue (list topic level dt msg)) - (begin - (when (> (queue-length buffer-queue) 0) - (for-each (λ (log-entry) - (when (needs-logging (cadr log-entry)) - (for-each (λ (e) - (let ((callback (cdr e))) - (apply callback log-entry))) - lc))) - (queue->list buffer-queue)) - (set! buffer-queue (make-queue))) - (when (needs-logging level) - (for-each (λ (e) - (let ((callback (cdr e))) - (callback topic level dt msg))) - lc)) - ) - ) - - (loop)))) - ) + (loop)))) + ) + ) ) (define (log-to* receiver log-callbacks)