(*
* This file is part of Bolt.
* Copyright (C) 2009-2011 Xavier Clerc.
*
* Bolt is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation; either version 3 of the License, or
* (at your option) any later version.
*
* Bolt 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 Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program. If not, see .
*)
(* Definitions *)
type t = (string list) * (string list) * (Event.t -> string)
let layouts = Hashtbl.create 17
let register name layout =
Hashtbl.replace layouts name layout
let register_unnamed layout =
let i = ref 0 in
while Hashtbl.mem layouts (string_of_int !i) do
incr i
done;
let name = string_of_int !i in
register name layout;
name
let get name =
Hashtbl.find layouts name
(* Predefined layouts *)
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 (Event.bindings e) fmt
let simple =
[], [], render "$(level:5) - $(message)"
let default =
[], [], render "$(relative:-6) [$(file:-16) $(line:4)] $(level:5) - $(message)"
let pattern h f p =
h, f, render p
let paje =
PajeFormat.header, [], PajeFormat.render
let paje_noheader =
[], [], PajeFormat.render
let style = [
""
]
let html =
[ "" ;
"" ;
"Log" ] @
style @
[ "" ;
"" ;
"" ;
"
" ;
("" ^
"| Identifier | " ^
"Time | " ^
"Millis | " ^
"Level | " ^
"File | " ^
"Message | " ^
"
") ],
[ "
" ;
"" ;
("Generated by Bolt " ^ Version.value ^ "
") ;
"" ;
"" ],
render ("" ^
"| $(id) | " ^
"$(hour):$(min):$(sec) | " ^
"$(relative) | " ^
"$(level) | " ^
"$(filebase:-24) $(line:4) | " ^
"$(message) | " ^
"
")
let protect_cdata s =
let len = String.length s in
let buf = Buffer.create len in
let i = ref 0 in
while (!i < len) do
if (!i >= 2) && (s.[!i - 2] = ']') && (s.[!i - 1] = ']') && (s.[!i] = '>') then
Buffer.add_string buf " >"
else
Buffer.add_char buf s.[!i];
incr i
done;
Buffer.contents buf
let xml =
[],
[],
(fun e ->
let properties =
List.map
(fun (k, v) -> Printf.sprintf " \n" k v)
e.Event.properties in
render_bindings
(List.map
(fun (k, v) -> (k, (if k = "message" then protect_cdata v else v)))
(Event.bindings e))
("\n" ^
"\n" ^
(match e.Event.error with
| Some (_, s) -> "\n"
| None -> "") ^
"\n" ^
"\n" ^
(String.concat "" properties) ^
"\n" ^
"\n"))
let csv sep l =
let render e =
let b = Event.bindings e in
let values = List.map (fun k -> try List.assoc k b with _ -> "") l in
String.concat sep values in
([], [], render)
let () =
List.iter
(fun (x, y) -> register x y)
[ "simple", simple ;
"default", default ;
"html", html ;
"paje", paje ;
"paje_noheader", paje_noheader ;
"xml", xml ]