2013-03-29 03:00:29 +00:00
|
|
|
#lang racket/base
|
|
|
|
|
|
|
|
(require racket/match)
|
|
|
|
|
2013-05-30 21:54:53 +00:00
|
|
|
(provide marketplace-root-logger
|
|
|
|
marketplace-log)
|
2013-03-29 03:00:29 +00:00
|
|
|
|
2013-05-30 21:54:53 +00:00
|
|
|
(define marketplace-root-logger (make-logger 'marketplace #f))
|
2013-03-29 03:00:29 +00:00
|
|
|
|
|
|
|
;; WARNING: duplicated in log-typed.rkt
|
2013-05-30 21:54:53 +00:00
|
|
|
(define-syntax marketplace-log
|
2013-03-29 03:00:29 +00:00
|
|
|
(syntax-rules ()
|
|
|
|
[(_ level-exp message)
|
|
|
|
(let ((level level-exp))
|
2013-05-30 21:54:53 +00:00
|
|
|
(when (log-level? marketplace-root-logger level)
|
|
|
|
(log-message marketplace-root-logger level message #f)))]
|
2013-03-29 03:00:29 +00:00
|
|
|
[(_ level format-string exp ...)
|
2013-05-30 21:54:53 +00:00
|
|
|
(marketplace-log level (format format-string exp ...))]))
|
2013-03-29 03:00:29 +00:00
|
|
|
|
|
|
|
(define (level-code level)
|
|
|
|
(match level
|
|
|
|
['debug "D"]
|
|
|
|
['info "I"]
|
|
|
|
['warning "W"]
|
|
|
|
['error "E"]
|
|
|
|
['fatal "F"]
|
|
|
|
[other (symbol->string other)]))
|
|
|
|
|
2013-05-30 21:54:53 +00:00
|
|
|
(match (getenv "MARKETPLACE_LOG")
|
2013-03-29 03:00:29 +00:00
|
|
|
[#f (void)]
|
|
|
|
[str (let ((level (string->symbol str)))
|
2013-05-30 21:54:53 +00:00
|
|
|
(define receiver (make-log-receiver marketplace-root-logger level))
|
2013-03-29 03:00:29 +00:00
|
|
|
(thread
|
|
|
|
(lambda ()
|
|
|
|
(let loop ()
|
|
|
|
(match (sync receiver)
|
2013-04-11 19:18:57 +00:00
|
|
|
[(vector level message data event-name)
|
2013-03-29 03:00:29 +00:00
|
|
|
(fprintf (current-error-port) "~a/~a\n" (level-code level) message)])
|
|
|
|
(loop)))))])
|