Fixed some bitrot and some unused variables.

[cocanwiki.git] / scripts / mailing_list_confirm.ml

diff --git a/scripts/mailing_list_confirm.ml b/scripts/mailing_list_confirm.ml
index 2f8ff0c..e35c32b 100644 (file)
--- a/scripts/mailing_list_confirm.ml
+++ b/scripts/mailing_list_confirm.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
- * $Id: mailing_list_confirm.ml,v 1.1 2004/09/24 16:41:16 rich Exp $
+ * $Id: mailing_list_confirm.ml,v 1.7 2006/07/26 13:12:10 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
@@ -27,35 +27,34 @@ open Printf
 open Cocanwiki
 open Cocanwiki_ok
 
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
   let pending = q#param "p" in
 
   (* Get the relevant fields from the database. *)
-  let sth = dbh#prepare_cached "select email from mailing_lists
-                                 where hostid = ? and pending = ?" in
-  sth#execute [`Int hostid; `String pending];
-
-  let page =
-    try
-      sth#fetch1string ()
-    with
-       Not_found ->
-         error ~close_button:true ~title:"Email already confirmed"
-           q "It looks like that email address has already been confirmed.";
-         return () in
+  let rows = PGSQL(dbh) "select email from mailing_lists
+                          where hostid = $hostid and pending = $pending" in
+
+  (* Already confirmed? *)
+  (match rows with
+   | [_] -> ()
+   | [] ->
+       error ~close_button:true ~title:"Email already confirmed"
+        dbh hostid q
+        "It looks like that email address has already been confirmed.";
+       return ()
+   | _ -> assert false);
 
   (* Update the database. *)
-  let sth = dbh#prepare_cached "update mailing_lists set pending = null
-                                 where hostid = ? and pending = ?" in
-  sth#execute [`Int hostid; `String pending];
+  PGSQL(dbh) "update mailing_lists set pending = null
+               where hostid = $hostid and pending = $pending";
 
-  dbh#commit ();
+  PGOCaml.commit dbh;
 
   (* Confirmed. *)
-  let buttons = [ ok_button ("/" ^ page) ] in
+  let buttons = [ ok_button "/" ] in
   ok ~buttons ~title:"Confirmed"
-    q ("Your email address has been confirmed.  " ^
-       "You are now on our mailing list.")
+    dbh hostid q ("Your email address has been confirmed.  " ^
+                 "You are now on our mailing list.")
 
 let () =
-  register_script run
+  register_script ~restrict:[CanView] run