(* Virtual_strings *)
(* $Id$ *)

type file = {
  name : string;
  fd : Unix.file_descr;
  mtime : float;
  mutable mtime_counter : int;
  range_low : int;
  range_high : int
} and pool = {
  mutable count : int;
  mutable files : file array;
  mutable high : int
} and virtual_string = {
  beginning : int;
  length : int
} and t = Real of string | Virtual of virtual_string;;

exception Error of string;;
exception Not_real;;
exception File_out_of_date of string;;

let sf = Printf.sprintf;;

let create () = { count = 0; files = [||]; high = 0 };;

let add_file p name fd =
  let st = Unix.fstat fd in
  let a = p.files in
  p.files <- Array.init (p.count + 1)
    (fun i ->
      if i < p.count then
        a.(i)
      else
        { name = name;
          fd = fd;
          mtime = st.Unix.st_mtime;
          mtime_counter = 0;
          range_low = p.high;
          range_high = p.high + st.Unix.st_size - 1 });
  p.count <- 1 + p.count;
  p.high <- p.high + st.Unix.st_size;
  p.count - 1
;;

(*** find_file *)
let find_file p o =
  let a = p.files in
  let m = Array.length a in
  let rec loop i0 m =
    if m = 0 then
      raise Not_found
    else
      begin
        if m < 8 then
          if a.(i0).range_low <= o && o <= a.(i0).range_high then
            i0
          else
            loop (i0 + 1) (m - 1)
        else
          let i = i0 + m / 2 in
          if a.(i).range_low <= o then
            if o <= a.(i).range_high then
              i
            else
              loop (i + 1) (m - m / 2)
          else
            loop i0 (m / 2)
      end
  in
  loop 0 m
;;
(* ***)

let make_virtual_string p f o m =
  if m = 0 then
    Real ""
  else
    Virtual{ beginning = p.files.(f).range_low + o;
             length = m }
;;

let empty_string = Real "";;

let is_empty = function
  | Real "" -> true
  | _ -> false
;;

let make_real_string s = Real(s)
;;

let rec get_real_string p = function
  | Real(u) -> u
  | Virtual(_) -> raise Not_real
;;

let check_mtime_every = ref 100;;
let mtime_counter = ref 0;;

(*** get_string *)
let rec get_string p = function
  | Real(u) -> u
  | Virtual(s) ->
    let f = find_file p s.beginning in
    assert (p.files.(f).range_low <= s.beginning && s.beginning <= p.files.(f).range_high);
    let o = s.beginning - p.files.(f).range_low in
    try
      (* XXX *)
      let fl = p.files.(f) in
      fl.mtime_counter <- 1 + fl.mtime_counter;
      if fl.mtime_counter >= !check_mtime_every then
        begin
          fl.mtime_counter <- 0;
          let st = Unix.fstat fl.fd in
          if st.Unix.st_mtime > fl.mtime then
            raise (File_out_of_date fl.name);
        end;
      ignore (Unix.lseek fl.fd o Unix.SEEK_SET);
      let u = String.create s.length in
      if s.length <> Unix.read fl.fd u 0 s.length then
        raise (Error(sf "Read error in file %S" fl.name))
      else
        u
    with
    | File_out_of_date _ as x -> raise x
    | x ->
        raise (Error(sf "Error in file %S offsets %d+%d (%d): %s"
                        p.files.(f).name
                        o
                        s.beginning
                        s.length
                        (Printexc.to_string x)))

;;
(* ***)
