X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;ds=sidebyside;f=scripts%2Fedit.ml;h=016b0bb497d568319ee11aa0bfca8bb7c2b08b57;hb=4b281fea34f35536bff368f825c7a661e21c132b;hp=19324f97984613c7c3eebad122922724060b6ef2;hpb=714e5e5b4b585da1eca55274e3903ee9a1dbf0d6;p=cocanwiki.git

diff --git a/scripts/edit.ml b/scripts/edit.ml
index 19324f9..016b0bb 100644
--- a/scripts/edit.ml
+++ b/scripts/edit.ml
@@ -1,7 +1,22 @@
-(* COCANWIKI scripts.
+(* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
- * $Id: edit.ml,v 1.2 2004/09/07 13:40:10 rich Exp $
+ * $Id: edit.ml,v 1.17 2004/10/09 09:52:10 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
@@ -11,22 +26,22 @@ open Printf
 
 open ExtString
 
-open Merjisforwiki
-
 open Cocanwiki
 open Cocanwiki_template
 open Cocanwiki_ok
 open Cocanwiki_emailnotify
 open Cocanwiki_diff
+open Cocanwiki_strings
 
-let template = get_template "edit.html"
-let template_conflict = get_template "edit_conflict.html"
+(* Page of title. *)
+type pt_t = Page of string | Title of string
 
 (* We keep an "internal model" of the page - see build_internal_model ()
  * below.
  *)
 type model_t = {
-  id : int;				(* Original page ID. *)
+  id : int;				(* Original page ID (0 = none). *)
+  pt : pt_t;				(* Page of title (only used if id=0) *)
   description : string;			(* Description. *)
   redirect : string;			(* Redirect to ("" = none). *)
   contents : (string * string * string) list;
@@ -34,7 +49,11 @@ type model_t = {
 					 * for each section. *)
 }
 
-let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ =
+let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
+  let template = get_template dbh hostid "edit.html" in
+  let template_conflict = get_template dbh hostid "edit_conflict.html" in
+  let template_email = get_template dbh hostid "edit_page_email.txt" in
+
   (* Workaround bugs in IE, specifically lack of support for <button>
    * elements.
    *)
@@ -52,6 +71,10 @@ let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ =
     let id = int_of_string (q#param "id") in
     let description = q#param "description" in
     let redirect = q#param "redirect" in
+    let pt = match q#param "pt_type" with
+	"page" -> Page (q#param "pt_value")
+      | "title" -> Title (q#param "pt_value")
+      | _ -> failwith "unknown value for pt_type parameter" in
 
     let contents = ref [] in
     let i = ref 1 in
@@ -65,6 +88,7 @@ let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ =
     let contents = List.rev !contents in
 
     { id = id;
+      pt = pt;
       description = description;
       redirect = redirect;
       contents = contents; }
@@ -104,12 +128,16 @@ let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ =
 		   "(ie. not to a page which is itself a redirect).")
     );
 
-    (* All sections have sectionnames? *)
-    List.iter (function (sectionnames, _, _)
-		   when string_is_whitespace sectionnames ->
-		     add_error ("Every section must have a title.");
-		 | _ -> ())
-      model.contents;
+    (* All sections after the first one have sectionnames?  The first
+     * section ONLY is allowed to have an empty title.
+     *)
+    if model.contents <> [] then
+      List.iter (function (sectionnames, _, _)
+		     when string_is_whitespace sectionnames ->
+		       add_error
+		       ("Every section except the first must have a title.");
+		   | _ -> ())
+	(List.tl model.contents);
 
     get_errors ()
   in
@@ -174,6 +202,14 @@ let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ =
     template#set "id" (string_of_int model.id);
     template#set "description" model.description;
 
+    (match model.pt with
+	 Page page ->
+	   template#set "pt_type" "page";
+	   template#set "pt_value" page
+       | Title title ->
+	   template#set "pt_type" "title";
+	   template#set "pt_value" title);
+
     (* Redirects table. *)
     let sth = dbh#prepare_cached "select url, title from pages
                                    where url is not null
@@ -189,12 +225,18 @@ let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ =
 			   | _ -> assert false) in
     template#table "redirects" table;
 
-    (* Need to go to the database to get the title of the page ... *)
-    let sth = dbh#prepare_cached "select title from pages
-                                   where hostid = ? and id = ?" in
-    sth#execute [`Int hostid; `Int model.id];
-    let title = sth#fetch1string () in
-    template#set "title" title;
+    if model.id <> 0 then (
+      (* Need to go to the database to get the title of the page ... *)
+      let sth = dbh#prepare_cached "select title from pages
+                                     where hostid = ? and id = ?" in
+      sth#execute [`Int hostid; `Int model.id];
+      let title = sth#fetch1string () in
+      template#set "title" title;
+    ) else (
+      match model.pt with
+	  Page page -> template#set "title" page
+	| Title title -> template#set "title" title
+    );
 
     let ordering = ref 0 in
     let table =
@@ -215,6 +257,15 @@ let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ =
     template#conditional "has_errors" (errors <> [])
   in
 
+  (* Check if a URL exists in the database. *)
+  let page_exists page =
+    let sth =
+      dbh#prepare_cached "select 1 from pages where hostid = ? and url = ?" in
+    sth#execute [`Int hostid; `String page];
+
+    try sth#fetch1int () = 1 with Not_found -> false
+  in
+
   (* Begin editing a page, pulling the page out of the database and building
    * a model from it.
    *)
@@ -233,7 +284,8 @@ let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ =
 	| _ -> assert false in
 
     (* Get the sections. *)
-    let sth = dbh#prepare_cached "select sectionname, content,
+    let sth = dbh#prepare_cached "select coalesce (sectionname, ''),
+                                         content,
                                          coalesce (divname, '')
                                     from contents
                                    where pageid = ?
@@ -247,6 +299,7 @@ let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ =
 		 | _ -> assert false) in
 
     let model = { id = pageid;
+		  pt = Page page;
 		  description = description;
 		  redirect = redirect;
 		  contents = contents; } in
@@ -254,6 +307,31 @@ let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ =
     model_to_template model template
   in
 
+  (* Begin editing with a blank page, typically a template. *)
+  let begin_editing_new pt =
+    let url, title =
+      match pt with
+	  Page url -> url, url
+	| Title title ->
+	    match Wikilib.generate_url_of_title dbh hostid title with
+		Wikilib.GenURL_OK url -> url, title
+	      | Wikilib.GenURL_Duplicate url ->
+		  q#redirect ("http://" ^ hostname ^ "/" ^ url);
+		  return ()
+	      | Wikilib.GenURL_TooShort | Wikilib.GenURL_BadURL ->
+		  error ~back_button:true ~title:"Bad page name"
+		    q "The page name supplied is too short or invalid.";
+		  return () in
+
+    let model = { id = 0;
+		  pt = pt;
+		  description = title;
+		  redirect = "";
+		  contents = [] } in
+
+    model_to_template model template
+  in
+
   let continue_editing () =
     let model = ref (build_internal_model ()) in
 
@@ -318,107 +396,221 @@ let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ =
     if no_errors then (
       (* No errors, so we can save the page ... *)
 
-      (* Pull out fields from the database. *)
-      let sth = dbh#prepare_cached "select creation_date,
-                                           coalesce (url, url_deleted),
-                                           title, css
-                                      from pages
-                                     where hostid = ? and id = ?" in
-      sth#execute [`Int hostid; `Int model.id];
-
-      let creation_date, url, title, css =
-	match sth#fetch1 () with
-	    [ creation_date; `String url; `String title; css ] ->
-	      creation_date, url, title, css
-	  | _ -> assert false in
-
-      (* Has someone else edited this page in the meantime? *)
-      let sth = dbh#prepare_cached "select max(id) from pages
-                                     where hostid = ? and url = ?" in
-      sth#execute [`Int hostid; `String url];
-
-      let max_id = sth#fetch1int () in
-      let edited = max_id <> model.id in
-
-      if edited then (
-	(* Edited by someone else ...  Get the other's changes. *)
-	let other_diff, _ =
-	  get_diff dbh hostid url ~old_version:model.id ~version:max_id () in
-
-	(* Synthesize our own changes. *)
-	let old_page = get_version_for_diff dbh model.id in
-	let new_page =
-	  let css = match css with
-	      `Null -> "" | `String css -> css
-	    | _ -> assert false in
-	  page_for_diff css (List.map (fun (sectionname, _, content) ->
-			       sectionname, content) model.contents) in
-	let our_diff = diff_cmd old_page new_page in
-
-	(* Fill out the conflict template. *)
-	template_conflict#set "other_diff" other_diff;
-	template_conflict#set "our_diff" our_diff;
-	template_conflict#set "old_version" (string_of_int model.id);
-	template_conflict#set "new_version" (string_of_int max_id);
-	template_conflict#set "url" url;
-
-	q#template template_conflict;
-	raise CgiExit
-      );
-
-      (* Defer the pages_redirect_cn constraint because that would
-       * temporarily fail on the next UPDATE.
-       *)
-      let sth =
-	dbh#prepare_cached "set constraints pages_redirect_cn deferred" in
-      sth#execute [];
-
-      (* Mark the old page as deleted.  NB. There is a small race
-       * condition here because PostgreSQL doesn't do isolation
-       * properly.  If a user tries to visit this page between the
-       * delete and the creation of the new page, then they'll get
-       * a page not found error. (XXX)
-       *)
-      let sth = dbh#prepare_cached "update pages set url_deleted = url,
-                                                     url = null
-                                     where hostid = ? and id = ?" in
-      sth#execute [`Int hostid; `Int model.id];
-
       (* Get the IP address of the user, if available. *)
       let logged_ip =
 	try `String (Connection.remote_ip (Request.connection r))
 	with Not_found -> `Null in
 
+      let logged_user =
+	match user with
+	  | User (id, _, _) -> `Int id
+	  | _ -> `Null in
+
       (* Get redirect. *)
-      let redirect = if model.redirect = "" then `Null
-                     else `String model.redirect in
-
-      (* Create the new page. *)
-      let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
-                                      description, creation_date, logged_ip,
-                                      redirect, css)
-                                    values (?, ?, ?, ?, ?, ?, ?, ?)" in
-      sth#execute [`Int hostid; `String url; `String title;
-		   `String model.description; creation_date; logged_ip;
-		   redirect; css];
-
-      (* New page ID <> old page ID model.id. *)
-      let pageid = sth#serial "pages_id_seq" in
-
-      (* Create the page contents. *)
-      let sth = dbh#prepare_cached "insert into contents (pageid,
-                                      ordering, sectionname, divname, content)
-                                    values (?, ?, ?, ?, ?)" in
-      let ordering = ref 0 in		(* Creating new ordering. *)
-      List.iter (fun (sectionname, divname, content) ->
-		   let divname =
-		     if string_is_whitespace divname then `Null
-		     else `String divname in
-		   incr ordering; let ordering = !ordering in
-		   sth#execute [`Int pageid; `Int ordering;
-				`String sectionname; divname;
-				`String content])
-	model.contents;
+      let redirect =
+	if model.redirect = "" then `Null
+        else `String model.redirect in
+
+      let url, pageid =
+	(* Creating a new page (id = 0)?  If so, we're just going to insert
+	 * a new row, which is easy.
+	 *)
+	if model.id = 0 then (
+	  (* Create the page title or URL. *)
+	  let url, title =
+	    match model.pt with
+		Page url -> url, url
+	      | Title title ->
+		  match Wikilib.generate_url_of_title dbh hostid title with
+		      Wikilib.GenURL_OK url -> url, title
+		    | Wikilib.GenURL_Duplicate url ->
+			error ~back_button:true ~title:"Page exists"
+			  q ("While you were editing that page, it looks " ^
+			     "like another user created the same page.");
+			return ()
+		    | _ ->
+			assert false (* This should have been detected in
+				      * begin_editing_new.
+				      *) in
+
+	  let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
+                                        description, logged_ip, logged_user,
+                                        redirect)
+                                        values (?, ?, ?, ?, ?, ?, ?)" in
+	  sth#execute [`Int hostid; `String url; `String title;
+		       `String model.description; logged_ip; logged_user;
+		       redirect];
+
+	  let pageid = sth#serial "pages_id_seq" in
+
+	  (* Create the page contents. *)
+	  let sth = dbh#prepare_cached "insert into contents (pageid,
+                                        ordering, sectionname, divname,
+                                        content)
+                                        values (?, ?, ?, ?, ?)" in
+	  let ordering = ref 0 in	(* Creating new ordering. *)
+	  List.iter (fun (sectionname, divname, content) ->
+		       let divname =
+			 if string_is_whitespace divname then `Null
+			 else `String divname in
+		       let sectionname =
+			 if string_is_whitespace sectionname then `Null
+			 else `String sectionname in
+		       incr ordering; let ordering = !ordering in
+		       sth#execute [`Int pageid; `Int ordering;
+				    sectionname; divname;
+				    `String content])
+	    model.contents;
+
+	  url, pageid
+	)
+	(* Otherwise it's an old page which we're updating. *)
+	else (
+	  (* Pull out fields from the database. *)
+	  let sth = dbh#prepare_cached "select creation_date,
+                                               coalesce (url, url_deleted),
+                                               title, css
+                                          from pages
+                                         where hostid = ? and id = ?" in
+	  sth#execute [`Int hostid; `Int model.id];
+
+	  let creation_date, url, title, css =
+	    match sth#fetch1 () with
+		[ creation_date; `String url; `String title; css ] ->
+		  creation_date, url, title, css
+	      | _ -> assert false in
+
+	  (* Has someone else edited this page in the meantime? *)
+	  let sth = dbh#prepare_cached "select max(id) from pages
+                                         where hostid = ? and url = ?" in
+	  sth#execute [`Int hostid; `String url];
+
+	  let max_id = sth#fetch1int () in
+	  let edited = max_id <> model.id in
+
+	  if edited then (
+	    (* Edited by someone else ...  Get the other's changes. *)
+	    let other_diff, _ =
+	      get_diff dbh hostid url
+		~old_version:model.id ~version:max_id () in
+
+	    (* Synthesize our own changes. *)
+	    let old_page = get_version_for_diff dbh model.id in
+	    let new_page =
+	      let css = match css with
+		  `Null -> "" | `String css -> css
+		| _ -> assert false in
+	      page_for_diff css (List.map (fun (sectionname, _, content) ->
+				sectionname, content) model.contents) in
+	    let our_diff = diff_cmd old_page new_page in
+
+	    (* Fill out the conflict template. *)
+	    template_conflict#set "other_diff" other_diff;
+	    template_conflict#set "our_diff" our_diff;
+	    template_conflict#set "old_version" (string_of_int model.id);
+	    template_conflict#set "new_version" (string_of_int max_id);
+	    template_conflict#set "url" url;
+
+	    q#template template_conflict;
+	    return ()
+	  );
+
+	  (* Defer the pages_redirect_cn constraint because that would
+	   * temporarily fail on the next UPDATE.
+	   *)
+	  let sth =
+	    dbh#prepare_cached
+	      "set constraints pages_redirect_cn, sitemenu_url_cn,
+                   page_emails_url_cn, links_from_cn deferred" in
+	  sth#execute [];
+
+	  (* Mark the old page as deleted.  NB. There is a small race
+	   * condition here because PostgreSQL doesn't do isolation
+	   * properly.  If a user tries to visit this page between the
+	   * delete and the creation of the new page, then they'll get
+	   * a page not found error. (XXX)
+	   *)
+	  let sth = dbh#prepare_cached "update pages set url_deleted = url,
+                                                         url = null
+                                         where hostid = ? and id = ?" in
+	  sth#execute [`Int hostid; `Int model.id];
+
+	  (* Create the new page. *)
+	  let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
+                                        description, creation_date, logged_ip,
+                                        logged_user, redirect, css)
+                                        values (?, ?, ?, ?, ?, ?, ?, ?, ?)" in
+	  sth#execute [`Int hostid; `String url; `String title;
+		       `String model.description; creation_date; logged_ip;
+		       logged_user; redirect; css];
+
+	  (* New page ID <> old page ID model.id. *)
+	  let pageid = sth#serial "pages_id_seq" in
+
+	  (* Create the page contents. *)
+	  let sth = dbh#prepare_cached "insert into contents (pageid,
+                                        ordering, sectionname, divname,
+                                        content)
+                                        values (?, ?, ?, ?, ?)" in
+	  let ordering = ref 0 in	(* Creating new ordering. *)
+	  List.iter (fun (sectionname, divname, content) ->
+		       let divname =
+			 if string_is_whitespace divname then `Null
+			 else `String divname in
+		       let sectionname =
+			 if string_is_whitespace sectionname then `Null
+			 else `String sectionname in
+		       incr ordering; let ordering = !ordering in
+		       sth#execute [`Int pageid; `Int ordering;
+				    sectionname; divname;
+				    `String content])
+	    model.contents;
+
+	  (* General email notification of page edits.  Send an email to
+	   * anyone in the page_emails table who has a confirmed address
+	   * and who hasn't received an email already today.
+	   *)
+	  let sth = dbh#prepare_cached "select email, opt_out from page_emails
+                                         where hostid = ? and url = ?
+                                           and pending is null
+                                           and last_sent < current_date" in
+	  sth#execute [`Int hostid; `String url];
+
+	  let addrs = sth#map (function [`String email; `String opt_out] ->
+				 email, opt_out
+				 | _ -> assert false) in
+
+	  if addrs <> [] then (
+	    (* Construct the email. *)
+	    template_email#set "hostname" hostname;
+	    template_email#set "page" url;
+
+	    let subject =
+	      "Site notice: " ^ hostname ^ "/" ^ url ^ " has been updated" in
+
+	    (* Send each email individually (they all have different opt out
+	     * links).
+	     *)
+	    List.iter (fun (to_addr, opt_out) ->
+			 template_email#set "opt_out" opt_out;
+			 let body = template_email#to_string in
+			 Sendmail.send_mail ~subject
+			   ~to_addr:[to_addr] ~body ())
+	      addrs
+	  );
+
+	  (* Update the database to record when these emails were sent. *)
+	  let sth = dbh#prepare_cached "update page_emails
+                                           set last_sent = current_date
+                                         where hostid = ? and url = ?
+                                           and pending is null" in
+	  sth#execute [`Int hostid; `String url];
+
+	  url, pageid
+	) in
+
+      (* Keep the links table in synch. *)
+      Cocanwiki_links.update_links_for_page dbh hostid url;
 
       (* Commit changes to the database. *)
       dbh#commit ();
