2 * Written by Richard W.M. Jones <rich@merjis.com>.
3 * Copyright (C) 2004 Merjis Ltd.
4 * $Id: restore.ml,v 1.1 2004/09/07 10:14:09 rich Exp $
15 open Cocanwiki_emailnotify
19 let run r (q : cgi) (dbh : Dbi.connection) (hostid, hostname) _ =
20 let version = int_of_string (q#param "version") in
21 let page = q#param "page" in
23 if q#param_true "yes" then (
24 (* Get the IP address of the user, if available. *)
26 try `String (Connection.remote_ip (Request.connection r))
27 with Not_found -> `Null in
29 (* Copy the old version of the page to be live. *)
30 let sth = dbh#prepare_cached "select title, description, creation_date,
34 and url_deleted = ? and id = ?" in
35 sth#execute [`Int hostid; `String page; `Int version];
37 let title, description, creation_date, redirect, css =
38 match sth#fetch1 () with
39 [ title; description; creation_date; redirect; css ] ->
40 title, description, creation_date, redirect, css
41 | _ -> assert false in
44 dbh#prepare_cached "set constraints pages_redirect_cn deferred" in
47 let sth = dbh#prepare_cached "update pages set url_deleted = url,
49 where hostid = ? and url = ?" in
50 sth#execute [`Int hostid; `String page];
52 let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
53 description, creation_date, logged_ip,
55 values (?, ?, ?, ?, ?, ?, ?, ?)" in
56 sth#execute [`Int hostid; `String page; title; description;
57 creation_date; logged_ip; redirect; css ];
59 let pageid = sth#serial "pages_id_seq" in
61 let sth = dbh#prepare_cached "insert into contents (pageid, ordering,
62 sectionname, content, divname)
63 select ? as pageid, ordering, sectionname,
67 sth#execute [`Int pageid; `Int version];
72 let subject = "Page " ^ page ^ " has been restored." in
74 (* Prepare the diff between this version and the previous version. *)
75 let diff, _ = get_diff dbh hostid page ~version:pageid () in
76 "Page: http://" ^ hostname ^ "/" ^ page ^ "\n\n" ^
79 email_notify ~body ~subject dbh hostid;
82 let buttons = [ ok_button ("/" ^ page) ] in
83 ok ~title:"Restored" ~buttons
84 q "The old page was restored successfully."
86 q#redirect ("http://" ^ hostname ^ "/" ^ page)