(* Copies from libdsf *)

module Message = struct

  type spec = out_channel * (int ref * int ref)

  let specs = ref []

  (* Print a string if verbosity level is n or higher and update the column
     variable. *)

  let output n s =

    (* What column do we end at if we print string s? *)
    let newcol oldcol s =
      let l = (String.length s) in
      try l - (String.rindex s '\n') - 1
      with Not_found -> oldcol + l in

    List.iter
      (fun (chan, (level, col)) ->
	 if n <= !level then begin
	   output_string chan s;
	   col := newcol !col s;
	   flush chan
	 end)
      !specs

  let output_nl n s =
    List.iter
      (fun (chan, (level, col)) ->
	 if n <= !level then begin
	   if !col != 0 then output_char chan '\n';
	   output_string chan (s ^ "\n");
	   col := 0;
	   flush chan
	 end)
      !specs

  let vq str = output (-1) str
  let v0 str = output 0 str
  let v1 str = output 1 str
  let v2 str = output 2 str
  let v3 str = output 3 str
  let v4 str = output 4 str

  let vq_nl str = output_nl (-1) str
  let v0_nl str = output_nl 0 str
  let v1_nl str = output_nl 1 str
  let v2_nl str = output_nl 2 str
  let v3_nl str = output_nl 3 str
  let v4_nl str = output_nl 4 str

end

module Util = struct

  let tassoc key alist =
    let (w, v) = List.assoc key alist in v

end

module File = struct

  let exists a = try ignore (Unix.stat a); true with _ -> false

end

(* This module maintains a table of unique debs, with information
   about the original and modified versions, and with a flag indicating
   whether a deb has been processed.  The uniquifying key includes the
   version number but *not* the file's md5sum.  Instead, it includes the
   pool name, because we don't want package index entries in one pool
   to point to files in the other, and the md5sum is required to match.

   In addition, there is a table that allows us to determine which debs
   correspond to datbase entries.  Indexed by package name, the table
   contains the key of the deb with the most recent version number, or
   if there are more than one with the same version number the one that
   appears first in the sources list. *)

exception MD5sum_Mismatch

let create () = (Hashtbl.create 10000, Hashtbl.create 10000)

let to_string mirinfo =
  (Util.tassoc "Package" mirinfo) ^ " " ^
  (Util.tassoc "Version" mirinfo) ^ ", " ^
  (Util.tassoc "Pool" mirinfo) ^ " " ^
  (Util.tassoc "MD5sum" mirinfo)

let match_checksums oldinfo mirinfo =
  if (Util.tassoc "MD5sum" oldinfo) <> (Util.tassoc "MD5sum" mirinfo) then begin
    Message.vq_nl ("MD5sum mismatch:\n  " ^
		   (Util.tassoc "Filename" oldinfo) ^ "\n  " ^
		   (Util.tassoc "Filename" mirinfo));
    raise MD5sum_Mismatch
  end

let subkey mirinfo =
  let (_,pool) = List.assoc "Pool" mirinfo
  and (_,version) = List.assoc "Version" mirinfo in
  (*Message.v0_nl ("subkey: (" ^ pool ^ ", " ^ version ^ ")");*)
  if not (File.exists pool) then raise Not_found;
  (pool, version)

(* Add a package unless it is already present. *)

let add (debtab, dbtab) mirinfo =
  let (_,package) = List.assoc "Package" mirinfo in
  let subtab =
    try Hashtbl.find debtab package
    with Not_found ->
      let subtab = Hashtbl.create 10 in
      Hashtbl.add debtab package subtab; subtab in
  let (pool, version) as subkey = subkey mirinfo in
  try
    let (_,oldinfo,_) = Hashtbl.find subtab subkey in
    match_checksums oldinfo mirinfo
  with
    Not_found ->
      Hashtbl.add subtab subkey (mirinfo, [], false);
      try
	let (_,oldver) = Hashtbl.find dbtab package in
	if Debian.version_compare version oldver > 0
	then Hashtbl.replace dbtab package subkey
      with Not_found ->
	Hashtbl.add dbtab package subkey

let db_version (debtab, dbtab) mirinfo =
  let (_,package) = List.assoc "Package" mirinfo in
  let (_, dbver) = Hashtbl.find dbtab package in
  dbver

let is_db (debtab, dbtab) mirinfo =
  let (_,pool) = List.assoc "Pool" mirinfo in
(*
    try List.assoc "Pool" mirinfo
    with Not_found as exn ->
      Message.vq_nl "No 'Pool' attribute in mirinfo:";
      List.iter (fun (a, (w, v)) ->
		   Message.vq_nl ("  " ^ a ^ ": " ^ w ^ v)) mirinfo;
      raise exn in
*)
  let (_,package) = List.assoc "Package" mirinfo in
  let (_,version) = List.assoc "Version" mirinfo in
  let (dbpool ,dbver) = Hashtbl.find dbtab package in
  dbpool = pool && dbver = version

let set_cache (debtab, _) mirinfo newinfo =
  let (_,package) = List.assoc "Package" mirinfo in
  let subtab = Hashtbl.find debtab package in
  let subkey = subkey mirinfo in
  let (oldinfo, _, _) =
    try Hashtbl.find subtab subkey
    with Not_found as exn ->
      let (pool, version) = subkey in
      Message.v0_nl ("Not found in subtab: (" ^ pool ^ ", " ^ version ^ ")");
      Hashtbl.iter (fun (pool, version) (oldinfo, newinfo, flag) ->
		      Message.v0_nl ("  (" ^ pool ^ ", " ^ version ^ ")")) subtab;		      
      raise exn in
  match_checksums mirinfo oldinfo;
  Hashtbl.replace subtab subkey (mirinfo, newinfo, true)

let get_cache (debtab, _) mirinfo =
  let (_,package) = List.assoc "Package" mirinfo in
  let subtab = Hashtbl.find debtab package in
  let subkey = (subkey mirinfo) in
  let (oldinfo, newinfo, flag) = Hashtbl.find subtab subkey in
  match_checksums oldinfo mirinfo;
  if not flag then raise Not_found;
  newinfo

let find (debtab, dbtab) package =
  let subtab = Hashtbl.find debtab package in
  let result = ref [] in
  Hashtbl.iter (fun subkey info -> result := info :: !result) subtab;
  List.rev !result

let print (debtab, dbtab) =
  Hashtbl.iter
    (fun package subtable ->
       let (_,dbver) = Hashtbl.find dbtab package in
       Message.vq_nl (" " ^ package ^ " db version: " ^
		      dbver ^ ", other versions:");
       Hashtbl.iter
	 (fun (pool,version) (mirinfo,modinfo,flag) ->
	    Message.vq_nl ("  " ^ pool ^ " " ^ version ^
			   (if flag then " (processed)" else "")))
	 subtable)
    debtab