--- /dev/null
+(* 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
--- /dev/null
+<!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 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"/>
+->
+<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 © 2004</a> </li>
+</ul>
+
+</body>
+</html>
\ No newline at end of file
git.annexia.org / cocanwiki.git / commitdiff