X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=scripts%2Fedit.ml;h=abf8e3ca60d409bab2ffee9a005cef4ca83a9389;hb=bfc0f85bc1869f5139505dd6ffbacecb1af564a4;hp=e8cc7c544ca986c7c88aa6e116e0c168c6ab65f9;hpb=eeb304015c65ccf593a77058d5db5f5a3e3b45d5;p=cocanwiki.git diff --git a/scripts/edit.ml b/scripts/edit.ml index e8cc7c5..abf8e3c 100644 --- a/scripts/edit.ml +++ b/scripts/edit.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit.ml,v 1.13 2004/09/28 10:56:39 rich Exp $ + * $Id: edit.ml,v 1.22 2004/10/25 07:44:55 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 @@ -32,18 +32,7 @@ open Cocanwiki_ok open Cocanwiki_emailnotify open Cocanwiki_diff open Cocanwiki_strings - -(* We keep an "internal model" of the page - see build_internal_model () - * below. - *) -type model_t = { - id : int; (* Original page ID. *) - description : string; (* Description. *) - redirect : string; (* Redirect to ("" = none). *) - contents : (string * string * string) list; - (* (sectionname, divname, content) - * for each section. *) -} +open Cocanwiki_pages let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = let template = get_template dbh hostid "edit.html" in @@ -67,6 +56,10 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = 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 @@ -80,6 +73,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = let contents = List.rev !contents in { id = id; + pt = pt; description = description; redirect = redirect; contents = contents; } @@ -193,6 +187,14 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = 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 @@ -208,12 +210,18 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = | _ -> 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 = @@ -234,42 +242,42 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = 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. *) let begin_editing page = - (* Pull out the page itself from the database. *) - let sth = dbh#prepare_cached "select id, title, description, - coalesce (redirect, '') - from pages - where hostid = ? and url = ?" in - sth#execute [`Int hostid; `String page]; + let model = load_page dbh hostid ~url:page () in + model_to_template model template + in - let pageid, title, description, redirect = - match sth#fetch1 () with - [`Int pageid; `String title; `String description; `String redirect]-> - pageid, title, description, redirect - | _ -> assert false in - - (* Get the sections. *) - let sth = dbh#prepare_cached "select coalesce (sectionname, ''), - content, - coalesce (divname, '') - from contents - where pageid = ? - order by ordering" in - sth#execute [`Int pageid]; - - let contents = - sth#map (function - | [`String sectionname; `String content; `String divname] -> - sectionname, divname, content - | _ -> assert false) in - - let model = { id = pageid; - description = description; - redirect = redirect; - contents = contents; } 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 = match pt with + Page url -> new_page pt + | Title title -> new_page_with_title title in model_to_template model template in @@ -338,131 +346,38 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = 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; - 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, links_to_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, - 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; - - (* Commit changes to the database. *) - dbh#commit (); - - (* Email notification, if anyone is listed for this host. *) - let subject = "Page " ^ url ^ " has been edited" in - - let body = fun () -> - (* Prepare the diff between this version and the previous version. *) - let diff, _ = get_diff dbh hostid url ~version:pageid () in - "Page: http://" ^ hostname ^ "/" ^ url ^ "\n\n" ^ - diff in - - email_notify ~body ~subject dbh hostid; + let url, pageid = + try + save_page dbh hostid ~user ~r model + with + SaveURLError -> + error ~back_button:true ~title:"Page exists" + q ("While you were editing that page, it looks " ^ + "like another user created the same page."); + return () + + | SaveConflict (new_version, old_version, url, css) -> + (* Edited by someone else ... Get the other's changes. *) + let other_diff, _ = + get_diff dbh hostid url + ~old_version ~version:new_version () in + + (* Synthesize our own changes. *) + let old_page = get_version_for_diff dbh old_version in + let new_page = + 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 old_version); + template_conflict#set "new_version" (string_of_int new_version); + template_conflict#set "url" url; + + q#template template_conflict; + return () in (* General email notification of page edits. Send an email to * anyone in the page_emails table who has a confirmed address @@ -492,7 +407,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = 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 ()) + Sendmail.send_mail ~subject + ~to_addr:[to_addr] ~body ()) addrs ); @@ -503,23 +419,45 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = and pending is null" in sth#execute [`Int hostid; `String url]; + (* Commit changes to the database. *) dbh#commit (); - let buttons = [ ok_button ("/" ^ url) ] in - ok ~title:"Saved" ~buttons - q "The page was saved." - ); + (* Email notification, if anyone is listed for this host. *) + let subject = "Page " ^ url ^ " has been edited" in - no_errors + let body = fun () -> + (* Prepare the diff between this version and the previous version. *) + let diff, _ = get_diff dbh hostid url ~version:pageid () in + "Page: http://" ^ hostname ^ "/" ^ url ^ "\n\n" ^ + diff in + + email_notify ~body ~subject ~user dbh hostid; + + (* Redirect back to the URL. *) + q#redirect ("http://" ^ hostname ^ "/" ^ url); + return () + ); 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 + let url = + if id <> 0 then ( + let sth = dbh#prepare_cached "select coalesce (url, url_deleted) + 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) + q#redirect ("http://" ^ hostname ^ "/" ^ url); + return () in (* This codes decides where we are in the current editing cycle. @@ -529,24 +467,33 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = * 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; - return () - ); - if q#param_true "save" then ( - let ok = try_save () in - if ok then return () (* ... 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