Store out channels in a hash table.

hashofchannels.ml

module Logs = struct

  exception NoSuchLog of string

  let file_opts = [Unix.O_WRONLY; Unix.O_APPEND; Unix.O_CREAT]                 
  let file_perm = 0o600
  let hash : (string, out_channel) Hashtbl.t = Hashtbl.create 256

  let register key oc = Hashtbl.add hash key oc

  let find key =
    try
      Some (Hashtbl.find hash key)
    with Not_found -> None

  let list_all = fun () ->
    Printf.printf "Listing hash contents.\n%!";                                
    Hashtbl.iter (fun key _ -> Printf.printf "key: %s\n%!" key) hash

  let close key =
    Printf.printf "Closing '%s'\n%!" key;                                      
    match find key with
    | Some oc -> Printf.printf "Closing...\n%!";
      close_out oc;
      Hashtbl.remove hash key
    | None -> Printf.printf "None found.\n%!"; ()                              

  let close_all	= fun () ->
    Hashtbl.iter (fun key _ -> close key) hash

  let file_out_channel key path =
    let fd = Unix.openfile path file_opts file_perm in
    Unix.out_channel_of_descr fd

  let channel_of key =
    match key with
    | "stdout" -> Unix.out_channel_of_descr Unix.stdout
    | "stderr" -> Unix.out_channel_of_descr Unix.stderr
    | path -> file_out_channel key path

  let create key target =
    match find key with
    | Some oc -> ()
    | None ->
      let oc = channel_of target in
      register key oc

  let log key msg =
    match find key with
    | Some oc -> Printf.fprintf oc "%s\n%!" msg
    | None -> raise (NoSuchLog (Printf.sprintf "No such log: '%s'\n%!" key))

end

let main () =
  Printf.printf "Running...\n\n%!";
  at_exit Logs.close_all;

  Logs.list_all ();
  Printf.printf "\n%!";

  Logs.create "verbose_log" "verbose.log";
  Logs.create "verbose_log_2" "verbose.log";

  Logs.list_all ();
  Printf.printf "\n%!";

  Logs.log "verbose_log" "A message.";

  Logs.close "verbose_log";

  Logs.log "verbose_log_2" "Another message.";

  Logs.list_all ();
  Printf.printf "\n%!"

let () = main ()