(* Views:

   1) package | section | dist1 | dist2 | dist3 |
      --------+---------+-------+-------+-------+
       name   |  main   |version|version|version|
*)

let root = "/build/packages/cnr-webdev/fullpool"
let sources = 
  ["lindowsos", "stable", ["main", ["i386"];
			   "contrib", ["i386"];
			   "non-free", ["i386"];
			   "kde3", ["i386"]];
   "lindowsos", "testing", ["main", ["i386"];
			    "contrib", ["i386"];
			    "non-free", ["i386"];
			    "kde3", ["i386"]];
   "lindowsos", "unstable", ["main", ["i386"];
			     "contrib", ["i386"];
			     "non-free", ["i386"];
			     "kde3", ["i386"]]]

let version_table () =

  let dists = ["stable"; "testing"; "unstable"] in
  let table =
    let tmp = Hashtbl.create 10000 in
    Debian.iter_packages_of_sources
      (fun (pool, dist, sect, arch, url, control) ->
	 let name = Util.tassoc "Package" control
	 and version = Util.tassoc "Version" control in
	 Hashtbl.replace tmp name ((sect, dist, version) :: 
				     (try Hashtbl.find tmp name
				      with Not_found -> [])))
      root sources;
    tmp in

  print_endline "<table cellpadding=0 cellspacing=0 border=0 align=center>";

  let row = ref "even" in
  let values =
    let tmp = ref [] in
    Hashtbl.iter (fun key value -> tmp := (key, value) :: !tmp) table;
    List.sort (fun (n1, _) (n2, _) -> compare n1 n2) !tmp in
  print_endline
    ("<tr><th>package<th>" ^ (String.concat "<th>" dists) ^ "</tr>");

  let rowtext name lst =
    let alist =
      List.map (fun (sect, dist, version) -> (dist, version)) lst in
    let versions = List.map (fun dist ->
			       try List.assoc dist alist
			       with Not_found -> "") dists in
    (* Replace the empty strings with the version number of 
       the more stable distribution *)
    let versions' =
      List.rev
	(List.fold_left
	   (fun result b ->
	      match result with
		a :: etc ->
		  if b = ""
		  then a :: result
		  else b :: result
	      | [] -> [b])
	   [] versions) in

    (* If a less stable version has an older version, mark it red.
       If a less stable version has the same version print a left
       arrow. *)

    let versions'' =
      let rec loop lst =
	match lst with
	  a :: b :: etc ->
	    let a' = 
	      if a <> "" && a = b
	      then "&lt;-"
	      else if Debian.version_compare a b < 0
	      then "<FONT color=#ff0000>" ^ a ^ "</FONT>"
	      else a in
	    a' :: loop (b :: etc)
	| _ -> lst in
      List.rev (loop (List.rev versions')) in

    "<td>" ^ name ^ "<td>" ^ (String.concat "<td>" versions'') in
  
  List.iter
    (fun (name, lst) ->
       row := if !row = "even" then "odd" else "even";
       print_endline ("<tr class=" ^ !row ^ ">" ^
		      (rowtext name lst) ^ "</tr>"))
    values;

  print_endline "</table>\n"

let db_table () =

  let dblabels = ["live"; "testing"; "unstable"]
  and dbname = Some "lindows" in
  let dbhosts = 
    List.map (function
		  "live" -> "10.0.0.70"
		| "testing" -> "65.241.11.124"
		| "unstable" -> "65.241.11.24"
		| _ -> assert false) dblabels in

  let dblst = 
    List.map (fun host ->
		Db.connect {Db.typ = Db.MysqlDB;
			    Db.host = Some host;
			    Db.name = dbname;
			    Db.port = None;
			    Db.pwd = Some "ocaml";
			    Db.user = Some "warehouse"}) dbhosts in

  let query = 
    Db.Select
      ("applications",
       [|"serialnumber"; "package_name"; "version"|],
       Db.TRUE) in
  let reslist =
    List.map (fun db -> Db.command db query) dblst in
  let tables = List.map (fun res -> Hashtbl.create 10000) reslist in
  let names = Hashtbl.create 10000 in
  List.iter2 (fun res table ->
		Db.iter
		(function
		     [|Db.Int sn; Db.Str pn; Db.Str v|] as tuple ->
		       Hashtbl.add table pn tuple;
		       Hashtbl.replace names pn ()
		   | [|Db.Int sn; Db.Null; _|] as tuple ->
		       ()
		   | [|Db.Int sn; Db.Str pn; Db.Null|] ->
		       ()
		   | other ->
		       Message.vq_nl ("Bad row: " ^ (String.concat " " (List.map Db.value_name (Array.to_list other))));
		       assert false)
		res) reslist tables;
  let names = List.sort compare
    (let tmp = ref [] in
     Hashtbl.iter (fun name _ -> tmp := name :: !tmp) names; !tmp) in
  print_endline "<table cellpadding=0 cellspacing=0 border=0 align=center>";
  print_endline ("<tr><th>package<th>" ^
		 (String.concat "<th>" dblabels) ^ "</tr>");
    
  List.iter
    (fun name ->
       print_string ("<tr><td>" ^ name);
       let infolst = List.map (fun table ->
			      try Some (Hashtbl.find table name)
			      with Not_found -> None) tables in
       List.iter
	 (function
	      Some [|Db.Int sn; _; Db.Str v|] ->
		print_string ("<td>" ^ v ^ " (id=" ^ (string_of_int sn) ^ ")");
	    | None ->
		print_string "<td>"
	    | _ ->
		assert false)
	 infolst;
       print_endline "</tr>")
    names;

  print_endline "</table>\n"
	   
let _ =
  (* Header *)
  print_endline "Content-type: text/html";
  (* If the request URI doesn't include the values of the CGI variables,
     re-issue the corrected request and exit. *)
  if Params.new_request_uri <> Unix.getenv "REQUEST_URI"
  then begin
    print_endline
      ("Location: " ^ "http://" ^ (Unix.getenv "HTTP_HOST") ^
       Params.new_request_uri ^ "\n");
    raise Exit
  end
  else
    print_newline ();	(* End of header *)

  print_string "<html>\n";
  Report.print_style ();
  flush stdout;		(* Should clear the window *)
  (*version_table ();*)
  db_table ();
  print_string "</html>\n"