diff --git a/extra/logging/analysis/analysis.factor b/extra/logging/analysis/analysis.factor index a074ccd1b9..8f7f79d81e 100755 --- a/extra/logging/analysis/analysis.factor +++ b/extra/logging/analysis/analysis.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences namespaces words assocs logging sorting -prettyprint io io.styles strings logging.parser calendar.format -combinators ; +prettyprint io io.styles io.files io.encodings.utf8 +strings combinators +logging.server logging.parser calendar.format ; IN: logging.analysis SYMBOL: word-names @@ -69,3 +70,6 @@ SYMBOL: message-histogram : analyze-log ( lines word-names -- ) >r parse-log r> analyze-entries analysis. ; + +: analyze-log-file ( service word-names -- ) + >r parse-log-file r> analyze-entries analysis. ; diff --git a/extra/logging/insomniac/insomniac.factor b/extra/logging/insomniac/insomniac.factor index c7d1faf42e..7810a4afad 100755 --- a/extra/logging/insomniac/insomniac.factor +++ b/extra/logging/insomniac/insomniac.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: logging.analysis logging.server logging smtp kernel io.files io.streams.string namespaces alarms assocs -io.encodings.utf8 accessors calendar qualified ; +io.encodings.utf8 accessors calendar sequences qualified ; QUALIFIED: io.sockets IN: logging.insomniac @@ -10,11 +10,7 @@ SYMBOL: insomniac-sender SYMBOL: insomniac-recipients : ?analyze-log ( service word-names -- string/f ) - >r log-path 1 log# dup exists? [ - utf8 file-lines r> [ analyze-log ] with-string-writer - ] [ - r> 2drop f - ] if ; + [ analyze-log-file ] with-string-writer ; : email-subject ( service -- string ) [ @@ -22,14 +18,14 @@ SYMBOL: insomniac-recipients ] "" make ; : (email-log-report) ( service word-names -- ) - dupd ?analyze-log dup [ + dupd ?analyze-log dup empty? [ 2drop ] [ swap >>body insomniac-recipients get >>to insomniac-sender get >>from swap email-subject >>subject send-email - ] [ 2drop ] if ; + ] if ; \ (email-log-report) NOTICE add-error-logging diff --git a/extra/logging/parser/parser.factor b/extra/logging/parser/parser.factor index 7215f29865..9c9161a15d 100755 --- a/extra/logging/parser/parser.factor +++ b/extra/logging/parser/parser.factor @@ -1,12 +1,15 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors parser-combinators memoize kernel sequences -logging arrays words strings vectors io io.files +USING: accessors peg peg.parsers memoize kernel sequences +logging arrays words strings vectors io io.files io.encodings.utf8 namespaces combinators combinators.lib logging.server calendar calendar.format ; IN: logging.parser -: string-of ( quot -- parser ) satisfy [ >string ] <@ ; +TUPLE: log-entry date level word-name message ; + +: string-of ( quot -- parser ) + satisfy repeat0 [ >string ] action ; inline SYMBOL: multiline @@ -14,13 +17,13 @@ SYMBOL: multiline [ "]" member? not ] string-of [ dup multiline-header = [ drop multiline ] [ rfc3339>timestamp ] if - ] <@ + ] action "[" "]" surrounded-by ; : 'log-level' ( -- parser ) log-levels [ - [ name>> token ] keep [ nip ] curry <@ - ] map ; + [ name>> token ] keep [ nip ] curry action + ] map choice ; : 'word-name' ( -- parser ) [ " :" member? not ] string-of ; @@ -28,36 +31,42 @@ SYMBOL: multiline SYMBOL: malformed : 'malformed-line' ( -- parser ) - [ drop t ] string-of [ malformed swap 2array ] <@ ; + [ drop t ] string-of + [ log-entry new swap >>message malformed >>level ] action ; : 'log-message' ( -- parser ) - [ drop t ] string-of [ 1vector ] <@ ; + [ drop t ] string-of + [ 1vector ] action ; -MEMO: 'log-line' ( -- parser ) - 'date' " " token <& - 'log-level' " " token <& <&> - 'word-name' ": " token <& <:&> - 'log-message' <:&> - 'malformed-line' <|> ; +: 'log-line' ( -- parser ) + [ + 'date' , + " " token hide , + 'log-level' , + " " token hide , + 'word-name' , + ": " token hide , + 'log-message' , + ] seq* [ first4 log-entry boa ] action + 'malformed-line' 2choice ; -: parse-log-line ( string -- entry ) - 'log-line' parse-1 ; +PEG: parse-log-line ( string -- entry ) 'log-line' ; : malformed? ( line -- ? ) - first malformed eq? ; + level>> malformed eq? ; : multiline? ( line -- ? ) - first multiline eq? ; + level>> multiline eq? ; : malformed-line ( line -- ) "Warning: malformed log line:" print - second print ; + message>> print ; : add-multiline ( line -- ) building get empty? [ "Warning: log begins with multiline entry" print drop ] [ - fourth first building get peek fourth push + message>> first building get peek message>> push ] if ; : parse-log ( lines -- entries ) @@ -70,3 +79,7 @@ MEMO: 'log-line' ( -- parser ) } cond ] each ] { } make ; + +: parse-log-file ( service -- entries ) + log-path 1 log# dup exists? + [ utf8 file-lines parse-log ] [ drop f ] if ;