+++ /dev/null
-(*
- * Copyright (C) 2003:
- * Stefano Zacchiroli <zack@cs.unibo.it>
- * for the HELM Team http://helm.cs.unibo.it/
- *
- * This file is part of HELM, an Hypertextual, Electronic
- * Library of Mathematics, developed at the Computer Science
- * Department, University of Bologna, Italy.
- *
- * HELM is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * HELM is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with HELM; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- * MA 02111-1307, USA.
- *
- * For details, see the HELM World-Wide-Web page,
- * http://helm.cs.unibo.it/
- *)
-
-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) ?(outchan = stderr) () =
- object (self)
- val level_no = int_of_priority level
- val mutable enabled = false
- method level = level
- method levelNo = level_no
- method enable = enabled <- true
- method disable = enabled <- false
- method log (prio: priority) msg =
- let tm = Unix.localtime (Unix.time ()) in
- if enabled && (int_of_priority prio <= level_no) then begin
- fprintf outchan ("[UWOBO %02d/%02d/%4d %02d:%02d:%02d] %s: %s\n")
- tm.Unix.tm_mday (tm.Unix.tm_mon + 1) (tm.Unix.tm_year + 1900)
- tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
- (string_of_priority prio) msg;
- flush outchan
- end
- end
-
-type lineType =
- | Line of string (** normal line *)
- | LineBold of string (** bold line *)
- | LineEmph of string (** emph line *)
-;;
-
- (** non thread safe, a processingLogger is usually instantied locally for each
- thread *)
-class processingLogger =
- let html_escape = Netencoding.Html.encode ~in_enc:`Enc_iso88591 () in
- let html_of_line = function
- | Line l -> html_escape l
- | LineBold l -> "<b>" ^ html_escape l ^ "</b>"
- | LineEmph l -> "<em>" ^ html_escape l ^ "</em>"
- in
- let text_of_line = function
- | Line l -> l
- | LineBold l -> l
- | LineEmph l -> l
- in
- fun () ->
- object
- val mutable log_lines = []
- method log msg = log_lines <- Line msg :: log_lines
- method logBold msg = log_lines <- LineBold msg :: log_lines
- method logEmph msg = log_lines <- LineEmph msg :: log_lines
- method asText =
- String.concat "\n" (List.rev (List.map text_of_line log_lines))
- method asHtml =
- sprintf
- "<html><body>\n%s\n</body></html>"
- (String.concat "<br />\n" (List.map html_of_line (List.rev log_lines)))
- end
-
projects / helm.git / blobdiff