X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=scripts%2Fedit.ml;h=abf8e3ca60d409bab2ffee9a005cef4ca83a9389;hb=bfc0f85bc1869f5139505dd6ffbacecb1af564a4;hp=952e9ef4e92f542f46c5a7e9972a744c5d124efe;hpb=cdac12b60bfef03623b847ef9e7d4eab2b1ad43e;p=cocanwiki.git diff --git a/scripts/edit.ml b/scripts/edit.ml index 952e9ef..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.18 2004/10/10 15:33:36 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,22 +32,7 @@ open Cocanwiki_ok open Cocanwiki_emailnotify open Cocanwiki_diff open Cocanwiki_strings - -(* 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 (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; - (* (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 @@ -270,40 +255,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = * 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 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; - pt = Page page; - description = description; - redirect = redirect; - contents = contents; } in - + let model = load_page dbh hostid ~url:page () in model_to_template model template in @@ -323,19 +275,9 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = q "The page name supplied is too short or invalid."; return () in - (* Initial page contents. *) - let contents = - match pt with - Page url -> [] - | Title title -> - [ "", "", - "" ^ title ^ " is " ] in - - let model = { id = 0; - pt = pt; - description = title; - redirect = ""; - contents = contents } 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 @@ -404,221 +346,78 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = if no_errors then ( (* No errors, so we can save the page ... *) - (* 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 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 - let logged_user = - match user with - | User (id, _, _) -> `Int id - | _ -> `Null 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; - (* Get redirect. *) - let redirect = - if model.redirect = "" then `Null - else `String model.redirect in + q#template template_conflict; + return () in - let url, pageid = - (* Creating a new page (id = 0)? If so, we're just going to insert - * a new row, which is easy. + (* 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). *) - 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; + 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]; (* Commit changes to the database. *) dbh#commit (); @@ -632,7 +431,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = "Page: http://" ^ hostname ^ "/" ^ url ^ "\n\n" ^ diff in - email_notify ~body ~subject dbh hostid; + email_notify ~body ~subject ~user dbh hostid; (* Redirect back to the URL. *) q#redirect ("http://" ^ hostname ^ "/" ^ url); @@ -643,7 +442,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = let cancel id = let url = if id <> 0 then ( - let sth = dbh#prepare_cached "select url from pages + 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 ()