(* 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.5 2006/03/27 16:43:44 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 : 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_ : (string option * string option * string) list;
- (* (sectionname, divname, content)
- * for each section. *)
+ contents_ : section list;
}
exception SaveURLError
-exception SaveConflict of int32 * int32 * 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 = 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, "<b>" ^ title ^ "</b> is " ] in
+ let contents = [ None, None, None, None, "<b>" ^ title ^ "</b> is " ] in
let model = { id = 0l;
pt = Title title;
description = title;
+ keywords = None;
+ noodp = None;
redirect = None;
contents_ = contents } in
model
let rows =
match version with
| None ->
- PGSQL(dbh) "select id, title, description, redirect
+ 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, redirect
+ 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, redirect =
+ 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, content
+ "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 dbh hostid ?user ?r model =
+let save_page r dbh hostid ?user model =
(* Logging information, if available. *)
let logged_user =
match user with
| _ -> None in
let logged_ip =
- match r with
- None -> None
- | Some r ->
- try Some (Connection.remote_ip (Request.connection r))
- with Not_found -> None 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
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 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, logged_ip, logged_user,
+ description, keywords, noodp,
+ logged_ip, logged_user,
redirect)
- values ($hostid, $url, $title, $description,
+ 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, content) ->
+ fun (sectionname, divname, divclass, jsgo, content) ->
incr ordering; let ordering = Int32.of_int !ordering in
PGSQL(dbh)
"insert into contents (pageid, ordering, sectionname, divname,
- content)
+ divclass, jsgo, content)
values ($pageid, $ordering,
- $?sectionname, $?divname, $content)"
+ $?sectionname, $?divname, $?divclass, $?jsgo, $content)"
) model.contents_;
url, pageid
let edited = max_id <> model_id in
- if edited then (
- let css = match css with None -> "" | Some css -> css 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.
page_emails_url_cn, links_from_cn, recently_visited_url_cn
deferred";
- (* 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)
+ (* 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, creation_date, logged_ip,
+ description, keywords, noodp,
+ creation_date, logged_ip,
logged_user, redirect, css)
- values ($hostid, $url, $title, $description, $creation_date,
+ values ($hostid, $url, $title, $description, $?keywords, $?noodp,
+ $creation_date,
$?logged_ip, $?logged_user, $?redirect, $?css)";
(* New page ID <> old page ID model.id. *)
(* Create the page contents. *)
let ordering = ref 0 in (* Creating new ordering. *)
List.iter (
- fun (sectionname, divname, content) ->
+ fun (sectionname, divname, divclass, jsgo, content) ->
incr ordering; let ordering = Int32.of_int !ordering in
PGSQL(dbh) "insert into contents (pageid,
- ordering, sectionname, divname, content)
+ ordering, sectionname, divname, divclass,
+ jsgo, content)
values ($pageid, $ordering, $?sectionname,
- $?divname, $content)"
+ $?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