(* COCANWIKI - a wiki written in Objective CAML.
 * Written by Richard W.M. Jones <rich@merjis.com>.
 * Copyright (C) 2004 Merjis Ltd.
 * $Id: visualise_links.ml.,v 1.1 2004/10/21 11:42:04 rich Exp $
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 * Boston, MA 02111-1307, USA.
 *)

open Apache
open Registry
open Cgi
open Printf

open ExtList

open Cocanwiki
open Cocanwiki_template
open Cocanwiki_files

let rec takepairs = function
  | [] -> []
  | [x] -> invalid_arg "takepairs: odd number of elements in list"
  | x :: y :: xs -> (x, y) :: takepairs xs

let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
  let template = get_template dbh hostid "visualise_links.html" in

  (* This function generates a layout using the 'dot' program, part of
   * GraphViz.
   *)
  let gv_layout () =
    let sth = dbh#prepare_cached "select from_url, to_url from links
                                   where hostid = ?" in
    sth#execute [`Int hostid];

    let edges = sth#map (function [`String from_url; `String to_url] ->
			   from_url, to_url
			   | _ -> assert false) in

    let dotfile =
      String.concat ""
	([ "digraph t {\n";
	   "  fill=\"auto\";\n";
	   "  center=1;\n"; ] @
         (List.map (fun (node1, node2) ->
		      sprintf "  \"%s\" -> \"%s\";\n" node1 node2)
	    edges) @
         [ "}\n" ]) in

    let filename = output_tempfile dotfile in
    let cmd = sprintf "dot -Tplain %s" filename in

    let lines = pget cmd in
    unlink filename;

    (* For documentation of the output format of 'dot -Tplain', please see:
     * http://www.research.att.com/%7Eerg/graphviz/info/output.html#d:plain
     *)
    (* Split each line up into fields.  Unfortunately some fields are
     * quoted (if they contain spaces or other special characters) so we
     * have to deal with that.
     *)
    let split line =
      let n = String.length line in
      let rec skip_spaces i =
	if i < n && line.[i] = ' ' then skip_spaces (i+1) else i
      in
      let rec find i c =
	if i >= n then -1
	else if line.[i] = c then i
	else find (i+1) c
      in
      let rec loop i acc =
	if i >= n then acc
	else (
	  let c = line.[i] in
	  if c = '"' then (		(* quoted field *)
	    let j = find (i+1) '"' in
	    let field, i =
	      if i < j then String.sub line i (j-i), skip_spaces (j+1)
	      else String.sub line i (n-i), n in
	    loop i (field :: acc)
	  ) else (			(* ordinary field *)
	    let j = find (i+1) ' ' in
	    let field, i =
	      if i < j then String.sub line i (j-i), skip_spaces j
	      else String.sub line i (n-i), n in
	    loop i (field :: acc)
	  )
	)
      in
      List.rev (loop 0 [])
    in
    let lines = List.map split lines in

    (* First line is 'graph'. *)
    let graph_line, lines = List.hd lines, List.tl lines in
    let width, height =
      match graph_line with
	  [ "graph"; _; width; height ] ->
	    float_of_string width, float_of_string height
	| _ -> assert false in

    (* Get the nodes and edges. *)
    let is_node = function "node" :: _ -> true | _ -> false in
    let is_edge = function "edge" :: _ -> true | _ -> false in
    let nodes, edges = List.filter is_node lines, List.filter is_edge lines in

    (* Process the nodes and edges. *)
    let process_node = function
	"node" :: url :: x :: y :: width :: height :: _ ->
	  url, (float_of_string x, float_of_string y,
		float_of_string width, float_of_string height)
      | _ -> assert false
    in
    let nodes = List.map process_node nodes in

    let process_edge = function
	"edge" :: node1 :: node2 :: n :: rest ->
	  let n = int_of_string n in
	  let points =
	    List.map (fun (x, y) -> float_of_string x, float_of_string y)
	      (takepairs (List.take (n*2) rest)) in
	  node1, node2, points
      | _ -> assert false
    in
    let edges = List.map process_edge edges in

    (* Scale the whole thing to 1000x1000 pixel coordinates. *)
    let wscale = 1000. /. width in
    let hscale = 1000. /. height in

    let process_node (url, (x, y, width, height)) =
      url, (x *. wscale, y *. hscale, width *. wscale, height *. hscale)
    in
    let nodes = List.map process_node nodes in

    let process_edge (node1, node2, points) =
      let process_point (x, y) = x *. wscale, y *. hscale in
      node1, node2, List.map process_point points
    in
    let edges = List.map process_edge edges in

    (* Return the layout. *)
    let layout = nodes, edges in
    layout
  in

  (* XXX In future we are able to load this from the database. *)
  let nodes, edges = gv_layout () in

  let table =
    List.map (fun (url, (x, y, width, height)) ->
		[ "url", Template.VarString url;
		  "x", Template.VarString (string_of_float x);
		  "y", Template.VarString (string_of_float y);
		  "width", Template.VarString (string_of_float width);
		  "height", Template.VarString (string_of_float height) ])
      nodes in

  template#table "nodes" table;

  let table =
    List.map (fun (node1, node2, points) ->
		let xpoints, ypoints = List.split points in
		let xpoints =
		  List.map (fun x ->
			      [ "x", Template.VarString (string_of_float x) ])
		    xpoints in
		let ypoints =
		  List.map (fun y ->
			      [ "y", Template.VarString (string_of_float y) ])
		    ypoints in

		[ "node1", Template.VarString node1;
		  "node2", Template.VarString node2;
		  "xpoints", Template.VarTable xpoints;
		  "ypoints", Template.VarTable ypoints; ])
      edges in

  template#table "edges" table;







  q#template template

let () =
  register_script ~restrict:[CanEdit] run