scripts/lib/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.5 2006/03/27 16:43:44 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 : int32;                           (* Original page ID (0 = none). *)
  31   pt : pt;                              (* Page of title (only used if id=0) *)
  32   description : string;                 (* Description. *)
  33   redirect : string option;             (* Redirect to. *)
  34   (* NB. Don't call this 'contents' because that clashes with the
  35    * Pervasives.contents fields of the ref type.
  36    *)
  37   contents_ : (string option * string option * string) list;
  38                                         (* (sectionname, divname, content)
  39                                          * for each section. *)
  40 }
  41
  42 exception SaveURLError
  43 exception SaveConflict of int32 * int32 * string * string
  44
  45 let new_page pt =
  46   let description =
  47     match pt with
  48         Page page -> page
  49       | Title title -> title in
  50
  51   let model = { id = 0l;
  52                 pt = pt;
  53                 description = description;
  54                 redirect = None;
  55                 contents_ = [] } in
  56   model
  57
  58 let new_page_with_title title =
  59   (* Initial page contents. *)
  60   let contents = [ None, None, "<b>" ^ title ^ "</b> is " ] in
  61   let model = { id = 0l;
  62                 pt = Title title;
  63                 description = title;
  64                 redirect = None;
  65                 contents_ = contents } in
  66   model
  67
  68 let load_page dbh hostid ~url ?version () =
  69   (* Pull out the page itself from the database. *)
  70   let rows =
  71     match version with
  72     | None ->
  73         PGSQL(dbh) "select id, title, description, redirect
  74                       from pages
  75                      where hostid = $hostid and url = $url"
  76     | Some version ->
  77         PGSQL(dbh) "select id, title, description, redirect
  78                       from pages
  79                      where hostid = $hostid and id = $version and
  80                            (url = $url or url_deleted = $url)" in
  81
  82   let pageid, title, description, redirect =
  83     match rows with
  84     | [row] -> row
  85     | _ -> raise Not_found in
  86
  87   (* Get the sections. *)
  88   let contents = PGSQL(dbh)
  89     "select sectionname, divname, content
  90        from contents
  91       where pageid = $pageid
  92       order by ordering" in
  93
  94   let model = { id = pageid;
  95                 pt = Page url;
  96                 description = description;
  97                 redirect = redirect;
  98                 contents_ = contents } in
  99   model
 100
 101 let save_page dbh hostid ?user ?r model =
 102   (* Logging information, if available. *)
 103   let logged_user =
 104     match user with
 105         None -> None
 106       | Some user ->
 107           match user with
 108             | User (id, _, _, _) -> Some id
 109             | _ -> None in
 110
 111   let logged_ip =
 112     match r with
 113         None -> None
 114       | Some r ->
 115           try Some (Connection.remote_ip (Request.connection r))
 116           with Not_found -> None in
 117
 118   let url, pageid =
 119     (* Creating a new page (id = 0)?  If so, we're just going to insert
 120      * a new row, which is easy.
 121      *)
 122     if model.id = 0l then (
 123       (* Create the page title or URL. *)
 124       let url, title =
 125         match model.pt with
 126             Page url -> url, url
 127           | Title title ->
 128               match Wikilib.generate_url_of_title dbh hostid title with
 129                   Wikilib.GenURL_OK url -> url, title
 130                 | _ ->
 131                     raise SaveURLError in
 132
 133       let description = model.description in
 134       let redirect = model.redirect in
 135       PGSQL(dbh) "insert into pages (hostid, url, title,
 136                                      description, logged_ip, logged_user,
 137                                      redirect)
 138                   values ($hostid, $url, $title, $description,
 139                           $?logged_ip, $?logged_user, $?redirect)";
 140
 141       let pageid = PGOCaml.serial4 dbh "pages_id_seq" in
 142
 143       (* Create the page contents. *)
 144       let ordering = ref 0 in   (* Creating new ordering. *)
 145       List.iter (
 146         fun (sectionname, divname, content) ->
 147           incr ordering; let ordering = Int32.of_int !ordering in
 148           PGSQL(dbh)
 149             "insert into contents (pageid, ordering, sectionname, divname,
 150                                    content)
 151              values ($pageid, $ordering,
 152                      $?sectionname, $?divname, $content)"
 153       ) model.contents_;
 154
 155       url, pageid
 156     )
 157       (* Otherwise it's an old page which we're updating. *)
 158     else (
 159       (* Pull out fields from the database. *)
 160       let model_id = model.id in
 161       let rows =
 162         PGSQL(dbh)
 163         "select creation_date, coalesce (url, url_deleted),
 164                 title, css
 165            from pages
 166           where hostid = $hostid and id = $model_id" in
 167
 168       let creation_date, url, title, css =
 169         match rows with
 170         | [ row ] -> row
 171         | _ -> assert false in
 172       let url = Option.get url in
 173
 174       (* Title changed? *)
 175       let title =
 176         match model.pt with
 177         | Title new_title when title <> new_title -> new_title
 178         | _ -> title in
 179
 180       (* Has someone else edited this page in the meantime? *)
 181       let max_id = Option.get (
 182         List.hd (
 183           PGSQL(dbh) "select max(id) from pages
 184                        where hostid = $hostid and url = $url"
 185         )
 186       ) in
 187
 188       let edited = max_id <> model_id in
 189
 190       if edited then (
 191         let css = match css with None -> "" | Some css -> css in
 192         raise (SaveConflict (max_id, model_id, url, css))
 193       );
 194
 195       (* Defer the pages_redirect_cn constraint because that would
 196        * temporarily fail on the next UPDATE.
 197        *)
 198       PGSQL(dbh)
 199         "set constraints
 200                pages_redirect_cn, sitemenu_url_cn,
 201                page_emails_url_cn, links_from_cn, recently_visited_url_cn
 202              deferred";
 203
 204       (* Mark the old page as deleted.  NB. There is a small race
 205        * condition here because PostgreSQL doesn't do isolation
 206        * properly.  If a user tries to visit this page between the
 207        * delete and the creation of the new page, then they'll get
 208        * a page not found error. (XXX)
 209        *)
 210       PGSQL(dbh) "update pages set url_deleted = url, url = null
 211                    where hostid = $hostid and id = $model_id";
 212
 213       let description = model.description in
 214       let redirect = model.redirect in
 215       PGSQL(dbh)
 216         "insert into pages (hostid, url, title,
 217                             description, creation_date, logged_ip,
 218                             logged_user, redirect, css)
 219          values ($hostid, $url, $title, $description, $creation_date,
 220                  $?logged_ip, $?logged_user, $?redirect, $?css)";
 221
 222       (* New page ID <> old page ID model.id. *)
 223       let pageid = PGOCaml.serial4 dbh "pages_id_seq" in
 224
 225       (* Create the page contents. *)
 226       let ordering = ref 0 in   (* Creating new ordering. *)
 227       List.iter (
 228         fun (sectionname, divname, content) ->
 229           incr ordering; let ordering = Int32.of_int !ordering in
 230           PGSQL(dbh) "insert into contents (pageid,
 231                          ordering, sectionname, divname, content)
 232                       values ($pageid, $ordering, $?sectionname,
 233                               $?divname, $content)"
 234       ) model.contents_;
 235
 236       url, pageid
 237     ) in
 238
 239   (* Keep the links table in synch. *)
 240   Cocanwiki_links.update_links_for_page dbh hostid url;
 241
 242   url, pageid