1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
type time = float
let current_time () = Unix.gettimeofday ()
let initial_time = current_time ()
let time x = int_of_float (x *. 1000.)
let time64 x = Int64.of_float (x *. 1000.)
let next_id =
let id = ref 0 in
fun () ->
incr id;
!id
type t = {
id : int;
hostname : string;
process : int;
thread : int;
timestamp : time;
relative : int;
level : Level.t;
logger : Name.t;
origin : Name.t;
file : string;
line : int;
column : int;
message : string;
properties : (string * string) list;
error : (exn * string) option;
}
let make logger level ?(origin = None) ?(file = "") ?(line = ~-1)
?(column = ~-1) ?(properties = []) ?(error = None) message =
let now = current_time () in
let origin = match origin with
| Some x -> x
| None -> logger in
let error = match error with
| Some x -> Some (x, Printexc.get_backtrace ())
| None -> None in
{ id = next_id ();
hostname = (try Unix.gethostname () with _ -> "");
process = (try Unix.getpid () with _ -> 0);
thread = Utils.get_thread_id ();
timestamp = now;
relative = time (now -. initial_time);
level = level;
logger = logger;
origin = origin;
file = file;
line = line;
column = column;
message = message;
properties = properties;
error = error }
let with_logger l e =
{ e with logger = l }
let string_of_wday = function
| 0 -> "Sunday"
| 1 -> "Monday"
| 2 -> "Tuesday"
| 3 -> "Wednesday"
| 4 -> "Thursday"
| 5 -> "Friday"
| 6 -> "Saturday"
| _ -> assert false
let string_of_month = function
| 1 -> "January"
| 2 -> "February"
| 3 -> "March"
| 4 -> "April"
| 5 -> "May"
| 6 -> "June"
| 7 -> "July"
| 8 -> "August"
| 9 -> "September"
| 10 -> "October"
| 11 -> "November"
| 12 -> "December"
| _ -> assert false
let string_of_month_abrv m =
(String.sub (string_of_month m) 0 3)
let bindings e =
let string_of_properties l =
"[" ^ (String.concat "; " (List.map (fun (x, y) -> x ^ ": " ^ y) l)) ^ "]" in
let tm = Unix.localtime e.timestamp in
let string_of_int' = function
| 0 -> "00"
| 1 -> "01"
| 2 -> "02"
| 3 -> "03"
| 4 -> "04"
| 5 -> "05"
| 6 -> "06"
| 7 -> "07"
| 8 -> "08"
| 9 -> "09"
| x -> string_of_int x in
[ "id", string_of_int e.id;
"hostname", e.hostname;
"process", string_of_int e.process;
"thread", string_of_int e.thread;
"sec", string_of_int' tm.Unix.tm_sec;
"min", string_of_int' tm.Unix.tm_min;
"hour", string_of_int' tm.Unix.tm_hour;
"mday", string_of_int tm.Unix.tm_mday;
"month", string_of_int' (succ tm.Unix.tm_mon);
"monthname", string_of_month (succ tm.Unix.tm_mon);
"monthnm", string_of_month_abrv (succ tm.Unix.tm_mon);
"year", string_of_int (tm.Unix.tm_year + 1900);
"wday", string_of_wday tm.Unix.tm_wday;
"time", Int64.to_string (time64 e.timestamp);
"relative", string_of_int e.relative;
"level", Level.to_string e.level;
"logger", Name.to_string e.logger;
"origin", Name.to_string e.origin;
"file", if e.file <> "" then e.file else "<nofile>";
"filebase", if e.file <> "" then Filename.basename e.file else "<nofile>";
"line", string_of_int e.line;
"column", string_of_int e.column;
"message", e.message;
"properties", string_of_properties e.properties;
"exception", (match e.error with Some (x, _) -> Printexc.to_string x | None -> "");
"backtrace", (match e.error with Some (_, x) -> x | None -> "") ]
@ e.properties
let decode s =
try
let idx = String.index s ':' in
let len = String.length s in
let key = String.sub s 0 idx in
let size = String.sub s (succ idx) (len - idx - 1) in
key, (try int_of_string size with _ -> 0)
with Not_found -> s, 0
let assoc l s =
try
let key, size = decode s in
let res = List.assoc key l in
let left = size < 0 in
let pad_size = (abs size) - (String.length res) in
let pad_string = String.make (max 0 pad_size) ' ' in
if left then pad_string ^ res else res ^ pad_string
with _ ->
""
let render_bindings b fmt =
let buffer = Buffer.create 256 in
try
Buffer.add_substitute buffer (assoc b) fmt;
Buffer.contents buffer
with _ -> fmt
let render fmt e =
render_bindings (bindings e) fmt