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.4 2005/11/17 10:14:43 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 = Int64.to_int (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
200 Title new_title when title <> new_title -> new_title
203 (* Has someone else edited this page in the meantime? *)
204 let sth = dbh#prepare_cached "select max(id) from pages
205 where hostid = ? and url = ?" in
206 sth#execute [`Int hostid; `String url];
208 let max_id = sth#fetch1int () in
209 let edited = max_id <> model.id in
212 let css = match css with
213 `Null -> "" | `String css -> css
214 | _ -> assert false in
215 raise (SaveConflict (max_id, model.id, url, css))
218 (* Defer the pages_redirect_cn constraint because that would
219 * temporarily fail on the next UPDATE.
223 "set constraints pages_redirect_cn, sitemenu_url_cn,
224 page_emails_url_cn, links_from_cn, recently_visited_url_cn
228 (* Mark the old page as deleted. NB. There is a small race
229 * condition here because PostgreSQL doesn't do isolation
230 * properly. If a user tries to visit this page between the
231 * delete and the creation of the new page, then they'll get
232 * a page not found error. (XXX)
234 let sth = dbh#prepare_cached "update pages set url_deleted = url,
236 where hostid = ? and id = ?" in
237 sth#execute [`Int hostid; `Int model.id];
239 (* Create the new page. *)
240 let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
241 description, creation_date, logged_ip,
242 logged_user, redirect, css)
243 values (?, ?, ?, ?, ?, ?, ?, ?, ?)" in
244 sth#execute [`Int hostid; `String url; `String title;
245 `String model.description; creation_date; logged_ip;
246 logged_user; redirect; css];
248 (* New page ID <> old page ID model.id. *)
249 let pageid = Int64.to_int (sth#serial "pages_id_seq") in
251 (* Create the page contents. *)
252 let sth = dbh#prepare_cached "insert into contents (pageid,
253 ordering, sectionname, divname,
255 values (?, ?, ?, ?, ?)" in
256 let ordering = ref 0 in (* Creating new ordering. *)
257 List.iter (fun (sectionname, divname, content) ->
259 if string_is_whitespace divname then `Null
260 else `String divname in
262 if string_is_whitespace sectionname then `Null
263 else `String sectionname in
264 incr ordering; let ordering = !ordering in
265 sth#execute [`Int pageid; `Int ordering;
266 sectionname; divname;
273 (* Keep the links table in synch. *)
274 Cocanwiki_links.update_links_for_page dbh hostid url;