scripts/cocanwiki_pages.ml

   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 $
   5  *
   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.
  10  *
  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.
  15  *
  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.
  20  *)
  21
  22 open Apache
  23
  24 open Cocanwiki
  25 open Cocanwiki_strings
  26
  27 type pt = Page of string | Title of string
  28
  29 type model = {
  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. *)
  37 }
  38
  39 exception SaveURLError
  40 exception SaveConflict of int * int * string * string
  41
  42 let new_page pt =
  43   let description =
  44     match pt with
  45         Page page -> page
  46       | Title title -> title in
  47
  48   let model = { id = 0;
  49                 pt = pt;
  50                 description = description;
  51                 redirect = "";
  52                 contents = [] } in
  53   model
  54
  55 let new_page_with_title title =
  56   (* Initial page contents. *)
  57   let contents = [ "", "", "<b>" ^ title ^ "</b> is " ] in
  58   let model = { id = 0;
  59                 pt = Title title;
  60                 description = title;
  61                 redirect = "";
  62                 contents = contents } in
  63   model
  64
  65 let load_page (dbh : Dbi.connection) hostid ~url ?version () =
  66   (* Pull out the page itself from the database. *)
  67   let sth =
  68     match version with
  69         None ->
  70           let sth = dbh#prepare_cached "select id, title, description,
  71                                                coalesce (redirect, '')
  72                                           from pages
  73                                          where hostid = ? and url = ?" in
  74           sth#execute [`Int hostid; `String url];
  75           sth
  76       | Some version ->
  77           let sth = dbh#prepare_cached "select id, title, description,
  78                                                coalesce (redirect, '')
  79                                           from pages
  80                                          where hostid = ? and id = ? and
  81                                                (url = ? or url_deleted = ?)" in
  82           sth#execute [`Int hostid; `String url; `String url];
  83           sth in
  84
  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
  90
  91   (* Get the sections. *)
  92   let sth = dbh#prepare_cached "select coalesce (sectionname, ''),
  93                                        content,
  94                                        coalesce (divname, '')
  95                                   from contents
  96                                  where pageid = ?
  97                                  order by ordering" in
  98   sth#execute [`Int pageid];
  99
 100   let contents =
 101     sth#map (function
 102                | [`String sectionname; `String content; `String divname] ->
 103                    sectionname, divname, content
 104                | _ -> assert false) in
 105
 106   let model = { id = pageid;
 107                 pt = Page url;
 108                 description = description;
 109                 redirect = redirect;
 110                 contents = contents; } in
 111   model
 112
 113 let save_page (dbh : Dbi.connection) hostid ?user ?r model =
 114   (* Logging information, if available. *)
 115   let logged_user =
 116     match user with
 117         None -> `Null
 118       | Some user ->
 119           match user with
 120             | User (id, _, _) -> `Int id
 121             | _ -> `Null in
 122
 123   let logged_ip =
 124     match r with
 125         None -> `Null
 126       | Some r ->
 127           try `String (Connection.remote_ip (Request.connection r))
 128           with Not_found -> `Null in
 129
 130   (* Get redirect. *)
 131   let redirect =
 132     if model.redirect = "" then `Null
 133     else `String model.redirect in
 134
 135   let url, pageid =
 136     (* Creating a new page (id = 0)?  If so, we're just going to insert
 137      * a new row, which is easy.
 138      *)
 139     if model.id = 0 then (
 140       (* Create the page title or URL. *)
 141       let url, title =
 142         match model.pt with
 143             Page url -> url, url
 144           | Title title ->
 145               match Wikilib.generate_url_of_title dbh hostid title with
 146                   Wikilib.GenURL_OK url -> url, title
 147                 | _ ->
 148                     raise SaveURLError in
 149
 150       let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
 151                                       description, logged_ip, logged_user,
 152                                       redirect)
 153                                       values (?, ?, ?, ?, ?, ?, ?)" in
 154       sth#execute [`Int hostid; `String url; `String title;
 155                    `String model.description; logged_ip; logged_user;
 156                    redirect];
 157
 158       let pageid = sth#serial "pages_id_seq" in
 159
 160       (* Create the page contents. *)
 161       let sth = dbh#prepare_cached "insert into contents (pageid,
 162                                       ordering, sectionname, divname,
 163                                       content)
 164                                       values (?, ?, ?, ?, ?)" in
 165       let ordering = ref 0 in   (* Creating new ordering. *)
 166       List.iter (fun (sectionname, divname, content) ->
 167                    let divname =
 168                      if string_is_whitespace divname then `Null
 169                      else `String divname in
 170                    let sectionname =
 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;
 176                                 `String content])
 177         model.contents;
 178
 179       url, pageid
 180     )
 181       (* Otherwise it's an old page which we're updating. *)
 182     else (
 183       (* Pull out fields from the database. *)
 184       let sth = dbh#prepare_cached "select creation_date,
 185                                            coalesce (url, url_deleted),
 186                                            title, css
 187                                       from pages
 188                                      where hostid = ? and id = ?" in
 189       sth#execute [`Int hostid; `Int model.id];
 190
 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
 196
 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];
 201
 202       let max_id = sth#fetch1int () in
 203       let edited = max_id <> model.id in
 204
 205       if edited then (
 206         let css = match css with
 207             `Null -> "" | `String css -> css
 208           | _ -> assert false in
 209         raise (SaveConflict (max_id, model.id, url, css))
 210       );
 211
 212       (* Defer the pages_redirect_cn constraint because that would
 213        * temporarily fail on the next UPDATE.
 214        *)
 215       let sth =
 216         dbh#prepare_cached
 217           "set constraints pages_redirect_cn, sitemenu_url_cn,
 218                page_emails_url_cn, links_from_cn, recently_visited_url_cn
 219                deferred" in
 220       sth#execute [];
 221
 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)
 227        *)
 228       let sth = dbh#prepare_cached "update pages set url_deleted = url,
 229                                                      url = null
 230                                      where hostid = ? and id = ?" in
 231       sth#execute [`Int hostid; `Int model.id];
 232
 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];
 241
 242       (* New page ID <> old page ID model.id. *)
 243       let pageid = sth#serial "pages_id_seq" in
 244
 245       (* Create the page contents. *)
 246       let sth = dbh#prepare_cached "insert into contents (pageid,
 247                                     ordering, sectionname, divname,
 248                                     content)
 249                                     values (?, ?, ?, ?, ?)" in
 250       let ordering = ref 0 in   (* Creating new ordering. *)
 251       List.iter (fun (sectionname, divname, content) ->
 252                    let divname =
 253                      if string_is_whitespace divname then `Null
 254                      else `String divname in
 255                    let sectionname =
 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;
 261                                 `String content])
 262         model.contents;
 263
 264       url, pageid
 265     ) in
 266
 267   (* Keep the links table in synch. *)
 268   Cocanwiki_links.update_links_for_page dbh hostid url;
 269
 270   url, pageid