basis/logging/analysis/analysis.factor

   1 ! Copyright (C) 2008 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\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 } memq? [ dup errors get push ] when\r
  16     1 over word-name>> word-histogram get at+\r
  17     dup word-name>> word-names get member? [\r
  18         1 over [ level>> ] [ word-name>> ] [ message>> ] tri 3array\r
  19         message-histogram get at+\r
  20     ] when\r
  21     drop ;\r
  22 \r
  23 : analyze-entries ( entries word-names -- errors word-histogram message-histogram )\r
  24     [\r
  25         word-names set\r
  26         V{ } clone errors set\r
  27         H{ } clone word-histogram set\r
  28         H{ } clone message-histogram set\r
  29 \r
  30         [\r
  31             analyze-entry\r
  32         ] each\r
  33 \r
  34         errors get\r
  35         word-histogram get\r
  36         message-histogram get\r
  37     ] with-scope ;\r
  38 \r
  39 : histogram. ( assoc quot -- )\r
  40     standard-table-style [\r
  41         >r >alist sort-values <reversed> r> [\r
  42             [ >r swap r> with-cell pprint-cell ] with-row\r
  43         ] curry assoc-each\r
  44     ] tabular-output ;\r
  45 \r
  46 : log-entry. ( entry -- )\r
  47     "====== " write\r
  48     {\r
  49         [ date>> (timestamp>string) bl ]\r
  50         [ level>> pprint bl ]\r
  51         [ word-name>> write nl ]\r
  52         [ message>> "\n" join print ]\r
  53     } cleave ;\r
  54 \r
  55 : errors. ( errors -- )\r
  56     [ log-entry. ] each ;\r
  57 \r
  58 : analysis. ( errors word-histogram message-histogram -- )\r
  59     "==== INTERESTING MESSAGES:" print nl\r
  60     "Total: " write dup values sum . nl\r
  61     [\r
  62         dup level>> write ": " write message>> "\n" join write\r
  63     ] histogram.\r
  64     nl\r
  65     "==== WORDS:" print nl\r
  66     [ write ] histogram.\r
  67     nl\r
  68     "==== ERRORS:" print nl\r
  69     errors. ;\r
  70 \r
  71 : analyze-log ( lines word-names -- )\r
  72     >r parse-log r> analyze-entries analysis. ;\r
  73 \r
  74 : analyze-log-file ( service word-names -- )\r
  75     >r parse-log-file r> analyze-entries analysis. ;\r