From d6978d316016d0c96753ace2a2e474c50bd40c42 Mon Sep 17 00:00:00 2001
From: rich <rich>
Date: Wed, 8 Sep 2004 14:47:47 +0000
Subject: [PATCH] Editable site menu.

---
 scripts/Makefile             |   3 +-
 scripts/edit_sitemenu.ml     | 300 +++++++++++++++++++++++++++++++++++++++++++
 templates/edit_sitemenu.html |  56 ++++++++
 templates/page.html          |   5 +-
 4 files changed, 362 insertions(+), 2 deletions(-)
 create mode 100644 scripts/edit_sitemenu.ml
 create mode 100644 templates/edit_sitemenu.html

diff --git a/scripts/Makefile b/scripts/Makefile
index 987806b..423e712 100644
--- a/scripts/Makefile
+++ b/scripts/Makefile
@@ -1,5 +1,5 @@
 # Makefile for COCANWIKI.
-# $Id: Makefile,v 1.8 2004/09/08 12:45:38 rich Exp $
+# $Id: Makefile,v 1.9 2004/09/08 14:47:47 rich Exp $
 
 include ../Makefile.config
 
@@ -31,6 +31,7 @@ OBJS := create.cmo \
 	edit.cmo \
 	edit_page_css.cmo \
 	edit_page_css_form.cmo \
+	edit_sitemenu.cmo \
 	edit_user.cmo \
 	edit_user_form.cmo \
 	file.cmo \
diff --git a/scripts/edit_sitemenu.ml b/scripts/edit_sitemenu.ml
new file mode 100644
index 0000000..25997e8
--- /dev/null
+++ b/scripts/edit_sitemenu.ml
@@ -0,0 +1,300 @@
+(* COCANWIKI scripts.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: edit_sitemenu.ml,v 1.1 2004/09/08 14:47:47 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
+
+let template = get_template "edit_sitemenu.html"
+
+(* 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, _) _ =
+  (* 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
diff --git a/templates/edit_sitemenu.html b/templates/edit_sitemenu.html
new file mode 100644
index 0000000..30f9608
--- /dev/null
+++ b/templates/edit_sitemenu.html
@@ -0,0 +1,56 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<title>Edit site menu</title>
+<meta name="robots" content="noindex,nofollow"/>
+<meta name="author" content="http://www.merjis.com/" />
+<link rel="stylesheet" href="/_css/standard.css" type="text/css" title="Standard"/>
+<link rel="stylesheet" href="/_css/editor.css" type="text/css" title="Standard"/>
+</head><body>
+
+<h1>Edit site menu</h1>
+
+<form method="post" action="/_bin/edit_sitemenu.cmo">
+<input type="hidden" name="inedit" value="1"/>
+
+<p class="insert">
+<input class="insert" type="submit" name="action_insert_0" value="Insert"/>
+</p>
+
+::table(contents)::
+<div class="action">
+::if(msie)::
+<input type="submit" class="action" name="action_moveup_::ordering::" value="Up" title="Move this item up"/>
+<input type="submit" class="action" name="action_movedn_::ordering::" value="Down" title="Move this item down"/>
+<input type="submit" class="action" name="action_delete_::ordering::" value="Delete" title="Delete this item"/>
+<a href="/_static/markup.html" target="_blank" class="help_link">(Editing&nbsp;help)</a>
+::else::
+<button type="submit" class="action" name="action_moveup_::ordering::" value="1" title="Move this item up"><img src="/_graphics/arrow-up.png" width="10" height="10" alt=""/> Up</button>
+<button type="submit" class="action" name="action_movedn_::ordering::" value="1" title="Move this item down"><img src="/_graphics/arrow-down.png" width="10" height="10" alt=""/> Down</button>
+<button type="submit" class="action" name="action_delete_::ordering::" value="1" title="Delete this item"><img src="/_graphics/cross.png" width="10" height="10" alt=""/> Delete</button>
+::end::
+</div>
+<input name="label_::ordering::" value="::label_html_tag::" size="12"/>
+-&gt;
+<select name="url_::ordering::">
+::table(urls)::<option value="::url_html_tag::" ::if(selected)::selected="selected"::end::>::title_html::</option>::end::
+</select>
+
+<p class="insert">
+<input class="insert" type="submit" name="action_insert_::ordering::" value="Insert"/>
+</p>
+::end::
+
+<input type="submit" class="action" name="save" value="Save" title="Save menu"/>
+<input type="submit" class="action" name="cancel" value="Cancel" title="Cancel all edits"/>
+
+</form>
+
+<hr/>
+
+<ul id="footer" class="menu">
+<li> <a href="/copyright">Copyright &copy; 2004</a> </li>
+</ul>
+
+</body>
+</html>
\ No newline at end of file
diff --git a/templates/page.html b/templates/page.html
index df3fe71..77a4353 100644
--- a/templates/page.html
+++ b/templates/page.html
@@ -63,11 +63,14 @@
 <li> <a href="/_images">Images</a> </li>
 <li> <a href="/_files">Files</a> </li>
 <li> <a href="/::page_html_tag::/editcss">Edit&nbsp;stylesheet&nbsp;for&nbsp;this&nbsp;page</a> </li>
-<li> <a href="/_bin/admin/admin.cmo">Wiki&nbsp;administration</a> </li>
+<li> <a href="/_bin/edit_sitemenu.cmo">Edit&nbsp;site&nbsp;menu</a> </li>
 ::end::
 ::if(can_manage_users)::
 <li> <a href="/_users">Manage&nbsp;users</a> </li>
 ::end::
+::if(can_edit)::
+<li> <a href="/_bin/admin/admin.cmo">Server&nbsp;administration</a> </li>
+::end::
 </ul>
 
 <hr/>
-- 
1.8.3.1