2 * Written by Richard W.M. Jones <rich@merjis.com>.
3 * Copyright (C) 2004 Merjis Ltd.
4 * $Id: restore.ml,v 1.5 2004/09/08 13:09:05 rich Exp $
15 open Cocanwiki_emailnotify
17 let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname, _) _ =
18 let version = int_of_string (q#param "version") in
19 let page = q#param "page" in
21 if q#param_true "yes" then (
22 (* Get the IP address of the user, if available. *)
24 try `String (Connection.remote_ip (Request.connection r))
25 with Not_found -> `Null in
27 (* Copy the old version of the page to be live. *)
28 let sth = dbh#prepare_cached "select title, description, creation_date,
32 and url_deleted = ? and id = ?" in
33 sth#execute [`Int hostid; `String page; `Int version];
35 let title, description, creation_date, redirect, css =
36 match sth#fetch1 () with
37 [ title; description; creation_date; redirect; css ] ->
38 title, description, creation_date, redirect, css
39 | _ -> assert false in
43 "set constraints pages_redirect_cn, sitemenu_url_cn deferred" in
46 let sth = dbh#prepare_cached "update pages set url_deleted = url,
48 where hostid = ? and url = ?" in
49 sth#execute [`Int hostid; `String page];
51 let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
52 description, creation_date, logged_ip,
54 values (?, ?, ?, ?, ?, ?, ?, ?)" in
55 sth#execute [`Int hostid; `String page; title; description;
56 creation_date; logged_ip; redirect; css ];
58 let pageid = sth#serial "pages_id_seq" in
60 let sth = dbh#prepare_cached "insert into contents (pageid, ordering,
61 sectionname, content, divname)
62 select ? as pageid, ordering, sectionname,
66 sth#execute [`Int pageid; `Int version];
71 let subject = "Page " ^ page ^ " has been restored." in
73 (* Prepare the diff between this version and the previous version. *)
74 let diff, _ = get_diff dbh hostid page ~version:pageid () in
75 "Page: http://" ^ hostname ^ "/" ^ page ^ "\n\n" ^
78 email_notify ~body ~subject dbh hostid;
81 let buttons = [ ok_button ("/" ^ page) ] in
82 ok ~title:"Restored" ~buttons
83 q "The old page was restored successfully."
85 q#redirect ("http://" ^ hostname ^ "/" ^ page)
88 register_script ~restrict:[CanEdit] run