basis/logging/analysis/analysis.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel sequences namespaces words assocs logging sorting
   4 prettyprint io io.styles io.files io.encodings.utf8
   5 strings combinators accessors arrays math
   6 logging.server logging.parser calendar.format ;
   7 IN: logging.analysis
   8
   9 SYMBOL: word-names
  10 SYMBOL: errors
  11 SYMBOL: word-histogram
  12 SYMBOL: message-histogram
  13
  14 : analyze-entry ( entry -- )
  15     dup level>> { ERROR CRITICAL } member-eq? [ dup errors get push ] when
  16     dup word-name>> word-histogram get inc-at
  17     dup word-name>> word-names get member? [
  18         dup [ level>> ] [ word-name>> ] [ message>> ] tri 3array
  19         message-histogram get inc-at
  20     ] when
  21     drop ;
  22
  23 : recent-histogram ( assoc n -- alist )
  24     [ sort-values <reversed> ] dip short head ;
  25
  26 : analyze-entries ( entries word-names -- errors word-histogram message-histogram )
  27     [
  28         word-names set
  29         V{ } clone errors set
  30         H{ } clone word-histogram set
  31         H{ } clone message-histogram set
  32
  33         [ analyze-entry ] each
  34
  35         errors get
  36         word-histogram get 10 recent-histogram
  37         message-histogram get 10 recent-histogram
  38     ] with-scope ;
  39
  40 : histogram. ( assoc quot -- )
  41     standard-table-style [
  42         [
  43             [ swapd with-cell pprint-cell ] with-row
  44         ] curry assoc-each
  45     ] tabular-output ; inline
  46
  47 : 10-most-recent ( errors -- errors )
  48     10 tail* "Only showing 10 most recent errors" print nl ;
  49
  50 : errors. ( errors -- )
  51     dup length 10 >= [ 10-most-recent ] when
  52     log-entries. ;
  53
  54 : analysis. ( errors word-histogram message-histogram -- )
  55     nl "==== FREQUENT MESSAGES:" print nl
  56     "Total: " write dup values sum . nl
  57     [
  58         [ first name>> write bl ]
  59         [ second write ": " write ]
  60         [ third "\n" join write ]
  61         tri
  62     ] histogram.
  63     nl nl
  64     "==== FREQUENT WORDS:" print nl
  65     [ write ] histogram.
  66     nl nl
  67     "==== ERRORS:" print nl
  68     errors. ;
  69
  70 : analyze-log ( lines word-names -- )
  71     [ parse-log ] dip analyze-entries analysis. ;
  72
  73 : analyze-log-file ( service word-names -- )
  74     [ parse-log-file ] dip analyze-entries analysis. ;