steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
basis/logging/logging-tests.factor
View File

@ -1,5 +1,6 @@
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 ) + ;
@ -13,14 +14,16 @@ USING: tools.test logging logging.analysis io math ;
\ error-logging-test ERROR add-error-logging
"logging-test" [
[ 4 ] [ 1 3 input-logging-test ] unit-test
[ 4 ] [ 1 3 output-logging-test ] unit-test
[ 4/3 ] [ 4 3 error-logging-test ] unit-test
[ f ] [ 1 0 error-logging-test ] unit-test
] with-logging
temp-directory [
"logging-test" [
[ 4 ] [ 1 3 input-logging-test ] unit-test
[ ] [ "logging-test" { "input-logging-test" } analyze-log-file ] unit-test
[ 4 ] [ 1 3 output-logging-test ] unit-test
[ 4/3 ] [ 4 3 error-logging-test ] unit-test
[ f ] [ 1 0 error-logging-test ] unit-test
] with-logging
[ ] [ "logging-test" { "input-logging-test" } analyze-log-file ] unit-test
] with-log-root

15
basis/logging/server/server.factor
View File

@ -3,12 +3,12 @@
USING: assocs calendar calendar.format combinators
concurrency.messaging continuations debugger destructors init io
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 ;
IN: logging.server
: log-root ( -- string )
\ log-root get [ "logs" resource-path ] unless* ;
\ log-root get-global [ "logs" resource-path ] unless* ;
: log-path ( service -- path )
log-root prepend-path ;
@ -26,10 +26,19 @@ SYMBOL: log-files
: log-stream ( service -- stream )
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. ( -- )
"[" write now (timestamp>rfc3339) "] " write ;
CONSTANT: multiline-header $[ 20 CHAR: - <string> ]
: multiline-header ( -- str ) 20 CHAR: - <string> ; foldable
: multiline-header. ( -- )
"[" write multiline-header write "] " write ;