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

logging.server fixes

db4
Slava Pestov 2008-02-10 01:39:37 -06:00
parent b120abcee2
commit 619d676af6
3 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/logging/insomniac/insomniac.factor
View File

@ -42,7 +42,7 @@ SYMBOL: insomniac-recipients
: email-log-report ( service word-names -- ) : email-log-report ( service word-names -- )
"logging.insomniac" [ (email-log-report) ] with-logging ; "logging.insomniac" [ (email-log-report) ] with-logging ;
: schedule-insomniac ( alist -- ) : schedule-insomniac ( service word-names -- )
{ 25 } { 6 } f f f <when> -rot [ { 25 } { 6 } f f f <when> -rot [
[ email-log-report ] assoc-each rotate-logs [ email-log-report ] assoc-each rotate-logs
] 2curry schedule ; ] 2curry schedule ;

10
extra/logging/logging.factor
View File

@ -4,7 +4,7 @@ USING: logging.server sequences namespaces concurrency
words kernel arrays shuffle tools.annotations words kernel arrays shuffle tools.annotations
prettyprint.config prettyprint debugger io.streams.string prettyprint.config prettyprint debugger io.streams.string
splitting continuations effects arrays.lib parser strings splitting continuations effects arrays.lib parser strings
combinators.lib ; combinators.lib quotations ;
IN: logging IN: logging
SYMBOL: DEBUG SYMBOL: DEBUG
@ -112,9 +112,13 @@ PRIVATE>
: log-critical ( error word -- ) CRITICAL (log-error) ; : log-critical ( error word -- ) CRITICAL (log-error) ;
: stack-balancer ( effect word -- quot )
>r dup effect-in length r> [ over >r ERROR log-stack r> ndrop ] 2curry
swap effect-out length f <repetition> append >quotation ;
: error-logging-quot ( quot word -- quot' ) : error-logging-quot ( quot word -- quot' )
dup stack-effect effect-in length [ [ log-error ] curry ] keep
[ >r log-error r> ndrop ] 2curry [ stack-effect ] keep stack-balancer compose
[ recover ] 2curry ; [ recover ] 2curry ;
: add-error-logging ( word level -- ) : add-error-logging ( word level -- )

2
extra/logging/server/server.factor
View File

@ -84,7 +84,7 @@ SYMBOL: log-files
(close-logs) (close-logs)
log-root directory [ drop rotate-log ] assoc-each ; log-root directory [ drop rotate-log ] assoc-each ;
: log-server-loop : log-server-loop ( -- )
[ [
receive unclip { receive unclip {
{ "log-message" [ (log-message) ] } { "log-message" [ (log-message) ] }