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 ) + ;
\ 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
-
-[ ] [ "logging-test" { "input-logging-test" } analyze-log-file ] unit-test
+temp-directory [
+ "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
+
+ [ ] [ "logging-test" { "input-logging-test" } analyze-log-file ] unit-test
+] with-log-root
USING: assocs calendar calendar.format combinators\r
concurrency.messaging continuations debugger destructors init io\r
io.directories io.encodings.utf8 io.files io.pathnames kernel\r
-literals math math.parser math.ranges namespaces sequences\r
+locals math math.parser math.ranges namespaces sequences\r
strings threads ;\r
IN: logging.server\r
\r
: log-root ( -- string )\r
- \ log-root get [ "logs" resource-path ] unless* ;\r
+ \ log-root get-global [ "logs" resource-path ] unless* ;\r
\r
: log-path ( service -- path )\r
log-root prepend-path ;\r
: log-stream ( service -- stream )\r
log-files get [ open-log-stream ] cache ;\r
\r
+: close-log-streams ( -- )\r
+ log-files get [ values dispose-each ] [ clear-assoc ] bi ;\r
+\r
+:: with-log-root ( path quot -- )\r
+ [ close-log-streams path \ log-root set-global quot call ]\r
+ \ log-root get-global\r
+ [ \ log-root set-global close-log-streams ] curry\r
+ [ ] cleanup ; inline\r
+\r
: timestamp-header. ( -- )\r
"[" write now (timestamp>rfc3339) "] " write ;\r
\r
-CONSTANT: multiline-header $[ 20 CHAR: - <string> ]\r
+: multiline-header ( -- str ) 20 CHAR: - <string> ; foldable\r
\r
: multiline-header. ( -- )\r
"[" write multiline-header write "] " write ;\r