(**************************************************************************)
(*                                                                        *)
(*  Ocamlviz --- real-time profiling tools for Objective Caml             *)
(*  Copyright (C) by INRIA - CNRS - Universite Paris Sud                  *)
(*  Authors: Julien Robert                                                *)
(*           Guillaume Von Tokarski                                       *)
(*           Sylvain Conchon                                              *)
(*           Jean-Christophe Filliatre                                    *)
(*           Fabrice Le Fessant                                           *)
(*  GNU Library General Public License version 2                          *)
(*  See file LICENSE for details                                          *)
(*                                                                        *)
(**************************************************************************)


include Monitor_impl


open Printf
open Sys
open Unix

let debug = ref true

let sock = socket PF_INET SOCK_STREAM 0

let clients = ref ([] : out_channel list)

let port = 
  try int_of_string (Sys.getenv "OCAMLVIZ_PORT")
  with Not_found -> 51000

let period = 
  try float_of_string (Sys.getenv "OCAMLVIZ_PERIOD")
  with Not_found -> 0.1


let init_sock () =
  try
    let sockaddr = ADDR_INET (inet_addr_any, port) in
    setsockopt sock SO_REUSEADDR true;
    bind sock sockaddr;
    listen sock 3
  with Unix.Unix_error _ as e -> 
    eprintf "run: couldn't run the server (%s)\n" (Printexc.to_string e); 
    exit 1

(* FIXME *)
let send_string fd s =
  let n = String.length s in
  let _ = Unix.write fd s 0 n in
  (* if m <> n then Format.eprintf "send_string: incomplete@."; *)
  ()
  

let send_string out s =
  Printf.fprintf out "%s" s;
  flush out

let new_client _ =
  let fd,_ = accept sock in
  set_nonblock fd;
  let out = out_channel_of_descr fd in
  send_string out (declare_tags ());
  clients := out :: !clients;
  set_nb_clients (List.length !clients)

let send_data s out = 
  try
    send_string out s;
  with e -> 
    (* Format.printf "%s@." (Printexc.to_string e);  *)
    clients := List.filter (fun s -> s!=out) !clients;
    set_nb_clients (List.length !clients)  

let send () =
  try
    let ready,_,_ = Unix.select [sock] [] [] 0. in
    List.iter new_client ready;
    if !clients <> [] then
      let s = to_send () in
      List.iter (send_data s) !clients;
  with e -> 
    Format.eprintf "send: %s@." (Printexc.to_string e); ()

let mutex = ref false

let alarm_handler _ =
  if not !mutex then begin  
    mutex := true;
    begin try
      send ()
    with e -> 
      Format.eprintf "send: %s@." (Printexc.to_string e); ()
    end;
    mutex := false
  end

let send_now () =
  if not !mutex && !clients <> [] then begin  
    mutex := true;
    begin try
      let s = to_send () in
      List.iter (send_data s) !clients
    with e -> 
      Format.eprintf "send_now: %s@." (Printexc.to_string e); ()
    end;
    mutex := false
  end
      
let () = 
  set_signal sigalrm (Signal_handle alarm_handler);
  set_signal sigpipe Signal_ignore

let () =
  init_sock ();
  ignore (Unix.setitimer Unix.ITIMER_REAL
	    { Unix.it_value = 0.1; Unix.it_interval = period })

(* triggers a GC cycle to allow alarms to be handled *)
let yield () = ignore [Random.int 1000]

let init () = ()



(*
Local Variables: 
compile-command: "unset LANG; make -C .."
End: 
*)
