io/logger/main.rkt

5          "logger.rkt"
10 (provide logger?
11          logger-name
12          current-logger
13          unsafe-root-logger
14          make-logger
27          logger-init!
33 (define (make-root-logger)
34   (create-logger #:topic #f #:parent #f #:propagate-filters 'none))
36 (define-place-local root-logger (make-root-logger))
38 (define (unsafe-root-logger) root-logger)
40 (define current-logger
41   (make-parameter root-logger
43                     (unless (logger? l)
44                       (raise-argument-error 'current-logger "logger?" l))
46                   'current-logger))
48 (define (logger-init!)
49   (set! root-logger (make-root-logger))
50   (current-logger root-logger))
52 (define (make-logger [topic #f] [parent #f] . filters)
54     (raise-argument-error 'make-logger "(or/c symbol? #f)" topic))
55   (unless (or (not parent) (logger? parent))
56     (raise-argument-error 'make-logger "(or/c logger? #f)" parent))
57   (create-logger #:topic topic
59                  #:propagate-filters (parse-filters 'make-logger filters #:default-level 'debug)))
66 (define/who (log-level? logger level [topic #f])
67   (check who logger? logger)
71    (log-level?* logger level topic)))
75    (log-level?* root-logger 'debug 'future)))
79    (log-level?* root-logger 'debug 'place)))
82 (define/who (log-level?* logger level topic)
83   (level>=? (logger-wanted-level logger topic) level))
85 (define/who (log-max-level logger [topic #f])
86   (check who logger? logger)
90     (logger-wanted-level logger topic))))
92 (define/who (log-all-levels logger)
93   (check who logger? logger)
94   (logger-all-levels logger))
96 (define/who (log-level-evt logger)
97   (check who logger? logger)
101        [(unbox (logger-level-sema-box logger))
105         (set-box! (logger-level-sema-box logger) s)
112     [(logger level message)
113      (define topic (and (logger? logger) (logger-name logger)))
114      (do-log-message who logger level topic message #f #t)]
115     [(logger level topic/message message/data)
118         (define topic (and (logger? logger) (logger-name logger)))
119         (do-log-message who logger level topic topic/message message/data #t)]
121         (do-log-message who logger level topic/message message/data #f #t)]
123         (check who logger? logger)
126     [(logger level topic/message message/data data/prefix?)
129         (define topic (and (logger? logger) (logger-name logger)))
130         (do-log-message who logger level topic topic/message message/data data/prefix?)]
132         (do-log-message who logger level topic/message message/data data/prefix? #t)]
134         (check who logger? logger)
137     [(logger level topic message data prefix?)
138      (do-log-message who logger level topic message data prefix?)]))
140 (define (do-log-message who logger level topic message data prefix?)
141   (check who logger? logger)
146    (log-message* logger level topic message data prefix? #f)))
150    (log-message* root-logger 'debug 'future message data #t #f)))
154    (log-message* root-logger 'debug 'place message data #t #f)))
159 (define (log-message* logger level topic message data prefix? in-interrupt?)
161   (when ((logger-max-wanted-level* logger) . level>=? . level)
162     (let loop ([logger logger])
163       (for ([r (in-list (logger-receivers logger))])
177       (let ([parent (logger-parent logger)])
179 …            ((filters-level-for-topic (logger-propagate-filters logger) topic) . level>=? . level))