86 lines
		
	
	
		
			2.2 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			86 lines
		
	
	
		
			2.2 KiB
		
	
	
	
		
			Factor
		
	
	
| ! Copyright (C) 2008 Slava Pestov.
 | |
| ! See http://factorcode.org/license.txt for BSD license.
 | |
| USING: accessors peg peg.parsers memoize kernel sequences
 | |
| logging arrays words strings vectors io io.files
 | |
| io.encodings.utf8 namespaces make combinators logging.server
 | |
| calendar calendar.format ;
 | |
| IN: logging.parser
 | |
| 
 | |
| TUPLE: log-entry date level word-name message ;
 | |
| 
 | |
| : string-of ( quot -- parser )
 | |
|     satisfy repeat0 [ >string ] action ; inline
 | |
| 
 | |
| SYMBOL: multiline
 | |
| 
 | |
| : 'date' ( -- parser )
 | |
|     [ "]" 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 action
 | |
|     ] map choice ;
 | |
| 
 | |
| : 'word-name' ( -- parser )
 | |
|     [ " :" member? not ] string-of ;
 | |
| 
 | |
| SYMBOL: malformed
 | |
| 
 | |
| : 'malformed-line' ( -- parser )
 | |
|     [ drop t ] string-of
 | |
|     [ log-entry new swap >>message malformed >>level ] action ;
 | |
| 
 | |
| : 'log-message' ( -- parser )
 | |
|     [ drop t ] string-of
 | |
|     [ 1vector ] action ;
 | |
| 
 | |
| : '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 ;
 | |
| 
 | |
| PEG: parse-log-line ( string -- entry ) 'log-line' ;
 | |
| 
 | |
| : malformed? ( line -- ? )
 | |
|     level>> malformed eq? ;
 | |
| 
 | |
| : multiline? ( line -- ? )
 | |
|     level>> multiline eq? ;
 | |
| 
 | |
| : malformed-line ( line -- )
 | |
|     "Warning: malformed log line:" print
 | |
|     message>> print ;
 | |
| 
 | |
| : add-multiline ( line -- )
 | |
|     building get empty? [
 | |
|         "Warning: log begins with multiline entry" print drop
 | |
|     ] [
 | |
|         message>> first building get peek message>> push
 | |
|     ] if ;
 | |
| 
 | |
| : parse-log ( lines -- entries )
 | |
|     [
 | |
|         [
 | |
|             parse-log-line {
 | |
|                 { [ dup malformed? ] [ malformed-line ] }
 | |
|                 { [ dup multiline? ] [ add-multiline ] }
 | |
|                 [ , ]
 | |
|             } cond
 | |
|         ] each
 | |
|     ] { } make ;
 | |
| 
 | |
| : parse-log-file ( service -- entries )
 | |
|     log-path 1 log# dup exists?
 | |
|     [ utf8 file-lines parse-log ] [ drop f ] if ;
 |