(* * Copyright (C) 2003: * Stefano Zacchiroli * 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 (** 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 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 "\n%s\n" (String.concat "
\n" (List.map html_escape (List.rev log_lines))) end