logging.server: add support for changing the logging root temporarily.

db4
John Benediktsson 2014-03-12 12:41:57 -07:00
parent 317b0c8d20
commit a6989e2cc2
2 changed files with 26 additions and 14 deletions

View File

@ -1,5 +1,6 @@
IN: logging.tests IN: logging.tests
USING: tools.test logging logging.analysis io math ; USING: tools.test logging logging.analysis logging.server io
io.files.temp math ;
: input-logging-test ( a b -- c ) + ; : input-logging-test ( a b -- c ) + ;
@ -13,6 +14,7 @@ USING: tools.test logging logging.analysis io math ;
\ error-logging-test ERROR add-error-logging \ error-logging-test ERROR add-error-logging
temp-directory [
"logging-test" [ "logging-test" [
[ 4 ] [ 1 3 input-logging-test ] unit-test [ 4 ] [ 1 3 input-logging-test ] unit-test
@ -24,3 +26,4 @@ USING: tools.test logging logging.analysis io math ;
] with-logging ] with-logging
[ ] [ "logging-test" { "input-logging-test" } analyze-log-file ] unit-test [ ] [ "logging-test" { "input-logging-test" } analyze-log-file ] unit-test
] with-log-root

View File

@ -3,12 +3,12 @@
USING: assocs calendar calendar.format combinators USING: assocs calendar calendar.format combinators
concurrency.messaging continuations debugger destructors init io concurrency.messaging continuations debugger destructors init io
io.directories io.encodings.utf8 io.files io.pathnames kernel io.directories io.encodings.utf8 io.files io.pathnames kernel
literals math math.parser math.ranges namespaces sequences locals math math.parser math.ranges namespaces sequences
strings threads ; strings threads ;
IN: logging.server IN: logging.server
: log-root ( -- string ) : log-root ( -- string )
\ log-root get [ "logs" resource-path ] unless* ; \ log-root get-global [ "logs" resource-path ] unless* ;
: log-path ( service -- path ) : log-path ( service -- path )
log-root prepend-path ; log-root prepend-path ;
@ -26,10 +26,19 @@ SYMBOL: log-files
: log-stream ( service -- stream ) : log-stream ( service -- stream )
log-files get [ open-log-stream ] cache ; log-files get [ open-log-stream ] cache ;
: close-log-streams ( -- )
log-files get [ values dispose-each ] [ clear-assoc ] bi ;
:: with-log-root ( path quot -- )
[ close-log-streams path \ log-root set-global quot call ]
\ log-root get-global
[ \ log-root set-global close-log-streams ] curry
[ ] cleanup ; inline
: timestamp-header. ( -- ) : timestamp-header. ( -- )
"[" write now (timestamp>rfc3339) "] " write ; "[" write now (timestamp>rfc3339) "] " write ;
CONSTANT: multiline-header $[ 20 CHAR: - <string> ] : multiline-header ( -- str ) 20 CHAR: - <string> ; foldable
: multiline-header. ( -- ) : multiline-header. ( -- )
"[" write multiline-header write "] " write ; "[" write multiline-header write "] " write ;