scripts/edit_page_title.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: edit_page_title.ml,v 1.3 2004/10/07 11:36:46 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 open Registry
  24 open Cgi
  25 open Printf
  26
  27 open Cocanwiki
  28 open Cocanwiki_ok
  29 open Cocanwiki_emailnotify
  30 open Cocanwiki_strings
  31
  32 let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
  33   let page = q#param "page" in
  34   let new_title = trim (q#param "title") in
  35
  36   (* Get the old title. *)
  37   let sth = dbh#prepare_cached "select title from pages
  38                                  where hostid = ? and url = ?" in
  39   sth#execute [`Int hostid; `String page];
  40
  41   let old_title = sth#fetch1string () in
  42
  43   (* New title mustn't be empty string. *)
  44   if new_title = "" then (
  45     error ~back_button:true ~title:"Empty title not allowed"
  46       q "The new title cannot be empty.";
  47     return ()
  48   );
  49
  50   (* If it's the index page, then they can change the title however
  51    * they want.  On other pages, however, you are only allowed limited
  52    * edits which preserve the title -> url mapping.
  53    *)
  54   if page <> "index" then (
  55     let new_page =
  56       match Wikilib.generate_url_of_title dbh hostid new_title with
  57           Wikilib.GenURL_OK url -> url
  58         | Wikilib.GenURL_TooShort
  59         | Wikilib.GenURL_BadURL -> ""
  60         | Wikilib.GenURL_Duplicate url -> url in
  61
  62     if new_page <> page then (
  63       error ~back_button:true ~title:"Title altered too much"
  64         q ("The new title is too different from the old one.  You can only " ^
  65            "make limited changes to the title of a page.  The manual " ^
  66            "describes why, and how to copy pages instead.");
  67       return ()
  68     )
  69   );
  70
  71   (* Get the IP address of the user, if available. *)
  72   let logged_ip =
  73     try `String (Connection.remote_ip (Request.connection r))
  74     with Not_found -> `Null in
  75
  76   let logged_user =
  77     match user with
  78       | User (id, _, _) -> `Int id
  79       | _ -> `Null in
  80
  81   (* Changing the title creates a new version of the page.  This enables
  82    * us to revert changes.
  83    *)
  84   let sth = dbh#prepare_cached "select id, description, creation_date,
  85                                        redirect, css
  86                                   from pages
  87                                  where hostid = ? and url = ?" in
  88   sth#execute [`Int hostid; `String page];
  89
  90   let oldpageid, description, creation_date, redirect, css =
  91     match sth#fetch1 () with
  92         [ `Int id; description; creation_date; redirect; css ] ->
  93           id, description, creation_date, redirect, css
  94       | _ -> assert false in
  95
  96   let sth = dbh#prepare_cached
  97               "set constraints pages_redirect_cn, sitemenu_url_cn,
  98                    page_emails_url_cn, links_from_cn deferred" in
  99   sth#execute [];
 100
 101   let sth = dbh#prepare_cached "update pages set url_deleted = url,
 102                                                  url = null
 103                                  where hostid = ? and id = ?" in
 104   sth#execute [`Int hostid; `Int oldpageid];
 105
 106   let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
 107                                    description, creation_date, logged_ip,
 108                                    logged_user, redirect, css)
 109                                 values (?, ?, ?, ?, ?, ?, ?, ?, ?)" in
 110   sth#execute [`Int hostid; `String page; `String new_title; description;
 111                creation_date; logged_ip; logged_user; redirect; css ];
 112
 113   let pageid = sth#serial "pages_id_seq" in
 114
 115   let sth = dbh#prepare_cached "insert into contents (pageid, ordering,
 116                                        sectionname, content, divname)
 117                                 select ? as pageid, ordering, sectionname,
 118                                             content, divname
 119                                   from contents
 120                                  where pageid = ?" in
 121   sth#execute [`Int pageid; `Int oldpageid];
 122
 123   dbh#commit ();
 124
 125   (* Email notification. *)
 126   let subject = "Title of page " ^ page ^ " has been modified" in
 127   let body = fun () ->
 128     "Page: http://" ^ hostname ^ "/" ^ page ^ "\n\n" ^
 129     "Old title: " ^ old_title ^ "\n" ^
 130     "New title: " ^ new_title ^ "\n" in
 131
 132   email_notify ~subject ~body dbh hostid;
 133
 134   let buttons = [ ok_button ("/" ^ page) ] in
 135   ok ~title:"Title changed" ~buttons
 136     q "The page title was changed successfully."
 137
 138 let () =
 139   register_script ~restrict:[CanEdit] run