(* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. * $Id: cocanwiki_pages.ml,v 1.12 2006/12/07 15:46:54 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 open Cocanwiki open Cocanwiki_strings type pt = Page of string | Title of string type section = string option * string option * string option * string option * string (* (sectionname, divname, divclass, jsgo, content) *) type model = { id : int32; (* Original page ID (0 = none). *) pt : pt; (* Page of title (only used if id=0) *) description : string; (* Description. *) keywords : string option; (* Keywords. *) noodp : bool option; (* NOODP per-page override. *) redirect : string option; (* Redirect to. *) (* NB. Don't call this 'contents' because that clashes with the * Pervasives.contents fields of the ref type. *) contents_ : section list; } exception SaveURLError exception SaveConflict of int32 * int32 * string * string option let new_page pt = let description = match pt with | Page page -> page | Title title -> title in let model = { id = 0l; pt = pt; description = description; keywords = None; noodp = None; redirect = None; contents_ = [] } in model let new_page_with_title title = (* Initial page contents. *) let contents = [ None, None, None, None, "" ^ title ^ " is " ] in let model = { id = 0l; pt = Title title; description = title; keywords = None; noodp = None; redirect = None; contents_ = contents } in model let load_page dbh hostid ~url ?version () = (* Pull out the page itself from the database. *) let rows = match version with | None -> PGSQL(dbh) "select id, title, description, keywords, noodp, redirect from pages where hostid = $hostid and url = $url" | Some version -> PGSQL(dbh) "select id, title, description, keywords, noodp, redirect from pages where hostid = $hostid and id = $version and (url = $url or url_deleted = $url)" in let pageid, title, description, keywords, noodp, redirect = match rows with | [row] -> row | _ -> raise Not_found in (* Get the sections. *) let contents = PGSQL(dbh) "select sectionname, divname, divclass, jsgo, content from contents where pageid = $pageid order by ordering" in let model = { id = pageid; pt = Page url; description = description; keywords = keywords; noodp = noodp; redirect = redirect; contents_ = contents } in model let save_page r dbh hostid ?user model = (* Logging information, if available. *) let logged_user = match user with None -> None | Some user -> match user with | User (id, _, _, _) -> Some id | _ -> None in let logged_ip = try Some (Connection.remote_ip (Request.connection r)) with Not_found -> None 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 = 0l 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 r dbh hostid title with Wikilib.GenURL_OK url -> url, title | _ -> raise SaveURLError in let description = model.description in let keywords = model.keywords in let noodp = model.noodp in let redirect = model.redirect in PGSQL(dbh) "insert into pages (hostid, url, title, description, keywords, noodp, logged_ip, logged_user, redirect) values ($hostid, $url, $title, $description, $?keywords, $?noodp, $?logged_ip, $?logged_user, $?redirect)"; let pageid = PGOCaml.serial4 dbh "pages_id_seq" in (* Create the page contents. *) let ordering = ref 0 in (* Creating new ordering. *) List.iter ( fun (sectionname, divname, divclass, jsgo, content) -> incr ordering; let ordering = Int32.of_int !ordering in PGSQL(dbh) "insert into contents (pageid, ordering, sectionname, divname, divclass, jsgo, content) values ($pageid, $ordering, $?sectionname, $?divname, $?divclass, $?jsgo, $content)" ) model.contents_; url, pageid ) (* Otherwise it's an old page which we're updating. *) else ( (* Pull out fields from the database. *) let model_id = model.id in let rows = PGSQL(dbh) "select creation_date, coalesce (url, url_deleted), title, css from pages where hostid = $hostid and id = $model_id" in let creation_date, url, title, css = match rows with | [ row ] -> row | _ -> assert false in let url = Option.get url in (* Title changed? *) let title = match model.pt with | Title new_title when title <> new_title -> new_title | _ -> title in (* Has someone else edited this page in the meantime? *) let max_id = Option.get ( List.hd ( PGSQL(dbh) "select max(id) from pages where hostid = $hostid and url = $url" ) ) in let edited = max_id <> model_id in if edited then raise (SaveConflict (max_id, model_id, url, css)); (* Defer the pages_redirect_cn constraint because that would * temporarily fail on the next UPDATE. *) PGSQL(dbh) "set constraints pages_redirect_cn, sitemenu_url_cn, page_emails_url_cn, links_from_cn, recently_visited_url_cn deferred"; (* Lock the pages table to avoid bogus 404 errors. The * lock is released at the end of the current transaction. *) PGSQL(dbh) "lock table pages"; (* Mark the old page as deleted. *) PGSQL(dbh) "update pages set url_deleted = url, url = null where hostid = $hostid and id = $model_id"; let description = model.description in let keywords = model.keywords in let noodp = model.noodp in let redirect = model.redirect in PGSQL(dbh) "insert into pages (hostid, url, title, description, keywords, noodp, creation_date, logged_ip, logged_user, redirect, css) values ($hostid, $url, $title, $description, $?keywords, $?noodp, $creation_date, $?logged_ip, $?logged_user, $?redirect, $?css)"; (* New page ID <> old page ID model.id. *) let pageid = PGOCaml.serial4 dbh "pages_id_seq" in (* Create the page contents. *) let ordering = ref 0 in (* Creating new ordering. *) List.iter ( fun (sectionname, divname, divclass, jsgo, content) -> incr ordering; let ordering = Int32.of_int !ordering in PGSQL(dbh) "insert into contents (pageid, ordering, sectionname, divname, divclass, jsgo, content) values ($pageid, $ordering, $?sectionname, $?divname, $?divclass, $?jsgo, $content)" ) model.contents_; url, pageid ) in (* Keep the links table in synch. *) Cocanwiki_links.update_links_for_page r dbh hostid url; url, pageid