1 ! Copyright (C) 2008, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs calendar calendar.format calendar.parser
4 combinators io io.encodings.utf8 io.files kernel logging
5 logging.server make namespaces peg peg.parsers prettyprint sequences
6 strings vectors words ;
9 TUPLE: log-entry date level word-name message ;
11 : string-of ( quot -- parser )
12 satisfy repeat0 [ >string ] action ; inline
16 : date-parser ( -- parser )
17 [ "]" member? not ] string-of [
18 dup multiline-header =
19 [ drop multiline ] [ rfc3339>timestamp ] if
21 "[" "]" surrounded-by ;
23 : log-level-parser ( -- parser )
25 [ name>> token ] keep [ nip ] curry action
28 : word-name-parser ( -- parser )
29 [ " :" member? not ] string-of ;
33 : malformed-line-parser ( -- parser )
35 [ log-entry new swap >>message malformed >>level ] action ;
37 : log-message-parser ( -- parser )
41 : log-line-parser ( -- parser )
50 ] seq* [ first4 log-entry boa ] action
51 malformed-line-parser 2choice ;
53 PEG: parse-log-line ( string -- entry ) log-line-parser ;
55 : malformed? ( line -- ? )
56 level>> malformed eq? ;
58 : multiline? ( line -- ? )
59 level>> multiline eq? ;
61 : malformed-line ( line -- )
62 "Warning: malformed log line:" print
65 : add-multiline ( line -- )
67 "Warning: log begins with multiline entry" print drop
69 message>> first building get last message>> push
72 : parse-log ( lines -- entries )
76 { [ dup malformed? ] [ malformed-line ] }
77 { [ dup multiline? ] [ add-multiline ] }
83 : parse-log-file ( service -- entries )
84 log-path 1 log# dup exists?
85 [ utf8 file-lines parse-log ] [ drop f ] if ;
87 GENERIC: log-timestamp. ( date -- )
89 M: timestamp log-timestamp. write-timestamp ;
90 M: word log-timestamp. drop "multiline" write ;
92 : log-entry. ( entry -- )
95 [ date>> log-timestamp. bl ]
97 [ word-name>> write nl ]
98 [ message>> "\n" join print ]
101 : log-entries. ( errors -- )
102 [ log-entry. ] each ;