#! /bin/sh
# (*
exec /opt/godi/bin/ocaml "$0" "$@"
*) directory ".";;

(* $Id: browser.cgi 6 2004-10-22 11:05:52Z gerd $
 * ----------------------------------------------------------------------
 *
 *)

#use "topfind";;
#require "findlib";;
#require "unix";;
#require "str";;
#require "cgi";;

(*-CUT-*)

(* ---------------------------------------------------------------------- *)

let cgi = new Netcgi.std_activation
	    ~operating_type:Netcgi.buffered_transactional_optype ();;

let param n = (cgi # argument n) # value;;

let print s = cgi # output # output_string s;;

let cancel() = cgi # output # rollback_work();;

let commit() = cgi # output # commit_work();;

(* ---------------------------------------------------------------------- *)

let list_directory d =
  try
    let dd = Unix.opendir d in
    let rec read () =
      try
        let name = Unix.readdir dd in
        if name <> "." & name <> ".." then
          name :: read()
        else
          read()
      with
        End_of_file ->
          Unix.closedir dd;
          []
    in
    read()
  with
    Unix.Unix_error (code,_,_) ->
      prerr_endline ("Warning: cannot read directory " ^ d ^ ": " ^
                     Unix.error_message code);
      []
;;


let all_packages() =
  let l = Fl_package_base.list_packages() in
  Sort.list ( <= ) l
;;


let modules_of_pkg pkg =
  try
    List.map
      String.capitalize
      (Str.split
	 (Str.regexp "[ \t]*\\([ \t]\\|,\\)[ \t]*")
	 (Findlib.package_property [] pkg "browse_interfaces"))
  with
    Not_found ->
      let d = Findlib.package_directory pkg in
      let l = list_directory d in
      let re = Str.regexp "^\\(.*\\)\\.cmi$" in
      List.flatten
	(List.map
	   (fun f ->
	     if Str.string_match re f 0 then
	       [String.capitalize (Str.matched_group 1 f)]
	     else
	       [])
	   l)
;;

(* ---------------------------------------------------------------------- *)

let escape_html =
  Netencoding.Html.encode ~in_enc:`Enc_iso88591 ()
;;


type text =
    Highlighted of string
  | Normal of string
;;


let read_file path =
  let fd = open_in path in
  let rec read () =
    try
      let line = input_line fd in
      Normal line :: Normal "\n" :: read()
    with
      End_of_file -> []
  in
  let t = read() in
  close_in fd;
  t
;;


let rec highlight re t =
  let rec highlight_string s k =
    if k < String.length s then begin
      try
	let k' = Str.search_forward re s k in
	let x1 = Normal (String.sub s k (k'-k)) in
	let x2 = Highlighted (Str.matched_string s) in
	let x3 = highlight_string s (Str.match_end()) in
	x1 :: x2 :: x3
      with
	Not_found ->
	  [ Normal (String.sub s k (String.length s - k)) ]
    end
    else []
  in

  match t with
    Highlighted s :: t' -> Highlighted s :: highlight re t'
  | Normal s :: t' ->
      highlight_string s 0 @ highlight re t'
  | [] ->
      []
;;


let rec somewhere_highlighted t =
  match t with
    Normal s :: t' -> somewhere_highlighted t'
  | Highlighted s :: t' -> true
  | [] -> false
;;


let highlighted_lines t =
  let rec extract this_line t =
    match t with
      Normal "\n" :: t' ->
	extract t' t'
    | Normal s :: t' ->
	extract this_line t'
    | Highlighted s :: t' ->
	extract_line this_line
    | [] ->
	[]
  and extract_line this_line =
    match this_line with
      Normal "\n" :: l' -> Normal "\n" :: extract l' l'
    | [] -> []
    | x :: l' -> x :: extract_line l'
  in
  extract t t
;;


let rec print_text t =
  match t with
    Normal s :: t' ->
      print (escape_html s);
      print_text t'
  | Highlighted s :: t' ->
      print "<font color=\"blue\"><b>";
      print (escape_html s);
      print "</b></font>";
      print_text t'
  | [] ->
      ()
;;


(* ---------------------------------------------------------------------- *)

let action() =
  let pkg =
    try
      Str.split (Str.regexp ",") (param "pkg")
    with
      Not_found -> [] in

  let modules =
    try
      Str.split (Str.regexp ",") (param "mod")
    with
      Not_found -> [] in

  let searchmod = try param "searchmod" with Not_found -> "" in
  let searchtext = try param "searchtext" with Not_found -> "" in
  let hlight = try param "hlight" with Not_found -> "" in

  let pkg_url p =
    "<a href=\"browser.cgi?" ^ 
    "pkg=" ^ Netencoding.Url.encode p ^
    "\">" ^
    escape_html p ^
    "</a>"
  in

  let mod_url p m =
    "<a href=\"browser.cgi?" ^ 
    "pkg=" ^ Netencoding.Url.encode p ^
    "&mod=" ^ Netencoding.Url.encode m ^
    "\">" ^
    escape_html m ^
    "</a>"
  in

  let mod_url_hl p m hl =
    "<a href=\"browser.cgi?" ^ 
    "pkg=" ^ Netencoding.Url.encode p ^
    "&mod=" ^ Netencoding.Url.encode m ^
    "&hlight=" ^ Netencoding.Url.encode hl ^
    "\">" ^
    escape_html m ^
    "</a>"
  in

  (*** headline ***)

  cgi # set_header();
  print "<html><head><title>Objective Caml Packages</title></head>\n";
  print "<body bgcolor=white>\n";
  print "<h1>Objective Caml Packages</h1>\n";

  (*** package list ***)

  let n_cols = 6 in

  let l_packages = all_packages() in
  let packages = Array.of_list l_packages in
  let n = Array.length packages in
  let n_rows = (n-1)/n_cols + 1 in

  print "<table>\n";
  for row = 0 to n_rows - 1 do
    print "<tr>\n";
    for col = 0 to n_cols - 1 do
      let k = col * n_rows + row in
      if k < n then begin
	print "<td>";
	print (pkg_url packages.(k));
	print "</td>\n";
      end
    done;
    print "</tr>\n";
  done;
  print "</table>\n";

  (*** searched modules ***)

  if searchmod <> "" then begin
    print "<h1>Results of module search</h1>\n";
    let l1 = Str.split_delim (Str.regexp "\\*") searchmod in
    let s1 = "^" ^ String.concat ".*" (List.map Str.quote l1) ^ "$" in
    let r1 = Str.regexp_case_fold s1 in

    let rec search_pkg pl =
      match pl with
	[] -> []
      |	p :: pl' ->
	  let modules = Sort.list ( <= ) (modules_of_pkg p) in
	  let found_modules =
	    List.flatten
	      (List.map
		 (fun m ->
		   if Str.string_match r1 m 0 then [m] else [])
		 modules) in
	  List.map (fun m -> p,m) found_modules
	  @ search_pkg pl'
    in

    let result = search_pkg l_packages in
    if result = [] then
      print "Sorry, nothing found.\n"
    else begin
      print "<table>\n";
      List.iter
	(fun (p,m) ->
	  print "<tr valign=top>\n";
	  print ("<td>Package " ^ pkg_url p ^ "</td>\n");
	  print ("<td>Module " ^ mod_url p m ^ "</td>\n");
	  print "</tr>\n")
	result;
      print "</table>\n"
    end
  end;

  (*** full-text search ***)

  if searchtext <> "" then begin
    print "<h1>Results of full-text search</h1>\n";
    let l1 = Str.split_delim (Str.regexp "\\*") searchtext in
    let s1 = String.concat ".*" (List.map Str.quote l1) in
    let r1 = Str.regexp_case_fold s1 in

    let rec search_pkg pl =
      match pl with
	[] -> []
      |	p :: pl' ->
	  let p_dir = Findlib.package_directory p in
	  let modules = Sort.list ( <= ) (modules_of_pkg p) in
	  let found =
	    List.flatten
	      (List.map
		 (fun m ->
		   let m_file = String.uncapitalize m ^ ".mli" in
		   let m_path = Filename.concat p_dir m_file in
		   if Sys.file_exists m_path then begin
		     let t = read_file m_path in
		     let t' = highlight r1 t in
		     if somewhere_highlighted t' then
		       let lines = highlighted_lines t' in
		       [p,m,lines]
		     else
		       []
		   end
		   else [])
		 modules) in
	  found @ search_pkg pl'
    in

    let result = search_pkg l_packages in
    if result = [] then
      print "Sorry, nothing found.\n"
    else begin
      print "<table>\n";
      List.iter
	(fun (p,m,lines) ->
	  print "<tr valign=top>\n";
	  print ("<td>Package " ^ pkg_url p ^ "</td>\n");
	  print ("<td>Module " ^ mod_url_hl p m s1 ^ "</td>\n");
	  print "</tr>\n";
	  print "<tr valign=top>\n";
	  print "<td></td><td><pre>\n";
	  print_text lines;
	  print "</pre></td></tr>\n")
	result;
      print "</table>\n"
    end
  end;

  (*** selected packages ***)

  List.iter
    (fun p ->
      if List.mem p l_packages then begin
	let p_html = escape_html p in
	print ("<h1>Package <code>" ^ p_html ^ "</code></h1>\n");

	let version = 
	  try Findlib.package_property [] p "version" 
	  with Not_found -> "unknown"
	in
	let description =
	  try Findlib.package_property [] p "description" 
	  with Not_found -> "none"
	in
	let uses_pkg = Findlib.package_ancestors [] p in
	let pkg_mods = Sort.list ( <= ) (modules_of_pkg p) in
	print "<table>\n";
	print "<tr valign=top>\n";
	print "<td>Version:</td>\n";
	print ("<td>" ^ escape_html version ^ "</td>\n");
	print "</tr>\n";
	print "<tr valign=top>\n";
	print "<td>Description:</td>\n";
	print ("<td>" ^ escape_html description ^ "</td>\n");
	print "</tr>\n";
	print "<tr valign=top>\n";
	print "<td>Ancestors:</td>\n";
	print "<td>";
	if uses_pkg = [] then
	  print "none"
	else
	  print (String.concat ", "  (List.map pkg_url uses_pkg));
	print "</td>\n";
	print "</tr>\n";
	print "<tr valign=top>\n";
	print "<td>Modules:</td>\n";
	print "<td>";
	if pkg_mods = [] then
	  print "none"
	else
	  print (String.concat ", "  (List.map (mod_url p) pkg_mods));
	print "</td>\n";
	print "</tr>\n";
	
	print "</table>\n";
      end)
    pkg;

  (*** selected modules ***)

  if List.length pkg = 1 then begin
    let p = List.hd pkg in
    let p_dir = Findlib.package_directory p in
    List.iter
      (fun m ->
	let m_html = escape_html m in
	print ("<h1>Module <code>" ^ m_html ^ "</code></h1>\n");
	let m_file = String.uncapitalize m ^ ".mli" in
	let m_path = Filename.concat p_dir m_file in
	if Sys.file_exists m_path then begin
	  print "<pre>\n";
	  let t = read_file m_path in
	  let t' = 
	    if hlight <> "" then
	      highlight (Str.regexp_case_fold hlight) t
	    else
	      t
	  in
	  print_text t';
	  print "</pre>\n"
	end
	else
	  print "Sorry, no printable interface definition found.")
      modules
  end;

  (*** search ***)

  print "<h1>Search</h1>\n";
  print "You may use <code>*</code> as wildcard character.<br>\n";
  print "<form method=post action=\"browser.cgi\">\n";
  print "<table>\n";
  print "<tr>\n";
  print "<td>Search toplevel module:</td>";
  print "<td><input type=text name=\"searchmod\"></td>";
  print "<td><input type=submit name=\"do_searchmod\" value=\"Go!\"><br></td>\n";
  print "</tr>\n";
  print "<tr>\n";
  print "<td>Full-text search:</td>";
  print "<td><input type=text name=\"searchtext\"></td>";
  print "<td><input type=submit name=\"do_searchtext\" value=\"Go!\"><br></td>\n";
  print "</tr>\n";
  print "</table>\n";
  print "</form>\n";

  print "</body></html>\n"
;;

begin try
  action()
with
  e ->
    cgi # set_header();
    print "<html><body><h1>Software error</h1>\n";
    print (Printexc.to_string e);
    print "</body></html>\n";
end;
commit()