logging.analysis: fix it up and make it work

basis/logging/analysis/analysis.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences namespaces words assocs logging sorting
 prettyprint io io.styles io.files io.encodings.utf8
-strings combinators accessors arrays
+strings combinators accessors arrays math
 logging.server logging.parser calendar.format ;
 IN: logging.analysis
 
@@ -20,6 +20,9 @@ SYMBOL: message-histogram
     ] when
     drop ;
 
+: recent-histogram ( assoc n -- alist )
+    [ >alist sort-values <reversed> ] dip short head ;
+
 : analyze-entries ( entries word-names -- errors word-histogram message-histogram )
     [
         word-names set
@@ -27,44 +30,40 @@ SYMBOL: message-histogram
         H{ } clone word-histogram set
         H{ } clone message-histogram set
 
-        [
-            analyze-entry
-        ] each
+        [ analyze-entry ] each
 
         errors get
-        word-histogram get
-        message-histogram get
+        word-histogram get 10 recent-histogram
+        message-histogram get 10 recent-histogram
     ] with-scope ;
 
 : histogram. ( assoc quot -- )
     standard-table-style [
-        [ >alist sort-values <reversed> ] dip [
+        [
             [ swapd with-cell pprint-cell ] with-row
         ] curry assoc-each
     ] tabular-output ; inline
 
-: log-entry. ( entry -- )
-    "====== " write
-    {
-        [ date>> (timestamp>string) bl ]
-        [ level>> pprint bl ]
-        [ word-name>> write nl ]
-        [ message>> "\n" join print ]
-    } cleave ;
+: 10-most-recent ( errors -- errors )
+    10 tail* "Only showing 10 most recent errors" print nl ;
 
 : errors. ( errors -- )
-    [ log-entry. ] each ;
+    dup length 10 >= [ 10-most-recent ] when
+    log-entries. ;
 
 : analysis. ( errors word-histogram message-histogram -- )
-    "==== INTERESTING MESSAGES:" print nl
+    nl "==== FREQUENT MESSAGES:" print nl
     "Total: " write dup values sum . nl
     [
-        dup level>> write ": " write message>> "\n" join write
+        [ first name>> write bl ]
+        [ second write ": " write ]
+        [ third "\n" join write ]
+        tri
     ] histogram.
-    nl
-    "==== WORDS:" print nl
+    nl nl
+    "==== FREQUENT WORDS:" print nl
     [ write ] histogram.
-    nl
+    nl nl
     "==== ERRORS:" print nl
     errors. ;
 

basis/logging/insomniac/insomniac.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: logging.analysis logging.server logging smtp kernel
 io.files io.streams.string namespaces make timers assocs
@@ -14,7 +14,7 @@ SYMBOL: insomniac-recipients
 
 : email-subject ( service -- string )
     [
-        "[INSOMNIAC] " % % " on " % io.sockets:host-name %
+        "Log analysis for " % % " on " % io.sockets:host-name %
     ] "" make ;
 
 : (email-log-report) ( service word-names -- )
@@ -33,5 +33,5 @@ SYMBOL: insomniac-recipients
     "logging.insomniac" [ (email-log-report) ] with-logging ;
 
 : schedule-insomniac ( service word-names -- )
-    [ [ email-log-report ] assoc-each rotate-logs ] 2curry
-    1 days delayed-every drop ;
+    [ email-log-report rotate-logs ] 2curry
+    1 days every drop ;

basis/logging/logging-tests.factor

@@ -1,5 +1,5 @@
 IN: logging.tests
-USING: tools.test logging math ;
+USING: tools.test logging logging.analysis io math ;
 
 : input-logging-test ( a b -- c ) + ;
 
@@ -22,3 +22,5 @@ USING: tools.test logging math ;
     
     [ f ] [ 1 0 error-logging-test ] unit-test
 ] with-logging
+
+[ ] [ "logging-test" { "input-logging-test" } analyze-log-file ] unit-test

basis/logging/parser/parser.factor

@@ -1,9 +1,9 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 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 assocs ;
+calendar calendar.format assocs prettyprint ;
 IN: logging.parser
 
 TUPLE: log-entry date level word-name message ;
@@ -83,3 +83,20 @@ PEG: parse-log-line ( string -- entry ) 'log-line' ;
 : parse-log-file ( service -- entries )
     log-path 1 log# dup exists?
     [ utf8 file-lines parse-log ] [ drop f ] if ;
+
+GENERIC: log-timestamp. ( date -- )
+
+M: timestamp log-timestamp. (timestamp>string) ;
+M: word log-timestamp. drop "multiline" write ;
+
+: log-entry. ( entry -- )
+    "====== " write
+    {
+        [ date>> log-timestamp. bl ]
+        [ level>> pprint bl ]
+        [ word-name>> write nl ]
+        [ message>> "\n" join print ]
+    } cleave ;
+
+: log-entries. ( errors -- )
+    [ log-entry. ] each ;