src/logger.ml

   1 (* Functions for logging. *)
   2
   3 (* Uses Printf and Unix. *)
   4
   5 open Printf
   6
   7 (* Loglevels. *)
   8 let loglevel_fatal = 100
   9 let loglevel_error = 200
  10 let loglevel_warning = 300
  11 let loglevel_notice = 400
  12 let loglevel_debug = 500
  13
  14 (** Channel to log to. Default is stderr. *)
  15 let log_channel = ref stderr
  16
  17 (** Loglevel threshold. *)
  18 let loglevel = ref loglevel_notice
  19
  20 (** Log a raw string. *)
  21 let log_raw string =
  22   let channel = !log_channel in
  23     output_string channel string;
  24     flush channel
  25
  26 (** Convert a timestamp (float) to a string for use in logging. *)
  27 let string_of_timestamp time =
  28   let tm = Unix.gmtime time in
  29   let seconds = (float_of_int tm.Unix.tm_sec) +. (fst (modf time)) in
  30     sprintf "%04d-%02d-%02d %02d:%02d:%02.3f"
  31       (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
  32       tm.Unix.tm_hour tm.Unix.tm_min seconds
  33
  34 (** Log a string with a timestamp. *)
  35 let log_with_timestamp time string =
  36   log_raw ((string_of_timestamp time) ^ " " ^ string)
  37
  38 (** Log a message with the given level, if the level is
  39     urgent enough.
  40 *)
  41 let log level message =
  42   if level <= !loglevel then
  43     let time = Unix.gettimeofday () in
  44       log_with_timestamp time (message ^ "\n")
  45
  46 let log_fatal message = log loglevel_fatal ("FATAL " ^ message)
  47 let log_error message = log loglevel_error ("ERROR " ^ message)
  48 let log_warning message = log loglevel_warning ("WARNING " ^ message)
  49 let log_notice message = log loglevel_notice ("NOTICE " ^ message)
  50 let log_debug message = log loglevel_debug ("DEBUG " ^ message)
  51
  52 let set_log_channel channel = log_channel := channel
  53 let set_loglevel level = loglevel := level
  54 let get_loglevel _ = !loglevel