(* COCANWIKI scripts.
 * Written by Richard W.M. Jones <rich@merjis.com>.
 * Copyright (C) 2004 Merjis Ltd.
 * $Id: edit_sitemenu.ml,v 1.2 2004/09/08 15:46:53 rich Exp $
 *)

open Apache
open Registry
open Cgi
open Printf

open ExtString
open ExtList

open Cocanwiki
open Cocanwiki_template
open Cocanwiki_ok
open Cocanwiki_emailnotify
open Cocanwiki_strings

(* We keep an "internal model" of the menu - see build_internal_model ()
 * below.
 *)
type model_t = (string * string) list	(* label, url *)

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

  (* Workaround bugs in IE, specifically lack of support for <button>
   * elements.
   *)
  let msie =
    try
      let ua = Table.get (Request.headers_in r) "User-Agent" in
      ignore (String.find ua "MSIE"); (* Throws Invalid_string if not found. *)
      true
    with
	Not_found | String.Invalid_string -> false in
  template#conditional "msie" msie;

  (* Pull in the list of URLs in useful format. *)
  let sth = dbh#prepare_cached "select url, title from pages
                                 where hostid = ?
                                   and url is not null
                                   and url <> 'index'
                                 order by 2" in
  sth#execute [`Int hostid];

  let urls = sth#map (function [`String url; `String title] ->
			url, title
			| _ -> assert false) in

  (* Build the internal model from the parameters passed to the script. *)
  let build_internal_model () =
    let model = ref [] in
    let i = ref 1 in
    while q#param_exists ("label_" ^ string_of_int !i) do
      let label = q#param ("label_" ^ string_of_int !i) in
      let url = q#param ("url_" ^ string_of_int !i) in
      model := (label, url) :: !model;
      incr i
    done;
    (List.rev !model : model_t)
  in

  (* Check for errors in the model. *)
  let check_for_errors model =
    let errors = ref [] in
    let add_error msg = errors := msg :: !errors in
    let get_errors () = List.rev !errors in

    (* XXX Not implemented yet. *)




    get_errors ()
  in

  (* Various "actions" that can be performed on the model. *)
  let action_insert model posn item =
    (* posn = 0 means insert before the first element of the current list. *)
    let rec loop =
      function
          0, xs -> item :: xs
        | _, [] -> [ item ]
        | n, x :: xs -> x :: (loop (n-1, xs))
    in
    loop (posn, model)
  in
  let action_moveup model posn =
    (* posn = 1 means move up the first element, ie. do nothing
     * posn = 2 means move up the second element to the first position
     * etc.
     *)
    let rec loop =
      function
          0, xs
        | 1, xs -> xs
        | _, [] -> []
        | 2, x :: y :: xs -> y :: x :: xs
        | n, x :: xs -> x :: (loop (n-1, xs))
    in
    loop (posn, model)
  in
  let action_movedn model posn =
    (* posn = 1 means move down the first element to the second position
     * etc.
     *)
    let rec loop =
      function
          0, xs -> xs
        | _, [] -> []
        | 1, x :: y :: xs -> y :: x :: xs
        | n, x :: xs -> x :: (loop (n-1, xs))
    in
    loop (posn, model)
  in
  let action_delete model posn =
    (* posn = 1 means delete the first element *)
    let rec loop =
      function
          0, xs -> xs
        | _, [] -> []
        | 1, x :: xs -> xs
        | n, x :: xs -> x :: (loop (n-1, xs))
    in
    loop (posn, model)
  in

  (* Convert model to template. *)
  let model_to_template model template =
    let ordering = ref 0 in
    let table =
      List.map
	(fun (label, url) ->
	   incr ordering; let ordering = !ordering in

	   let table =
	     List.map
	       (fun (u, title) ->
		  let selected = u = url in
		  [ "url", Template.VarString u;
		    "title", Template.VarString (truncate 30 title);
		    "selected", Template.VarConditional selected ]) urls in

	   [ "ordering", Template.VarString (string_of_int ordering);
	     "label", Template.VarString label;
	     "url", Template.VarString url;
	     "urls", Template.VarTable table; ]) model in
    template#table "contents" table;

    (* Check for errors and put those into the template. *)
    let errors = check_for_errors model in
    let errors = List.map (fun msg ->
			     [ "error", Template.VarString msg ]) errors in
    template#table "errors" errors;
    template#conditional "has_errors" (errors <> [])
  in

  (* Begin editing a page, pulling the menu out of the database and building
   * a model from it.
   *)
  let begin_editing () =
    let sth = dbh#prepare_cached "select label, url, ordering
                                    from sitemenu
                                   where hostid = ?
                                   order by ordering" in
    sth#execute [`Int hostid];

    let model = sth#map (function [`String label; `String url; _] ->
			   label, url
			   | _ -> assert false) in

    model_to_template model template
  in

  let continue_editing () =
    let model = ref (build_internal_model ()) in

    (* An "action" parameter? *)
    let is_action, get_action =
      let actions = q#params in
      (* Don't actually care about the value fields ... *)
      let actions = List.map (fun (str, _) -> str) actions in
      (* Some of our actions are imagemaps, so parameters like name.x, name.y
       * need to be changed to name and have resulting duplicates removed.
       *)
      let actions =
	List.filter (fun str ->
		       String.length str > 7 &&
		       String.sub str 0 7 = "action_" &&
		       not (String.ends_with str ".y")) actions in
      let actions =
	List.map (fun str ->
		    if String.ends_with str ".x" then (
		      let str = String.sub str 0 (String.length str - 2) in
		      str
		    )
		    else str) actions in
      let actions =
	List.map (fun str ->
		    let action_type = String.sub str 7 6 in
		    let action_value =
		      String.sub str 14 (String.length str - 14) in
		    let action_value = int_of_string action_value in
		    action_type, action_value) actions in

      let is_action typ = List.mem_assoc typ actions in
      let get_value typ = List.assoc typ actions in

      is_action, get_value
    in

    if is_action "insert" then (
      let posn = get_action "insert" in
      let item = "", "" in
      model := action_insert !model posn item
    ) else if is_action "moveup" then (
      let posn = get_action "moveup" in
      model := action_moveup !model posn
    ) else if is_action "movedn" then (
      let posn = get_action "movedn" in
      model := action_movedn !model posn
    ) else if is_action "delete" then (
      let posn = get_action "delete" in
      model := action_delete !model posn
    );

    model_to_template !model template
  in

  (* Try to save the page.  Returns a boolean indicating if the
   * page was saved successfully.
   *)
  let try_save () =
    let model = build_internal_model () in
    let no_errors = [] = check_for_errors model in
    if no_errors then (
      (* No errors, so we can save the page ... *)

      let sth = dbh#prepare_cached "delete from sitemenu where hostid = ?" in
      sth#execute [`Int hostid];

      let sth = dbh#prepare_cached "insert into sitemenu (hostid, label, url,
                                    ordering) values (?, ?, ?, ?)" in

      List.iteri (fun i (label, url) ->
		    let ordering = 10 * (i+1) in
		    sth#execute [`Int hostid; `String label; `String url;
				 `Int ordering]) model;

      (* Commit changes to the database. *)
      dbh#commit ();

      (* Email notification, if anyone is listed for this host. *)
      let subject = "The site menu has been edited" in

      let body = fun () -> "Site: http://" ^ hostname ^ "/\n\n" in

      email_notify ~body ~subject dbh hostid;

      let buttons = [ ok_button "/" ] in
      ok ~title:"Saved" ~buttons
        q "The site menu was saved."
    );

    no_errors
  in

  let cancel () =
    q#redirect ("http://" ^ hostname ^ "/")
  in

  (* This codes decides where we are in the current editing cycle.
   *
   * Inputs:
   *   inedit - if set, then we are in the midst of editing a page.
   *   save - if set, then we want to save the page.
   *   cancel - if set, abandon changes and go back to viewing the page.
   *   action_* - one of the action buttons was set, eg. move up/down.
   *   page - the page URL opened newly for editing.
   *)
  if q#param_true "inedit" then (
    if q#param_true "cancel" then (
      cancel ();
      raise CgiExit
    );
    if q#param_true "save" then (
      let ok = try_save () in
      if ok then raise CgiExit		(* ... else fall through *)
    );
    continue_editing ()			(* Processes the action, if any. *)
  ) else
    begin_editing ();

  q#template template

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