basis/logging/analysis/analysis.factor

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