Source

ocaml-toys / src / log.ml

Full commit
type loglevel = DEBUG | INFO | WARN | ERROR | DISABLED

type logger = {
	debug: string -> unit;
	info: string -> unit;
	warn: string -> unit;
	error: string -> unit;
	close: unit -> unit;
}

let string_of_level = function
	| DEBUG -> "DEBUG"
	| INFO -> "INFO"
	| WARN -> "WARN"
	| ERROR -> "ERROR"
	| DISABLED -> "DISABLED"

(* exemple: 2012-02-22 14:32:20 *)
let string_of_time seconds =
	let open Unix in
	let tm = localtime seconds in
	let ms = int_of_float ((seconds -. (floor seconds)) *. 1000.) in
	Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d.%03d"
		(tm.tm_year +1900) (tm.tm_mon +1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec ms

let write channel loglevel level msg =
	if level >= loglevel then
		let now = string_of_time (Unix.gettimeofday()) in
		Printf.fprintf channel "%s [%-5s] %s\n%!" now (string_of_level level) msg

let create_logger channel level = {
	debug = write channel level DEBUG;
	info = write channel level INFO;
	warn = write channel level WARN;
	error = write channel level ERROR;
	close = fun () -> close_out channel;
}

let create_file_logger path level =
	let channel = open_out_gen [Open_wronly; Open_append; Open_creat; Open_text] 0666 path
	in create_logger channel level

(* default logger for easy access *)

let default_logger = ref (create_logger stderr DEBUG)

let set_default_logger logger = default_logger := logger

let debug msg = !default_logger.debug msg
and warn msg = !default_logger.warn msg
and info msg = !default_logger.info msg
and error msg = !default_logger.error msg