]> gitweb.factorcode.org Git - factor.git/commitdiff
logging.server: add support for changing the logging root temporarily.
authorJohn Benediktsson <mrjbq7@gmail.com>
Wed, 12 Mar 2014 19:41:57 +0000 (12:41 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Wed, 12 Mar 2014 19:41:57 +0000 (12:41 -0700)
basis/logging/logging-tests.factor
basis/logging/server/server.factor

index a7cc6c6f5f6d2e2c107ccca3c84e9f5a52b0eb89..a2e67bfd627dc2b71b3bc779e220e33e59525798 100644 (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
-
-[ ] [ "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
index 440e192107b527c6d00ed78a6ca33a1da9317dab..28fbe22e7b15fc88cfc320c206c3e84af93c9ede 100644 (file)
@@ -3,12 +3,12 @@
 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
@@ -26,10 +26,19 @@ SYMBOL: log-files
 : 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