(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki_pages.ml,v 1.3 2004/11/22 11:07:32 rich Exp $
+ * $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
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 : int; (* Original page ID (0 = none). *)
+ id : int32; (* Original page ID (0 = none). *)
pt : pt; (* 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. *)
+ 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 int * int * string * string
+exception SaveConflict of int32 * int32 * string * string option
let new_page pt =
let description =
match pt with
- Page page -> page
- | Title title -> title in
+ | Page page -> page
+ | Title title -> title in
- let model = { id = 0;
+ let model = { id = 0l;
pt = pt;
description = description;
- redirect = "";
- contents = [] } in
+ keywords = None;
+ noodp = None;
+ redirect = None;
+ contents_ = [] } in
model
let new_page_with_title title =
(* Initial page contents. *)
- let contents = [ "", "", "<b>" ^ title ^ "</b> is " ] in
- let model = { id = 0;
+ let contents = [ None, None, None, None, "<b>" ^ title ^ "</b> is " ] in
+ let model = { id = 0l;
pt = Title title;
description = title;
- redirect = "";
- contents = contents } in
+ keywords = None;
+ noodp = None;
+ redirect = None;
+ contents_ = contents } in
model
-let load_page (dbh : Dbi.connection) hostid ~url ?version () =
+let load_page dbh hostid ~url ?version () =
(* Pull out the page itself from the database. *)
- let sth =
+ let rows =
match version with
- None ->
- let sth = dbh#prepare_cached "select id, title, description,
- coalesce (redirect, '')
- from pages
- where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String url];
- sth
- | Some version ->
- let sth = dbh#prepare_cached "select id, title, description,
- coalesce (redirect, '')
- from pages
- where hostid = ? and id = ? and
- (url = ? or url_deleted = ?)" in
- sth#execute [`Int hostid; `String url; `String url];
- sth 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
+ | 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 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 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
+ contents_ = contents } in
model
-let save_page (dbh : Dbi.connection) hostid ?user ?r model =
+let save_page r dbh hostid ?user model =
(* Logging information, if available. *)
let logged_user =
match user with
- None -> `Null
+ None -> None
| Some user ->
match user with
- | User (id, _, _, _) -> `Int id
- | _ -> `Null in
+ | User (id, _, _, _) -> Some id
+ | _ -> None in
let logged_ip =
- match r with
- None -> `Null
- | Some r ->
- try `String (Connection.remote_ip (Request.connection r))
- with Not_found -> `Null in
-
- (* Get redirect. *)
- let redirect =
- if model.redirect = "" then `Null
- else `String model.redirect in
+ 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 = 0 then (
+ 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 dbh hostid title with
+ match Wikilib.generate_url_of_title r dbh hostid title with
Wikilib.GenURL_OK url -> url, title
| _ ->
raise SaveURLError 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 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 = sth#serial "pages_id_seq" in
+ let pageid = PGOCaml.serial4 dbh "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;
+ 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 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 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 sth#fetch1 () with
- [ creation_date; `String url; `String title; css ] ->
- creation_date, url, title, css
- | _ -> assert false in
+ 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
+ | Title new_title when title <> new_title -> new_title
+ | _ -> title 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 = Option.get (
+ List.hd (
+ PGSQL(dbh) "select max(id) from pages
+ where hostid = $hostid and url = $url"
+ )
+ ) in
- let max_id = sth#fetch1int () in
- let edited = max_id <> model.id in
+ let edited = max_id <> model_id in
- if edited then (
- let css = match css with
- `Null -> "" | `String css -> css
- | _ -> assert false in
- raise (SaveConflict (max_id, model.id, url, css))
- );
+ 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.
*)
- let sth =
- dbh#prepare_cached
- "set constraints pages_redirect_cn, sitemenu_url_cn,
+ PGSQL(dbh)
+ "set constraints
+ pages_redirect_cn, sitemenu_url_cn,
page_emails_url_cn, links_from_cn, recently_visited_url_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)
+ deferred";
+
+ (* Lock the pages table to avoid bogus 404 errors. The
+ * lock is released at the end of the current transaction.
*)
- 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];
+ 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 = sth#serial "pages_id_seq" in
+ let pageid = PGOCaml.serial4 dbh "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;
+ 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 dbh hostid url;
+ Cocanwiki_links.update_links_for_page r dbh hostid url;
url, pageid
git.annexia.org / cocanwiki.git / blobdiff