(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: admin.ml,v 1.6 2004/09/09 12:21:22 rich Exp $
+ * $Id: admin.ml,v 1.7 2006/03/27 18:09:47 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
let template = _get_template "admin/admin.html"
-let run r (q : cgi) (dbh : Dbi.connection) _ _ _ =
+let run r (q : cgi) dbh _ _ _ =
(* Select out the alternative hostnames. *)
let sth = dbh#prepare_cached
"select hs.hostid, hs.name from hostnames hs
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: create_host.ml,v 1.10 2005/11/24 14:54:14 rich Exp $
+ * $Id: create_host.ml,v 1.11 2006/03/27 18:09:47 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
"Administrator" "123456" true None in
(* Commit to the database. *)
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Print confirmation page. *)
let buttons = [
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_host_css.ml,v 1.7 2005/11/24 14:54:14 rich Exp $
+ * $Id: edit_host_css.ml,v 1.8 2006/03/27 18:09:47 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_ok
open Cocanwiki_strings
-let run r (q : cgi) (dbh : Dbi.connection) _ _ _ =
+let run r (q : cgi) dbh _ _ _ =
let hostid = int_of_string (q#param "hostid") in
let css = q#param "css" in
let sth = dbh#prepare_cached "update hosts set css = ? where id = ?" in
sth#execute [css; `Int hostid];
- dbh#commit ();
+ PGOCaml.commit dbh;
let buttons = [
{ Template.StdPages.label = "OK";
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_host_css_form.ml,v 1.5 2004/09/09 12:21:22 rich Exp $
+ * $Id: edit_host_css_form.ml,v 1.6 2006/03/27 18:09:47 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
let template = _get_template "admin/edit_host_css_form.html"
-let run r (q : cgi) (dbh : Dbi.connection) _ _ _ =
+let run r (q : cgi) dbh _ _ _ =
let hostid = int_of_string (q#param "hostid") in
template#set "id" (string_of_int hostid);
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_hostnames.ml,v 1.8 2005/11/24 14:54:14 rich Exp $
+ * $Id: edit_hostnames.ml,v 1.9 2006/03/27 18:09:47 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
let split_re = Pcre.regexp "[\\s,;]+"
-let run r (q : cgi) (dbh : Dbi.connection) _ host' _ =
+let run r (q : cgi) dbh _ host' _ =
let hostid = int_of_string (q#param "hostid") in
if q#param_true "cancel" then (
sth#execute [`Int hostid; `String name]) hostnames;
(* Commit to the database. *)
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Print confirmation page. *)
let buttons = [
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_hostnames_form.ml,v 1.5 2004/09/09 12:21:22 rich Exp $
+ * $Id: edit_hostnames_form.ml,v 1.6 2006/03/27 18:09:47 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
let template = _get_template "admin/edit_hostnames_form.html"
-let run r (q : cgi) (dbh : Dbi.connection) _ _ _ =
+let run r (q : cgi) dbh _ _ _ =
let hostid = int_of_string (q#param "hostid") in
template#set "id" (string_of_int hostid);
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: host.ml,v 1.8 2005/12/05 10:07:45 rich Exp $
+ * $Id: host.ml,v 1.9 2006/03/27 18:09:47 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
let template = _get_template "admin/host.html"
-let run r (q : cgi) (dbh : Dbi.connection) _ _ _ =
+let run r (q : cgi) dbh _ _ _ =
let hostid = int_of_string (q#param "hostid") in
template#set "id" (string_of_int hostid);
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: broken_links.ml,v 1.1 2004/10/09 16:25:08 rich Exp $
+ * $Id: broken_links.ml,v 1.2 2006/03/27 18:09:46 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
let keys h = Hashtbl.fold (fun key _ xs -> key :: xs) h []
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "broken_links.html" in
(* The links table (to_url) field can now point to a non-existant
* aren't broken links either because some of the content is
* synthesized.
*)
- let sth =
- dbh#prepare_cached
+ let rows =
+ PGSQL(dbh)
"select l.from_url, p.title, l.to_url
from links l, pages p
- where l.hostid = ?
+ where l.hostid = $hostid
and l.hostid = p.hostid and l.from_url = p.url
and p.redirect is null
and not exists (select id from pages
and not exists (select id from templates
where l.to_url ~ url_regexp)
order by 3, 1 desc" in
- sth#execute [`Int hostid];
(* Group the links together. *)
let h = Hashtbl.create 32 in
- sth#iter (function [`String from_url; `String from_title; `String to_url] ->
- let a = try Hashtbl.find h to_url with Not_found -> [] in
- let a = (from_url, from_title) :: a in
- Hashtbl.replace h to_url a
- | _ -> assert false);
+ List.iter (
+ fun (from_url, from_title, to_url) ->
+ let a = try Hashtbl.find h to_url with Not_found -> [] in
+ let a = (from_url, from_title) :: a in
+ Hashtbl.replace h to_url a
+ ) rows;
let keys = List.sort compare (keys h) in
let table =
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: change_password.ml,v 1.4 2005/11/24 14:54:11 rich Exp $
+ * $Id: change_password.ml,v 1.5 2006/03/27 18:09:46 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
open Cocanwiki_ok
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ user =
+let run r (q : cgi) dbh hostid _ user =
let old_password = q#param "old_password" in
(* Check the old password was supplied correctly. *)
Anonymous -> assert false (* cannot happen *)
| User (userid, _, _, _) -> userid in
- let sth = dbh#prepare_cached "select 1 from users
- where hostid = ? and id = ?
- and password = ?" in
- sth#execute [`Int hostid; `Int userid; `String old_password];
+ let rows = PGSQL(dbh)
+ "select 1 from users
+ where hostid = $hostid and id = $userid and password = $old_password" in
let old_password_ok =
- try 1 = sth#fetch1int ()
- with
- Not_found -> false in
+ match rows with
+ | [Some 1l] -> true
+ | [] -> false
+ | _ -> assert false in
if not old_password_ok then (
error ~title:"Bad password"
let password = password1 in
(* Change the password. *)
- let sth =
- dbh#prepare_cached
- "update users set password = ?, force_password_change = false
- where hostid = ? and id = ?" in
- sth#execute [`String password; `Int hostid; `Int userid];
+ PGSQL(dbh)
+ "update users set password = $password, force_password_change = false
+ where hostid = $hostid and id = $userid";
- dbh#commit ();
+ PGOCaml.commit dbh;
let buttons = [ ok_button "/" ] in
ok ~buttons ~title:"Password changed"
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: change_password_form.ml,v 1.1 2004/09/25 13:17:00 rich Exp $
+ * $Id: change_password_form.ml,v 1.2 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "change_password_form.html" in
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: contact.ml,v 1.9 2005/11/24 14:54:11 rich Exp $
+ * $Id: contact.ml,v 1.10 2006/03/27 18:09:46 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_template
open Cocanwiki_ok
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
+let run r (q : cgi) dbh hostid {hostname = hostname} user =
let template = get_template dbh hostid "contact.txt" in
let fail msg =
fail "The 'name' field is missing in that form." in
(* Get the contacts / emails from the database. *)
- let sth = dbh#prepare_cached "select id, subject from contacts
- where hostid = ? and name = ?" in
- sth#execute [`Int hostid; `String name];
+ let rows = PGSQL(dbh)
+ "select id, subject from contacts
+ where hostid = $hostid and name = $name" in
let id, subject =
- try
- (match sth#fetch1 () with
- [ `Int id; `String subject ] -> id, subject
- | _ -> assert false
- )
- with Not_found -> fail "There is no such contact form in the database." in
+ match rows with
+ | [row] -> row
+ | [] -> fail "There is no such contact form in the database."
+ | _ -> assert false in
- let sth = dbh#prepare_cached "select email from contact_emails
- where contactid = ?" in
- sth#execute [`Int id];
-
- let emails = sth#map (function [`String email] -> email
- | _ -> assert false) in
+ let emails =
+ PGSQL(dbh) "select email from contact_emails where contactid = $id" in
if emails = [] then
fail "There are no email addresses associated with that contact id.";
match user with
Anonymous -> "anonymous"
| User (userid, username, _, _) ->
- sprintf "%s (%d)" username userid in
+ sprintf "%s (%ld)" username userid in
template#set "ip" ip;
template#set "ua" ua;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: contact_show.ml,v 1.1 2004/09/17 16:03:34 rich Exp $
+ * $Id: contact_show.ml,v 1.2 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "contact_show.html" in
- let id = int_of_string (q#param "id") in
- template#set "id" (string_of_int id);
+ let id = Int32.of_string (q#param "id") in
+ template#set "id" (Int32.to_string id);
(* Pull out all the details out of the database. *)
- let sth = dbh#prepare_cached
- "select name, subject
- from contacts where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
+ let rows = PGSQL(dbh)
+ "select name, subject from contacts
+ where hostid = $hostid and id = $id" in
let name, subject =
- match sth#fetch1 () with
- [ `String name; `String subject ] -> name, subject
- | _ -> assert false in
+ match rows with
+ | [row] -> row
+ | _ -> assert false in
template#set "name" name;
template#set "subject" subject;
(* Get the emails. *)
- let sth = dbh#prepare_cached
- "select email from contact_emails where contactid = ?
- order by 1" in
- sth#execute [`Int id];
-
- let table = sth#map (function [`String email] ->
- [ "email", Template.VarString email ]
- | _ -> assert false) in
+ let rows = PGSQL(dbh)
+ "select email from contact_emails where contactid = $id
+ order by 1" in
+ let table =
+ List.map (fun email -> [ "email", Template.VarString email ]) rows in
template#table "emails" table;
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: contacts.ml,v 1.2 2005/11/23 11:32:12 rich Exp $
+ * $Id: contacts.ml,v 1.3 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "contacts.html" in
(* Pull out all the contacts from the database. *)
- let sth = dbh#prepare_cached
- "select c.id, c.name, c.subject,
- (select count(*)::int4 from contact_emails
- where contactid = c.id)
- from contacts c
- where c.hostid = ?
- order by c.name, c.id" in
- sth#execute [`Int hostid];
+ let rows = PGSQL(dbh)
+ "select c.id, c.name, c.subject,
+ (select count(*)::int4 from contact_emails
+ where contactid = c.id)
+ from contacts c
+ where c.hostid = $hostid
+ order by c.name, c.id" in
let table =
- sth#map
- (function
- [`Int id; `String name; `String subject; `Int count] ->
- [ "id", Template.VarString (string_of_int id);
- "name", Template.VarString name;
- "subject", Template.VarString subject;
- "count", Template.VarString (string_of_int count) ]
- | _ -> assert false) in
+ List.map
+ (fun (id, name, subject, count) ->
+ [ "id", Template.VarString (Int32.to_string id);
+ "name", Template.VarString name;
+ "subject", Template.VarString subject;
+ "count", Template.VarString (Int32.to_string (Option.get count)) ]
+ ) rows in
template#table "contacts" table;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: crash.ml,v 1.4 2005/03/31 14:24:04 rich Exp $
+ * $Id: crash.ml,v 1.5 2006/03/27 18:09:46 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_template
open Cocanwiki_server_settings
-let run r (q : cgi) (dbh : Dbi.connection) hostid
+let run r (q : cgi) dbh hostid
{ canonical_hostname = canonical_hostname } _ =
let template = get_template dbh hostid "crash.html" in
let crash_email = server_settings_crash_email dbh in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: create_contact.ml,v 1.5 2005/11/24 14:54:11 rich Exp $
+ * $Id: create_contact.ml,v 1.6 2006/03/27 18:09:46 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
let split_re = Pcre.regexp "[\\r\\n,;]+"
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let name = trim (q#param "name") in
let subject = trim (q#param "subject") in
let emails = try q#param "emails" with Not_found -> "" in
);
(* Update the database. *)
- let sth = dbh#prepare_cached "insert into contacts (hostid, name, subject)
- values (?, ?, ?)" in
- sth#execute [`Int hostid; `String name; `String subject];
+ PGSQL(dbh) "insert into contacts (hostid, name, subject)
+ values ($hostid, $name, $subject)";
- let contactid = Int64.to_int (sth#serial "contacts_id_seq") in
+ let contactid = PGOCaml.serial4 dbh "contacts_id_seq" in
- let sth = dbh#prepare_cached "insert into contact_emails (contactid, email)
- values (?, ?)" in
- List.iter (fun email ->
- sth#execute [`Int contactid; `String email]) emails;
+ List.iter (
+ fun email ->
+ PGSQL(dbh) "insert into contact_emails (contactid, email)
+ values ($contactid, $email)"
+ ) emails;
(* Finish off. *)
- dbh#commit ();
+ PGOCaml.commit dbh;
- let msg = sprintf "Contact form created. The contact id is %d. On the next page you will be given some same <html> code which you should copy and paste onto a web page to create a simple form, which can then be modified for your requirements." contactid in
+ let msg = sprintf "Contact form created. The contact id is %ld. On the next page you will be given some same <html> code which you should copy and paste onto a web page to create a simple form, which can then be modified for your requirements." contactid in
let buttons = [ { Template.StdPages.label = " View contact form ";
Template.StdPages.link = "/_bin/contact_show.cmo";
Template.StdPages.method_ = None;
Template.StdPages.params =
- [ "id", string_of_int contactid ] } ] in
+ [ "id", Int32.to_string contactid ] } ] in
ok ~title:"Contact form created" ~buttons dbh hostid q msg
let () =
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: create_contact_form.ml,v 1.1 2004/09/21 15:55:48 rich Exp $
+ * $Id: create_contact_form.ml,v 1.2 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "create_contact_form.html" in
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: create_user.ml,v 1.6 2005/11/24 14:54:11 rich Exp $
+ * $Id: create_user.ml,v 1.7 2006/03/27 18:09:46 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_ok
open Cocanwiki_strings
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let username = trim (q#param "username") in
let password1 = trim (q#param "password1") in
let password2 = trim (q#param "password2") in
let password = password1 in
- (*
- Uh oh ... Not making UNICODE assumptions ... XXX
- if String.length username > 32 || String.length password > 32 then
- *)
+ if UTF8.length username > 32 || UTF8.length password > 128 then (
+ error ~back_button:true ~title:"Username or password too long"
+ dbh hostid q "Usernames should be less than 32 characters long. For passwords we let you have a generous 128 characters.";
+ return ()
+ );
(* Not a duplicate? *)
- let sth = dbh#prepare_cached "select id from users
- where hostid = ? and name = ?" in
- sth#execute [`Int hostid; `String username];
+ let rows = PGSQL(dbh)
+ "select id from users where hostid = $hostid and name = $username" in
- (try
- sth#fetch1 ();
- error ~back_button:true ~title:"Username already taken"
- dbh hostid q "Someone has already taken that username.";
- return ()
- with
- Not_found -> ());
+ (match rows with
+ | [_] ->
+ error ~back_button:true ~title:"Username already taken"
+ dbh hostid q "Someone has already taken that username.";
+ return ()
+ | [] -> ()
+ | _ -> assert false
+ );
let can_edit = q#param_true "can_edit" in
let can_manage_users = q#param_true "can_manage_users" in
let force_password_change = q#param_true "force_password_change" in
(* Create the user account. *)
- let sth = dbh#prepare_cached "insert into users (name, password,
- hostid, can_edit, can_manage_users,
- can_manage_contacts, can_manage_site,
- can_edit_global_css, can_import_mail,
- force_password_change)
- values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" in
- sth#execute [`String username; `String password; `Int hostid;
- `Bool can_edit; `Bool can_manage_users;
- `Bool can_manage_contacts; `Bool can_manage_site;
- `Bool can_edit_global_css; `Bool can_import_mail;
- `Bool force_password_change];
+ PGSQL(dbh)
+ "insert into users (name, password,
+ hostid, can_edit, can_manage_users,
+ can_manage_contacts, can_manage_site,
+ can_edit_global_css, can_import_mail,
+ force_password_change)
+ values ($username, $password, $hostid, $can_edit, $can_manage_users,
+ $can_manage_contacts, $can_manage_site,
+ $can_edit_global_css, $can_import_mail,
+ $force_password_change)";
- dbh#commit ();
+ PGOCaml.commit dbh;
let buttons = [ ok_button "/_users" ] in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: create_user_form.ml,v 1.1 2004/09/21 13:01:15 rich Exp $
+ * $Id: create_user_form.ml,v 1.2 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "create_user_form.html" in
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: dead_ends.ml,v 1.2 2004/10/04 15:19:56 rich Exp $
+ * $Id: dead_ends.ml,v 1.3 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "dead_ends.html" in
- let sth =
- dbh#prepare_cached
+ let rows =
+ PGSQL(dbh)
"select p.url, p.title, count (l.to_url)
from pages p left outer join links l
on p.hostid = l.hostid and p.url = l.from_url
- where p.hostid = ?
+ where p.hostid = $hostid
and p.url is not null
and p.redirect is null
group by 1, 2
having count(l.to_url) = 0
order by 1" in
- sth#execute [`Int hostid];
let table =
- sth#map (function [`String page; `String title; _] ->
- [ "page", Template.VarString page;
- "title", Template.VarString title ]
- | _ -> assert false) in
+ List.map (
+ fun (page, title, _) ->
+ let page = Option.get page in
+ [ "page", Template.VarString page;
+ "title", Template.VarString title ]
+ ) rows in
template#table "pages" table;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: delete_contact.ml,v 1.4 2005/11/24 14:54:11 rich Exp $
+ * $Id: delete_contact.ml,v 1.5 2006/03/27 18:09:46 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
open Cocanwiki_ok
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
+let run r (q : cgi) dbh hostid { hostname = hostname } _ =
(* Cancel? *)
if q#param_true "cancel" then (
q#redirect ("http://" ^ hostname ^ "/_bin/contacts.cmo");
(* We can delete multiple contact forms from this script, which is
* quite unusual.
*)
- let ids = List.map int_of_string (q#param_all "delete") in
+ let ids = List.map Int32.of_string (q#param_all "delete") in
if ids = [] then (
q#redirect ("http://" ^ hostname ^ "/_bin/contacts.cmo");
return ()
);
(* Need to check the contact emails all belong to this host. *)
- let qs = Dbi.placeholders (List.length ids) in
- let sth = dbh#prepare_cached ("select count(*)::int4 from contacts
- where hostid = ? and id in " ^ qs) in
- sth#execute (`Int hostid :: (List.map (fun id -> `Int id) ids));
-
- assert (sth#fetch1int () = List.length ids);
+ let rows = PGSQL(dbh)
+ "select count(*)::int4 from contacts
+ where hostid = $hostid and id in $@ids" in
+ assert (List.length rows = List.length ids);
(* Delete them. *)
- let sth = dbh#prepare_cached ("delete from contact_emails
- where contactid in " ^ qs) in
- sth#execute (List.map (fun id -> `Int id) ids);
-
- let sth = dbh#prepare_cached ("delete from contacts
- where hostid = ? and id in " ^ qs) in
- sth#execute (`Int hostid :: (List.map (fun id -> `Int id) ids));
+ PGSQL(dbh) "delete from contact_emails where contactid in $@ids";
+ PGSQL(dbh) "delete from contacts where hostid = $hostid and id in $@ids";
(* Finish off. *)
- dbh#commit ();
+ PGOCaml.commit dbh;
ok ~title:"Contact form(s) deleted" ~buttons:[ok_button "/_bin/contacts.cmo"]
dbh hostid q "Those contact form(s) were deleted."
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: delete_contact_form.ml,v 1.2 2004/09/23 11:56:47 rich Exp $
+ * $Id: delete_contact_form.ml,v 1.3 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
+let run r (q : cgi) dbh hostid { hostname = hostname } _ =
let template = get_template dbh hostid "delete_contact_form.html" in
(* We can delete multiple contact forms from this script, which is
* quite unusual.
*)
- let ids = List.map int_of_string (q#param_all "delete") in
+ let ids = List.map Int32.of_string (q#param_all "delete") in
if ids = [] then (
q#redirect ("http://" ^ hostname ^ "/_bin/contacts.cmo");
return ()
);
- let qs = Dbi.placeholders (List.length ids) in
- let sth = dbh#prepare_cached ("select id, name, subject from contacts
- where hostid = ? and id in " ^ qs ^ "
- order by name, id") in
- sth#execute (`Int hostid :: (List.map (fun id -> `Int id) ids));
+ let rows = PGSQL(dbh)
+ "select id, name, subject from contacts
+ where hostid = $hostid and id in $@ids
+ order by name, id" in
let table =
- sth#map (function [`Int id; `String name; `String subject] ->
- [ "id", Template.VarString (string_of_int id);
- "name", Template.VarString name;
- "subject", Template.VarString subject ]
- | _ -> assert false) in
+ List.map (
+ fun (id, name, subject) ->
+ [ "id", Template.VarString (Int32.to_string id);
+ "name", Template.VarString name;
+ "subject", Template.VarString subject ]
+ ) rows in
template#table "deletes" table;
let table =
- List.map (fun id -> [ "id", Template.VarString (string_of_int id) ]) ids in
+ List.map (fun id ->
+ [ "id", Template.VarString (Int32.to_string id) ]) ids in
template#table "ids" table;
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: delete_file.ml,v 1.9 2005/11/24 14:54:11 rich Exp $
+ * $Id: delete_file.ml,v 1.10 2006/03/27 18:09:46 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_ok
open Cocanwiki_emailnotify
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user=
- let id = int_of_string (q#param "id") in
+let run r (q : cgi) dbh hostid { hostname = hostname } user=
+ let id = Int32.of_string (q#param "id") in
if q#param_true "yes" then (
(* Get the name. *)
- let sth = dbh#prepare_cached "select coalesce (name, name_deleted)
- from files
- where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
- let name = sth#fetch1string () in
+ let rows = PGSQL(dbh) "select coalesce (name, name_deleted)
+ from files
+ where hostid = $hostid and id = $id" in
+ let name = Option.get (List.hd rows) in
(* Delete the file. *)
- let sth = dbh#prepare_cached "update files
- set name_deleted = name, name = null
- where hostid = ? and id = ?
- and name is not null" in
- sth#execute [`Int hostid; `Int id];
+ PGSQL(dbh) "update files
+ set name_deleted = name, name = null
+ where hostid = $hostid and id = $id
+ and name is not null";
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Email notify. *)
- let subject = "File " ^ name ^ "#" ^ string_of_int id ^
+ let subject = "File " ^ name ^ "#" ^ Int32.to_string id ^
" has been deleted." in
- let body = fun () ->
- "Page: http://" ^ hostname ^ "/_files?deleted=1" in
+ let body = fun () -> "Page: http://" ^ hostname ^ "/_files?deleted=1" in
email_notify ~body ~subject ~user dbh hostid;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: delete_file_form.ml,v 1.7 2004/09/09 12:21:22 rich Exp $
+ * $Id: delete_file_form.ml,v 1.8 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "delete_file_form.html" in
- let id = int_of_string (q#param "id") in
+ let id = Int32.of_string (q#param "id") in
- let sth = dbh#prepare_cached "select name from files
- where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
+ let name = List.hd (
+ PGSQL(dbh) "select name from files
+ where hostid = $hostid and id = $id"
+ ) in
- let name = sth#fetch1string () in
-
- template#set "id" (string_of_int id);
- template#set "name" name;
+ template#set "id" (Int32.to_string id);
+ template#set "name" (Option.get name);
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: delete_image.ml,v 1.9 2005/11/24 14:54:11 rich Exp $
+ * $Id: delete_image.ml,v 1.10 2006/03/27 18:09:46 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_ok
open Cocanwiki_emailnotify
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user=
- let id = int_of_string (q#param "id") in
+let run r (q : cgi) dbh hostid { hostname = hostname } user=
+ let id = Int32.of_string (q#param "id") in
if q#param_true "yes" then (
(* Get the name. *)
- let sth = dbh#prepare_cached "select coalesce (name, name_deleted)
- from images
- where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
- let name = sth#fetch1string () in
+ let name = Option.get (
+ List.hd (
+ PGSQL(dbh) "select coalesce (name, name_deleted)
+ from images
+ where hostid = $hostid and id = $id"
+ )
+ ) in
(* Delete the image. *)
- let sth = dbh#prepare_cached "update images
- set name_deleted = name, name = null
- where hostid = ? and id = ?
- and name is not null" in
- sth#execute [`Int hostid; `Int id];
+ PGSQL(dbh) "update images
+ set name_deleted = name, name = null
+ where hostid = $hostid and id = $id
+ and name is not null";
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Email notify. *)
- let subject = "Image " ^ name ^ "#" ^ string_of_int id ^
+ let subject = "Image " ^ name ^ "#" ^ Int32.to_string id ^
" has been deleted." in
let body = fun () ->
"Page: http://" ^ hostname ^ "/_images?deleted=1" in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: delete_image_form.ml,v 1.7 2004/09/09 12:21:22 rich Exp $
+ * $Id: delete_image_form.ml,v 1.8 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "delete_image_form.html" in
- let id = int_of_string (q#param "id") in
+ let id = Int32.of_string (q#param "id") in
- let sth = dbh#prepare_cached "select name, width, height, alt
- from images
- where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
+ let rows = PGSQL(dbh)
+ "select name, width, height, alt
+ from images
+ where hostid = $hostid and id = $id" in
let name, width, height, alt =
- match sth#fetch1 () with
- [ `String name; `Int width; `Int height; `String alt] ->
- name, width, height, alt
- | _ -> assert false in
-
- template#set "id" (string_of_int id);
- template#set "name" name;
- template#set "width" (string_of_int width);
- template#set "height" (string_of_int height);
+ match rows with
+ | [row] -> row
+ | _ -> assert false in
+
+ template#set "id" (Int32.to_string id);
+ template#set "name" (Option.get name);
+ template#set "width" (Int32.to_string width);
+ template#set "height" (Int32.to_string height);
template#set "alt" alt;
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: delete_user.ml,v 1.5 2005/11/24 14:54:11 rich Exp $
+ * $Id: delete_user.ml,v 1.6 2006/03/27 18:09:46 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
open Cocanwiki_ok
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} self =
+let run r (q : cgi) dbh hostid {hostname = hostname} self =
if q#param_true "cancel" then (
(* Request cancelled. *)
q#redirect ("http://" ^ hostname ^ "/_users");
return ()
);
- let userid = int_of_string (q#param "userid") in
+ let userid = Int32.of_string (q#param "userid") in
(* Check userid belongs to host. The statements below wouldn't
* enforce this correctly ...
*)
- let sth =
- dbh#prepare_cached "select 1 from users where id = ? and hostid = ?" in
- sth#execute [`Int userid; `Int hostid];
-
- assert (sth#fetch1int () = 1);
+ let rows =
+ PGSQL(dbh) "select 1 from users where id = $userid and hostid = $hostid" in
+ assert (rows = [Some 1l]);
(* Can't delete self! *)
let () =
| _ -> () in
(* Delete the user. *)
- let sth =
- dbh#prepare_cached "delete from recently_visited
- where userid = ? and hostid = ?" in
- sth#execute [`Int userid; `Int hostid];
-
- let sth =
- dbh#prepare_cached "delete from pending_email_changes
- where userid = ?" in
- sth#execute [`Int userid];
-
-
- let sth = dbh#prepare_cached "delete from usercookies where userid = ?" in
- sth#execute [`Int userid];
-
- let sth = dbh#prepare_cached "update pages set logged_user = null
- where logged_user = ? and hostid = ?" in
- sth#execute [`Int userid; `Int hostid];
+ PGSQL(dbh) "delete from recently_visited
+ where userid = $userid and hostid = $hostid";
- let sth =
- dbh#prepare_cached "delete from users where id = ? and hostid = ?" in
- sth#execute [`Int userid; `Int hostid];
+ PGSQL(dbh) "delete from pending_email_changes where userid = $userid";
+ PGSQL(dbh) "delete from usercookies where userid = $userid";
+ PGSQL(dbh) "update pages set logged_user = null
+ where logged_user = $userid and hostid = $hostid";
+ PGSQL(dbh) "delete from users where id = $userid and hostid = $hostid";
- dbh#commit ();
+ PGOCaml.commit dbh;
ok ~title:"Account deleted" ~buttons:[ok_button "/_users"]
dbh hostid q "That user account was deleted."
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: delete_user_form.ml,v 1.4 2005/11/24 14:54:11 rich Exp $
+ * $Id: delete_user_form.ml,v 1.5 2006/03/27 18:09:46 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_template
open Cocanwiki_ok
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ self =
+let run r (q : cgi) dbh hostid _ self =
let template = get_template dbh hostid "delete_user_form.html" in
- let userid = int_of_string (q#param "userid") in
- template#set "userid" (string_of_int userid);
+ let userid = Int32.of_string (q#param "userid") in
+ template#set "userid" (Int32.to_string userid);
(* Can't delete self! *)
let () =
| _ -> () in
(* Get this user from the database. *)
- let sth = dbh#prepare_cached "select name, email from users
- where id = ? and hostid = ?" in
- sth#execute [`Int userid; `Int hostid];
+ let rows =
+ PGSQL(dbh) "select name, email from users
+ where id = $userid and hostid = $hostid" in
let username, email =
- match sth#fetch1 () with
- [ `String username; `String email ] ->
- username, email
- | [ `String username; `Null ] ->
- username, ""
- | _ -> assert false in
+ match rows with
+ | [ username, Some email ] ->
+ username, email
+ | [ username, None ] ->
+ username, ""
+ | _ -> assert false in
template#set "username" username;
template#set "email" email;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: diff.ml,v 1.9 2004/11/01 12:57:53 rich Exp $
+ * $Id: diff.ml,v 1.10 2006/03/27 18:09:46 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_template
open Cocanwiki_diff
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ user =
+let run r (q : cgi) dbh hostid _ user =
let template = get_template dbh hostid "diff.html" in
let page = q#param "page" in
* NB. In case you hadn't worked it out yet, version numbers are
* page.ids.
*)
- let version = int_of_string (q#param "version") in
+ let version = Int32.of_string (q#param "version") in
let diff, old_version =
try
- let old_version = int_of_string (q#param "old_version") in
+ let old_version = Int32.of_string (q#param "old_version") in
get_diff dbh hostid page ~old_version ~version ()
with
Not_found ->
get_diff dbh hostid page ~version () in
- template#set "version" (string_of_int version);
- template#set "old_version" (string_of_int old_version);
+ template#set "version" (Int32.to_string version);
+ template#set "old_version" (Int32.to_string old_version);
template#set "page" page;
template#set "diff" diff;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit.ml,v 1.27 2005/11/24 14:54:11 rich Exp $
+ * $Id: edit.ml,v 1.28 2006/03/27 18:09:46 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_strings
open Cocanwiki_pages
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
+let run r (q : cgi) dbh hostid {hostname = hostname} user =
let template = get_template dbh hostid "edit.html" in
let template_conflict = get_template dbh hostid "edit_conflict.html" in
let template_email = get_template dbh hostid "edit_page_email.txt" in
(* Build the internal model from the parameters passed to the script. *)
let build_internal_model () =
- let id = int_of_string (q#param "id") in
+ let id = Int32.of_string (q#param "id") in
let description = q#param "description" in
let redirect = q#param "redirect" in
+ let redirect =
+ if string_is_whitespace redirect then
+ None else Some redirect in
let pt = match q#param "pt_type" with
- "page" -> Page (q#param "pt_value")
+ | "page" -> Page (q#param "pt_value")
| "title" -> Title (q#param "pt_value")
| _ -> failwith "unknown value for pt_type parameter" in
let i = ref 1 in
while q#param_exists ("content_" ^ string_of_int !i) do
let sectionname = q#param ("sectionname_" ^ string_of_int !i) in
+ let sectionname =
+ if string_is_whitespace sectionname then None else Some sectionname in
let content = q#param ("content_" ^ string_of_int !i) in
let divname = q#param ("divname_" ^ string_of_int !i) in
+ let divname =
+ if string_is_whitespace divname then None else Some divname in
contents := (sectionname, divname, content) :: !contents;
incr i
done;
pt = pt;
description = description;
redirect = redirect;
- contents = contents; }
+ contents_ = contents; }
in
(* Check for errors in the model. *)
let add_error msg = errors := msg :: !errors in
let get_errors () = List.rev !errors in
- if model.redirect = "" then (
- (* Empty page? *)
- if model.contents = [] then
- add_error ("This page is empty. Use 'Insert new section here' " ^
- "to write something!");
-
- (* Description field? *)
- if model.description = "" then
- add_error ("The description field is very important! This field is " ^
- "used by search engines and directories to describe " ^
- "what's on this page.");
- )
- else (* it's a redirect *) (
- (* Redirect points to a real page? *)
- let sth = dbh#prepare_cached "select 1 from pages
- where hostid = ?
- and url is not null
- and url = ?
- and id <> ?
- and redirect is null" in
- sth#execute [`Int hostid; `String model.redirect; `Int model.id];
-
- let ok = try sth#fetch1 () = [`Int 1] with Not_found -> false in
- if not ok then
- add_error ("Redirect must point to an ordinary page " ^
- "(ie. not to a page which is itself a redirect).")
+ (match model.redirect with
+ | None ->
+ (* Empty page? *)
+ if model.contents_ = [] then
+ add_error ("This page is empty. Use 'Insert new section here' " ^
+ "to write something!");
+
+ (* Description field? *)
+ if model.description = "" then
+ add_error ("The description field is very important! " ^
+ "This field is " ^
+ "used by search engines and directories to describe " ^
+ "what's on this page.");
+
+ | Some redirect ->
+ (* Redirect points to a real page? *)
+ let rows =
+ let model_id = model.id in
+ PGSQL(dbh)
+ "select 1 from pages
+ where hostid = $hostid and url is not null
+ and url = $redirect and id <> $model_id
+ and redirect is null" in
+
+ let ok = rows = [Some 1l] in
+ if not ok then
+ add_error ("Redirect must point to an ordinary page " ^
+ "(ie. not to a page which is itself a redirect).")
);
(* All sections after the first one have sectionnames? The first
* section ONLY is allowed to have an empty title.
*)
- if model.contents <> [] then
- List.iter (function (sectionnames, _, _)
- when string_is_whitespace sectionnames ->
- add_error
- ("Every section except the first must have a title.");
- | _ -> ())
- (List.tl model.contents);
+ if model.contents_ <> [] then
+ List.iter (function (None, _, _) ->
+ add_error
+ ("Every section except the first must have a title.");
+ | _ -> ())
+ (List.tl model.contents_);
get_errors ()
in
| _, [] -> [ item ]
| n, x :: xs -> x :: (loop (n-1, xs))
in
- let contents = loop (posn, model.contents) in
- { model with contents = contents }
+ let contents = loop (posn, model.contents_) in
+ { model with contents_ = contents }
in
let action_moveup model posn =
(* posn = 1 means move up the first element, ie. do nothing
| 2, x :: y :: xs -> y :: x :: xs
| n, x :: xs -> x :: (loop (n-1, xs))
in
- let contents = loop (posn, model.contents) in
- { model with contents = contents }
+ let contents = loop (posn, model.contents_) in
+ { model with contents_ = contents }
in
let action_movedn model posn =
(* posn = 1 means move down the first element to the second position
| 1, x :: y :: xs -> y :: x :: xs
| n, x :: xs -> x :: (loop (n-1, xs))
in
- let contents = loop (posn, model.contents) in
- { model with contents = contents }
+ let contents = loop (posn, model.contents_) in
+ { model with contents_ = contents }
in
let action_delete model posn =
(* posn = 1 means delete the first element *)
| 1, x :: xs -> xs
| n, x :: xs -> x :: (loop (n-1, xs))
in
- let contents = loop (posn, model.contents) in
- { model with contents = contents }
+ let contents = loop (posn, model.contents_) in
+ { model with contents_ = contents }
in
(* Convert model to template. *)
let model_to_template model template =
- template#set "id" (string_of_int model.id);
+ template#set "id" (Int32.to_string model.id);
template#set "description" model.description;
(match model.pt with
template#set "pt_value" title);
(* Redirects table. *)
- let sth = dbh#prepare_cached "select url, title from pages
- where url is not null
- and redirect is null
- and hostid = ? and id <> ?
- order by 2" in
- sth#execute [`Int hostid; `Int model.id];
- let table = sth#map (function [`String url; `String title] ->
- let selected = model.redirect = url in
- [ "url", Template.VarString url;
- "title", Template.VarString title;
- "selected", Template.VarConditional selected ]
- | _ -> assert false) in
+ let rows =
+ let model_id = model.id in
+ PGSQL(dbh)
+ "select url, title from pages
+ where url is not null
+ and redirect is null
+ and hostid = $hostid and id <> $model_id
+ order by 2" in
+ let table = List.map (
+ fun (url, title) ->
+ let url = Option.get url in
+ let selected = model.redirect = Some url in
+ [ "url", Template.VarString url;
+ "title", Template.VarString title;
+ "selected", Template.VarConditional selected ]
+ ) rows in
template#table "redirects" table;
- if model.id <> 0 then (
+ if model.id <> 0l then (
(* Need to go to the database to get the title of the page ... *)
- let sth = dbh#prepare_cached "select title from pages
- where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int model.id];
- let title = sth#fetch1string () in
+ let rows =
+ let model_id = model.id in
+ PGSQL(dbh)
+ "select title from pages
+ where hostid = $hostid and id = $model_id" in
+ let title = List.hd rows in
template#set "title" title;
) else (
match model.pt with
- Page page -> template#set "title" page
- | Title title -> template#set "title" title
+ | Page page -> template#set "title" page
+ | Title title -> template#set "title" title
);
let ordering = ref 0 in
let table =
List.map
(fun (sectionname, divname, content) ->
- incr ordering; let ordering = !ordering in
- [ "ordering", Template.VarString (string_of_int ordering);
+ incr ordering; let ordering = Int32.of_int !ordering in
+ let sectionname = match sectionname with None -> "" | Some s -> s in
+ let divname = match divname with None -> "" | Some s -> s in
+ [ "ordering", Template.VarString (Int32.to_string ordering);
"sectionname", Template.VarString sectionname;
"divname", Template.VarString divname;
- "content", Template.VarString content ]) model.contents in
+ "content", Template.VarString content ]) model.contents_ in
template#table "contents" table;
(* Check for errors and put those into the template. *)
(* Check if a URL exists in the database. *)
let page_exists page =
- let sth =
- dbh#prepare_cached "select 1 from pages where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String page];
-
- try sth#fetch1int () = 1 with Not_found -> false
+ let rows = PGSQL(dbh)
+ "select 1 from pages where hostid = $hostid and url = $page" in
+ rows = [ Some 1l ]
in
(* Begin editing a page, pulling the page out of the database and building
if is_action "insert" then (
let posn = get_action "insert" in
- let item = "New section - change this", "", "Write some content here." in
+ let item =
+ Some "The title of this section", None, "Write something here." in
model := action_insert !model posn item
) else if is_action "moveup" then (
let posn = get_action "moveup" in
(* Synthesize our own changes. *)
let old_page = get_version_for_diff dbh old_version in
let new_page =
- page_for_diff css (List.map (fun (sectionname, _, content) ->
- sectionname, content) model.contents) in
+ page_for_diff css (List.map (
+ fun (sectionname, _, content) ->
+ let sectionname = match sectionname with
+ | None -> ""
+ | Some s -> s in
+ sectionname, content
+ ) model.contents_) in
let our_diff = diff_cmd old_page new_page in
(* Fill out the conflict template. *)
template_conflict#set "other_diff" other_diff;
template_conflict#set "our_diff" our_diff;
- template_conflict#set "old_version" (string_of_int old_version);
- template_conflict#set "new_version" (string_of_int new_version);
+ template_conflict#set "old_version" (Int32.to_string old_version);
+ template_conflict#set "new_version" (Int32.to_string new_version);
template_conflict#set "url" url;
q#template template_conflict;
* anyone in the page_emails table who has a confirmed address
* and who hasn't received an email already today.
*)
- let sth = dbh#prepare_cached "select email, opt_out from page_emails
- where hostid = ? and url = ?
- and pending is null
- and last_sent < current_date" in
- sth#execute [`Int hostid; `String url];
-
- let addrs = sth#map (function [`String email; `String opt_out] ->
- email, opt_out
- | _ -> assert false) in
+ let rows = PGSQL(dbh)
+ "select email, opt_out from page_emails
+ where hostid = $hostid and url = $url
+ and pending is null
+ and last_sent < current_date" in
+ let addrs = List.map (
+ fun (email, opt_out) ->
+ email, opt_out
+ ) rows in
if addrs <> [] then (
(* Construct the email. *)
);
(* Update the database to record when these emails were sent. *)
- let sth = dbh#prepare_cached "update page_emails
- set last_sent = current_date
- where hostid = ? and url = ?
- and pending is null" in
- sth#execute [`Int hostid; `String url];
+ PGSQL(dbh)
+ "update page_emails
+ set last_sent = current_date
+ where hostid = $hostid and url = $url
+ and pending is null";
(* Commit changes to the database. *)
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Email notification, if anyone is listed for this host. *)
let subject = "Page " ^ url ^ " has been edited" in
let cancel id =
let url =
- if id <> 0 then (
- let sth = dbh#prepare_cached "select coalesce (url, url_deleted)
- from pages
- where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
- sth#fetch1string ()
+ if id <> 0l then (
+ let rows = PGSQL(dbh)
+ "select coalesce (url, url_deleted)
+ from pages
+ where hostid = $hostid and id = $id" in
+ Option.get (List.hd rows)
) else if q#param "pt_type" = "page" then
q#param "pt_value"
else
* title - page doesn't yet exist; create it.
*)
let id =
- try Some (int_of_string (q#param "id")) with Not_found -> None in
+ try Some (Int32.of_string (q#param "id")) with Not_found -> None in
(match id with
| None -> (* Begin editing the page. *)
if q#param_exists "page" then (
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_contact.ml,v 1.4 2005/11/24 14:54:11 rich Exp $
+ * $Id: edit_contact.ml,v 1.5 2006/03/27 18:09:46 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
let split_re = Pcre.regexp "[\\r\\n,;]+"
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
- let id = int_of_string (q#param "id") in
+let run r (q : cgi) dbh hostid _ _ =
+ let id = Int32.of_string (q#param "id") in
let name = trim (q#param "name") in
let subject = trim (q#param "subject") in
);
(* Need to verify that the contact belongs to the host. *)
- let sth = dbh#prepare_cached "select 1 from contacts
- where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
-
- assert (sth#fetch1int () = 1);
+ let rows = PGSQL(dbh) "select 1 from contacts
+ where hostid = $hostid and id = $id" in
+ assert (rows = [ Some 1l ]);
(* Update the database. *)
- let sth = dbh#prepare_cached "update contacts set name = ?, subject = ?
- where hostid = ? and id = ?" in
- sth#execute [`String name; `String subject; `Int hostid; `Int id];
-
- let sth =
- dbh#prepare_cached "delete from contact_emails where contactid = ?" in
- sth#execute [`Int id];
+ PGSQL(dbh) "update contacts set name = $name, subject = $subject
+ where hostid = $hostid and id = $id";
+ PGSQL(dbh) "delete from contact_emails where contactid = $id";
- let sth = dbh#prepare_cached "insert into contact_emails (contactid, email)
- values (?, ?)" in
- List.iter (fun email ->
- sth#execute [`Int id; `String email]) emails;
+ List.iter (
+ fun email ->
+ PGSQL(dbh) "insert into contact_emails (contactid, email)
+ values ($id, $email)"
+ ) emails;
(* Finish off. *)
- dbh#commit ();
+ PGOCaml.commit dbh;
let buttons = [
ok_button "/_bin/contacts.cmo";
{ Template.StdPages.label = " View contact form ";
Template.StdPages.link = "/_bin/contact_show.cmo";
Template.StdPages.method_ = None;
- Template.StdPages.params = [ "id", string_of_int id ] } ] in
+ Template.StdPages.params = [ "id", Int32.to_string id ] } ] in
ok ~title:"Contact form edited" ~buttons
dbh hostid q "The contact form was edited."
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_contact_form.ml,v 1.1 2004/09/21 18:24:15 rich Exp $
+ * $Id: edit_contact_form.ml,v 1.2 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "edit_contact_form.html" in
- let id = int_of_string (q#param "id") in
- template#set "id" (string_of_int id);
+ let id = Int32.of_string (q#param "id") in
+ template#set "id" (Int32.to_string id);
(* Get details from the database. *)
- let sth = dbh#prepare_cached "select name, subject from contacts
- where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
-
+ let rows = PGSQL(dbh) "select name, subject from contacts
+ where hostid = $hostid and id = $id" in
let name, subject =
- match sth#fetch1 () with
- [ `String name; `String subject ] -> name, subject
- | _ -> assert false in
+ match rows with
+ | [row] -> row
+ | _ -> assert false in
template#set "name" name;
template#set "subject" subject;
- let sth = dbh#prepare_cached "select email from contact_emails
- where contactid = ? order by 1" in
- sth#execute [`Int id];
-
- let table = sth#map (function [`String email] ->
- [ "email", Template.VarString email ]
- | _ -> assert false) in
+ let rows = PGSQL(dbh) "select email from contact_emails
+ where contactid = $id order by 1" in
+ let table = List.map (fun email ->
+ [ "email", Template.VarString email ]) rows in
template#table "emails" table;
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_file.ml,v 1.3 2005/11/24 14:54:11 rich Exp $
+ * $Id: edit_file.ml,v 1.4 2006/03/27 18:09:46 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_strings
open Cocanwiki_emailnotify
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
- let id = int_of_string (q#param "id") in
+let run r (q : cgi) dbh hostid {hostname = hostname} user =
+ let id = Int32.of_string (q#param "id") in
(* Get the fields. *)
let title = q#param "title" in
- let title = if string_is_whitespace title then `Null else `String title in
+ let title = if string_is_whitespace title then None else Some title in
(* Edit it. *)
- let sth = dbh#prepare_cached "update files set title = ?
- where hostid = ? and id = ?
- and name is not null" in
- sth#execute [title; `Int hostid; `Int id];
+ PGSQL(dbh) "update files set title = $?title
+ where hostid = $hostid and id = $id and name is not null";
(* Email notify. *)
let subject = "Description fields on file #" ^
- string_of_int id ^ " were changed." in
+ Int32.to_string id ^ " were changed." in
let body = fun () -> "Page: http://" ^ hostname ^ "/_files" in
email_notify ~body ~subject ~user dbh hostid;
(* Done it. *)
- dbh#commit ();
+ PGOCaml.commit dbh;
let buttons = [ ok_button "/_files" ] in
ok ~title:"Description fields updated" ~buttons
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_file_form.ml,v 1.1 2004/11/01 17:05:14 rich Exp $
+ * $Id: edit_file_form.ml,v 1.2 2006/03/27 18:09:46 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_template
open Cocanwiki_date
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "edit_file_form.html" in
- let id = int_of_string (q#param "id") in
+ let id = Int32.of_string (q#param "id") in
- let sth = dbh#prepare_cached "select name, coalesce (title, ''),
- mime_type,
- upload_date
- from files
- where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
+ let rows = PGSQL(dbh)
+ "select name, title, mime_type, upload_date from files
+ where hostid = $hostid and id = $id and name is not null" in
let name, title, mime_type, upload_date =
- match sth#fetch1 () with
- [ `String name; `String title; `String mime_type;
- `Timestamp upload_date ] ->
- name, title, mime_type, upload_date
- | _ -> assert false in
+ match rows with
+ | [row] -> row
+ | _ -> assert false in
- template#set "id" (string_of_int id);
+ let name = Option.get name in
+ let title = match title with None -> "" | Some t -> t in
+
+ template#set "id" (Int32.to_string id);
template#set "name" name;
template#set "title" title;
template#set "mime_type" mime_type;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_host_css.ml,v 1.5 2005/11/24 14:54:11 rich Exp $
+ * $Id: edit_host_css.ml,v 1.6 2006/03/27 18:09:46 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_ok
open Cocanwiki_strings
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let css = q#param "css" in
- let css = if string_is_whitespace css then `Null else `String css in
+ let css = if string_is_whitespace css then None else Some css in
(* XXX We should version the global stylesheet. However this requires
* some fairly non-trivial coding.
*)
- let sth = dbh#prepare_cached "update hosts set css = ? where id = ?" in
- sth#execute [css; `Int hostid];
+ PGSQL(dbh) "update hosts set css = $?css where id = $hostid";
- dbh#commit ();
+ PGOCaml.commit dbh;
let buttons = [
ok_button "/_bin/host_menu.cmo";
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_host_css_form.ml,v 1.3 2004/10/23 09:36:11 rich Exp $
+ * $Id: edit_host_css_form.ml,v 1.4 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "edit_host_css_form.html" in
- let sth = dbh#prepare_cached "select css from hosts where id = ?" in
- sth#execute [`Int hostid];
+ let rows = PGSQL(dbh) "select css from hosts where id = $hostid" in
let css =
- match sth#fetch1 () with
- | [ `Null ] -> ""
- | [ `String css ] -> css
- | _ -> assert false in
+ match rows with
+ | [ None ] -> ""
+ | [ Some css ] -> css
+ | _ -> assert false in
template#set "css" css;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_host_settings.ml,v 1.9 2005/11/24 14:54:11 rich Exp $
+ * $Id: edit_host_settings.ml,v 1.10 2006/03/27 18:09:46 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_ok
open Cocanwiki_strings
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
+let run r (q : cgi) dbh hostid { hostname = hostname } _ =
(* Cancel? *)
if q#param_true "cancel" then (
(* Request cancelled. *)
let brand_description = trim (q#param "brand_description") in
let pagebug = trim (q#param "pagebug") in
- let theme_css = if theme_css = "" then `Null else `String theme_css in
+ let theme_css = if theme_css = "" then None else Some theme_css in
let feedback_email =
- if feedback_email = "" then `Null else `String feedback_email in
- let brand = if brand = "" then `Null else `String brand in
+ if string_is_whitespace feedback_email then
+ None else Some feedback_email in
+ let brand = if string_is_whitespace brand then None else Some brand in
let brand_tagline =
- if brand_tagline = "" then `Null else `String brand_tagline in
+ if string_is_whitespace brand_tagline then None else Some brand_tagline in
let brand_description =
- if brand_description = "" then `Null else `String brand_description in
+ if string_is_whitespace brand_description then
+ None else Some brand_description in
let pagebug =
- if pagebug = "" then `Null else `String pagebug in
+ if string_is_whitespace pagebug then None else Some pagebug in
(* Update the database. *)
- let sth = dbh#prepare_cached "update hosts set edit_anon = ?,
- create_account_anon = ?, theme_css = ?,
- feedback_email = ?, mailing_list = ?,
- search_box = ?, navigation = ?,
- view_anon = ?,
- brand = ?, brand_tagline = ?,
- brand_description = ?,
- pagebug = ?
- where id = ?" in
- sth#execute [`Bool edit_anon; `Bool create_account_anon;
- theme_css; feedback_email; `Bool mailing_list; `Bool search_box;
- `Bool navigation; `Bool view_anon;
- brand; brand_tagline; brand_description;
- pagebug;
- `Int hostid];
+ PGSQL(dbh)
+ "update hosts set edit_anon = $edit_anon,
+ create_account_anon = $create_account_anon, theme_css = $?theme_css,
+ feedback_email = $?feedback_email, mailing_list = $mailing_list,
+ search_box = $search_box, navigation = $navigation,
+ view_anon = $view_anon,
+ brand = $?brand, brand_tagline = $?brand_tagline,
+ brand_description = $?brand_description,
+ pagebug = $?pagebug
+ where id = $hostid";
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Finish off. *)
ok ~title:"Global settings updated"
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_host_settings_form.ml,v 1.6 2004/11/03 13:36:45 rich Exp $
+ * $Id: edit_host_settings_form.ml,v 1.7 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "edit_host_settings_form.html" in
(* List of themes. *)
- let sth = dbh#prepare_cached "select theme_css, name, description
- from themes order by 2, 1" in
- sth#execute [];
+ let rows =
+ PGSQL(dbh) "select theme_css, name, description
+ from themes order by 2, 1" in
let themes =
- sth#map (function [`String theme_css; `String name; `String description] ->
- theme_css, (name, description)
- | _ -> assert false) in
+ List.map (fun (theme_css, name, description) ->
+ theme_css, (name, description)) rows in
(* Get lots of host-specific stuff from the database. *)
- let sth =
- dbh#prepare_cached
+ let rows =
+ PGSQL(dbh)
"select canonical_hostname, edit_anon, create_account_anon, theme_css,
feedback_email, mailing_list, search_box, navigation, view_anon,
- coalesce (brand, ''), coalesce (brand_tagline, ''),
- coalesce (brand_description, '')
- from hosts where id = ?" in
- sth#execute [`Int hostid];
+ brand, brand_tagline, brand_description
+ from hosts where id = $hostid" in
let canonical_hostname, edit_anon, create_account_anon, theme_css,
feedback_email, mailing_list, search_box, navigation, view_anon,
brand, brand_tagline, brand_description =
- match sth#fetch1 () with
- [ `String canonical_hostname;
- `Bool edit_anon; `Bool create_account_anon;
- (`String _ | `Null) as theme_css;
- (`String _ | `Null) as feedback_email;
- `Bool mailing_list; `Bool search_box; `Bool navigation;
- `Bool view_anon;
- `String brand; `String brand_tagline; `String brand_description ] ->
- let theme_css =
- match theme_css with `String s -> s | `Null -> "" in
- let feedback_email =
- match feedback_email with `String s -> s | `Null -> "" in
- canonical_hostname, edit_anon, create_account_anon, theme_css,
- feedback_email, mailing_list, search_box, navigation, view_anon,
- brand, brand_tagline, brand_description
- | _ -> assert false in
+ match rows with
+ | [canonical_hostname, edit_anon, create_account_anon, theme_css,
+ feedback_email, mailing_list, search_box, navigation, view_anon,
+ brand, brand_tagline, brand_description] ->
+ let theme_css =
+ match theme_css with Some s -> s | None -> "" in
+ let feedback_email =
+ match feedback_email with Some s -> s | None -> "" in
+ let brand =
+ match brand with Some s -> s | None -> "" in
+ let brand_tagline =
+ match brand_tagline with Some s -> s | None -> "" in
+ let brand_description =
+ match brand_description with Some s -> s | None -> "" in
+ canonical_hostname, edit_anon, create_account_anon, theme_css,
+ feedback_email, mailing_list, search_box, navigation, view_anon,
+ brand, brand_tagline, brand_description
+ | _ -> assert false in
template#set "canonical_hostname" canonical_hostname;
template#conditional "edit_anon" edit_anon;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_image.ml,v 1.3 2005/11/24 14:54:11 rich Exp $
+ * $Id: edit_image.ml,v 1.4 2006/03/27 18:09:46 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_strings
open Cocanwiki_emailnotify
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
- let id = int_of_string (q#param "id") in
+let run r (q : cgi) dbh hostid {hostname = hostname} user =
+ let id = Int32.of_string (q#param "id") in
(* Get the fields. *)
let alt = q#param "alt" in
return ()
);
- let title = if string_is_whitespace title then `Null else `String title in
+ let title = if string_is_whitespace title then None else Some title in
let longdesc =
- if string_is_whitespace longdesc then `Null else `String longdesc in
- let clazz = if string_is_whitespace clazz then `Null else `String clazz in
+ if string_is_whitespace longdesc then None else Some longdesc in
+ let clazz = if string_is_whitespace clazz then None else Some clazz in
(* Edit it. *)
- let sth = dbh#prepare_cached "update images set alt = ?, title = ?,
- longdesc = ?, class = ?
- where hostid = ? and id = ?
- and name is not null" in
- sth#execute [`String alt; title; longdesc; clazz;
- `Int hostid; `Int id];
+ PGSQL(dbh)
+ "update images set alt = $alt, title = $?title,
+ longdesc = $?longdesc, class = $?clazz
+ where hostid = $hostid and id = $id and name is not null";
(* Email notify. *)
let subject = "Description fields on image #" ^
- string_of_int id ^ " were changed." in
+ Int32.to_string id ^ " were changed." in
let body = fun () -> "Page: http://" ^ hostname ^ "/_images" in
email_notify ~body ~subject ~user dbh hostid;
(* Done it. *)
- dbh#commit ();
+ PGOCaml.commit dbh;
let buttons = [ ok_button "/_images" ] in
ok ~title:"Description fields updated" ~buttons
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_image_form.ml,v 1.1 2004/11/01 17:05:14 rich Exp $
+ * $Id: edit_image_form.ml,v 1.2 2006/03/27 18:09:46 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_template
open Cocanwiki_date
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "edit_image_form.html" in
- let id = int_of_string (q#param "id") in
+ let id = Int32.of_string (q#param "id") in
- let sth = dbh#prepare_cached "select name, alt, coalesce (title, ''),
- coalesce (longdesc, ''),
- coalesce (class, ''),
- mime_type,
- coalesce (tn_width, 0),
- coalesce (tn_height, 0),
- upload_date
- from images
- where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
+ let rows = PGSQL(dbh)
+ "select name, alt, title,
+ longdesc,
+ class,
+ mime_type,
+ tn_width,
+ tn_height,
+ upload_date
+ from images
+ where hostid = $hostid and id = $id and name is not null" in
let name, alt, title, longdesc, clazz, mime_type, tn_width, tn_height,
upload_date =
- match sth#fetch1 () with
- [ `String name; `String alt; `String title; `String longdesc;
- `String clazz; `String mime_type; `Int tn_width; `Int tn_height;
- `Timestamp upload_date ] ->
- name, alt, title, longdesc, clazz, mime_type, tn_width, tn_height,
- upload_date
- | _ -> assert false in
+ match rows with
+ | [name, alt, title, longdesc, clazz, mime_type, tn_width, tn_height,
+ upload_date] ->
+ name, alt, title, longdesc, clazz, mime_type, tn_width, tn_height,
+ upload_date
+ | _ -> assert false in
- template#set "id" (string_of_int id);
+ let name = Option.get name in
+ let title = match title with None -> "" | Some s -> s in
+ let longdesc = match longdesc with None -> "" | Some s -> s in
+ let clazz = match clazz with None -> "" | Some s -> s in
+ let tn_width = match tn_width with None -> 0l | Some s -> s in
+ let tn_height = match tn_height with None -> 0l | Some s -> s in
+
+ template#set "id" (Int32.to_string id);
template#set "name" name;
template#set "alt" alt;
template#set "title" title;
template#set "longdesc" longdesc;
template#set "class" clazz;
template#set "mime_type" mime_type;
- template#set "tn_width" (string_of_int tn_width);
- template#set "tn_height" (string_of_int tn_height);
+ template#set "tn_width" (Int32.to_string tn_width);
+ template#set "tn_height" (Int32.to_string tn_height);
template#set "upload_date" (printable_date upload_date);
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_page_css.ml,v 1.18 2005/11/24 14:54:11 rich Exp $
+ * $Id: edit_page_css.ml,v 1.19 2006/03/27 18:09:46 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_emailnotify
open Cocanwiki_strings
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
+let run r (q : cgi) dbh hostid {hostname = hostname} user =
let page = q#param "page" in
let css = q#param "css" in
- let css = if string_is_whitespace css then `Null else `String css in
+ let css = if string_is_whitespace css then None else Some css in
(* 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
(* Changing the CSS creates a new version of the page. This enables
* us to revert changes to the CSS easily.
redirect
from pages
where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
let oldpageid, title, description, creation_date, redirect =
match sth#fetch1 () with
- [ `Int id; title; description; creation_date; redirect ] ->
+ [ Some id; title; description; creation_date; redirect ] ->
id, title, description, creation_date, redirect
| _ -> assert false in
let sth = dbh#prepare_cached "update pages set url_deleted = url,
url = null
where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int oldpageid];
+ sth#execute [Some hostid; Some oldpageid];
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;
+ sth#execute [Some hostid; Some page; title; description;
creation_date; logged_ip; logged_user; redirect; css ];
let pageid = Int64.to_int (sth#serial "pages_id_seq") in
content, divname
from contents
where pageid = ?" in
- sth#execute [`Int pageid; `Int oldpageid];
+ sth#execute [Some pageid; Some oldpageid];
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Email notification. *)
let subject = "CSS for page " ^ page ^ " has been modified" in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_page_css_form.ml,v 1.6 2004/09/09 12:21:22 rich Exp $
+ * $Id: edit_page_css_form.ml,v 1.7 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "edit_page_css_form.html" in
let page = q#param "page" in
let sth = dbh#prepare_cached "select css from pages
where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
let css =
match sth#fetch1 () with
- | [ `Null ] -> ""
- | [ `String css ] -> css
+ | [ None ] -> ""
+ | [ Some css ] -> css
| _ -> assert false in
template#set "page" page;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_sitemenu.ml,v 1.9 2005/11/24 14:54:11 rich Exp $
+ * $Id: edit_sitemenu.ml,v 1.10 2006/03/27 18:09:46 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
*)
type model_t = (string * string) list (* label, url *)
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user=
+let run r (q : cgi) dbh hostid { hostname = hostname } user=
let template = get_template dbh hostid "edit_sitemenu.html" in
(* Workaround bugs in IE, specifically lack of support for <button>
and url is not null
and url <> 'index'
order by 2" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
- let urls = sth#map (function [`String url; `String title] ->
+ let urls = sth#map (function [Some url; Some title] ->
url, title
| _ -> assert false) in
let build_internal_model () =
let model = ref [] in
let i = ref 1 in
- while q#param_exists ("label_" ^ string_of_int !i) do
- let label = q#param ("label_" ^ string_of_int !i) in
- let url = q#param ("url_" ^ string_of_int !i) in
+ while q#param_exists ("label_" ^ Int32.to_string !i) do
+ let label = q#param ("label_" ^ Int32.to_string !i) in
+ let url = q#param ("url_" ^ Int32.to_string !i) in
model := (label, url) :: !model;
incr i
done;
"title", Template.VarString (truncate 30 title);
"selected", Template.VarConditional selected ]) urls in
- [ "ordering", Template.VarString (string_of_int ordering);
+ [ "ordering", Template.VarString (Int32.to_string ordering);
"label", Template.VarString label;
"url", Template.VarString url;
"urls", Template.VarTable table; ]) model in
from sitemenu
where hostid = ?
order by ordering" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
- let model = sth#map (function [`String label; `String url; _] ->
+ let model = sth#map (function [Some label; Some url; _] ->
label, url
| _ -> assert false) in
let action_type = String.sub str 7 6 in
let action_value =
String.sub str 14 (String.length str - 14) in
- let action_value = int_of_string action_value in
+ let action_value = Int32.of_string action_value in
action_type, action_value) actions in
let is_action typ = List.mem_assoc typ actions in
(* No errors, so we can save the page ... *)
let sth = dbh#prepare_cached "delete from sitemenu where hostid = ?" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let sth = dbh#prepare_cached "insert into sitemenu (hostid, label, url,
ordering) values (?, ?, ?, ?)" in
List.iteri (fun i (label, url) ->
let ordering = 10 * (i+1) in
- sth#execute [`Int hostid; `String label; `String url;
- `Int ordering]) model;
+ sth#execute [Some hostid; Some label; Some url;
+ Some ordering]) model;
(* Commit changes to the database. *)
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Email notification, if anyone is listed for this host. *)
let subject = "The site menu has been edited" in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_user.ml,v 1.10 2005/11/24 14:54:12 rich Exp $
+ * $Id: edit_user.ml,v 1.11 2006/03/27 18:09:46 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_strings
open Cocanwiki_ok
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ self =
- let userid = int_of_string (q#param "userid") in
+let run r (q : cgi) dbh hostid _ self =
+ let userid = Int32.of_string (q#param "userid") in
(* Get the user's original name. If we're going to change the
* name, we need to do additional checks.
*)
let sth = dbh#prepare_cached "select name from users
where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int userid];
+ sth#execute [Some hostid; Some userid];
let original_name = sth#fetch1string () in
let name = trim (q#param "name") in
(* Check it's not a duplicate, then change it. *)
let sth = dbh#prepare_cached "select id from users
where hostid = ? and name = ?" in
- sth#execute [`Int hostid; `String name];
+ sth#execute [Some hostid; Some name];
(try
sth#fetch1 ();
let sth = dbh#prepare_cached "update users set name = ?
where hostid = ? and id = ?" in
- sth#execute [`String name; `Int hostid; `Int userid]
+ sth#execute [Some name; Some hostid; Some userid]
);
(* Change permissions. *)
sth#execute [`Bool can_edit; `Bool can_manage_users;
`Bool can_manage_contacts; `Bool can_manage_site;
`Bool can_edit_global_css; `Bool can_import_mail;
- `Int hostid; `Int userid];
+ Some hostid; Some userid];
(* Finish up. *)
- dbh#commit ();
+ PGOCaml.commit dbh;
let buttons = [ ok_button "/_users" ] in
ok ~buttons ~title:"Saved"
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_user_form.ml,v 1.8 2005/11/23 11:32:13 rich Exp $
+ * $Id: edit_user_form.ml,v 1.9 2006/03/27 18:09:46 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_template
open Cocanwiki_date
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "edit_user_form.html" in
- let userid = int_of_string (q#param "userid") in
+ let userid = Int32.of_string (q#param "userid") in
let sth =
dbh#prepare_cached
(select count(*) from pages
where logged_user = u.id and url_deleted is null)::int4
from users u where u.hostid = ? and u.id = ?" in
- sth#execute [`Int hostid; `Int userid];
+ sth#execute [Some hostid; Some userid];
let name, email, registration_date, can_edit, can_manage_users,
can_manage_contacts, can_manage_site, can_edit_global_css,
can_import_mail, nr_edits, nr_edits_live =
match sth#fetch1 () with
- [`String name; (`Null | `String _) as email;
+ [Some name; (None | Some _) as email;
`Date registration_date;
`Bool can_edit; `Bool can_manage_users; `Bool can_manage_contacts;
`Bool can_manage_site; `Bool can_edit_global_css;
`Bool can_import_mail;
- `Int nr_edits; `Int nr_edits_live] ->
+ Some nr_edits; Some nr_edits_live] ->
name, email, registration_date, can_edit, can_manage_users,
can_manage_contacts, can_manage_site, can_edit_global_css,
can_import_mail, nr_edits, nr_edits_live
| _ -> assert false in
- template#set "userid" (string_of_int userid);
+ template#set "userid" (Int32.to_string userid);
template#set "name" name;
- template#set "email" (match email with `Null -> "" | `String s -> s);
+ template#set "email" (match email with None -> "" | Some s -> s);
template#set "registration_date" (printable_date' registration_date);
template#conditional "can_edit" can_edit;
template#conditional "can_manage_users" can_manage_users;
template#conditional "can_manage_site" can_manage_site;
template#conditional "can_edit_global_css" can_edit_global_css;
template#conditional "can_import_mail" can_import_mail;
- template#set "nr_edits" (string_of_int nr_edits);
- template#set "nr_edits_live" (string_of_int nr_edits_live);
+ template#set "nr_edits" (Int32.to_string nr_edits);
+ template#set "nr_edits_live" (Int32.to_string nr_edits_live);
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: email_change.ml,v 1.2 2005/11/24 14:54:12 rich Exp $
+ * $Id: email_change.ml,v 1.3 2006/03/27 18:09:46 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
open Cocanwiki_ok
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
(* Get the key in the pending_email_changes table. *)
let key = q#param "key" in
let sth = dbh#prepare_cached "select userid, email from pending_email_changes
where key = ?" in
- sth#execute [`String key];
+ sth#execute [Some key];
let userid, email =
try
(match sth#fetch1 () with
- [ `Int userid; `String email ] -> userid, email
+ [ Some userid; Some email ] -> userid, email
| _ -> assert false)
with
Not_found ->
(* Update the database. *)
let sth = dbh#prepare_cached "delete from pending_email_changes
where key = ?" in
- sth#execute [`String key];
+ sth#execute [Some key];
let sth = dbh#prepare_cached "update users set email = ? where id = ?" in
- sth#execute [`String email; `Int userid];
+ sth#execute [Some email; Some userid];
- dbh#commit ();
+ PGOCaml.commit dbh;
ok ~title:"Email address verified"
dbh hostid q "Thank you for verifying your new email address."
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: file.ml,v 1.13 2004/12/01 13:55:55 rich Exp $
+ * $Id: file.ml,v 1.14 2006/03/27 18:09:46 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
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} _ =
+let run r (q : cgi) dbh hostid {hostname = hostname} _ =
let name = q#param "name" in
let version =
- try Some (int_of_string (q#param "version")) with Not_found -> None in
+ try Some (Int32.of_string (q#param "version")) with Not_found -> None in
(* Get the file and its MIME type. *)
let where, args =
match version with
- None -> "hostid = ? and name = ?", [`Int hostid; `String name]
+ None -> "hostid = ? and name = ?", [Some hostid; Some name]
| Some version ->
"hostid = ? and (name = ? or name_deleted = ?) and id = ?",
- [`Int hostid; `String name; `String name; `Int version] in
+ [Some hostid; Some name; Some name; Some version] in
let sth =
dbh#prepare_cached ("select content, mime_type, name is null as deleted
let data, mime_type, deleted =
try
(match sth#fetch1 () with
- [ `Binary data; `String mime_type; `Bool deleted ] ->
+ [ `Binary data; Some mime_type; `Bool deleted ] ->
data, mime_type, deleted
| _ -> assert false)
with
(* Content-length header. *)
Table.set (Request.headers_out r) "Content-Length"
- (string_of_int (String.length data));
+ (Int32.to_string (String.length data));
q#header ~content_type:mime_type ();
ignore (print_string r data)
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: files.ml,v 1.7 2004/09/09 12:21:22 rich Exp $
+ * $Id: files.ml,v 1.8 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "files.html" in
let deleted = q#param_true "deleted" in
else "name_deleted is not null") ^
" order by 2, 3" in
let sth = dbh#prepare_cached sql in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let table =
sth#map
(fun row ->
let id, name, size, is_deleted =
match row with
- | [`Int id; `String name; `Null; `Int size] ->
+ | [Some id; Some name; None; Some size] ->
id, name, size, false
- | [`Int id; `Null; `String name; `Int size] ->
+ | [Some id; None; Some name; Some size] ->
id, name, size, true
| _ -> assert false in
- [ "id", Template.VarString (string_of_int id);
+ [ "id", Template.VarString (Int32.to_string id);
"name", Template.VarString name;
- "ksize", Template.VarString (string_of_int (size / 1024));
+ "ksize", Template.VarString (Int32.to_string (size / 1024));
"is_deleted", Template.VarConditional is_deleted ]) in
template#table "files" table;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: forgot_password.ml,v 1.8 2005/11/24 14:54:12 rich Exp $
+ * $Id: forgot_password.ml,v 1.9 2006/03/27 18:09:46 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_ok
open Cocanwiki_strings
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
+let run r (q : cgi) dbh hostid { hostname = hostname } _ =
let name = trim (q#param "name") in
if name = "" then (
and email is not null
and (lower (name) = lower (?)
or lower (email) = lower (?))" in
- sth#execute [`Int hostid; `String name; `String name];
+ sth#execute [Some hostid; Some name; Some name];
try
let email, name, password = match sth#fetch1 () with
- [ `String email; `String name; `String password ] ->
+ [ Some email; Some name; Some password ] ->
email, name, password
| _ -> assert false in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: forgot_password_form.ml,v 1.4 2004/09/09 12:21:22 rich Exp $
+ * $Id: forgot_password_form.ml,v 1.5 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "forgot_password_form.html" in
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: history.ml,v 1.9 2004/11/01 17:46:21 rich Exp $
+ * $Id: history.ml,v 1.10 2006/03/27 18:09:46 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_template
open Cocanwiki_date
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "history.html" in
let page = q#param "page" in
from pages p left outer join users u on p.logged_user = u.id
where p.hostid = ? and (p.url = ? or p.url_deleted = ?)
order by p.last_modified_date desc" in
- sth#execute [`Int hostid; `String page; `String page];
+ sth#execute [Some hostid; Some page; Some page];
let table =
sth#map
(function
- | [`Int version; `String url; _; `String title;
+ | [Some version; Some url; _; Some title;
`Timestamp last_modified_date; logged_ip; logged_user ] ->
let date = printable_date_time last_modified_date in
let has_logged_ip, logged_ip =
match logged_ip with
- `Null -> false, ""
- | `String ip -> true, ip
+ None -> false, ""
+ | Some ip -> true, ip
| _ -> assert false in
let has_logged_user, logged_user =
match logged_user with
- `Null -> false, ""
- | `String name -> true, name
+ None -> false, ""
+ | Some name -> true, name
| _ -> assert false in
- [ "version", Template.VarString (string_of_int version);
+ [ "version", Template.VarString (Int32.to_string version);
"url", Template.VarString url;
"title", Template.VarString title;
"last_modified_date", Template.VarString date;
"has_logged_user", Template.VarConditional has_logged_user;
"logged_user", Template.VarString logged_user;
"is_live", Template.VarConditional true ]
- | [`Int version; `Null; `String url; `String title;
+ | [Some version; None; Some url; Some title;
`Timestamp last_modified_date; logged_ip; logged_user ] ->
let date = printable_date_time last_modified_date in
let has_logged_ip, logged_ip =
match logged_ip with
- `Null -> false, ""
- | `String ip -> true, ip
+ None -> false, ""
+ | Some ip -> true, ip
| _ -> assert false in
let has_logged_user, logged_user =
match logged_user with
- `Null -> false, ""
- | `String name -> true, name
+ None -> false, ""
+ | Some name -> true, name
| _ -> assert false in
- [ "version", Template.VarString (string_of_int version);
+ [ "version", Template.VarString (Int32.to_string version);
"url", Template.VarString url;
"title", Template.VarString title;
"last_modified_date", Template.VarString date;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: history_rss.ml,v 1.2 2004/11/02 11:05:58 rich Exp $
+ * $Id: history_rss.ml,v 1.3 2006/03/27 18:09:46 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_template
open Cocanwiki_date
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} _ =
+let run r (q : cgi) dbh hostid {hostname = hostname} _ =
let template = get_template dbh hostid "history_rss.xml" in
let page = q#param "page" in
from pages p left outer join users u on p.logged_user = u.id
where p.hostid = ? and (p.url = ? or p.url_deleted = ?)
order by p.last_modified_date desc" in
- sth#execute [`Int hostid; `String page; `String page];
+ sth#execute [Some hostid; Some page; Some page];
let table =
sth#map
(function
- | [`Int version; `String url; _; `String title;
+ | [Some version; Some url; _; Some title;
`Timestamp last_modified_date; logged_ip; logged_user ] ->
let date = printable_date_time last_modified_date in
let has_logged_ip, logged_ip =
match logged_ip with
- `Null -> false, ""
- | `String ip -> true, ip
+ None -> false, ""
+ | Some ip -> true, ip
| _ -> assert false in
let has_logged_user, logged_user =
match logged_user with
- `Null -> false, ""
- | `String name -> true, name
+ None -> false, ""
+ | Some name -> true, name
| _ -> assert false in
- [ "version", Template.VarString (string_of_int version);
+ [ "version", Template.VarString (Int32.to_string version);
"url", Template.VarString url;
"title", Template.VarString title;
"last_modified_date", Template.VarString date;
"has_logged_user", Template.VarConditional has_logged_user;
"logged_user", Template.VarString logged_user;
"is_live", Template.VarConditional true ]
- | [`Int version; `Null; `String url; `String title;
+ | [Some version; None; Some url; Some title;
`Timestamp last_modified_date; logged_ip; logged_user ] ->
let date = printable_date_time last_modified_date in
let has_logged_ip, logged_ip =
match logged_ip with
- `Null -> false, ""
- | `String ip -> true, ip
+ None -> false, ""
+ | Some ip -> true, ip
| _ -> assert false in
let has_logged_user, logged_user =
match logged_user with
- `Null -> false, ""
- | `String name -> true, name
+ None -> false, ""
+ | Some name -> true, name
| _ -> assert false in
- [ "version", Template.VarString (string_of_int version);
+ [ "version", Template.VarString (Int32.to_string version);
"url", Template.VarString url;
"title", Template.VarString title;
"last_modified_date", Template.VarString date;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: host_menu.ml,v 1.7 2004/11/03 13:36:45 rich Exp $
+ * $Id: host_menu.ml,v 1.8 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid host user =
+let run r (q : cgi) dbh hostid host user =
let template = get_template dbh hostid "host_menu.html" in
(* Get user's specific permissions. *)
coalesce (h.brand_description, '')
from hosts h left outer join themes t on h.theme_css = t.theme_css
where h.id = ?" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let canonical_hostname, has_global_css, edit_anon, create_account_anon,
has_theme_css, theme_name, theme_description, has_feedback_email,
feedback_email, mailing_list, search_box, navigation, view_anon,
has_brand, brand, brand_tagline, brand_description =
match sth#fetch1 () with
- [ `String canonical_hostname; `Bool has_global_css;
+ [ Some canonical_hostname; `Bool has_global_css;
`Bool edit_anon; `Bool create_account_anon; `Bool has_theme_css;
- (`String _ | `Null) as theme_name;
- (`String _ | `Null) as theme_description;
- (`String _ | `Null) as feedback_email;
+ (Some _ | None) as theme_name;
+ (Some _ | None) as theme_description;
+ (Some _ | None) as feedback_email;
`Bool mailing_list; `Bool search_box; `Bool navigation;
`Bool view_anon;
- (`String _ | `Null) as brand; `String brand_tagline;
- `String brand_description ] ->
+ (Some _ | None) as brand; Some brand_tagline;
+ Some brand_description ] ->
let theme_name =
- match theme_name with `String s -> s | `Null -> "" in
+ match theme_name with Some s -> s | None -> "" in
let theme_description =
- match theme_description with `String s -> s | `Null -> "" in
+ match theme_description with Some s -> s | None -> "" in
let feedback_email, has_feedback_email =
match feedback_email with
- `String s -> s, true
- | `Null -> "", false in
+ Some s -> s, true
+ | None -> "", false in
let brand, has_brand =
match brand with
- `String s -> s, true
- | `Null -> "", false in
+ Some s -> s, true
+ | None -> "", false in
canonical_hostname, has_global_css, edit_anon, create_account_anon,
has_theme_css, theme_name, theme_description, has_feedback_email,
feedback_email, mailing_list, search_box, navigation, view_anon,
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: hoststyle.ml,v 1.6 2004/10/23 12:00:23 rich Exp $
+ * $Id: hoststyle.ml,v 1.7 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
(* Get the CSS. *)
let sth = dbh#prepare_cached "select css from hosts where id = ?" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let css =
match sth#fetch1 () with
- [ `Null ] -> ""
- | [ `String css ] -> css
+ [ None ] -> ""
+ | [ Some css ] -> css
| _ -> assert false in
(* It's crucial, for speed of page delivery and rendering, to have
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: image.ml,v 1.14 2004/12/01 13:55:55 rich Exp $
+ * $Id: image.ml,v 1.15 2006/03/27 18:09:46 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
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} _ =
+let run r (q : cgi) dbh hostid {hostname = hostname} _ =
let image = q#param "image" in
let is_thumbnail = q#param_true "thumbnail" in
let version =
- try Some (int_of_string (q#param "version")) with Not_found -> None in
+ try Some (Int32.of_string (q#param "version")) with Not_found -> None in
(* Get the image and its MIME type. *)
let what =
else "thumbnail, tn_mime_type, name is null as deleted" in
let where, args =
match version with
- None -> "hostid = ? and name = ?", [`Int hostid; `String image]
+ None -> "hostid = ? and name = ?", [Some hostid; Some image]
| Some version ->
"hostid = ? and (name = ? or name_deleted = ?) and id = ?",
- [`Int hostid; `String image; `String image; `Int version] in
+ [Some hostid; Some image; Some image; Some version] in
let sth = dbh#prepare_cached
("select " ^ what ^ " from images where " ^ where) in
let data, mime_type, deleted =
try
(match sth#fetch1 () with
- [ `Binary data; `String mime_type; `Bool deleted ] ->
+ [ `Binary data; Some mime_type; `Bool deleted ] ->
data, mime_type, deleted
| _ -> assert false)
with
(* Content-length header. *)
Table.set (Request.headers_out r) "Content-Length"
- (string_of_int (String.length data));
+ (Int32.to_string (String.length data));
q#header ~content_type:mime_type ();
ignore (print_string r data)
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: images.ml,v 1.7 2004/09/09 12:21:22 rich Exp $
+ * $Id: images.ml,v 1.8 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "images.html" in
let deleted = q#param_true "deleted" in
else "name_deleted is not null") ^
" order by 2, 3" in
let sth = dbh#prepare_cached sql in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let table =
sth#map
let id, name, width, height, alt, size, tn_width, tn_height,
is_deleted, has_thumbnail =
match row with
- | [`Int id; `String name; `Null; `Int width; `Int height;
- `String alt; `Int size; `Int tn_width; `Int tn_height] ->
+ | [Some id; Some name; None; Some width; Some height;
+ Some alt; Some size; Some tn_width; Some tn_height] ->
id, name, width, height, alt, size, tn_width, tn_height,
false, true
- | [`Int id; `Null; `String name; `Int width; `Int height;
- `String alt; `Int size; `Int tn_width; `Int tn_height] ->
+ | [Some id; None; Some name; Some width; Some height;
+ Some alt; Some size; Some tn_width; Some tn_height] ->
id, name, width, height, alt, size, tn_width, tn_height,
true, true
- | [`Int id; `String name; `Null; `Int width; `Int height;
- `String alt; `Int size; `Null; `Null] ->
+ | [Some id; Some name; None; Some width; Some height;
+ Some alt; Some size; None; None] ->
id, name, width, height, alt, size, 0, 0,
false, false
- | [`Int id; `Null; `String name; `Int width; `Int height;
- `String alt; `Int size; `Null; `Null] ->
+ | [Some id; None; Some name; Some width; Some height;
+ Some alt; Some size; None; None] ->
id, name, width, height, alt, size, 0, 0,
true, false
| _ -> assert false in
- [ "id", Template.VarString (string_of_int id);
+ [ "id", Template.VarString (Int32.to_string id);
"name", Template.VarString name;
- "width", Template.VarString (string_of_int width);
- "height", Template.VarString (string_of_int height);
+ "width", Template.VarString (Int32.to_string width);
+ "height", Template.VarString (Int32.to_string height);
"alt", Template.VarString alt;
- "ksize", Template.VarString (string_of_int (size / 1024));
- "tn_width", Template.VarString (string_of_int tn_width);
- "tn_height", Template.VarString (string_of_int tn_height);
+ "ksize", Template.VarString (Int32.to_string (size / 1024));
+ "tn_width", Template.VarString (Int32.to_string tn_width);
+ "tn_height", Template.VarString (Int32.to_string tn_height);
"is_deleted", Template.VarConditional is_deleted;
"has_thumbnail", Template.VarConditional has_thumbnail ]) in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: invite_user.ml,v 1.5 2005/11/24 14:54:12 rich Exp $
+ * $Id: invite_user.ml,v 1.6 2006/03/27 18:09:46 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
let split_re = Pcre.regexp "[\\s,;]+"
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
+let run r (q : cgi) dbh hostid {hostname = hostname} user =
let template = _get_template "invite_user.txt" in
let template_exists = _get_template "invite_user_exists.txt" in
let sth = dbh#prepare_cached "select id, invite from users
where hostid = ? and
(email = ? or name = ?)" in
- sth#execute [`Int hostid; `String email; `String email];
+ sth#execute [Some hostid; Some email; Some email];
let body =
try
(match sth#fetch1 () with
- [ `Int userid; `Null ] ->
+ [ Some userid; None ] ->
(* Existing user account - send reminder. *)
template_exists#set "username" username;
template_exists#set "hostname" hostname;
template_exists#to_string
- | [ `Int userid; `String invite ] ->
+ | [ Some userid; Some invite ] ->
(* Existing user account - resend the invite. *)
template#set "username" username;
template#set "hostname" hostname;
let invite = random_sessionid () in
let sth = dbh#prepare_cached "insert into users (hostid, name,
password, email, invite) values (?, ?, ?, ?, ?)" in
- sth#execute [`Int hostid; `String email; `String invite;
- `String email; `String invite];
+ sth#execute [Some hostid; Some email; Some invite;
+ Some email; Some invite];
template#set "username" username;
template#set "hostname" hostname;
) emails;
(* Finish off. *)
- dbh#commit ();
+ PGOCaml.commit dbh;
let buttons = [ ok_button "/_users" ] in
ok ~buttons ~title:"Invitation emails sent"
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: invite_user_confirm.ml,v 1.4 2005/11/24 14:54:12 rich Exp $
+ * $Id: invite_user_confirm.ml,v 1.5 2006/03/27 18:09:46 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_strings
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
+let run r (q : cgi) dbh hostid { hostname = hostname } _ =
let template = _get_template "invite_user_confirm.txt" in
let username = q#param "username" in
let sth = dbh#prepare_cached "select email, id from users
where hostid = ? and
name = ? and invite = ?" in
- sth#execute [`Int hostid; `String username; `String invite];
+ sth#execute [Some hostid; Some username; Some invite];
let email, userid =
try
match sth#fetch1 () with
- [ `String email; `Int userid ] -> Some email, userid
- | [ `Null; `Int userid ] -> None, userid
+ [ Some email; Some userid ] -> Some email, userid
+ | [ None; Some userid ] -> None, userid
| _ -> assert false
with Not_found ->
error ~title:"Already signed up"
"update users set password = ?, invite = null,
force_password_change = false
where hostid = ? and id = ?" in
- sth#execute [`String password; `Int hostid; `Int userid];
+ sth#execute [Some password; Some hostid; Some userid];
(* Send email to this user. *)
(match email with
let subject = "Your new account details" in
Sendmail.send_mail ~to_addr:[email] ~subject body);
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Redirect to the login page. *)
let redirect =
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: invite_user_confirm_form.ml,v 1.3 2005/11/24 14:54:12 rich Exp $
+ * $Id: invite_user_confirm_form.ml,v 1.4 2006/03/27 18:09:46 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_ok
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "invite_user_confirm_form.html" in
(* Get the invite ID. *)
let sth = dbh#prepare_cached "select name from users
where hostid = ? and invite = ?" in
- sth#execute [`Int hostid; `String invite];
+ sth#execute [Some hostid; Some invite];
let username =
try sth#fetch1string ()
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: invite_user_form.ml,v 1.1 2004/10/14 15:57:15 rich Exp $
+ * $Id: invite_user_form.ml,v 1.2 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "invite_user_form.html" in
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: largest_pages.ml,v 1.3 2004/10/04 15:19:56 rich Exp $
+ * $Id: largest_pages.ml,v 1.4 2006/03/27 18:09:46 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
let modem_speed = 56000 / 10 (* 56kbps modem. *)
let overhead = 2 (* Number of seconds to open connection + render page. *)
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "largest_pages.html" in
(* Grab the pages from the database, ordered by size.
from pages p, contents c
where p.hostid = ? and p.url is not null and p.redirect is null
and c.pageid = p.id group by 1, 2, 3 order by 4 desc" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let table =
sth#map
- (function [`Int pageid; `String page; `String title; `Int size] ->
+ (function [Some pageid; Some page; Some title; Some size] ->
let download_time = overhead + size / modem_speed in (* seconds *)
let download_time =
if download_time <= 4 then "<= 4 s"
if size < 4096 then sprintf "%d bytes" size
else sprintf "%d K" (size / 1024) in
- [ "pageid", Template.VarString (string_of_int pageid);
+ [ "pageid", Template.VarString (Int32.to_string pageid);
"page", Template.VarString page;
"title", Template.VarString title;
"size", Template.VarString size;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: links.ml,v 1.2 2004/11/02 18:47:54 rich Exp $
+ * $Id: links.ml,v 1.3 2006/03/27 18:09:46 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
* can show inbound or outbound links only. The format in all cases is a
* simple machine-parsable text file.
*)
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "links.txt" in
if q#param_exists "page" then (
dbh#prepare_cached "select to_url from links
where hostid = ? and from_url = ?" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
q#header ~content_type:"text/plain" ();
- sth#iter (function [`String url] -> ignore (print_endline r url)
+ sth#iter (function [Some url] -> ignore (print_endline r url)
| _ -> assert false)
) else
*)
let sth = dbh#prepare_cached "select to_url from links
where hostid = ? and from_url = ?" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
let table =
- sth#map (function [`String to_url] ->
+ sth#map (function [Some to_url] ->
[ "to", Template.VarString to_url ]
| _ -> assert false) in
let table =
let sth = dbh#prepare_cached "select from_url, to_url from links
where hostid = ?" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
- sth#iter (function [`String from_url; `String to_url] ->
+ sth#iter (function [Some from_url; Some to_url] ->
add_link from_url to_url
| _ -> assert false);
let sth = dbh#prepare_cached "select url, redirect from pages
where hostid = ? and url is not null
and redirect is not null" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
- sth#iter (function [`String url; `String redirect] ->
+ sth#iter (function [Some url; Some redirect] ->
add_link url redirect
| _ -> assert false);
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: login.ml,v 1.8 2005/11/24 14:54:12 rich Exp $
+ * $Id: login.ml,v 1.9 2006/03/27 18:09:46 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
let expires = "Wed, 18-May-2033 04:33:20 GMT"
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let username = q#param "username" in
let password = q#param "password" in
let permanent = try "1" = q#param "permanent" with Not_found -> false in
let sth = dbh#prepare_cached "select id, force_password_change from users
where name = ? and password = ?
and hostid = ?" in
- sth#execute [`String username; `String password; `Int hostid];
+ sth#execute [Some username; Some password; Some hostid];
try
let userid, force_password_change =
match sth#fetch1 () with
- [ `Int userid; `Bool force_password_change ] ->
+ [ Some userid; `Bool force_password_change ] ->
userid, force_password_change
| _ -> assert false in
let cookie = random_sessionid () in
let sth = dbh#prepare_cached "insert into usercookies (userid, cookie)
values (?, ?)" in
- sth#execute [`Int userid; `String cookie];
+ sth#execute [Some userid; Some cookie];
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Force password change? *)
let redirect =
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: login_form.ml,v 1.5 2004/10/15 12:47:18 rich Exp $
+ * $Id: login_form.ml,v 1.6 2006/03/27 18:09:46 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_template
open Cocanwiki_strings
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "login_form.html" in
let redirect = try q#param "redirect" with Not_found -> "" in
let sth = dbh#prepare_cached "select create_account_anon from hosts
where id = ?" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let create_account_anon =
match sth#fetch1 () with
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: logout.ml,v 1.6 2005/11/24 14:54:12 rich Exp $
+ * $Id: logout.ml,v 1.7 2006/03/27 18:09:46 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
let expires = "Sun, 09-Sep-2001 02:46:40 GMT"
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ user =
+let run r (q : cgi) dbh hostid _ user =
(* The logout function removes all of the associated cookies from the
* database. This isn't required, but is nice semantics, and also helps
* to reduce the size of the usercookies table in the database.
| User (userid, _, _, _) ->
let sth = dbh#prepare_cached "delete from usercookies
where userid = ?" in
- sth#execute [`Int userid];
+ sth#execute [Some userid];
- dbh#commit ()
+ PGOCaml.commit dbh
);
let cookie = Cookie.cookie "auth" "none" ~path:"/" ~expires in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: mail_import.ml,v 1.9 2005/11/24 14:54:12 rich Exp $
+ * $Id: mail_import.ml,v 1.10 2006/03/27 18:09:46 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
let comma_re = Pcre.regexp "\\s*,\\s*"
let lines_re = Pcre.regexp "\\r?\\n"
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ user =
+let run r (q : cgi) dbh hostid _ user =
let hdr_template = get_template dbh hostid "mail_import_header.txt" in
(* Overwrite old messages? *)
let overwrite =
let sth = dbh#prepare_cached "select id from messages
where hostid = ? and inet_message_id = ?" in
- sth#execute [`Int hostid; `String inet_message_id];
+ sth#execute [Some hostid; Some inet_message_id];
try
let id = sth#fetch1int () in
if not overwrite then (
dbh#prepare_cached
"insert into messages (hostid, subject, inet_message_id,
message_date) values (?, ?, ?, ?)" in
- sth#execute [`Int hostid; `String subject; `String inet_message_id;
+ sth#execute [Some hostid; Some subject; Some inet_message_id;
`Timestamp (date, time)];
let msgid = Int64.to_int (sth#serial "messages_id_seq") in
let ordering = ref 0 in
List.iter (fun inet_message_id ->
incr ordering; let ordering = !ordering in
- sth#execute [`Int msgid; `String inet_message_id;
- `Int ordering]) references;
+ sth#execute [Some msgid; Some inet_message_id;
+ Some ordering]) references;
msgid
dbh#prepare_cached
"select lower (title) from pages where hostid = ?
and url is not null and title not like 'Mail/%'" in
- sth#execute [`Int hostid];
- let links = sth#map (function [`String s] -> s | _ -> assert false) in
+ sth#execute [Some hostid];
+ let links = sth#map (function [Some s] -> s | _ -> assert false) in
(* This code cannot find titles which are split across multiple lines.
* XXX
thread_mail dbh hostid ~user ~r date.Dbi.year date.Dbi.month;
(* Commit to the database. *)
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Finish off. *)
ok ~title:"Imported"
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: mail_import_form.ml,v 1.1 2004/10/11 14:13:04 rich Exp $
+ * $Id: mail_import_form.ml,v 1.2 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "mail_import_form.html" in
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: mail_rebuild.ml,v 1.2 2005/11/24 14:54:12 rich Exp $
+ * $Id: mail_rebuild.ml,v 1.3 2006/03/27 18:09:46 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_ok
open Cocanwiki_mail
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ user =
- let year = int_of_string (q#param "year") in
- let month = int_of_string (q#param "month") in
+let run r (q : cgi) dbh hostid _ user =
+ let year = Int32.of_string (q#param "year") in
+ let month = Int32.of_string (q#param "month") in
thread_mail dbh hostid ~user ~r year month;
(* Commit to the database. *)
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Finish off. *)
ok ~title:"Rebuilt"
(* 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.4 2005/11/24 14:54:12 rich Exp $
+ * $Id: mailing_list_confirm.ml,v 1.5 2006/03/27 18:09:46 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
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];
+ sth#execute [Some hostid; Some pending];
let email =
try
(* 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];
+ sth#execute [Some hostid; Some pending];
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Confirmed. *)
let buttons = [ ok_button "/" ] in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: mailing_list_form.ml,v 1.2 2004/10/04 15:19:56 rich Exp $
+ * $Id: mailing_list_form.ml,v 1.3 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "mailing_list_form.html" in
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: mailing_list_send.ml,v 1.6 2005/11/24 14:54:12 rich Exp $
+ * $Id: mailing_list_send.ml,v 1.7 2006/03/27 18:09:46 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_template
open Cocanwiki_strings
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
+let run r (q : cgi) dbh hostid { hostname = hostname } _ =
let template = get_template dbh hostid "mailing_list_send.txt" in
let email = trim (q#param "email") in
where pending is not null
and entry_date < current_date - 7" in
sth#execute [];
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Is that email address already registered in the database? *)
let sth = dbh#prepare_cached "select 1 from mailing_lists where hostid = ?
and email = ?" in
- sth#execute [`Int hostid; `String email];
+ sth#execute [Some hostid; Some email];
let registered = try sth#fetch1int () = 1 with Not_found -> false in
(* Insert into the database. *)
let sth = dbh#prepare_cached "insert into mailing_lists (hostid, email, name,
pending, opt_out) values (?, ?, ?, ?, ?)" in
- sth#execute [`Int hostid; `String email; `String name;
- `String pending; `String opt_out];
+ sth#execute [Some hostid; Some email; Some name;
+ Some pending; Some opt_out];
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Send the initial email to the user. *)
template#set "hostname" hostname;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: mailing_list_unsubscribe.ml,v 1.2 2005/11/24 14:54:12 rich Exp $
+ * $Id: mailing_list_unsubscribe.ml,v 1.3 2006/03/27 18:09:46 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
open Cocanwiki_ok
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let opt_out = q#param "o" in
(* Update the database. *)
let sth = dbh#prepare_cached "delete from mailing_lists
where hostid = ? and opt_out = ?" in
- sth#execute [`Int hostid; `String opt_out];
+ sth#execute [Some hostid; Some opt_out];
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Confirmed. *)
let buttons = [ ok_button "/" ] in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: mailing_list_view.ml,v 1.2 2004/09/24 17:11:57 rich Exp $
+ * $Id: mailing_list_view.ml,v 1.3 2006/03/27 18:09:46 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_template
open Cocanwiki_date
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "mailing_list_view.html" in
let template_csv = get_template dbh hostid "mailing_list_view.txt" in
from mailing_lists
where hostid = ? and pending is null
order by 1" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let table =
- sth#map (function [`String email; `String name; `Date entry_date] ->
+ sth#map (function [Some email; Some name; `Date entry_date] ->
let entry_date = printable_date' entry_date in
[ "email", Template.VarString email;
"name", Template.VarString name;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: new_page_form.ml,v 1.1 2004/10/24 17:32:54 rich Exp $
+ * $Id: new_page_form.ml,v 1.2 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "new_page_form.html" in
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: orphans.ml,v 1.2 2004/11/10 22:46:25 rich Exp $
+ * $Id: orphans.ml,v 1.3 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "orphans.html" in
(* Start with the front page, the contents of the site menu and the
* special "copyright" page.
*)
let sth = dbh#prepare_cached "select url from sitemenu where hostid = ?" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
- let start_pages = sth#map (function [`String s] -> s | _ -> assert false) in
+ let start_pages = sth#map (function [Some s] -> s | _ -> assert false) in
let start_pages = "index" :: "copyright" :: start_pages in
(* The find the list of orphans, we first construct the list of
dbh#prepare_cached ("select distinct to_url from links
where hostid = ? and from_url in " ^ qs ^ "
and to_url not in " ^ qs') in
- sth#execute (`Int hostid ::
- (List.map (fun s -> `String s) border) @
- (List.map (fun s -> `String s) pages'));
- let border' = sth#map (function [`String s] -> s | _ -> assert false) in
+ sth#execute (Some hostid ::
+ (List.map (fun s -> Some s) border) @
+ (List.map (fun s -> Some s) pages'));
+ let border' = sth#map (function [Some s] -> s | _ -> assert false) in
if border' = [] then pages'
else loop pages' border'
and redirect is null
and url not in " ^ qs ^ "
order by 1") in
- sth#execute (`Int hostid :: (List.map (fun s -> `String s) non_orphans));
+ sth#execute (Some hostid :: (List.map (fun s -> Some s) non_orphans));
let table =
- sth#map (function [`String page; `String title] ->
+ sth#map (function [Some page; Some title] ->
[ "page", Template.VarString page;
"title", Template.VarString title ]
| _ -> assert false) in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: page.ml,v 1.42 2005/11/24 14:54:12 rich Exp $
+ * $Id: page.ml,v 1.43 2006/03/27 18:09:46 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
let xhtml_re = Pcre.regexp "<.*?>|[^<>]+"
-let run r (q : cgi) (dbh : Dbi.connection) hostid
+let run r (q : cgi) dbh hostid
({ edit_anon = edit_anon; view_anon = view_anon } as host)
user =
let page = q#param "page" in
feedback_email is not null,
mailing_list, navigation
from hosts where id = ?" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let has_host_css, has_feedback_email, mailing_list, navigation =
match sth#fetch1 () with
| [ `Bool has_host_css; `Bool has_feedback_email; `Bool mailing_list;
where ? ~ url_regexp
order by ordering
limit 1" in
- sth#execute [`String url];
+ sth#execute [Some url];
try
let name = sth#fetch1string () in
| Some pageid ->
t#conditional "is_old_version" true;
th#conditional "is_old_version" true;
- t#set "old_version" (string_of_int pageid);
- th#set "old_version" (string_of_int pageid));
+ t#set "old_version" (Int32.to_string pageid);
+ th#set "old_version" (Int32.to_string pageid));
(* At this point, we can print out the header and flush it back to
* the user, allowing the browser to start fetching stylesheets
let sth = dbh#prepare_cached
"select ordering, sectionname, content, divname
from contents where pageid = ? order by ordering" in
- sth#execute [`Int pageid];
+ sth#execute [Some pageid];
sth#map
- (function [`Int ordering;
- (`Null | `String _) as sectionname;
- `String content;
- (`Null | `String _) as divname] ->
+ (function [Some ordering;
+ (None | Some _) as sectionname;
+ Some content;
+ (None | Some _) as divname] ->
let divname, has_divname =
match divname with
- `Null -> "", false
- | `String divname -> divname, true in
+ None -> "", false
+ | Some divname -> divname, true in
let sectionname, has_sectionname =
match sectionname with
- `Null -> "", false
- | `String sectionname -> sectionname, true in
+ None -> "", false
+ | Some sectionname -> sectionname, true in
let linkname = linkname_of_sectionname sectionname in
- [ "ordering", Template.VarString (string_of_int ordering);
+ [ "ordering", Template.VarString (Int32.to_string ordering);
"has_sectionname",
Template.VarConditional has_sectionname;
"sectionname", Template.VarString sectionname;
let sth = dbh#prepare_cached "delete from recently_visited
where hostid = ? and userid = ?
and url = ?" in
- sth#execute [`Int hostid; `Int userid; `String page'];
+ sth#execute [Some hostid; Some userid; Some page'];
let sth = dbh#prepare_cached
"insert into recently_visited (hostid, userid, url)
values (?, ?, ?)" in
- sth#execute [`Int hostid; `Int userid; `String page'];
- dbh#commit ()
+ sth#execute [Some hostid; Some userid; Some page'];
+ PGOCaml.commit dbh
| _ -> ()
);
and rv.hostid = p.hostid and rv.url = p.url
order by 3 desc
limit ?") in
- let args = List.map (fun s -> `String s) not_urls in
+ let args = List.map (fun s -> Some s) not_urls in
sth#execute
- ([`Int hostid; `Int userid] @ args @ [`Int limit]);
+ ([Some hostid; Some userid] @ args @ [Some limit]);
sth#map
- (function [`String url; `String title; _] ->
+ (function [Some url; Some title; _] ->
url, title
| _ -> assert false)
| _ -> [] in
"select url, redirect, id, title, description,
last_modified_date, css is not null
from pages where hostid = ? and lower (url) = lower (?)" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
(try
(match sth#fetch1 () with
- | `String page' :: _ when page <> page' -> (* different case *)
+ | Some page' :: _ when page <> page' -> (* different case *)
FPExternalRedirect page'
- | [ _; `Null; `Int id; `String title; `String description;
+ | [ _; None; Some id; Some title; Some description;
`Timestamp last_modified_date; `Bool has_page_css ] ->
FPOK (id, title, description, last_modified_date,
has_page_css)
- | _ :: `String redirect :: _ ->
+ | _ :: Some redirect :: _ ->
FPInternalRedirect redirect
| xs -> failwith (Dbi.sdebug xs))
with
"select id, title, description, last_modified_date,
css is not null
from pages where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
(try
(match sth#fetch1 () with
- | [ `Int id; `String title; `String description;
+ | [ Some id; Some title; Some description;
`Timestamp last_modified_date; `Bool has_page_css ] ->
FPOK (id, title, description, last_modified_date,
has_page_css)
from pages
where hostid = ? and id = ? and
(url = ? or url_deleted = ?)" in
- sth#execute [`Int hostid; `Int version;
- `String page; `String page];
+ sth#execute [Some hostid; Some version;
+ Some page; Some page];
(try
(match sth#fetch1 () with
- | [ `Int id; `String title; `String description;
+ | [ Some id; Some title; Some description;
`Timestamp last_modified_date; `Bool has_page_css ] ->
FPOK (id, title, description, last_modified_date,
has_page_css)
let allow_redirect, version =
if can_edit then (
not (q#param_true "no_redirect"),
- try Some (int_of_string (q#param "version")) with Not_found -> None
+ try Some (Int32.of_string (q#param "version")) with Not_found -> None
) else
(true, None) in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: page_email_confirm.ml,v 1.3 2005/11/24 14:54:12 rich Exp $
+ * $Id: page_email_confirm.ml,v 1.4 2006/03/27 18:09:46 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
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 url, email from page_emails
where hostid = ? and pending = ?" in
- sth#execute [`Int hostid; `String pending];
+ sth#execute [Some hostid; Some pending];
let page, email =
try
(match sth#fetch1 () with
- [ `String page; `String email ] -> page, email
+ [ Some page; Some email ] -> page, email
| _ -> assert false)
with
Not_found ->
(* Update the database. *)
let sth = dbh#prepare_cached "update page_emails set pending = null
where hostid = ? and pending = ?" in
- sth#execute [`Int hostid; `String pending];
+ sth#execute [Some hostid; Some pending];
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Confirmed. *)
let buttons = [ ok_button ("/" ^ page) ] in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: page_email_form.ml,v 1.2 2004/10/04 15:19:56 rich Exp $
+ * $Id: page_email_form.ml,v 1.3 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "page_email_form.html" in
let page = q#param "page" in
(* Get the page title. *)
let sth = dbh#prepare_cached "select title from pages
where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
let title = sth#fetch1string () in
template#set "title" title;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: page_email_send.ml,v 1.4 2005/11/24 14:54:12 rich Exp $
+ * $Id: page_email_send.ml,v 1.5 2006/03/27 18:09:46 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_template
open Cocanwiki_strings
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
+let run r (q : cgi) dbh hostid { hostname = hostname } _ =
let template = get_template dbh hostid "page_email_send.txt" in
let page = q#param "page" in
where pending is not null
and entry_date < current_date - 7" in
sth#execute [];
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Is that email address already registered in the database? *)
let sth = dbh#prepare_cached "select 1 from page_emails where hostid = ?
and url = ? and email = ?" in
- sth#execute [`Int hostid; `String page; `String email];
+ sth#execute [Some hostid; Some page; Some email];
let registered = try sth#fetch1int () = 1 with Not_found -> false in
(* Insert into the database. *)
let sth = dbh#prepare_cached "insert into page_emails (hostid, url, email,
pending, opt_out) values (?, ?, ?, ?, ?)" in
- sth#execute [`Int hostid; `String page; `String email; `String pending;
- `String opt_out];
+ sth#execute [Some hostid; Some page; Some email; Some pending;
+ Some opt_out];
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Send the initial email to the user. *)
template#set "hostname" hostname;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: page_email_unsubscribe.ml,v 1.2 2005/11/24 14:54:12 rich Exp $
+ * $Id: page_email_unsubscribe.ml,v 1.3 2006/03/27 18:09:46 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
open Cocanwiki_ok
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let opt_out = q#param "o" in
(* Update the database. *)
let sth = dbh#prepare_cached "delete from page_emails
where hostid = ? and opt_out = ?" in
- sth#execute [`Int hostid; `String opt_out];
+ sth#execute [Some hostid; Some opt_out];
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Confirmed. *)
let buttons = [ ok_button "/" ] in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: page_rss.ml,v 1.2 2004/11/02 11:05:59 rich Exp $
+ * $Id: page_rss.ml,v 1.3 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} _ =
+let run r (q : cgi) dbh hostid {hostname = hostname} _ =
let template = get_template dbh hostid "page_rss.xml" in
let page = q#param "page" in
from pages
where hostid = ? and url = ?
and redirect is null" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
let pageid, title, description =
match sth#fetch1 () with
- [ `Int id; `String title; `String description ] ->
+ [ Some id; Some title; Some description ] ->
id, title, description
| _ -> assert false in
where pageid = ?
and sectionname is not null
order by ordering" in
- sth#execute [`Int pageid];
+ sth#execute [Some pageid];
let sections =
- sth#map (function [`String sectionname; `String content; _] ->
+ sth#map (function [Some sectionname; Some content; _] ->
sectionname, content
| _ -> assert false) in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: pagestyle.ml,v 1.6 2004/10/23 12:00:24 rich Exp $
+ * $Id: pagestyle.ml,v 1.7 2006/03/27 18:09:46 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
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let page = q#param "page" in
let version =
- try Some (int_of_string (q#param "version")) with Not_found -> None in
+ try Some (Int32.of_string (q#param "version")) with Not_found -> None in
(* Get the CSS. *)
let sth =
None ->
let sth = dbh#prepare_cached
"select css from pages where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
sth
| Some version ->
let sth = dbh#prepare_cached
"select css from pages
where hostid = ? and id = ? and
(url = ? or url_deleted = ?)" in
- sth#execute [`Int hostid; `Int version; `String page; `String page];
+ sth#execute [Some hostid; Some version; Some page; Some page];
sth in
let css =
match sth#fetch1 () with
- [ `Null ] -> ""
- | [ `String css ] -> css
+ [ None ] -> ""
+ | [ Some css ] -> css
| _ -> assert false in
(* It's crucial, for speed of page delivery and rendering, to have
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: preview.ml,v 1.7 2004/12/20 11:57:28 rich Exp $
+ * $Id: preview.ml,v 1.8 2006/03/27 18:09:46 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
* start-up SQL as possible.
*)
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let content = q#param "content" in
let xhtml = Wikilib.xhtml_of_content dbh hostid content in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: rebuild_links.ml,v 1.4 2005/11/23 11:32:13 rich Exp $
+ * $Id: rebuild_links.ml,v 1.5 2006/03/27 18:09:46 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_template
open Cocanwiki_links
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template_start = _get_template "rebuild_links_start.html" in
let template = _get_template "rebuild_links.html" in
let template_done = _get_template "rebuild_links_done.html" in
(* Delete entries in the old links table. *)
let sth = dbh#prepare_cached "delete from links where hostid = ?" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
(* Estimate how many sections we will have to process. *)
let sth =
and p.hostid = ?
and p.url is not null
and p.redirect is null" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let total_sections = sth#fetch1int () in
and p.url is not null
and p.redirect is null
order by p.url, c.ordering" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
q#header ();
print_string r template_start#to_string;
let i = ref 0 in
sth#iter
- (function [`String content; `Int ordering; `String url] ->
+ (function [Some content; Some ordering; Some url] ->
let pc = 100 * !i / total_sections in incr i;
- template#set "ordering" (string_of_int ordering);
+ template#set "ordering" (Int32.to_string ordering);
template#set "url" url;
- template#set "pc" (string_of_int pc);
+ template#set "pc" (Int32.to_string pc);
print_string r template#to_string;
let links = get_links_from_section dbh hostid content in
| _ -> assert false);
(* Finish off. *)
- dbh#commit ();
+ PGOCaml.commit dbh;
ignore (print_string r template_done#to_string)
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: recent.ml,v 1.10 2005/11/23 11:32:13 rich Exp $
+ * $Id: recent.ml,v 1.11 2006/03/27 18:09:46 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
let default_limit = 100
let max_limit = 1000
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "recent.html" in
(* Count the number of changes. *)
let sth = dbh#prepare_cached
"select count(*)::int4 from pages where hostid = ?" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let count = sth#fetch1int () in
(* Get the offset and limit specified, and adjust them so that we will
* be displaying some changes.
*)
let offset =
- try int_of_string (q#param "offset") with Not_found -> default_offset in
+ try Int32.of_string (q#param "offset") with Not_found -> default_offset in
let limit =
- try int_of_string (q#param "limit") with Not_found -> default_limit in
+ try Int32.of_string (q#param "limit") with Not_found -> default_limit in
let limit =
if limit < 1 then 1
else if offset >= count then max 0 (count - limit)
else offset in
- template#set "offset" (string_of_int offset);
- template#set "last" (string_of_int (min (offset + limit) count - 1));
- template#set "limit" (string_of_int limit);
- template#set "count" (string_of_int count);
+ template#set "offset" (Int32.to_string offset);
+ template#set "last" (Int32.to_string (min (offset + limit) count - 1));
+ template#set "limit" (Int32.to_string limit);
+ template#set "count" (Int32.to_string count);
template#conditional "has_next" (offset + limit < count);
- template#set "next_offset" (string_of_int (offset + limit));
+ template#set "next_offset" (Int32.to_string (offset + limit));
template#conditional "has_prev" (offset > 0);
- template#set "prev_offset" (string_of_int (max 0 (offset - limit)));
+ template#set "prev_offset" (Int32.to_string (max 0 (offset - limit)));
(* Get the actual changes. *)
let sth =
where p.hostid = ?
order by p.last_modified_date desc
offset ? limit ?" in
- sth#execute [`Int hostid; `Int offset; `Int limit];
+ sth#execute [Some hostid; Some offset; Some limit];
let table =
sth#map
(function
- | [`Int version; `String url; _; `String title;
+ | [Some version; Some url; _; Some title;
`Timestamp last_modified_date; logged_ip; logged_user] ->
let date = printable_date_time last_modified_date in
let has_logged_ip, logged_ip =
match logged_ip with
- `Null -> false, ""
- | `String ip -> true, ip
+ None -> false, ""
+ | Some ip -> true, ip
| _ -> assert false in
let has_logged_user, logged_user =
match logged_user with
- `Null -> false, ""
- | `String name -> true, name
+ None -> false, ""
+ | Some name -> true, name
| _ -> assert false in
- [ "version", Template.VarString (string_of_int version);
+ [ "version", Template.VarString (Int32.to_string version);
"url", Template.VarString url;
"title", Template.VarString title;
"last_modified_date", Template.VarString date;
"has_logged_user", Template.VarConditional has_logged_user;
"logged_user", Template.VarString logged_user;
"is_live", Template.VarConditional true ]
- | [`Int version; `Null; `String url; `String title;
+ | [Some version; None; Some url; Some title;
`Timestamp last_modified_date; logged_ip; logged_user] ->
let date = printable_date_time last_modified_date in
let has_logged_ip, logged_ip =
match logged_ip with
- `Null -> false, ""
- | `String ip -> true, ip
+ None -> false, ""
+ | Some ip -> true, ip
| _ -> assert false in
let has_logged_user, logged_user =
match logged_user with
- `Null -> false, ""
- | `String name -> true, name
+ None -> false, ""
+ | Some name -> true, name
| _ -> assert false in
- [ "version", Template.VarString (string_of_int version);
+ [ "version", Template.VarString (Int32.to_string version);
"url", Template.VarString url;
"title", Template.VarString title;
"last_modified_date", Template.VarString date;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: recent_rss.ml,v 1.2 2004/11/02 11:05:59 rich Exp $
+ * $Id: recent_rss.ml,v 1.3 2006/03/27 18:09:46 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
let limit = 30
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} _ =
+let run r (q : cgi) dbh hostid {hostname = hostname} _ =
let template = get_template dbh hostid "recent_rss.xml" in
template#set "hostname" hostname;
where p.hostid = ?
order by p.last_modified_date desc
limit ?" in
- sth#execute [`Int hostid; `Int limit];
+ sth#execute [Some hostid; Some limit];
let table =
sth#map
(function
- | [`Int version; `String url; _; `String title;
+ | [Some version; Some url; _; Some title;
`Timestamp last_modified_date; logged_ip; logged_user] ->
let date = printable_date_time last_modified_date in
let has_logged_ip, logged_ip =
match logged_ip with
- `Null -> false, ""
- | `String ip -> true, ip
+ None -> false, ""
+ | Some ip -> true, ip
| _ -> assert false in
let has_logged_user, logged_user =
match logged_user with
- `Null -> false, ""
- | `String name -> true, name
+ None -> false, ""
+ | Some name -> true, name
| _ -> assert false in
- [ "version", Template.VarString (string_of_int version);
+ [ "version", Template.VarString (Int32.to_string version);
"url", Template.VarString url;
"title", Template.VarString title;
"last_modified_date", Template.VarString date;
"has_logged_user", Template.VarConditional has_logged_user;
"logged_user", Template.VarString logged_user;
"is_live", Template.VarConditional true ]
- | [`Int version; `Null; `String url; `String title;
+ | [Some version; None; Some url; Some title;
`Timestamp last_modified_date; logged_ip; logged_user] ->
let date = printable_date_time last_modified_date in
let has_logged_ip, logged_ip =
match logged_ip with
- `Null -> false, ""
- | `String ip -> true, ip
+ None -> false, ""
+ | Some ip -> true, ip
| _ -> assert false in
let has_logged_user, logged_user =
match logged_user with
- `Null -> false, ""
- | `String name -> true, name
+ None -> false, ""
+ | Some name -> true, name
| _ -> assert false in
- [ "version", Template.VarString (string_of_int version);
+ [ "version", Template.VarString (Int32.to_string version);
"url", Template.VarString url;
"title", Template.VarString title;
"last_modified_date", Template.VarString date;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: recently_visited.ml,v 1.2 2004/10/30 10:16:10 rich Exp $
+ * $Id: recently_visited.ml,v 1.3 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ user =
+let run r (q : cgi) dbh hostid _ user =
let template = get_template dbh hostid "recently_visited.html" in
let userid =
where rv.hostid = ? and rv.userid = ?
and rv.hostid = p.hostid and rv.url = p.url
order by 3 desc" in
- sth#execute [`Int hostid; `Int userid];
+ sth#execute [Some hostid; Some userid];
- let table = sth#map (function [`String page; `String title; _] ->
+ let table = sth#map (function [Some page; Some title; _] ->
[ "page", Template.VarString page;
"title", Template.VarString title ]
| _ -> assert false) in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: rename_page.ml,v 1.3 2005/11/24 14:54:12 rich Exp $
+ * $Id: rename_page.ml,v 1.4 2006/03/27 18:09:46 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_strings
open Cocanwiki_emailnotify
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
+let run r (q : cgi) dbh hostid {hostname = hostname} user =
let page = q#param "page" in
(* Cancelled? *)
(* Get the old title. *)
let sth = dbh#prepare_cached "select title from pages
where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
let old_title = sth#fetch1string () in
);
(* Finish off XXX *)
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Email notification. *)
let subject = "Page " ^ page ^ " has been renamed" in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: rename_page_form.ml,v 1.1 2004/11/22 11:07:32 rich Exp $
+ * $Id: rename_page_form.ml,v 1.2 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "rename_page_form.html" in
let page = q#param "page" in
let sth = dbh#prepare_cached "select title from pages
where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
let title = sth#fetch1string () in
(* 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.20 2006/03/27 18:09:46 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,
from pages
where hostid = ?
and url_deleted = ? and id = ?" in
- sth#execute [`Int hostid; `String page; `Int version];
+ sth#execute [Some hostid; Some page; Some version];
let title, description, creation_date, redirect, css =
match sth#fetch1 () with
let sth = dbh#prepare_cached "update pages set url_deleted = url,
url = null
where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some 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;
+ sth#execute [Some hostid; Some page; title; description;
creation_date; logged_ip; logged_user; redirect; css ];
let pageid = Int64.to_int (sth#serial "pages_id_seq") in
content, divname
from contents
where pageid = ?" in
- sth#execute [`Int pageid; `Int version];
+ sth#execute [Some pageid; Some version];
(* Keep the links table in synch. *)
Cocanwiki_links.update_links_for_page dbh hostid page;
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Email notify. *)
let subject = "Page " ^ page ^ " has been restored." in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: restore_form.ml,v 1.11 2005/11/24 14:54:12 rich Exp $
+ * $Id: restore_form.ml,v 1.12 2006/03/27 18:09:46 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_ok
open Cocanwiki_diff
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ user =
+let run r (q : cgi) dbh hostid _ user =
let template = get_template dbh hostid "restore_form.html" in
(* Parameters. *)
let page = q#param "page" in
- let old_version = int_of_string (q#param "version") in
+ let old_version = Int32.of_string (q#param "version") in
template#set "page" page;
- template#set "version" (string_of_int old_version);
+ template#set "version" (Int32.to_string old_version);
(* Compute the diff between the latest version of this page and the
* page we're wanting to restore.
*)
let sth = dbh#prepare_cached "select id from pages
where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
let version = sth#fetch1int () in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: search.ml,v 1.8 2004/11/02 22:26:36 rich Exp $
+ * $Id: search.ml,v 1.9 2006/03/27 18:09:46 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
let split_words = Pcre.regexp "\\W+"
-let run r (q : cgi) (dbh : Dbi.connection) hostid host user =
+let run r (q : cgi) dbh hostid host user =
let template = get_template dbh hostid "search.html" in
template#set "canonical_hostname" host.canonical_hostname;
and redirect is null
and title_description_fti @@ to_tsquery (?, ?)
order by exact desc, last_modified_date desc, title") in
- sth#execute [`String query;
- `Int hostid; `String "default"; `String tsquery];
+ sth#execute [Some query;
+ Some hostid; Some "default"; Some tsquery];
let titles =
sth#map (function
- | [_; `String url; `Null; `String title;
+ | [_; Some url; None; Some title;
`Timestamp last_modified; _] ->
url, title, None, last_modified
- | [`Int version; `Null; `String url; `String title;
+ | [Some version; None; Some url; Some title;
`Timestamp last_modified; _] ->
url, title, Some version, last_modified
| _ -> assert false) in
and c.content_fti @@ to_tsquery (?, ?)
order by p.last_modified_date desc, p.title
limit 50") in
- sth#execute [`Int hostid; `String "default"; `String tsquery];
+ sth#execute [Some hostid; Some "default"; Some tsquery];
let contents =
sth#map (function
- | [`Int contentid; _; `String url; `Null;
- `String title; `Timestamp last_modified] ->
+ | [Some contentid; _; Some url; None;
+ Some title; `Timestamp last_modified] ->
contentid, url, title, None, last_modified
- | [`Int contentid; `Int version; `Null; `String url;
- `String title; `Timestamp last_modified] ->
+ | [Some contentid; Some version; None; Some url;
+ Some title; `Timestamp last_modified] ->
contentid, url, title, Some version, last_modified
| _ -> assert false) in
("select id, sectionname, content from contents
where id in " ^ qs) in
sth#execute
- (List.map (fun (contentid, _,_,_,_) -> `Int contentid) contents);
+ (List.map (fun (contentid, _,_,_,_) -> Some contentid) contents);
sth#map (function
- | [ `Int id; `Null; `String content ] ->
+ | [ Some id; None; Some content ] ->
id, (None, content)
- | [ `Int id; `String sectionname; `String content ] ->
+ | [ Some id; Some sectionname; Some content ] ->
id, (Some sectionname, content)
| _ -> assert false)
) in
[ "url", Template.VarString url;
"title", Template.VarString title;
"have_version", Template.VarConditional have_version;
- "version", Template.VarString (string_of_int version);
+ "version", Template.VarString (Int32.to_string version);
"last_modified", Template.VarString last_modified ]
) titles in
template#table "titles" table;
[ "url", Template.VarString url;
"title", Template.VarString title;
"have_version", Template.VarConditional have_version;
- "version", Template.VarString (string_of_int version);
+ "version", Template.VarString (Int32.to_string version);
"have_sectionname", Template.VarConditional have_sectionname;
"sectionname", Template.VarString sectionname;
"linkname", Template.VarString linkname;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: send_feedback.ml,v 1.6 2005/11/24 14:54:12 rich Exp $
+ * $Id: send_feedback.ml,v 1.7 2006/03/27 18:09:46 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_template
open Cocanwiki_ok
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
+let run r (q : cgi) dbh hostid {hostname = hostname} user =
let template = get_template dbh hostid "send_feedback.txt" in
if q#param_true "cancel" then (
(* Get the feedback email for this host. *)
let sth =
dbh#prepare_cached "select feedback_email from hosts where id = ?" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let to_addr = sth#fetch1string () in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: send_feedback_form.ml,v 1.3 2004/10/04 15:19:56 rich Exp $
+ * $Id: send_feedback_form.ml,v 1.4 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "send_feedback_form.html" in
let page = q#param "page" in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: set_password.ml,v 1.3 2005/11/24 14:54:12 rich Exp $
+ * $Id: set_password.ml,v 1.4 2006/03/27 18:09:46 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
open Cocanwiki_ok
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
- let userid = int_of_string (q#param "userid") in
+let run r (q : cgi) dbh hostid _ _ =
+ let userid = Int32.of_string (q#param "userid") in
let password1 = q#param "password1" in
let password2 = q#param "password2" in
let sth = dbh#prepare_cached "update users set password = ?
where id = ? and hostid = ?" in
- sth#execute [`String password; `Int userid; `Int hostid];
+ sth#execute [Some password; Some userid; Some hostid];
- dbh#commit ();
+ PGOCaml.commit dbh;
ok ~title:"Password updated" ~buttons:[ok_button "/_users"]
dbh hostid q "The password on that user account was updated."
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: set_password_form.ml,v 1.1 2004/09/21 13:01:16 rich Exp $
+ * $Id: set_password_form.ml,v 1.2 2006/03/27 18:09:46 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "set_password_form.html" in
- let userid = int_of_string (q#param "userid") in
+ let userid = Int32.of_string (q#param "userid") in
let sth = dbh#prepare_cached "select name from users
where id = ? and hostid = ?" in
- sth#execute [`Int userid; `Int hostid];
+ sth#execute [Some userid; Some hostid];
let username = sth#fetch1string () in
- template#set "userid" (string_of_int userid);
+ template#set "userid" (Int32.to_string userid);
template#set "username" username;
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: signup.ml,v 1.9 2005/11/24 14:54:13 rich Exp $
+ * $Id: signup.ml,v 1.10 2006/03/27 18:09:46 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_ok
open Cocanwiki_strings
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
(* Verify that we're allowed to create accounts anonymously
* on this host.
*)
let sth = dbh#prepare_cached "select create_account_anon from hosts
where id = ?" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let create_account_anon =
match sth#fetch1 () with
*)
let email = trim (q#param "email") in
- let email = if string_is_whitespace email then `Null else `String email in
+ let email = if string_is_whitespace email then None else Some email in
(* Not a duplicate? *)
let sth = dbh#prepare_cached "select id from users
where hostid = ? and name = ?" in
- sth#execute [`Int hostid; `String username];
+ sth#execute [Some hostid; Some username];
(try
sth#fetch1 ();
let sth = dbh#prepare_cached "insert into users (name, password, email,
hostid)
values (?, ?, ?, ?)" in
- sth#execute [`String username; `String password; email; `Int hostid];
+ sth#execute [Some username; Some password; email; Some hostid];
let userid = Int64.to_int (sth#serial "users_id_seq") in
let cookie = random_sessionid () in
let sth = dbh#prepare_cached "insert into usercookies (userid, cookie)
values (?, ?)" in
- sth#execute [`Int userid; `String cookie];
+ sth#execute [Some userid; Some cookie];
- dbh#commit ();
+ PGOCaml.commit dbh;
let buttons = [ ok_button "/" ] in
let cookie = Cookie.cookie "auth" cookie ~path:"/" in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: sitemap.ml,v 1.7 2004/10/04 15:19:56 rich Exp $
+ * $Id: sitemap.ml,v 1.8 2006/03/27 18:09:46 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_date
open Cocanwiki_strings
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
+let run r (q : cgi) dbh hostid { hostname = hostname } _ =
let template = get_template dbh hostid "sitemap.html" in
(* Pull out all the current pages, and a bit of content from each. *)
where p.hostid = ? and p.url is not null
and p.redirect is null
order by 2 desc, 3, 1" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let table =
sth#map
- (function [`String url; _; `String title; `String description;
+ (function [Some url; _; Some title; Some description;
`Timestamp last_modified_date;
- (`Null | `String _) as content] ->
+ (None | Some _) as content] ->
let url = if url = "index" then "" else url in
let date = printable_date last_modified_date in
[ "url", Template.VarString url;
"title", Template.VarString title;
"description", Template.VarString description;
"last_modified_date", Template.VarString date;
- "has_content", Template.VarConditional (content <> `Null);
+ "has_content", Template.VarConditional (content <> None);
"content", Template.VarString
(match content with
- `Null -> ""
- | `String c ->
+ None -> ""
+ | Some c ->
truncate 160
(Wikilib.text_of_xhtml
(Wikilib.xhtml_of_content dbh hostid c))) ]
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: sitemap_xml.ml,v 1.1 2005/11/23 11:32:37 rich Exp $
+ * $Id: sitemap_xml.ml,v 1.2 2006/03/27 18:09:47 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
* https://www.google.com/webmasters/sitemaps/docs/en_GB/protocol.html
*)
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
+let run r (q : cgi) dbh hostid { hostname = hostname } _ =
let template = get_template dbh hostid "sitemap.xml" in
(* Pull out all the current pages. *)
where p.hostid = ? and p.url is not null
and p.redirect is null
order by 2 desc, 1" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let table =
sth#map
- (function [`String url; `Bool is_index;
+ (function [Some url; `Bool is_index;
`Timestamp last_modified_date] ->
let url = if is_index then "" else url in
let last_modified_date = iso_8601_date_time last_modified_date in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: source.ml,v 1.3 2005/11/24 14:54:13 rich Exp $
+ * $Id: source.ml,v 1.4 2006/03/27 18:09:47 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
(* This is a very simple script which just returns the source of a page
* in a format which is easily machine-parsable.
*)
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let url = q#param "page" in
let url = if url = "" then "index" else url in
(* Get the title. *)
let sth = dbh#prepare_cached "select title from pages
where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int model.id];
+ sth#execute [Some hostid; Some model.id];
let title = sth#fetch1string () in
(* Function to write out fields, with RFC822-like escaping. *)
q#header ~content_type:"text/plain" ();
(* Write out the standard fields. *)
- write "Version" (string_of_int model.id);
+ write "Version" (Int32.to_string model.id);
write "Title" title;
write "Description" model.description;
if model.redirect <> "" then
write "Redirect" model.redirect
else
- write "Section-Count" (string_of_int (List.length model.contents));
+ write "Section-Count" (Int32.to_string (List.length model.contents));
ignore (print_newline r);
(* Now write out the sections. *)
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: stats.ml,v 1.4 2005/04/02 17:30:54 rich Exp $
+ * $Id: stats.ml,v 1.5 2006/03/27 18:09:47 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_template
open Cocanwiki_server_settings
-let run r (q : cgi) (dbh : Dbi.connection) hostid
+let run r (q : cgi) dbh hostid
{ canonical_hostname = canonical_hostname } _ =
let template = get_template dbh hostid "stats.html" in
let year, week, _ = Date.to_business date in
year, week in
- template#set "year" (string_of_int year);
- template#set "week" (string_of_int week);
+ template#set "year" (Int32.to_string year);
+ template#set "week" (Int32.to_string week);
(* Standard hashing function which we also use in tools/rocket/analysis.ml *)
let hash s = Digest.to_hex (Digest.string s) in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: stats_top.ml,v 1.2 2004/10/23 16:34:58 rich Exp $
+ * $Id: stats_top.ml,v 1.3 2006/03/27 18:09:47 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_template
open Cocanwiki_server_settings
-let run r (q : cgi) (dbh : Dbi.connection) hostid
+let run r (q : cgi) dbh hostid
{ canonical_hostname = canonical_hostname } _ =
let template = get_template dbh hostid "stats_top.html" in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: undelete_file.ml,v 1.7 2005/11/24 14:54:13 rich Exp $
+ * $Id: undelete_file.ml,v 1.8 2006/03/27 18:09:47 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_template
open Cocanwiki_ok
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
- let id = int_of_string (q#param "id") in
+let run r (q : cgi) dbh hostid { hostname = hostname } _ =
+ let id = Int32.of_string (q#param "id") in
if q#param_true "yes" then (
(* Get the name of the file. *)
let sth = dbh#prepare_cached "select name_deleted from files
where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
+ sth#execute [Some hostid; Some id];
let name = sth#fetch1string () in
let sth = dbh#prepare_cached "update files
set name_deleted = name, name = null
where hostid = ? and name = ?" in
- sth#execute [`Int hostid; `String name];
+ sth#execute [Some hostid; Some name];
(* Now copy the old row, changing name_deleted back to name so the file
* becomes live.
title, mime_type, upload_date
from files
where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
+ sth#execute [Some hostid; Some id];
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Done. *)
let buttons = [ ok_button "/_files" ] in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: undelete_file_form.ml,v 1.7 2004/09/09 12:21:22 rich Exp $
+ * $Id: undelete_file_form.ml,v 1.8 2006/03/27 18:09:47 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "undelete_file_form.html" in
- let id = int_of_string (q#param "id") in
+ let id = Int32.of_string (q#param "id") in
let sth = dbh#prepare_cached "select name, name_deleted
from files
where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
+ sth#execute [Some hostid; Some id];
let name =
match sth#fetch1 () with
- [ `String name; `Null]
- | [ `Null; `String name] -> name
+ [ Some name; None]
+ | [ None; Some name] -> name
| _ -> assert false in
- template#set "id" (string_of_int id);
+ template#set "id" (Int32.to_string id);
template#set "name" name;
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: undelete_image.ml,v 1.7 2005/11/24 14:54:13 rich Exp $
+ * $Id: undelete_image.ml,v 1.8 2006/03/27 18:09:47 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_template
open Cocanwiki_ok
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
- let id = int_of_string (q#param "id") in
+let run r (q : cgi) dbh hostid { hostname = hostname } _ =
+ let id = Int32.of_string (q#param "id") in
if q#param_true "yes" then (
(* Get the name of the image. *)
let sth = dbh#prepare_cached "select name_deleted from images
where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
+ sth#execute [Some hostid; Some id];
let name = sth#fetch1string () in
let sth = dbh#prepare_cached "update images
set name_deleted = name, name = null
where hostid = ? and name = ?" in
- sth#execute [`Int hostid; `String name];
+ sth#execute [Some hostid; Some name];
(* Now copy the old row, changing name_deleted back to name so the image
* becomes live.
upload_date
from images
where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
+ sth#execute [Some hostid; Some id];
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Done. *)
let buttons = [ ok_button "/_images" ] in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: undelete_image_form.ml,v 1.7 2004/09/09 12:21:22 rich Exp $
+ * $Id: undelete_image_form.ml,v 1.8 2006/03/27 18:09:47 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "undelete_image_form.html" in
- let id = int_of_string (q#param "id") in
+ let id = Int32.of_string (q#param "id") in
let sth = dbh#prepare_cached "select name, name_deleted, width, height, alt
from images
where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
+ sth#execute [Some hostid; Some id];
let name, width, height, alt =
match sth#fetch1 () with
- [ `String name; `Null; `Int width; `Int height; `String alt]
- | [ `Null; `String name; `Int width; `Int height; `String alt] ->
+ [ Some name; None; Some width; Some height; Some alt]
+ | [ None; Some name; Some width; Some height; Some alt] ->
name, width, height, alt
| _ -> assert false in
- template#set "id" (string_of_int id);
+ template#set "id" (Int32.to_string id);
template#set "name" name;
- template#set "width" (string_of_int width);
- template#set "height" (string_of_int height);
+ template#set "width" (Int32.to_string width);
+ template#set "height" (Int32.to_string height);
template#set "alt" alt;
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: upload_file.ml,v 1.11 2005/11/24 14:54:13 rich Exp $
+ * $Id: upload_file.ml,v 1.12 2006/03/27 18:09:47 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
(* Valid file names. *)
let file_ok_re = Pcre.regexp "^[a-z0-9][-._a-z0-9]*$"
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user=
+let run r (q : cgi) dbh hostid { hostname = hostname } user=
let name = q#param "name" in
let title = q#param "title" in
(* Identify the MIME type from the extension. *)
let mime_type = mime_type_of_filename name in
- let title = if string_is_whitespace title then `Null else `String title in
+ let title = if string_is_whitespace title then None else Some title in
(* Check if something with the same name already exists. If replace=1
* then we can replace it, otherwise we must present an error message.
let replace = q#param_true "replace" in
let sth = dbh#prepare_cached "select 1 from files
where hostid = ? and name = ?" in
- sth#execute [`Int hostid; `String name];
+ sth#execute [Some hostid; Some name];
let exists = try sth#fetch1int () = 1 with Not_found -> false in
let sth = dbh#prepare_cached "update files
set name_deleted = name, name = null
where hostid = ? and name = ?" in
- sth#execute [`Int hostid; `String name];
+ sth#execute [Some hostid; Some name];
)
);
dbh#prepare_cached
"insert into files (hostid, name, content, title, mime_type)
values (?, ?, ?, ?, ?)" in
- sth#execute [`Int hostid; `String name; `Binary file; title;
- `String mime_type];
+ sth#execute [Some hostid; Some name; `Binary file; title;
+ Some mime_type];
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Email notify. *)
let subject = "File " ^ name ^ " has been uploaded." in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: upload_file_form.ml,v 1.8 2004/11/01 16:05:27 rich Exp $
+ * $Id: upload_file_form.ml,v 1.9 2006/03/27 18:09:47 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "upload_file_form.html" in
(* If called with a 'name' argument, prefill the name field.
let name =
if q#param_exists "name" then q#param "name"
else if q#param_exists "id" then (
- let id = int_of_string (q#param "id") in
+ let id = Int32.of_string (q#param "id") in
let sth = dbh#prepare_cached "select coalesce (name, name_deleted)
from files
where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
+ sth#execute [Some hostid; Some id];
let name = sth#fetch1string () in
name
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: upload_image.ml,v 1.12 2005/11/24 14:54:13 rich Exp $
+ * $Id: upload_image.ml,v 1.13 2006/03/27 18:09:47 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
(* Valid image names. *)
let image_ok_re = Pcre.regexp "^[a-z0-9][-._a-z0-9]*\\.(jpg|jpeg|gif|ico|png)$"
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user=
+let run r (q : cgi) dbh hostid { hostname = hostname } user=
let name = q#param "name" in
let alt = q#param "alt" in
let title = q#param "title" in
return ()
);
- let title = if string_is_whitespace title then `Null else `String title in
+ let title = if string_is_whitespace title then None else Some title in
let longdesc =
- if string_is_whitespace longdesc then `Null else `String longdesc in
- let clazz = if string_is_whitespace clazz then `Null else `String clazz in
+ if string_is_whitespace longdesc then None else Some longdesc in
+ let clazz = if string_is_whitespace clazz then None else Some clazz in
(* Make a thumbnail of this image. *)
let thumbnail, tn_mime_type, tn_width, tn_height =
let replace = q#param_true "replace" in
let sth = dbh#prepare_cached "select 1 from images
where hostid = ? and name = ?" in
- sth#execute [`Int hostid; `String name];
+ sth#execute [Some hostid; Some name];
let exists = try sth#fetch1int () = 1 with Not_found -> false in
let sth = dbh#prepare_cached "update images
set name_deleted = name, name = null
where hostid = ? and name = ?" in
- sth#execute [`Int hostid; `String name];
+ sth#execute [Some hostid; Some name];
)
);
title, longdesc, class, thumbnail, tn_width,
tn_height, mime_type, tn_mime_type)
values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" in
- sth#execute [`Int hostid; `String name; `Binary image; `Int width;
- `Int height; `String alt; title; longdesc; clazz;
- `Binary thumbnail; `Int tn_width; `Int tn_height;
- `String mime_type; `String tn_mime_type];
+ sth#execute [Some hostid; Some name; `Binary image; Some width;
+ Some height; Some alt; title; longdesc; clazz;
+ `Binary thumbnail; Some tn_width; Some tn_height;
+ Some mime_type; Some tn_mime_type];
- dbh#commit ();
+ PGOCaml.commit dbh;
(* Email notify. *)
let subject = "Image " ^ name ^ " has been uploaded." in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: upload_image_form.ml,v 1.8 2004/11/01 16:05:27 rich Exp $
+ * $Id: upload_image_form.ml,v 1.9 2006/03/27 18:09:47 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
open Cocanwiki_template
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "upload_image_form.html" in
(* If called with a 'name' argument, prefill the name field.
let name =
if q#param_exists "name" then q#param "name"
else if q#param_exists "id" then (
- let id = int_of_string (q#param "id") in
+ let id = Int32.of_string (q#param "id") in
let sth = dbh#prepare_cached "select coalesce (name, name_deleted)
from images
where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int id];
+ sth#execute [Some hostid; Some id];
let name = sth#fetch1string () in
name
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: user_prefs.ml,v 1.6 2005/11/24 14:54:13 rich Exp $
+ * $Id: user_prefs.ml,v 1.7 2006/03/27 18:09:47 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_template
open Cocanwiki_strings
-let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname=hostname} user =
+let run r (q : cgi) dbh hostid {hostname=hostname} user =
let email_change_template = _get_template "user_prefs_email_change.txt" in
(* Get the fields. *)
dbh#prepare_cached "update users set email_notify = ?
where hostid = ? and id = ?" in
sth#execute [`Bool email_notify;
- `Int hostid; `Int userid];
+ Some hostid; Some userid];
(* Have we changed the email address? *)
let confirm_needed =
*)
let sth = dbh#prepare_cached "update users set email = null
where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int userid];
+ sth#execute [Some hostid; Some userid];
false
) else (
*)
let sth = dbh#prepare_cached "select ? <> coalesce (email, '')
from users where hostid = ? and id = ?" in
- sth#execute [`String new_email; `Int hostid; `Int userid];
+ sth#execute [Some new_email; Some hostid; Some userid];
let changed =
match sth#fetch1 () with [ `Bool b ] -> b | _ -> assert false in
(* Changed, so we add to the pending_email_changes table. *)
let sth = dbh#prepare_cached "insert into pending_email_changes
(key, userid, email) values (?, ?, ?)" in
- sth#execute [`String key; `Int userid; `String new_email];
+ sth#execute [Some key; Some userid; Some new_email];
(* Send the confirm email. *)
email_change_template#set "hostname" hostname;
sth#execute [];
(* Commit and finish off. *)
- dbh#commit ();
+ PGOCaml.commit dbh;
let buttons = [ ok_button "/_userprefs" ] in
ok ~title:"Preferences updated" ~buttons
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: user_prefs_form.ml,v 1.3 2004/11/01 12:57:53 rich Exp $
+ * $Id: user_prefs_form.ml,v 1.4 2006/03/27 18:09:47 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_template
open Cocanwiki_date
-let run r (q : cgi) (dbh : Dbi.connection) hostid host user =
+let run r (q : cgi) dbh hostid host user =
let template = get_template dbh hostid "user_prefs_form.html" in
let userid, name, prefs =
let sth =
dbh#prepare_cached
"select registration_date from users where hostid = ? and id = ?" in
- sth#execute [`Int hostid; `Int userid];
+ sth#execute [Some hostid; Some userid];
let registration_date =
match sth#fetch1 () with
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: users.ml,v 1.8 2004/10/23 15:00:16 rich Exp $
+ * $Id: users.ml,v 1.9 2006/03/27 18:09:47 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_template
open Cocanwiki_date
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "users.html" in
let sth =
can_manage_contacts, can_manage_site, can_edit_global_css,
can_import_mail
from users where hostid = ? order by name" in
- sth#execute [`Int hostid];
+ sth#execute [Some hostid];
let table =
sth#map
(function
- [`Int userid; `String name; (`Null | `String _) as email;
+ [Some userid; Some name; (None | Some _) as email;
`Date registration_date; `Bool invite_pending;
`Bool can_edit; `Bool can_manage_users;
`Bool can_manage_contacts; `Bool can_manage_site;
`Bool can_edit_global_css; `Bool can_import_mail] ->
- let email = match email with `Null -> "" | `String s -> s in
- [ "userid", Template.VarString (string_of_int userid);
+ let email = match email with None -> "" | Some s -> s in
+ [ "userid", Template.VarString (Int32.to_string userid);
"name", Template.VarString name;
"email", Template.VarString email;
"registration_date",
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: what_links_here.ml,v 1.4 2004/10/10 14:44:50 rich Exp $
+ * $Id: what_links_here.ml,v 1.5 2006/03/27 18:09:47 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_template
open Cocanwiki_links
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "what_links_here.html" in
let page = q#param "page" in
let sth = dbh#prepare_cached "select title from pages
where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
let title = sth#fetch1string () in
template#set "title" title;
*)
let sth = dbh#prepare_cached "select 1 from sitemenu
where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String page];
+ sth#execute [Some hostid; Some page];
let in_sitemenu = try sth#fetch1int () = 1 with Not_found -> false in
template#conditional "in_sitemenu" in_sitemenu;
git.annexia.org / cocanwiki.git / commitdiff