X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=scripts%2Fedit.ml;h=016b0bb497d568319ee11aa0bfca8bb7c2b08b57;hb=4b281fea34f35536bff368f825c7a661e21c132b;hp=e8cc7c544ca986c7c88aa6e116e0c168c6ab65f9;hpb=eeb304015c65ccf593a77058d5db5f5a3e3b45d5;p=cocanwiki.git diff --git a/scripts/edit.ml b/scripts/edit.ml index e8cc7c5..016b0bb 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.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 @@ -33,11 +33,15 @@ 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. *) + 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; @@ -67,6 +71,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 +88,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 +202,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 +225,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,6 +257,15 @@ 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. *) @@ -267,6 +299,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = | _ -> assert false) in let model = { id = pageid; + pt = Page page; description = description; redirect = redirect; contents = contents; } in @@ -274,6 +307,31 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = 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 @@ -338,74 +396,6 @@ 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)) @@ -417,38 +407,210 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = | _ -> `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; + 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 (); @@ -464,62 +626,30 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = email_notify ~body ~subject dbh hostid; - (* 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]; - - dbh#commit (); - - 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 + 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) + q#redirect ("http://" ^ hostname ^ "/" ^ url); + return () in (* This codes decides where we are in the current editing cycle. @@ -529,24 +659,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