1(*
2 * Copyright (C) 2012      Citrix Ltd.
3 * Author Ian Campbell <ian.campbell@citrix.com>
4 *
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU Lesser General Public License as published
7 * by the Free Software Foundation; version 2.1 only. with the special
8 * exception on linking described in file LICENSE.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 * GNU Lesser General Public License for more details.
14 *)
15
16open Printf
17open Random
18open Callback
19
20(* @@XTL_LEVELS@@ *)
21
22let compare_level x y =
23	compare (level_to_prio x) (level_to_prio y)
24
25type handle
26
27type logger_cbs = {
28	vmessage : level -> int option -> string option -> string -> unit;
29	progress : string option -> string -> int -> int64 -> int64 -> unit;
30	(*destroy : unit -> unit*)
31}
32
33external _create_logger: (string * string) -> handle = "stub_xtl_create_logger"
34external test: handle -> unit = "stub_xtl_test"
35
36let counter = ref 0L
37
38let create name cbs : handle =
39	(* Callback names are supposed to be unique *)
40	let suffix = Int64.to_string !counter in
41	counter := Int64.succ !counter;
42	let vmessage_name = sprintf "%s_vmessage_%s" name suffix in
43	let progress_name = sprintf "%s_progress_%s" name suffix in
44	(*let destroy_name = sprintf "%s_destroy" name in*)
45	Callback.register vmessage_name cbs.vmessage;
46	Callback.register progress_name cbs.progress;
47	_create_logger (vmessage_name, progress_name)
48
49