2 * Written by Richard W.M. Jones <rich@merjis.com>.
3 * Copyright (C) 2004 Merjis Ltd.
4 * $Id: restore.ml,v 1.4 2004/09/08 09:54:28 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
42 dbh#prepare_cached "set constraints pages_redirect_cn deferred" in
45 let sth = dbh#prepare_cached "update pages set url_deleted = url,
47 where hostid = ? and url = ?" in
48 sth#execute [`Int hostid; `String page];
50 let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
51 description, creation_date, logged_ip,
53 values (?, ?, ?, ?, ?, ?, ?, ?)" in
54 sth#execute [`Int hostid; `String page; title; description;
55 creation_date; logged_ip; redirect; css ];
57 let pageid = sth#serial "pages_id_seq" in
59 let sth = dbh#prepare_cached "insert into contents (pageid, ordering,
60 sectionname, content, divname)
61 select ? as pageid, ordering, sectionname,
65 sth#execute [`Int pageid; `Int version];
70 let subject = "Page " ^ page ^ " has been restored." in
72 (* Prepare the diff between this version and the previous version. *)
73 let diff, _ = get_diff dbh hostid page ~version:pageid () in
74 "Page: http://" ^ hostname ^ "/" ^ page ^ "\n\n" ^
77 email_notify ~body ~subject dbh hostid;
80 let buttons = [ ok_button ("/" ^ page) ] in
81 ok ~title:"Restored" ~buttons
82 q "The old page was restored successfully."
84 q#redirect ("http://" ^ hostname ^ "/" ^ page)
87 register_script ~restrict:[CanEdit] run