@@ -434,21 +626,30 @@ let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ =
 
       email_notify ~body ~subject dbh hostid;
 
-      let buttons = [ ok_button ("/" ^ url) ] in
-      ok ~title:"Saved" ~buttons
-        q "The page was saved."
+      (* Redirect back to the URL. *)
+      q#redirect ("http://" ^ hostname ^ "/" ^ url);
+      return ()
     );
-
-    no_errors
   in
 
   let cancel id =
-    let sth = dbh#prepare_cached "select url from pages
-                                   where hostid = ? and id = ?" in
-    sth#execute [`Int hostid; `Int id];
-    let url = sth#fetch1string () in
-
-    q#redirect ("http://" ^ hostname ^ "/" ^ url)
+    let url =
+      if id <> 0 then (
+	let sth = dbh#prepare_cached "select url from pages
+                                       where hostid = ? and id = ?" in
+	sth#execute [`Int hostid; `Int id];
+	sth#fetch1string ()
+      ) else if q#param "pt_type" = "page" then
+	q#param "pt_value"
+      else
+	(* Create a new page, but the user hits the cancel button.  Because
+	 * we didn't save where they came from, we now have nowhere to
+	 * go.  So we redirect to the home page. XXX
+	 *)
+	"" in
+
+    q#redirect ("http://" ^ hostname ^ "/" ^ url);
+    return ()
   in
 
   (* This codes decides where we are in the current editing cycle.
@@ -458,26 +659,35 @@ let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ =
    *   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.
+   *   page - the page URL opened newly for editing, or a template which
+   *          doesn't yet exist.
+   *   title - page doesn't yet exist; create it.
    *)
-  (try
-     let id = int_of_string (q#param "id") in
-     if q#param_true "cancel" then (
-       cancel id;
-       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. *)
-   with
-       Not_found ->
-	 let page = q#param "page" in
-	 let page = if page = "" then "index" else page in
-	 begin_editing page);
+  let id =
+    try Some (int_of_string (q#param "id")) with Not_found -> None in
+  (match id with
+     | None ->				(* Begin editing the page. *)
+	 if q#param_exists "page" then (
+	   let page = q#param "page" in
+	   let page = if page = "" then "index" else page in
+	   if page_exists page then
+	     begin_editing page
+	   else
+	     begin_editing_new (Page page)
+	 ) else (
+	   let title = q#param "title" in
+	   begin_editing_new (Title title)
+	 )
+
+     | Some id ->
+	 if q#param_true "cancel" then
+	   cancel id;
+	 if q#param_true "save" then
+	   try_save ();			(* might fail and fall through ... *)
+	 continue_editing ()
+  );
 
   q#template template
 
 let () =
-  register_script run
+  register_script ~restrict:[CanEdit] run