uwobo ocaml daily snapshot: Tue, 26 Nov 2002 14:26:36 +0100

[helm.git] / helm / uwobo / src / ocaml / uwobo_logger.ml
diff --git a/helm/uwobo/src/ocaml/uwobo_logger.ml b/helm/uwobo/src/ocaml/uwobo_logger.ml

new file mode 100644 (file)

index 0000000..c0e73b9
--- /dev/null
+++ b/helm/uwobo/src/ocaml/uwobo_logger.ml
@@ -0,0 +1,57 @@
+
+open Printf;;
+
+type priority = [ 
+  `Emerg | `Alert | `Crit | `Err | `Warning | `Notice | `Info | `Debug
+]
+
+let int_of_priority = function
+  | `Emerg    -> 0
+  | `Alert    -> 1
+  | `Crit     -> 2
+  | `Err      -> 3
+  | `Warning  -> 4
+  | `Notice   -> 5
+  | `Info     -> 6
+  | `Debug    -> 7
+
+let string_of_priority = function
+  | `Emerg    -> "EMERGENCY"
+  | `Alert    -> "ALERT"
+  | `Crit     -> "CRITICAL"
+  | `Err      -> "ERROR"
+  | `Warning  -> "WARNING"
+  | `Notice   -> "NOTICE"
+  | `Info     -> "INFO"
+  | `Debug    -> "DEBUG"
+
+class sysLogger ?(level: priority = `Notice) () =
+  object
+    val level_no = int_of_priority level
+    val mutable enabled = false
+    method enable = enabled <- true
+    method disable = enabled <- false
+    method log (prio: priority) msg =
+      if enabled && (int_of_priority prio < level_no) then
+        prerr_endline (sprintf ("%s: %s") (string_of_priority prio) msg)
+  end
+
+class processingLogger =
+  let html_escape s = (* TODO too naive, use Nethtml.encode instead *)
+    Pcre.replace ~pat:"<" ~templ:"&lt;"
+      (Pcre.replace ~pat:">" ~templ:"&gt;"
+        (Pcre.replace ~pat:"&" ~templ:"&amp;" s))
+  in
+  fun () ->
+  object
+    val mutable log_lines: string list = []
+    method log msg = log_lines <- msg :: log_lines
+    method asText = String.concat "\n" (List.rev log_lines)
+    method asHtml =
+      sprintf
+        "<html><body>\n%s\n</body></html>"
+        (String.concat
+          "<br />\n"
+          (List.map html_escape (List.rev log_lines)))
+  end
+