(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: restore.ml,v 1.19 2005/11/24 14:54:12 rich Exp $
+ * $Id: restore.ml,v 1.23 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
open Cocanwiki_diff
open Cocanwiki_emailnotify
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
- let version = int_of_string (q#param "version") in
+let run r (q : cgi) dbh hostid {hostname = hostname} user =
+ let version = Int32.of_string (q#param "version") in
let page = q#param "page" in
if not (q#param_true "no") then (
(* Get the IP address of the user, if available. *)
let logged_ip =
- try `String (Connection.remote_ip (Request.connection r))
- with Not_found -> `Null in
+ try Some (Connection.remote_ip (Request.connection r))
+ with Not_found -> None in
let logged_user =
match user with
- | User (id, _, _, _) -> `Int id
- | _ -> `Null in
+ | User (id, _, _, _) -> Some id
+ | _ -> None in
(* Copy the old version of the page to be live. *)
- let sth = dbh#prepare_cached "select title, description, creation_date,
- redirect, css
- from pages
- where hostid = ?
- and url_deleted = ? and id = ?" in
- sth#execute [`Int hostid; `String page; `Int version];
+ let rows = PGSQL(dbh)
+ "select title, description, creation_date,
+ redirect, css
+ from pages
+ where hostid = $hostid
+ and url_deleted = $page and id = $version" in
let title, description, creation_date, redirect, css =
- match sth#fetch1 () with
- [ title; description; creation_date; redirect; css ] ->
- title, description, creation_date, redirect, css
- | _ -> assert false in
-
- let sth =
- dbh#prepare_cached
- "set constraints pages_redirect_cn, sitemenu_url_cn,
- page_emails_url_cn, links_from_cn, recently_visited_url_cn
- deferred" in
- sth#execute [];
-
- let sth = dbh#prepare_cached "update pages set url_deleted = url,
- url = null
- where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String page];
-
- let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
- description, creation_date, logged_ip,
- logged_user, redirect, css)
- values (?, ?, ?, ?, ?, ?, ?, ?, ?)" in
- sth#execute [`Int hostid; `String page; title; description;
- creation_date; logged_ip; logged_user; redirect; css ];
-
- let pageid = Int64.to_int (sth#serial "pages_id_seq") in
-
- let sth = dbh#prepare_cached "insert into contents (pageid, ordering,
- sectionname, content, divname)
- select ? as pageid, ordering, sectionname,
- content, divname
- from contents
- where pageid = ?" in
- sth#execute [`Int pageid; `Int version];
+ match rows with
+ | [row] -> row
+ | _ -> assert false in
+
+ PGSQL(dbh)
+ "set constraints pages_redirect_cn, sitemenu_url_cn,
+ page_emails_url_cn, links_from_cn, recently_visited_url_cn
+ deferred";
+ PGSQL(dbh) "update pages set url_deleted = url, url = null
+ where hostid = $hostid and url = $page";
+ PGSQL(dbh) "insert into pages (hostid, url, title,
+ description, creation_date, logged_ip,
+ logged_user, redirect, css)
+ values ($hostid, $page, $title, $description, $creation_date,
+ $?logged_ip, $?logged_user, $?redirect, $?css)";
+
+ let pageid = PGOCaml.serial4 dbh "pages_id_seq" in
+
+ PGSQL(dbh) "insert into contents (pageid, ordering,
+ sectionname, content, divname, jsgo)
+ select $pageid, ordering, sectionname, content, divname, jsgo
+ from contents
+ where pageid = $version";
(* Keep the links table in synch. *)
- Cocanwiki_links.update_links_for_page dbh hostid page;
+ Cocanwiki_links.update_links_for_page r dbh hostid page;
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Email notify. *)
let subject = "Page " ^ page ^ " has been restored." in