1 (* COCANWIKI - a wiki written in Objective CAML.
2 * Written by Richard W.M. Jones <rich@merjis.com>.
3 * Copyright (C) 2004 Merjis Ltd.
4 * $Id: cocanwiki_pages.ml,v 1.1 2004/10/11 14:13:04 rich Exp $
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation; either version 2 of the License, or
9 * (at your option) any later version.
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 * GNU General Public License for more details.
16 * You should have received a copy of the GNU General Public License
17 * along with this program; see the file COPYING. If not, write to
18 * the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 * Boston, MA 02111-1307, USA.
25 open Cocanwiki_strings
27 type pt = Page of string | Title of string
30 id : int; (* Original page ID (0 = none). *)
31 pt : pt; (* Page of title (only used if id=0) *)
32 description : string; (* Description. *)
33 redirect : string; (* Redirect to ("" = none). *)
34 contents : (string * string * string) list;
35 (* (sectionname, divname, content)
36 * for each section. *)
39 exception SaveURLError
40 exception SaveConflict of int * int * string * string
46 | Title title -> title in
50 description = description;
55 let new_page_with_title title =
56 (* Initial page contents. *)
57 let contents = [ "", "", "<b>" ^ title ^ "</b> is " ] in
62 contents = contents } in
65 let load_page (dbh : Dbi.connection) hostid ~url ?version () =
66 (* Pull out the page itself from the database. *)
70 let sth = dbh#prepare_cached "select id, title, description,
71 coalesce (redirect, '')
73 where hostid = ? and url = ?" in
74 sth#execute [`Int hostid; `String url];
77 let sth = dbh#prepare_cached "select id, title, description,
78 coalesce (redirect, '')
80 where hostid = ? and id = ? and
81 (url = ? or url_deleted = ?)" in
82 sth#execute [`Int hostid; `String url; `String url];
85 let pageid, title, description, redirect =
86 match sth#fetch1 () with
87 [`Int pageid; `String title; `String description; `String redirect] ->
88 pageid, title, description, redirect
89 | _ -> assert false in
91 (* Get the sections. *)
92 let sth = dbh#prepare_cached "select coalesce (sectionname, ''),
94 coalesce (divname, '')
98 sth#execute [`Int pageid];
102 | [`String sectionname; `String content; `String divname] ->
103 sectionname, divname, content
104 | _ -> assert false) in
106 let model = { id = pageid;
108 description = description;
110 contents = contents; } in
113 let save_page (dbh : Dbi.connection) hostid ?user ?r model =
114 (* Logging information, if available. *)
120 | User (id, _, _) -> `Int id
127 try `String (Connection.remote_ip (Request.connection r))
128 with Not_found -> `Null in
132 if model.redirect = "" then `Null
133 else `String model.redirect in
136 (* Creating a new page (id = 0)? If so, we're just going to insert
137 * a new row, which is easy.
139 if model.id = 0 then (
140 (* Create the page title or URL. *)
145 match Wikilib.generate_url_of_title dbh hostid title with
146 Wikilib.GenURL_OK url -> url, title
148 raise SaveURLError in
150 let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
151 description, logged_ip, logged_user,
153 values (?, ?, ?, ?, ?, ?, ?)" in
154 sth#execute [`Int hostid; `String url; `String title;
155 `String model.description; logged_ip; logged_user;
158 let pageid = sth#serial "pages_id_seq" in
160 (* Create the page contents. *)
161 let sth = dbh#prepare_cached "insert into contents (pageid,
162 ordering, sectionname, divname,
164 values (?, ?, ?, ?, ?)" in
165 let ordering = ref 0 in (* Creating new ordering. *)
166 List.iter (fun (sectionname, divname, content) ->
168 if string_is_whitespace divname then `Null
169 else `String divname in
171 if string_is_whitespace sectionname then `Null
172 else `String sectionname in
173 incr ordering; let ordering = !ordering in
174 sth#execute [`Int pageid; `Int ordering;
175 sectionname; divname;
181 (* Otherwise it's an old page which we're updating. *)
183 (* Pull out fields from the database. *)
184 let sth = dbh#prepare_cached "select creation_date,
185 coalesce (url, url_deleted),
188 where hostid = ? and id = ?" in
189 sth#execute [`Int hostid; `Int model.id];
191 let creation_date, url, title, css =
192 match sth#fetch1 () with
193 [ creation_date; `String url; `String title; css ] ->
194 creation_date, url, title, css
195 | _ -> assert false in
197 (* Has someone else edited this page in the meantime? *)
198 let sth = dbh#prepare_cached "select max(id) from pages
199 where hostid = ? and url = ?" in
200 sth#execute [`Int hostid; `String url];
202 let max_id = sth#fetch1int () in
203 let edited = max_id <> model.id in
206 let css = match css with
207 `Null -> "" | `String css -> css
208 | _ -> assert false in
209 raise (SaveConflict (max_id, model.id, url, css))
212 (* Defer the pages_redirect_cn constraint because that would
213 * temporarily fail on the next UPDATE.
217 "set constraints pages_redirect_cn, sitemenu_url_cn,
218 page_emails_url_cn, links_from_cn, recently_visited_url_cn
222 (* Mark the old page as deleted. NB. There is a small race
223 * condition here because PostgreSQL doesn't do isolation
224 * properly. If a user tries to visit this page between the
225 * delete and the creation of the new page, then they'll get
226 * a page not found error. (XXX)
228 let sth = dbh#prepare_cached "update pages set url_deleted = url,
230 where hostid = ? and id = ?" in
231 sth#execute [`Int hostid; `Int model.id];
233 (* Create the new page. *)
234 let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
235 description, creation_date, logged_ip,
236 logged_user, redirect, css)
237 values (?, ?, ?, ?, ?, ?, ?, ?, ?)" in
238 sth#execute [`Int hostid; `String url; `String title;
239 `String model.description; creation_date; logged_ip;
240 logged_user; redirect; css];
242 (* New page ID <> old page ID model.id. *)
243 let pageid = sth#serial "pages_id_seq" in
245 (* Create the page contents. *)
246 let sth = dbh#prepare_cached "insert into contents (pageid,
247 ordering, sectionname, divname,
249 values (?, ?, ?, ?, ?)" in
250 let ordering = ref 0 in (* Creating new ordering. *)
251 List.iter (fun (sectionname, divname, content) ->
253 if string_is_whitespace divname then `Null
254 else `String divname in
256 if string_is_whitespace sectionname then `Null
257 else `String sectionname in
258 incr ordering; let ordering = !ordering in
259 sth#execute [`Int pageid; `Int ordering;
260 sectionname; divname;
267 (* Keep the links table in synch. *)
268 Cocanwiki_links.update_links_for_page dbh hostid url;