helm/uwobo/src/ocaml/uwobo_logger.ml

   1
   2 open Printf;;
   3
   4 type priority = [
   5   `Emerg | `Alert | `Crit | `Err | `Warning | `Notice | `Info | `Debug
   6 ]
   7
   8 let int_of_priority = function
   9   | `Emerg    -> 0
  10   | `Alert    -> 1
  11   | `Crit     -> 2
  12   | `Err      -> 3
  13   | `Warning  -> 4
  14   | `Notice   -> 5
  15   | `Info     -> 6
  16   | `Debug    -> 7
  17
  18 let string_of_priority = function
  19   | `Emerg    -> "EMERGENCY"
  20   | `Alert    -> "ALERT"
  21   | `Crit     -> "CRITICAL"
  22   | `Err      -> "ERROR"
  23   | `Warning  -> "WARNING"
  24   | `Notice   -> "NOTICE"
  25   | `Info     -> "INFO"
  26   | `Debug    -> "DEBUG"
  27
  28 class sysLogger ?(level: priority = `Notice) () =
  29   object
  30     initializer
  31       print_endline (sprintf "Logger started with level %s" (string_of_priority level))
  32     val level_no = int_of_priority level
  33     val mutable enabled = false
  34     method enable = enabled <- true
  35     method disable = enabled <- false
  36     method log (prio: priority) msg =
  37       if enabled && (int_of_priority prio <= level_no) then
  38         prerr_endline (sprintf ("%s: %s") (string_of_priority prio) msg)
  39   end
  40
  41 class processingLogger =
  42   let html_escape s = (* TODO too naive, use Nethtml.encode instead *)
  43     Pcre.replace ~pat:"<" ~templ:"&lt;"
  44       (Pcre.replace ~pat:">" ~templ:"&gt;"
  45         (Pcre.replace ~pat:"&" ~templ:"&amp;" s))
  46   in
  47   fun () ->
  48   object
  49     val mutable log_lines: string list = []
  50     method log msg = log_lines <- msg :: log_lines
  51     method asText = String.concat "\n" (List.rev log_lines)
  52     method asHtml =
  53       sprintf
  54         "<html><body>\n%s\n</body></html>"
  55         (String.concat
  56           "<br />\n"
  57           (List.map html_escape (List.rev log_lines)))
  58   end
  59