src/utils/cdk/printf2.ml

   1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
   2 (*
   3     This file is part of mldonkey.
   4
   5     mldonkey is free software; you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation; either version 2 of the License, or
   8     (at your option) any later version.
   9
  10     mldonkey 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 General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with mldonkey; if not, write to the Free Software
  17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 *)
  19
  20
  21 open Autoconf
  22 open Syslog
  23
  24 let syslog_oc = ref None
  25
  26 let log_time () =
  27   let t = Unix.localtime (Unix.time ()) in
  28   let { Unix.tm_year = tm_year; Unix.tm_mon = tm_mon; Unix.tm_mday = tm_mday;
  29         Unix.tm_hour = tm_hour; Unix.tm_min = tm_min; Unix.tm_sec = tm_sec } = t
  30   in
  31   Printf.sprintf "%4d/%02d/%02d %02d:%02d:%02d " (tm_year+1900) (tm_mon+1) tm_mday tm_hour tm_min tm_sec
  32
  33 let lprintf_handler = ref (fun s time ->
  34       Printf.printf "%sMessage [%s] discarded\n" time s;
  35   )
  36
  37 let lprintf fmt = Printf.ksprintf (fun s -> try !lprintf_handler "" s with _ -> ()) fmt
  38 let lprintf2 m fmt = Printf.ksprintf (fun s -> try !lprintf_handler (log_time ()) (m^" "^s) with _ -> ()) fmt
  39 let lprintf_nl fmt = Printf.ksprintf (fun s -> try !lprintf_handler (log_time ()) (s^"\n") with _ -> ()) fmt
  40 let lprintf_nl2 m fmt = Printf.ksprintf (fun s -> try !lprintf_handler (log_time ()) (m^" "^s^"\n") with _ -> ()) fmt
  41
  42 let lprint_newline () = lprintf "\n"
  43 let lprint_char = lprintf "%c"
  44 let lprint_int = lprintf "%d"
  45 let lprint_string = lprintf "%s"
  46
  47 let set_lprintf_handler f =
  48   lprintf_handler := f
  49
  50 let lprintf_max_size = ref 100
  51 let lprintf_size = ref 0
  52 let lprintf_fifo = Fifo.create ()
  53 let lprintf_to_channel = ref true
  54
  55 let lprintf_output = ref (Some stderr)
  56 let lprintf_original_output = ref None
  57
  58 let keep_console_output () =
  59   match !lprintf_original_output with
  60     Some c when c = stderr || c = stdout -> true
  61   | _ -> false
  62
  63 let () =
  64   set_lprintf_handler (fun time s ->
  65       (match !syslog_oc with
  66       | None -> ()
  67       | Some oc -> Syslog.syslog oc `LOG_INFO s);
  68       match !lprintf_output with
  69       | Some out when !lprintf_to_channel ->
  70           Printf.fprintf out "%s" (time ^ s); flush out
  71       | _ ->
  72           if !lprintf_size >= !lprintf_max_size then
  73             ignore (Fifo.take lprintf_fifo)
  74           else
  75             incr lprintf_size;
  76           Fifo.put lprintf_fifo (time ^ s)
  77   )
  78
  79 let detach () =
  80   match !lprintf_output with
  81     Some oc when oc == Pervasives.stdout -> lprintf_output := None
  82   | _ -> ()
  83
  84 let close_log () =
  85   lprintf_to_channel := false;
  86   match !lprintf_output with
  87     None -> ()
  88   | Some oc ->
  89       if oc != stderr && oc != stdout then
  90         close_out oc;
  91       lprintf_output := None
  92
  93 let log_to_file oc =
  94   close_log ();
  95   lprintf_output := Some oc;
  96   lprintf_to_channel := true
  97
  98 let log_to_buffer buf =
  99   try
 100     while true do
 101       let s = Fifo.take lprintf_fifo in
 102       decr lprintf_size;
 103       Buffer.add_string buf s
 104     done
 105   with _ -> ()
 106
 107 (* html_mods *)
 108
 109 let html_mods_commands buf n c l =
 110     (* Name Class List *)
 111     Printf.bprintf buf "\\<div class=\\\"%s\\\"\\>\\<table id=\\\"%s\\\"
 112     name=\\\"%s\\\" class=\\\"%s\\\" cellspacing=0 cellpadding=0
 113     width=\\\"100pc\\\"\\>\\<tbody\\>\\<tr\\>"
 114     c n n c;
 115     List.iter (fun (w,x,y,z)  ->
 116      (* Class Title Onclick Value *)
 117      Printf.bprintf buf "\\<td class=\\\"%s\\\"
 118      title=\\\"%s\\\" onMouseOver=\\\"mOvr(this,'mOvr1');\\\" onMouseOut=\\\"mOut(this);\\\"
 119      onClick=\\\"%s\\\" \\>%s\\</td\\>"
 120      w x y z;
 121     ) l;
 122     Printf.bprintf buf "\\</tr\\>\\</tbody\\>\\</table\\>\\</div\\>"
 123
 124 (*
 125   html_mods_commands buf "commandsTable" "commands" [
 126     ( "bu bbig", "Extend search to more servers and view results", "mSub('output','vr');", "Extend search" ) ;
 127 *)
 128
 129 type sort_kind = Num (* numeric, parse size suffixes (kMGT) *) | Str (* plain string *)
 130
 131 let html_mods_table_header buf ?(total = "0") n c l =
 132     (* Name Class List *)
 133     Printf.bprintf buf "\\<div class=\\\"%s\\\"\\>\\<table id=\\\"%s\\\" name=\\\"%s\\\" class=\\\"%s\\\" cellspacing=0 cellpadding=0\\>"
 134     c n n c;
 135     if List.length l > 0 then begin
 136         Printf.bprintf buf "\\<tr\\>";
 137         List.iter (fun (w,x,y,z)  ->
 138          let sort = match w with Num -> "1" | Str -> "0" in
 139          (* Sort Class Title Value *)
 140          Printf.bprintf buf "\\<td onClick=\\\"_tabSort(this,%s,%s);\\\" class=\\\"%s\\\" title=\\\"%s\\\"\\>%s\\</td\\>"
 141          sort total x y z;
 142         ) l;
 143         Printf.bprintf buf "\\</tr\\>"
 144       end
 145 (* Add colspan functionality to html_mods_table_header *)
 146
 147 let html_mods_table_header_colspan buf ?(total="0") n c l =
 148     (* Name Class List *)
 149     Printf.bprintf buf "\\<div class=\\\"%s\\\"\\>\\<table id=\\\"%s\\\" name=\\\"%s\\\" class=\\\"%s\\\" cellspacing=0 cellpadding=0\\>\\<tr\\>"
 150     c n n c;
 151     List.iter (fun (v,w,x,y,z)  ->
 152      (* Sort Class Title Value *)
 153      Printf.bprintf buf "\\<td colspan=%s onClick=\\\"_tabSort(this,%s,%s);\\\" class=\\\"%s\\\" title=\\\"%s\\\"\\>%s\\</td\\>"
 154      v w total x y z;
 155     ) l;
 156     Printf.bprintf buf "\\</tr\\>"
 157
 158 let html_mods_table_no_header buf n c l =
 159     (* 1 row * n cols *)
 160     (* Name Class List *)
 161     Printf.bprintf buf "\\<div class=\\\"%s\\\"\\>\\<table id=\\\"%s\\\" name=\\\"%s\\\" class=\\\"%s\\\" cellspacing=0 cellpadding=0\\>\\<tr\\>"
 162     c n n c;
 163     List.iter (fun (t,c,d)  ->
 164     (* Title Class Value *)
 165      Printf.bprintf buf "\\<td class=\\\"%s\\\" %s\\>%s\\</td\\>"
 166      c (if t <> "" then "title=\\\"" ^ t ^ "\\\"" else "") d;
 167     ) l;
 168     Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>"
 169
 170 let html_mods_table_one_row buf n c l =
 171     (* 1 row * n cols *)
 172     (* Name Class List *)
 173     Printf.bprintf buf "\\<div class=\\\"%s\\\"\\>\\<table id=\\\"%s\\\" name=\\\"%s\\\" class=\\\"%s\\\" cellspacing=0 cellpadding=0\\>\\<tr\\>"
 174     c n n c;
 175     List.iter (fun (t,c,d)  ->
 176     (* Title Class Value *)
 177      Printf.bprintf buf "\\<td class=\\\"%s\\\" %s\\>%s\\</td\\>"
 178      c (if t <> "" then "title=\\\"" ^ t ^ "\\\"" else "") d;
 179     ) l;
 180     Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>"
 181
 182 let html_mods_table_one_col buf n c l =
 183     (* n rows * 1 col *)
 184     (* Name Class List *)
 185     Printf.bprintf buf "\\<div class=\\\"%s\\\"\\>\\<table id=\\\"%s\\\" name=\\\"%s\\\" class=\\\"%s\\\" cellspacing=0 cellpadding=0\\>\\<tr\\>"
 186     c n n c;
 187     List.iter (fun (t,c,d)  ->
 188     (* Title Class Value *)
 189      Printf.bprintf buf "\\<tr\\>\\<td class=\\\"%s\\\" %s\\>%s\\</td\\>\\</tr\\>"
 190      c (if t <> "" then "title=\\\"" ^ t ^ "\\\"" else "") d;
 191     ) l;
 192     Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>"
 193
 194 let html_mods_td buf l =
 195     (* List *)
 196     List.iter (fun (t,c,d)  ->
 197     (* Title Class Value *)
 198      Printf.bprintf buf "\\<td class=\\\"%s\\\" %s\\>%s\\</td\\>"
 199      c (if t <> "" then "title=\\\"" ^ t ^ "\\\"" else "") d;
 200     ) l
 201
 202
 203 let html_mods_big_header_start buf c l =
 204   Printf.bprintf buf "\\<div class=\\\"%s\\\"\\>\\<table class=main border=0 cellspacing=0 cellpadding=0\\>\\<tr\\>\\<td\\>" c;
 205   Printf.bprintf buf "\\<table cellspacing=0 cellpadding=0 width=100%%\\>\\<tr\\>";
 206   Printf.bprintf buf "\\<td width=100%%\\>\\</td\\>";
 207   let len = List.length l in
 208   let cnt = ref 0 in
 209   List.iter (fun s ->
 210     incr cnt;
 211     Printf.bprintf buf "\\<td nowrap class=\\\"fbig%s\\\"\\>%s\\</td\\>" (if !cnt = len then " pr" else "") s;
 212   ) l;
 213   Printf.bprintf buf "\\</tr\\>\\</table\\>\\</td\\>\\</tr\\>\\<tr\\>\\<td\\>"
 214
 215 let html_mods_big_header_end buf =
 216   Printf.bprintf buf "\\</td\\>\\</tr\\>\\</table\\>\\</div\\>"
 217
 218 let html_mods_counter = ref true
 219
 220 let html_mods_cntr () =
 221     html_mods_counter := not !html_mods_counter;
 222     if !html_mods_counter then 1 else 2
 223
 224 let html_mods_cntr_init () =
 225   html_mods_counter := true
 226
 227 let print_plural_s v =
 228   if v > 1 then "s" else ""