! Copyright (C) 2008 Slava Pestov.\r
! See http://factorcode.org/license.txt for BSD license.\r
-USING: namespaces kernel io calendar sequences io.files\r
-io.sockets continuations destructors prettyprint assocs\r
-math.parser words debugger math combinators\r
-concurrency.messaging threads arrays init math.ranges strings\r
-calendar.format io.encodings.utf8 ;\r
+USING: namespaces kernel io io.files io.pathnames io.directories\r
+io.encodings.utf8 calendar calendar.format sequences continuations\r
+destructors prettyprint assocs math.parser words debugger math\r
+combinators concurrency.messaging threads arrays init math.ranges\r
+strings ;\r
IN: logging.server\r
\r
: log-root ( -- string )\r
: log-stream ( service -- stream )\r
log-files get [ open-log-stream ] cache ;\r
\r
-: multiline-header 20 CHAR: - <string> ; foldable\r
+: multiline-header ( -- string ) 20 CHAR: - <string> ; foldable\r
\r
-: (write-message) ( msg name>> level multi? -- )\r
+: (write-message) ( msg word-name level multi? -- )\r
[\r
"[" write multiline-header write "] " write\r
] [\r
] if\r
write bl write ": " write print ;\r
\r
-: write-message ( msg name>> level -- )\r
- rot harvest {\r
- { [ dup empty? ] [ 3drop ] }\r
- { [ dup length 1 = ] [ first -rot f (write-message) ] }\r
+: write-message ( msg word-name level -- )\r
+ [ harvest ] 2dip {\r
+ { [ pick empty? ] [ 3drop ] }\r
+ { [ pick length 1 = ] [ [ first ] 2dip f (write-message) ] }\r
[\r
- [ first -rot f (write-message) ] 3keep\r
- rest -rot [ t (write-message) ] 2curry each\r
+ [ [ first ] 2dip f (write-message) ]\r
+ [ [ rest ] 2dip [ t (write-message) ] 2curry each ]\r
+ 3bi\r
]\r
} cond ;\r
\r
: (log-message) ( msg -- )\r
- #! msg: { msg name>> level service }\r
+ #! msg: { msg word-name level service }\r
first4 log-stream [ write-message flush ] with-output-stream* ;\r
\r
: try-dispose ( stream -- )\r
dup values [ try-dispose ] each\r
clear-assoc ;\r
\r
-: keep-logs 10 ;\r
+CONSTANT: keep-logs 10\r
\r
: ?delete-file ( path -- )\r
dup exists? [ delete-file ] [ drop ] if ;\r
over exists? [ move-file ] [ 2drop ] if ;\r
\r
: advance-log ( path n -- )\r
- [ 1- log# ] 2keep log# ?move-file ;\r
+ [ 1 - log# ] 2keep log# ?move-file ;\r
\r
: rotate-log ( service -- )\r
dup close-log\r
\r
: (rotate-logs) ( -- )\r
(close-logs)\r
- log-root directory [ drop rotate-log ] assoc-each ;\r
+ log-root directory-files [ rotate-log ] each ;\r
\r
: log-server-loop ( -- )\r
receive unclip {\r