(* 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.7 2006/03/27 18:09:47 rich Exp $
+ * $Id: admin.ml,v 1.8 2006/03/28 16:24:08 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 run r (q : cgi) dbh _ _ _ =
(* Select out the alternative hostnames. *)
- let sth = dbh#prepare_cached
- "select hs.hostid, hs.name from hostnames hs
- where not exists (select 1 from hosts
- where id = hs.hostid
- and canonical_hostname = hs.name)" in
- sth#execute [];
-
- let hostnames = sth#map (function [`Int hostid; `String name] ->
- hostid, name
- | _ -> assert false) in
+ let hostnames = PGSQL(dbh)
+ "select hs.hostid, hs.name from hostnames hs
+ where not exists (select 1 from hosts
+ where id = hs.hostid
+ and canonical_hostname = hs.name)" in
(* Pull out the details of all the wikis on the server. *)
- let sth = dbh#prepare_cached
- "select h.id, h.canonical_hostname,
- (select count(*) from pages
- where hostid = h.id and url is not null),
- (select max(last_modified_date) from pages
- where hostid = h.id and url is not null)
- from hosts h
- order by 2" in
- sth#execute [];
+ let rows = PGSQL(dbh)
+ "select h.id, h.canonical_hostname,
+ (select count(*) from pages
+ where hostid = h.id and url is not null),
+ (select max(last_modified_date) from pages
+ where hostid = h.id and url is not null)
+ from hosts h
+ order by 2" in
let table =
- sth#map
- (function [`Int id; `String canonical_hostname;
- (`Null | `Int _) as page_count;
- (`Null | `Timestamp _) as last_modified_date] ->
+ List.map (
+ function (id, canonical_hostname,
+ page_count, last_modified_date) ->
let page_count = match page_count with
- `Null -> 0
- | `Int n -> n in
+ | None -> 0L
+ | Some n -> n in
let last_modified_date = match last_modified_date with
- `Null -> "-"
- | `Timestamp date -> printable_date date in
+ | None -> "-"
+ | Some date -> printable_date date in
let hostnames =
List.filter (fun (i, _) -> i = id) hostnames in
[ "hostname", Template.VarString hostname ])
hostnames in
- [ "id", Template.VarString (string_of_int id);
+ [ "id", Template.VarString (Int32.to_string id);
"canonical_hostname", Template.VarString canonical_hostname;
- "page_count", Template.VarString (string_of_int page_count);
+ "page_count", Template.VarString (Int64.to_string page_count);
"last_modified_date", Template.VarString last_modified_date;
"hostnames", Template.VarTable hostnames ]
-
- | _ -> assert false) in
+ ) rows in
template#table "hosts" table;
(* 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.11 2006/03/27 18:09:47 rich Exp $
+ * $Id: create_host.ml,v 1.12 2006/03/28 16:24:08 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 run r =
let q = new cgi r in
- let dbh = Cocanwiki._get_dbh r in
+ let dbh = PGOCaml.connect ~database:"cocanwiki" () in
+ PGOCaml.begin_work dbh;
let canonical_hostname = q#param "canonical_hostname" in
let hostnames = try q#param "hostnames" with Not_found -> "" in
let title = trim title in
if title = "" then (
Cocanwiki_ok.error ~back_button:true ~title:"Bad title"
- dbh (-1) q "You must give a title for this Wiki.";
+ dbh (-1l) q "You must give a title for this Wiki.";
) else (
(* In theory we could verify characters in hostnames. However
* it's probably best to assume the sysadmin knows what they're up to
let hostnames = List.filter ((<>) "") hostnames in
let template =
- if q#param_true "template" then int_of_string (q#param "template")
- else 0 in
+ if q#param_true "template" then Int32.of_string (q#param "template")
+ else 0l in
let hostid = create_host dbh canonical_hostname hostnames template title
"Administrator" "123456" true None in
{ Template.StdPages.label = "OK";
Template.StdPages.link = "/_bin/admin/host.cmo";
Template.StdPages.method_ = None;
- Template.StdPages.params = [ "hostid", string_of_int hostid ] }
+ Template.StdPages.params = [ "hostid", Int32.to_string hostid ] }
] in
Cocanwiki_ok.ok ~title:"Wiki created" ~buttons
- dbh (-1) q "A new Wiki was created."
+ dbh (-1l) q "A new Wiki was created."
)
let () =
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: create_host_form.ml,v 1.5 2004/09/25 11:45:59 rich Exp $
+ * $Id: create_host_form.ml,v 1.6 2006/03/28 16:24:08 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 run r =
let q = new cgi r in
- let dbh = Cocanwiki._get_dbh r in
+ let dbh = PGOCaml.connect ~database:"cocanwiki" () in
+ PGOCaml.begin_work dbh;
(* Get the template hosts. *)
- let sth = dbh#prepare_cached "select id, canonical_hostname from hosts
- where is_template order by 2" in
- sth#execute [];
+ let rows = PGSQL(dbh)
+ "select id, canonical_hostname from hosts
+ where is_template order by 2" in
- let table = sth#map (function [`Int id; `String canonical_hostname] ->
- [ "id", Template.VarString (string_of_int id);
- "canonical_hostname",
- Template.VarString canonical_hostname ]
- | _ -> assert false) in
+ let table = List.map (
+ fun (id, canonical_hostname) ->
+ [ "id", Template.VarString (Int32.to_string id);
+ "canonical_hostname", Template.VarString canonical_hostname ]
+ ) rows in
template#table "templates" 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_host_css.ml,v 1.8 2006/03/27 18:09:47 rich Exp $
+ * $Id: edit_host_css.ml,v 1.9 2006/03/28 16:24:08 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
let run r (q : cgi) dbh _ _ _ =
- let hostid = int_of_string (q#param "hostid") in
+ let hostid = Int32.of_string (q#param "hostid") 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
(* 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";
PGOCaml.commit dbh;
{ Template.StdPages.label = "OK";
Template.StdPages.link = "/_bin/admin/host.cmo";
Template.StdPages.method_ = None;
- Template.StdPages.params = [ "hostid", string_of_int hostid ] };
+ Template.StdPages.params = [ "hostid", Int32.to_string hostid ] };
{ Template.StdPages.label = "Edit stylesheet again";
Template.StdPages.link = "/_bin/admin/edit_host_css_form.cmo";
Template.StdPages.method_ = None;
- Template.StdPages.params = [ "hostid", string_of_int hostid ] }
+ Template.StdPages.params = [ "hostid", Int32.to_string hostid ] }
] in
ok ~title:"Stylesheet changed" ~buttons
- dbh (-1) q
+ dbh (-1l) q
("The stylesheet was changed successfully. " ^
"Note: You must RELOAD the page to see changes to stylesheets.")
(* 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.6 2006/03/27 18:09:47 rich Exp $
+ * $Id: edit_host_css_form.ml,v 1.7 2006/03/28 16:24:08 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 _ _ _ =
- let hostid = int_of_string (q#param "hostid") in
- template#set "id" (string_of_int hostid);
+ let hostid = Int32.of_string (q#param "hostid") in
+ template#set "id" (Int32.to_string hostid);
- let sth = dbh#prepare_cached "select css from hosts where id = ?" in
- sth#execute [`Int hostid];
+ let css = List.hd (
+ PGSQL(dbh) "select css from hosts where id = $hostid"
+ ) in
let css =
- match sth#fetch1 () with
- | [ `Null ] -> ""
- | [ `String css ] -> css
- | _ -> assert false in
+ match css with
+ | None -> ""
+ | Some css -> css 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_hostnames.ml,v 1.9 2006/03/27 18:09:47 rich Exp $
+ * $Id: edit_hostnames.ml,v 1.10 2006/03/28 16:24:08 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 _ host' _ =
- let hostid = int_of_string (q#param "hostid") in
+ let hostid = Int32.of_string (q#param "hostid") in
if q#param_true "cancel" then (
let { hostname = hostname } = host' in
q#redirect ("http://" ^ hostname ^ "/_bin/admin/host.cmo?hostid=" ^
- string_of_int hostid);
+ Int32.to_string hostid);
return ()
);
let hostnames = List.filter ((<>) "") hostnames in
(* Update the database. *)
- let sth = dbh#prepare_cached
- "set constraints \"hosts_hostname_cn\" deferred" in
- sth#execute [];
- let sth = dbh#prepare_cached "update hosts set canonical_hostname = ?
- where id = ?" in
- sth#execute [`String canonical_hostname; `Int hostid];
- let sth = dbh#prepare_cached "delete from hostnames where hostid = ?" in
- sth#execute [`Int hostid];
- let sth = dbh#prepare_cached "insert into hostnames (hostid, name)
- values (?, ?)" in
- sth#execute [`Int hostid; `String canonical_hostname];
- List.iter (fun name ->
- sth#execute [`Int hostid; `String name]) hostnames;
+ PGSQL(dbh) "set constraints \"hosts_hostname_cn\" deferred";
+ PGSQL(dbh) "update hosts set canonical_hostname = $canonical_hostname
+ where id = $hostid";
+ PGSQL(dbh) "delete from hostnames where hostid = $hostid";
+ List.iter (
+ fun name ->
+ PGSQL(dbh) "insert into hostnames (hostid, name)
+ values ($hostid, $name)";
+ ) hostnames;
(* Commit to the database. *)
PGOCaml.commit dbh;
{ Template.StdPages.label = "OK";
Template.StdPages.link = "/_bin/admin/host.cmo";
Template.StdPages.method_ = None;
- Template.StdPages.params = [ "hostid", string_of_int hostid ] }
+ Template.StdPages.params = [ "hostid", Int32.to_string hostid ] }
] in
ok ~title:"Saved" ~buttons
- dbh (-1) q "Hostnames updated."
+ dbh (-1l) q "Hostnames updated."
let () =
register_script run
(* 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.6 2006/03/27 18:09:47 rich Exp $
+ * $Id: edit_hostnames_form.ml,v 1.7 2006/03/28 16:24:08 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 _ _ _ =
- let hostid = int_of_string (q#param "hostid") in
+ let hostid = Int32.of_string (q#param "hostid") in
+ template#set "id" (Int32.to_string hostid);
- template#set "id" (string_of_int hostid);
+ let canonical_hostname = List.hd (
+ PGSQL(dbh)
+ "select canonical_hostname from hosts where id = $hostid"
+ ) in
- let sth = dbh#prepare_cached
- "select canonical_hostname from hosts where id = ?" in
- sth#execute [`Int hostid];
-
- let canonical_hostname = sth#fetch1string () in
template#set "canonical_hostname" canonical_hostname;
- let sth = dbh#prepare_cached "select name from hostnames
- where hostid = ?
- and name <> ?" in
- sth#execute [`Int hostid; `String canonical_hostname];
+ let hostnames = PGSQL(dbh)
+ "select name from hostnames
+ where hostid = $hostid and name <> $canonical_hostname" in
- let hostnames = sth#map (function [`String hostname] -> hostname
- | _ -> assert false) in
template#set "hostnames" (String.concat "\n" hostnames);
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: host.ml,v 1.9 2006/03/27 18:09:47 rich Exp $
+ * $Id: host.ml,v 1.10 2006/03/28 16:24:08 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 _ _ _ =
- let hostid = int_of_string (q#param "hostid") in
-
- template#set "id" (string_of_int hostid);
+ let hostid = Int32.of_string (q#param "hostid") in
+ template#set "id" (Int32.to_string hostid);
(* Pull out some overall details for this host. *)
- let sth = dbh#prepare_cached
- "select h.canonical_hostname, h.css is not null,
- (select count(*) from pages
- where hostid = h.id and url is not null),
- (select count(*) from pages
- where hostid = h.id),
- (select max(last_modified_date) from pages
- where hostid = h.id and url is not null),
- (select min(last_modified_date) from pages
- where hostid = h.id and url is not null)
- from hosts h
- where h.id = ?" in
- sth#execute [`Int hostid];
+ let rows = PGSQL(dbh)
+ "select h.canonical_hostname, h.css is not null,
+ (select count(*) from pages
+ where hostid = h.id and url is not null),
+ (select count(*) from pages
+ where hostid = h.id),
+ (select max(last_modified_date) from pages
+ where hostid = h.id and url is not null),
+ (select min(last_modified_date) from pages
+ where hostid = h.id and url is not null)
+ from hosts h
+ where h.id = $hostid" in
let canonical_hostname, has_css, page_count, total_count,
last_modified_date, creation_date =
- match sth#fetch1 () with
- [ `String canonical_hostname;
- `Bool has_css;
- (`Null | `Int _ | `Int64 _) as page_count;
- (`Null | `Int _ | `Int64 _) as total_count;
- (`Null | `Timestamp _) as last_modified_date;
- (`Null | `Timestamp _) as creation_date ] ->
- let page_count = match page_count with
- `Null -> 0
- | `Int64 n -> Int64.to_int n
- | `Int n -> n in
- let total_count = match total_count with
- `Null -> 0
- | `Int64 n -> Int64.to_int n
- | `Int n -> n in
- let last_modified_date = match last_modified_date with
- `Null -> ""
- | `Timestamp t -> printable_date t in
- let creation_date = match creation_date with
- `Null -> ""
- | `Timestamp t -> printable_date t in
- canonical_hostname, has_css, page_count, total_count,
- last_modified_date, creation_date
- | xs -> failwith (Dbi.sdebug xs) in
+ match rows with
+ | [ canonical_hostname, Some has_css,
+ page_count,
+ total_count,
+ last_modified_date, creation_date ] ->
+ let page_count = match page_count with
+ | None -> 0L
+ | Some n -> n in
+ let total_count = match total_count with
+ | None -> 0L
+ | Some n -> n in
+ let last_modified_date = match last_modified_date with
+ | None -> ""
+ | Some t -> printable_date t in
+ let creation_date = match creation_date with
+ | None -> ""
+ | Some t -> printable_date t in
+ canonical_hostname, has_css, page_count, total_count,
+ last_modified_date, creation_date
+ | _ -> assert false in
template#set "canonical_hostname" canonical_hostname;
template#conditional "has_css" has_css;
- template#set "page_count" (string_of_int page_count);
- template#set "total_count" (string_of_int total_count);
+ template#set "page_count" (Int64.to_string page_count);
+ template#set "total_count" (Int64.to_string total_count);
template#set "last_modified_date" last_modified_date;
template#set "creation_date" creation_date;
(* Pull out any aliases. *)
- let sth = dbh#prepare_cached "select name from hostnames
- where hostid = ?
- and name <> ?" in
- sth#execute [`Int hostid; `String canonical_hostname];
-
- let table = sth#map (function [`String hostname] ->
- [ "hostname", Template.VarString hostname ]
- | _ -> assert false) in
+ let rows = PGSQL(dbh)
+ "select name from hostnames
+ where hostid = $hostid and name <> $canonical_hostname" in
+ let table = List.map (
+ fun hostname ->
+ [ "hostname", Template.VarString hostname ]
+ ) rows in
template#table "hostnames" 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: images.ml,v 1.9 2006/03/28 13:20:00 rich Exp $
+ * $Id: images.ml,v 1.10 2006/03/28 16:24:07 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
order by 2, 3" in
let table =
- sth#map
+ List.map
(fun row ->
let id, name, width, height, alt, size, tn_width, tn_height,
is_deleted, has_thumbnail =
match row with
- | [id, Some name, None, width, height,
- alt, Some size, tn_width, tn_height] ->
+ | (id, Some name, None, width, height,
+ alt, Some size, Some tn_width, Some tn_height) ->
id, name, width, height, alt, size, tn_width, tn_height,
false, true
- | [id, None, Some name, width, height,
- alt, Some size, tn_width, tn_height] ->
+ | (id, None, Some name, width, height,
+ alt, Some size, Some tn_width, Some tn_height) ->
id, name, width, height, alt, size, tn_width, tn_height,
true, true
- | [id, Some name, None, width, height,
- alt, Some size, None, None] ->
- id, name, width, height, alt, size, 0, 0,
+ | (id, Some name, None, width, height,
+ alt, Some size, None, None) ->
+ id, name, width, height, alt, size, 0l, 0l,
false, false
- | [id, None, Some name, width, height,
- alt, Some size, None, None] ->
- id, name, width, height, alt, size, 0, 0,
+ | (id, None, Some name, width, height,
+ alt, Some size, None, None) ->
+ id, name, width, height, alt, size, 0l, 0l,
true, false
| _ -> assert false in
let size = Int32.to_int size in
"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
+ "has_thumbnail", Template.VarConditional has_thumbnail ]
+ ) rows in
template#table "images" table;
(* 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.6 2006/03/28 13:20:00 rich Exp $
+ * $Id: invite_user_confirm.ml,v 1.7 2006/03/28 16:24:07 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 email, userid =
match rows with
- | [ Some email; userid ] -> Some email, userid
- | [ None; userid ] -> None, userid
+ | [ Some email, userid ] -> Some email, userid
+ | [ None, userid ] -> None, userid
| [] ->
error ~title:"Already signed up"
dbh hostid q "It looks like you have already used your invitation.";
(* 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.5 2006/03/28 13:20:00 rich Exp $
+ * $Id: largest_pages.ml,v 1.6 2006/03/28 16:24:07 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 table =
List.map
- (function [pageid; page; title; Some size] ->
- let size = Int32.to_int size in
- let download_time = overhead + size / modem_speed in (* seconds *)
- let download_time =
- if download_time <= 4 then "<= 4 s"
- else if download_time < 60 then sprintf "%d s" download_time
- else sprintf "%d m %d s" (download_time / 60) (download_time mod 60)
- in
+ (fun (pageid, page, title, size) ->
+ let page = Option.get page in
+ let size = Int64.to_int (Option.get size) in
+ let download_time = overhead + size / modem_speed in (* seconds *)
+ let download_time =
+ if download_time <= 4 then "<= 4 s"
+ else if download_time < 60 then sprintf "%d s" download_time
+ else
+ sprintf "%d m %d s" (download_time / 60) (download_time mod 60)
+ in
- let size =
- if size < 4096 then sprintf "%d bytes" size
- else sprintf "%d K" (size / 1024) in
+ let size =
+ if size < 4096 then sprintf "%d bytes" size
+ else sprintf "%d K" (size / 1024) in
- [ "pageid", Template.VarString (Int32.to_string pageid);
- "page", Template.VarString page;
- "title", Template.VarString title;
- "size", Template.VarString size;
- "download_time", Template.VarString download_time ]
- | _ -> assert false) in
+ [ "pageid", Template.VarString (Int32.to_string pageid);
+ "page", Template.VarString page;
+ "title", Template.VarString title;
+ "size", Template.VarString size;
+ "download_time", Template.VarString download_time ]
+ ) rows in
template#table "pages" 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: cocanwiki.ml,v 1.9 2006/03/27 16:43:44 rich Exp $
+ * $Id: cocanwiki.ml,v 1.10 2006/03/28 16:24:08 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 can_edit_global_css host = test_permission host CanEditGlobalCSS
let can_import_mail host = test_permission host CanImportMail
+let get_uri_from_request r =
+ try
+ (* If we passed through mod_rewrite, then it saved the
+ * unmodified original URL in a subprocess environment
+ * variable called SCRIPT_URL:
+ *)
+ let tbl = Request.subprocess_env r in
+ Some (Table.get tbl "SCRIPT_URL")
+ with
+ Not_found ->
+ try
+ (* Otherwise try the ordinary uri field
+ * in request_rec.
+ *)
+ Some (Request.uri r)
+ with Not_found ->
+ None
+
(* Our wrapper around the standard [register_script] function.
*
* The optional ~restrict and ~anonymous parameters work as follows:
* table in the database.
*)
let hostid, hostname, canonical_hostname, edit_anon, view_anon =
- let hostname = try Request.hostname r
- with Not_found ->
- error ~back_button:true
- ~title:"Browser problem" dbh (-1l) q
- ("Your browser didn't send a \"Host\" header as part of " ^
- "the HTTP request. Unfortunately this web server cannot "^
- "handle HTTP requests without a \"Host\" header.");
- return () in
+ let hostname =
+ try Request.hostname r
+ with Not_found ->
+ error ~back_button:true
+ ~title:"Browser problem" dbh (-1l) q
+ ("Your browser didn't send a \"Host\" header as part of " ^
+ "the HTTP request. Unfortunately this web server " ^
+ "cannot handle HTTP requests without a \"Host\" " ^
+ "header.");
+ return () in
let hostname = String.lowercase hostname in
let rows =
* so redirect to the login script. If possible set the
* redirect parameter so that we return to the right URL.
*)
- let redirect =
- try
- (* If we passed through mod_rewrite, then it saved the
- * unmodified original URL in a subprocess environment
- * variable called SCRIPT_URL:
- *)
- let tbl = Request.subprocess_env r in
- Some (Table.get tbl "SCRIPT_URL")
- with
- Not_found ->
- try
- (* Otherwise try the ordinary uri field
- * in request_rec.
- *)
- Some (Request.uri r)
- with Not_found ->
- None in
+ let redirect = get_uri_from_request r in
let url =
"http://" ^ hostname ^ "/_login" ^
(* XXX Connection pooling - see above. *)
PGOCaml.close dbh;
+ (* To help with debugging, if there is an exception, print some
+ * extended details.
+ *)
+ (match exn with
+ | Some exn ->
+ fprintf stderr "COCANWIKI exception: %S\n" (Std.dump exn);
+ fprintf stderr "Time: %s\n"
+ (Printer.CalendarPrinter.to_string (Calendar.now ()));
+ let hostname =
+ try Some (Request.hostname r) with Not_found -> None in
+ fprintf stderr "Host: ";
+ (match hostname with
+ | None -> fprintf stderr "not available\n"
+ | Some hostname -> fprintf stderr "%S\n" hostname
+ );
+ let uri = get_uri_from_request r in
+ fprintf stderr "Request: ";
+ (match uri with
+ | None -> fprintf stderr "not available\n"
+ | Some uri -> fprintf stderr "%S\n" uri
+ );
+ | _ -> ()
+ );
+
(* May re-raise the caught exception. *)
Option.may raise exn
)
(* 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.4 2006/03/28 13:20:00 rich Exp $
+ * $Id: links.ml,v 1.5 2006/03/28 16:24:07 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
q#header ~content_type:"text/plain" ();
- List.iter (fun url -> ignore (print_endline r url))
+ List.iter (fun url -> ignore (print_endline r url)) rows
) else
failwith "'type' parameter should be 'inbound' or 'outbound'"
let rows = PGSQL(dbh) "select from_url, to_url from links
where hostid = $hostid" in
- sth#iter (fun (from_url, to_url) ->
- add_link from_url to_url) rows;
+ List.iter (fun (from_url, to_url) ->
+ add_link from_url to_url) rows;
(* Don't forget redirects! They're kinda like links ... *)
let rows = PGSQL(dbh) "select url, redirect from pages
where hostid = $hostid and url is not null
and redirect is not null" in
- sth#iter (function
- | (url, Some redirect) -> add_link url redirect
- | (_, None) -> ()
- ) rows;
+ List.iter (function
+ | (Some url, Some redirect) -> add_link url redirect
+ | _ -> ()
+ ) rows;
let keys h = Hashtbl.fold (fun key _ xs -> key :: xs) h [] in
(* 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.10 2006/03/28 13:20:00 rich Exp $
+ * $Id: login.ml,v 1.11 2006/03/28 16:24:07 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
error
~title:"Bad name or password"
~back_button:true
- dbh hostid q "The name or password was wrong."
+ dbh hostid q "The name or password was wrong.";
+ return ()
| [ row ] -> row
| _ -> 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: logout.ml,v 1.8 2006/03/28 13:20:00 rich Exp $
+ * $Id: logout.ml,v 1.9 2006/03/28 16:24:07 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
(match user with
Anonymous -> ()
| User (userid, _, _, _) ->
- PGSQL(dbh) "delete from usercookies where userid = $userid" in
+ PGSQL(dbh) "delete from usercookies where userid = $userid";
PGOCaml.commit dbh
);
(* 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.11 2006/03/28 13:20:00 rich Exp $
+ * $Id: mail_import.ml,v 1.12 2006/03/28 16:24:07 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
* NB. Do not change this unique title - it is also used during thread
* indexing.
*)
- let title = sprintf "Mail/%s (%d)" subject msgid in
+ let title = sprintf "Mail/%s (%ld)" subject msgid in
(* Choose a suitable URL. *)
let url =
match overwrite with
| None -> new_page (Title title)
| Some _ -> load_page dbh hostid ~url () in
- let model = { model with redirect = "" } in
+ let model = { model with redirect = None } in
(* Create the first section (mail header). *)
let section0 =
hdr_template#set "from" from;
hdr_template#set "inet_message_id" inet_message_id;
- let yyyy, mm, dd = date.Dbi.year, date.Dbi.month, date.Dbi.day in
- hdr_template#set "yyyy" (sprintf "%04d" yyyy);
- hdr_template#set "mm" (sprintf "%02d" mm);
- hdr_template#set "dd" (sprintf "%02d" dd);
- hdr_template#set "short_month" (short_month mm);
+ let date = fst message_date in
+ hdr_template#set "yyyy" (Printer.CalendarPrinter.sprint "%Y" date);
+ hdr_template#set "mm" (Printer.CalendarPrinter.sprint "%m" date);
+ hdr_template#set "dd" (Printer.CalendarPrinter.sprint "%d" date);
+ hdr_template#set "short_month"
+ (Printer.short_name_of_month (Calendar.month date));
let get_table hdr =
List.map (fun addr -> [ "addr", Template.VarString addr ])
hdr_template#to_string
in
- "", "mail_header", content in
+ None, Some "mail_header", content in
(* Create the second section (mail body).
* XXX Very simple. Should be extended to understand attachments and
with
Not_found ->
"No plain text message body found" in
- "Message", "mail_body", content in
+ Some "Message", Some "mail_body", content in
(* Overwrite the first two sections of the current page, regardless of
* what they contain.
* use the divname to identify the old mail_header and mail_body and
* overwrite those, or insert them if they don't exist.
*)
- let contents = model.contents in
+ let contents = model.contents_ in
let contents =
match contents with
- [] | [_] -> [ section0; section1 ]
- | _ :: _ :: xs -> section0 :: section1 :: xs in
- let model = { model with contents = contents } in
+ | [] | [_] -> [ section0; section1 ]
+ | _ :: _ :: xs -> section0 :: section1 :: xs in
+ let model = { model with contents_ = contents } in
(* Write the page back. This can throw several exceptions, but we ignore
* them because we want to script to fail abruptly if any of these
* unexpected conditions arises.
*)
- save_page dbh hostid ~user ~r model;
+ ignore (save_page dbh hostid ~user ~r model);
(* Rebuild threads? *)
if rebuild then
- thread_mail dbh hostid ~user ~r date.Dbi.year date.Dbi.month;
+ thread_mail dbh hostid ~user ~r
+ (Calendar.year (fst message_date))
+ (Date.int_of_month (Calendar.month (fst message_date)));
(* Commit to the database. *)
PGOCaml.commit dbh;
(* 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.3 2006/03/27 18:09:46 rich Exp $
+ * $Id: mail_rebuild.ml,v 1.4 2006/03/28 16:24:07 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_mail
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
+ let year = int_of_string (q#param "year") in
+ let month = int_of_string (q#param "month") in
thread_mail dbh hostid ~user ~r year month;
(* 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.4 2006/03/28 13:20:00 rich Exp $
+ * $Id: orphans.ml,v 1.5 2006/03/28 16:24:07 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 border' =
PGSQL(dbh) "select distinct to_url from links
where hostid = $hostid and from_url in $@border
- and to_url not in $@pages')" in
+ and to_url not in $@pages'" in
if border' = [] then pages'
else loop pages' border'
in
let table =
List.map (fun (page, title) ->
- [ "page", Template.VarString page;
- "title", Template.VarString title ]) rows in
+ 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: page.ml,v 1.44 2006/03/28 13:20:00 rich Exp $
+ * $Id: page.ml,v 1.45 2006/03/28 16:24:07 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_server_settings
open Cocanwiki_links
-type fp_status = FPOK of int * string * string * Dbi.datetime * bool
+type fp_status = FPOK of int32 * string * string * Calendar.t * bool
| FPInternalRedirect of string
| FPExternalRedirect of string
| FPNotFound
* and background images while we compose the page.
*)
q#header ();
- print_string r th#to_string;
- Request.rflush r;
+ ignore (print_string r th#to_string);
+ ignore (Request.rflush r);
t#conditional "has_feedback_email" has_feedback_email;
t#conditional "mailing_list" mailing_list;
from pages
where hostid = $hostid and lower (url) = lower ($page)" in
match rows with
- | [page', _, _, _, _, _, _]
+ | [Some page', _, _, _, _, _, _]
when page <> page' -> (* different case *)
FPExternalRedirect page'
| [ _, None, id, title, description,
(* 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.4 2006/03/27 18:09:46 rich Exp $
+ * $Id: page_email_confirm.ml,v 1.5 2006/03/28 16:24:07 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 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 [Some hostid; Some pending];
+ let rows = PGSQL(dbh) "select url, email from page_emails
+ where hostid = $hostid and pending = $pending" in
let page, email =
- try
- (match sth#fetch1 () with
- [ Some page; Some email ] -> page, email
- | _ -> assert false)
- with
- Not_found ->
- error ~close_button:true ~title:"Email already confirmed"
- dbh hostid q
- "It looks like that email address has already been confirmed.";
- return () in
+ match rows with
+ | [ row ] -> row
+ | [] ->
+ error ~close_button:true ~title:"Email already confirmed"
+ dbh hostid q
+ "It looks like that email address has already been confirmed.";
+ return ()
+ | _ -> assert false in
(* Update the database. *)
- let sth = dbh#prepare_cached "update page_emails set pending = null
- where hostid = ? and pending = ?" in
- sth#execute [Some hostid; Some pending];
+ PGSQL(dbh) "update page_emails set pending = null
+ where hostid = $hostid and pending = $pending";
PGOCaml.commit dbh;
(* 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.3 2006/03/27 18:09:46 rich Exp $
+ * $Id: page_email_form.ml,v 1.4 2006/03/28 16:24:07 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
template#set "page" page;
(* Get the page title. *)
- let sth = dbh#prepare_cached "select title from pages
- where hostid = ? and url = ?" in
- sth#execute [Some hostid; Some page];
-
- let title = sth#fetch1string () in
+ let title = List.hd (
+ PGSQL(dbh) "select title from pages
+ where hostid = $hostid and url = $page"
+ ) in
template#set "title" title;
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: page_email_send.ml,v 1.5 2006/03/27 18:09:46 rich Exp $
+ * $Id: page_email_send.ml,v 1.6 2006/03/28 16:24:07 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
);
(* Good a place as any to delete old, unconfirmed emails. *)
- let sth = dbh#prepare_cached "delete from page_emails
- where pending is not null
- and entry_date < current_date - 7" in
- sth#execute [];
+ PGSQL(dbh)
+ "delete from page_emails
+ where pending is not null
+ and entry_date < current_date - 7";
+
PGOCaml.commit dbh;
+ PGOCaml.begin_work 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 [Some hostid; Some page; Some email];
+ let rows = PGSQL(dbh)
+ "select 1 from page_emails where hostid = $hostid
+ and url = $page and email = $email" in
- let registered = try sth#fetch1int () = 1 with Not_found -> false in
+ let registered = rows = [Some 1l] in
if registered then (
error ~title:"Email address already used" ~back_button:true
let opt_out = random_sessionid () in
(* Insert into the database. *)
- let sth = dbh#prepare_cached "insert into page_emails (hostid, url, email,
- pending, opt_out) values (?, ?, ?, ?, ?)" in
- sth#execute [Some hostid; Some page; Some email; Some pending;
- Some opt_out];
+ PGSQL(dbh)
+ "insert into page_emails (hostid, url, email, pending, opt_out)
+ values ($hostid, $page, $email, $pending, $opt_out)";
PGOCaml.commit dbh;
(* 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.3 2006/03/27 18:09:46 rich Exp $
+ * $Id: page_email_unsubscribe.ml,v 1.4 2006/03/28 16:24:08 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 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 [Some hostid; Some opt_out];
+ PGSQL(dbh)
+ "delete from page_emails where hostid = $hostid and opt_out = $opt_out";
PGOCaml.commit dbh;
(* 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.3 2006/03/27 18:09:46 rich Exp $
+ * $Id: page_rss.ml,v 1.4 2006/03/28 16:24:08 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
template#set "hostname" hostname;
(* Get the title and description of the page. *)
- let sth = dbh#prepare_cached "select id, title, description
- from pages
- where hostid = ? and url = ?
- and redirect is null" in
- sth#execute [Some hostid; Some page];
+ let rows = PGSQL(dbh)
+ "select id, title, description from pages
+ where hostid = $hostid and url = $page and redirect is null" in
let pageid, title, description =
- match sth#fetch1 () with
- [ Some id; Some title; Some description ] ->
- id, title, description
- | _ -> assert false in
+ match rows with
+ | [row] -> row
+ | _ -> assert false in
template#set "title" title;
template#set "description" description;
(* Get the sections in the live page. *)
- let sth = dbh#prepare_cached "select sectionname, content, ordering
- from contents
- where pageid = ?
- and sectionname is not null
- order by ordering" in
- sth#execute [Some pageid];
+ let rows = PGSQL(dbh)
+ "select sectionname, content, ordering
+ from contents
+ where pageid = $pageid
+ and sectionname is not null
+ order by ordering" in
let sections =
- sth#map (function [Some sectionname; Some content; _] ->
- sectionname, content
- | _ -> assert false) in
+ List.map (fun (sectionname, content, _) -> sectionname, content) rows in
let sections =
List.map (fun (sectionname, content) ->
+ let sectionname = match sectionname with
+ | None -> "" | Some s -> s in
let content = Wikilib.xhtml_of_content dbh hostid content in
let linkname = linkname_of_sectionname sectionname in
[ "sectionname", Template.VarString sectionname;
(* 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.7 2006/03/27 18:09:46 rich Exp $
+ * $Id: pagestyle.ml,v 1.8 2006/03/28 16:24:08 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
try Some (Int32.of_string (q#param "version")) with Not_found -> None in
(* Get the CSS. *)
- let sth =
- match version with
- None ->
- let sth = dbh#prepare_cached
- "select css from pages where hostid = ? and url = ?" in
- 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 [Some hostid; Some version; Some page; Some page];
- sth in
let css =
- match sth#fetch1 () with
- [ None ] -> ""
- | [ Some css ] -> css
- | _ -> assert false in
+ match version with
+ | None ->
+ List.hd (
+ PGSQL(dbh)
+ "select css from pages where hostid = $hostid and url = $page"
+ )
+ | Some version ->
+ List.hd (
+ PGSQL(dbh)
+ "select css from pages
+ where hostid = $hostid and id = $version and
+ (url = $page or url_deleted = $page)"
+ ) in
+
+ let css = match css with None -> "" | Some css -> css in
(* It's crucial, for speed of page delivery and rendering, to have
* an expires header for CSS. Even though this means that occasionally
(* 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.5 2006/03/27 18:09:46 rich Exp $
+ * $Id: rebuild_links.ml,v 1.6 2006/03/28 16:24:08 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_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 [Some hostid];
-
- (* Estimate how many sections we will have to process. *)
- let sth =
- dbh#prepare_cached
- "select count(c.id)::int4 from contents c, pages p
- where c.pageid = p.id
- and p.hostid = ?
- and p.url is not null
- and p.redirect is null" in
- sth#execute [Some hostid];
-
- let total_sections = sth#fetch1int () in
+ PGSQL(dbh) "delete from links where hostid = $hostid";
(* Pull out the list of sections to process. *)
- let sth =
- dbh#prepare_cached
+ let sections =
+ PGSQL(dbh)
"select c.content, c.ordering, p.url from contents c, pages p
where c.pageid = p.id
- and p.hostid = ?
+ and p.hostid = $hostid
and p.url is not null
and p.redirect is null
order by p.url, c.ordering" in
- sth#execute [Some hostid];
+
+ let total_sections = List.length sections in
q#header ();
- print_string r template_start#to_string;
+ ignore (print_string r template_start#to_string);
(* Process each section ... *)
let i = ref 0 in
- sth#iter
- (function [Some content; Some ordering; Some url] ->
- let pc = 100 * !i / total_sections in incr i;
- template#set "ordering" (Int32.to_string ordering);
- template#set "url" url;
- template#set "pc" (Int32.to_string pc);
- print_string r template#to_string;
-
- let links = get_links_from_section dbh hostid content in
- List.iter (insert_link dbh hostid url) links
+ List.iter (
+ fun (content, ordering, url) ->
+ let url = Option.get url in
+ let pc = 100 * !i / total_sections in incr i;
+ template#set "ordering" (Int32.to_string ordering);
+ template#set "url" url;
+ template#set "pc" (string_of_int pc);
+ ignore (print_string r template#to_string);
- | _ -> assert false);
+ let links = get_links_from_section dbh hostid content in
+ List.iter (insert_link dbh hostid url) links
+ ) sections;
(* Finish off. *)
PGOCaml.commit dbh;
(* 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.11 2006/03/27 18:09:46 rich Exp $
+ * $Id: recent.ml,v 1.12 2006/03/28 16:24:08 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 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 [Some hostid];
- let count = sth#fetch1int () in
+ let count = Option.get (
+ List.hd (
+ PGSQL(dbh) "select count(*) from pages where hostid = $hostid"
+ )
+ ) in
+ let count = Int64.to_int count in
(* Get the offset and limit specified, and adjust them so that we will
* be displaying some changes.
*)
let offset =
- try Int32.of_string (q#param "offset") with Not_found -> default_offset in
+ try int_of_string (q#param "offset") with Not_found -> default_offset in
let limit =
- try Int32.of_string (q#param "limit") with Not_found -> default_limit in
+ try int_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" (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#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#conditional "has_next" (offset + limit < count);
- template#set "next_offset" (Int32.to_string (offset + limit));
+ template#set "next_offset" (string_of_int (offset + limit));
template#conditional "has_prev" (offset > 0);
- template#set "prev_offset" (Int32.to_string (max 0 (offset - limit)));
+ template#set "prev_offset" (string_of_int (max 0 (offset - limit)));
(* Get the actual changes. *)
- let sth =
- dbh#prepare_cached
- "select p.id, p.url, p.url_deleted, p.title, p.last_modified_date,
- p.logged_ip, u.name
- from pages p left outer join users u on p.logged_user = u.id
- where p.hostid = ?
- order by p.last_modified_date desc
- offset ? limit ?" in
- sth#execute [Some hostid; Some offset; Some limit];
+ let rows =
+ let offset = Int32.of_int offset in
+ let limit = Int32.of_int limit in
+ PGSQL(dbh) "nullable-results"
+ "select p.id, p.url, p.url_deleted, p.title, p.last_modified_date,
+ p.logged_ip, u.name
+ from pages p left outer join users u on p.logged_user = u.id
+ where p.hostid = $hostid
+ order by p.last_modified_date desc
+ offset $offset limit $limit" in
let table =
- sth#map
+ List.map
(function
- | [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
- None -> false, ""
- | Some ip -> true, ip
- | _ -> assert false in
- let has_logged_user, logged_user =
- match logged_user with
- None -> false, ""
- | Some name -> true, name
- | _ -> assert false in
- [ "version", Template.VarString (Int32.to_string version);
- "url", Template.VarString url;
- "title", Template.VarString title;
- "last_modified_date", Template.VarString date;
- "has_logged_ip", Template.VarConditional has_logged_ip;
- "logged_ip", Template.VarString logged_ip;
- "has_logged_user", Template.VarConditional has_logged_user;
- "logged_user", Template.VarString logged_user;
- "is_live", Template.VarConditional true ]
- | [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
- None -> false, ""
- | Some ip -> true, ip
- | _ -> assert false in
- let has_logged_user, logged_user =
- match logged_user with
- None -> false, ""
- | Some name -> true, name
- | _ -> assert false in
- [ "version", Template.VarString (Int32.to_string version);
- "url", Template.VarString url;
- "title", Template.VarString title;
- "last_modified_date", Template.VarString date;
- "has_logged_ip", Template.VarConditional has_logged_ip;
- "logged_ip", Template.VarString logged_ip;
- "has_logged_user", Template.VarConditional has_logged_user;
- "logged_user", Template.VarString logged_user;
- "is_live", Template.VarConditional false ]
- | _ -> assert false) in
+ | (Some version, Some url, _, Some title,
+ Some 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
+ None -> false, ""
+ | Some ip -> true, ip in
+ let has_logged_user, logged_user =
+ match logged_user with
+ None -> false, ""
+ | Some name -> true, name in
+ [ "version", Template.VarString (Int32.to_string version);
+ "url", Template.VarString url;
+ "title", Template.VarString title;
+ "last_modified_date", Template.VarString date;
+ "has_logged_ip", Template.VarConditional has_logged_ip;
+ "logged_ip", Template.VarString logged_ip;
+ "has_logged_user", Template.VarConditional has_logged_user;
+ "logged_user", Template.VarString logged_user;
+ "is_live", Template.VarConditional true ]
+ | (Some version, None, Some url, Some title,
+ Some 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
+ None -> false, ""
+ | Some ip -> true, ip in
+ let has_logged_user, logged_user =
+ match logged_user with
+ None -> false, ""
+ | Some name -> true, name in
+ [ "version", Template.VarString (Int32.to_string version);
+ "url", Template.VarString url;
+ "title", Template.VarString title;
+ "last_modified_date", Template.VarString date;
+ "has_logged_ip", Template.VarConditional has_logged_ip;
+ "logged_ip", Template.VarString logged_ip;
+ "has_logged_user", Template.VarConditional has_logged_user;
+ "logged_user", Template.VarString logged_user;
+ "is_live", Template.VarConditional false ]
+ | _ -> assert false) rows in
template#table "recent_changes" table;
(* 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.3 2006/03/27 18:09:46 rich Exp $
+ * $Id: recent_rss.ml,v 1.4 2006/03/28 16:24:08 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 limit = 30
+let limit = 30_l
let run r (q : cgi) dbh hostid {hostname = hostname} _ =
let template = get_template dbh hostid "recent_rss.xml" in
template#set "hostname" hostname;
(* Get the changes. *)
- let sth =
- dbh#prepare_cached
+ let rows =
+ PGSQL(dbh) "nullable-results"
"select p.id, p.url, p.url_deleted, p.title, p.last_modified_date,
p.logged_ip, u.name
from pages p left outer join users u on p.logged_user = u.id
- where p.hostid = ?
+ where p.hostid = $hostid
order by p.last_modified_date desc
- limit ?" in
- sth#execute [Some hostid; Some limit];
+ limit $limit" in
let table =
- sth#map
+ List.map
(function
- | [Some version; Some url; _; Some title;
- `Timestamp last_modified_date; logged_ip; logged_user] ->
+ | (Some version, Some url, _, Some title,
+ Some 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
None -> false, ""
- | Some ip -> true, ip
- | _ -> assert false in
+ | Some ip -> true, ip in
let has_logged_user, logged_user =
match logged_user with
None -> false, ""
- | Some name -> true, name
- | _ -> assert false in
+ | Some name -> true, name in
[ "version", Template.VarString (Int32.to_string version);
"url", Template.VarString url;
"title", Template.VarString title;
"has_logged_user", Template.VarConditional has_logged_user;
"logged_user", Template.VarString logged_user;
"is_live", Template.VarConditional true ]
- | [Some version; None; Some url; Some title;
- `Timestamp last_modified_date; logged_ip; logged_user] ->
+ | (Some version, None, Some url, Some title,
+ Some 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
None -> false, ""
- | Some ip -> true, ip
- | _ -> assert false in
+ | Some ip -> true, ip in
let has_logged_user, logged_user =
match logged_user with
None -> false, ""
- | Some name -> true, name
- | _ -> assert false in
+ | Some name -> true, name in
[ "version", Template.VarString (Int32.to_string version);
"url", Template.VarString url;
"title", Template.VarString title;
"has_logged_user", Template.VarConditional has_logged_user;
"logged_user", Template.VarString logged_user;
"is_live", Template.VarConditional false ]
- | _ -> assert false) in
+ | _ -> assert false) rows in
template#table "recent_changes" table;
(* 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.3 2006/03/27 18:09:46 rich Exp $
+ * $Id: recently_visited.ml,v 1.4 2006/03/28 16:24:08 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
User (userid, _, _, _) -> userid
| _ -> assert false in
- let sth = dbh#prepare_cached "select rv.url, p.title, rv.visit_time
- from recently_visited rv, pages p
- where rv.hostid = ? and rv.userid = ?
- and rv.hostid = p.hostid and rv.url = p.url
- order by 3 desc" in
- sth#execute [Some hostid; Some userid];
-
- let table = sth#map (function [Some page; Some title; _] ->
- [ "page", Template.VarString page;
- "title", Template.VarString title ]
- | _ -> assert false) in
+ let rows = PGSQL(dbh)
+ "select rv.url, p.title, rv.visit_time
+ from recently_visited rv, pages p
+ where rv.hostid = $hostid and rv.userid = $userid
+ and rv.hostid = p.hostid and rv.url = p.url
+ order by 3 desc" in
+
+ let table = List.map (
+ fun (page, title, _) ->
+ [ "page", Template.VarString page;
+ "title", Template.VarString title ]
+ ) rows in
template#table "recently_visited" 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: rename_page.ml,v 1.4 2006/03/27 18:09:46 rich Exp $
+ * $Id: rename_page.ml,v 1.5 2006/03/28 16:24:08 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
);
(* Get the old title. *)
- let sth = dbh#prepare_cached "select title from pages
- where hostid = ? and url = ?" in
- sth#execute [Some hostid; Some page];
-
- let old_title = sth#fetch1string () in
+ let old_title = List.hd (
+ PGSQL (dbh) "select title from pages
+ where hostid = $hostid and url = $page"
+ ) in
(* Generate URL for the new title. *)
let new_page =
let old_model = load_page dbh hostid ~url:page () in
let new_model = new_page_with_title new_title in
let new_model = { new_model with description = old_model.description;
- contents = old_model.contents } in
- let old_model = { old_model with redirect = new_page } in
- save_page dbh hostid ~user ~r old_model;
+ contents_ = old_model.contents_ } in
+ let old_model = { old_model with redirect = Some new_page } in
+ ignore (save_page dbh hostid ~user ~r old_model);
try
ignore (save_page dbh hostid ~user ~r new_model)
(* 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.2 2006/03/27 18:09:46 rich Exp $
+ * $Id: rename_page_form.ml,v 1.3 2006/03/28 16:24:08 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 page = q#param "page" in
- let sth = dbh#prepare_cached "select title from pages
- where hostid = ? and url = ?" in
- sth#execute [Some hostid; Some page];
-
- let title = sth#fetch1string () in
+ let title = List.hd (
+ PGSQL(dbh) "select title from pages
+ where hostid = $hostid and url = $page"
+ ) in
template#set "page" page;
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: restore.ml,v 1.20 2006/03/27 18:09:46 rich Exp $
+ * $Id: restore.ml,v 1.21 2006/03/28 16:24:08 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
| _ -> None in
(* Copy the old version of the page to be live. *)
- let sth = dbh#prepare_cached "select title, description, creation_date,
- redirect, css
- from pages
- where hostid = ?
- and url_deleted = ? and id = ?" in
- sth#execute [Some hostid; Some page; Some version];
+ let rows = PGSQL(dbh)
+ "select title, description, creation_date,
+ redirect, css
+ from pages
+ where hostid = $hostid
+ and url_deleted = $page and id = $version" in
let title, description, creation_date, redirect, css =
- match sth#fetch1 () with
- [ title; description; creation_date; redirect; css ] ->
- title, description, creation_date, redirect, css
- | _ -> assert false in
-
- let sth =
- dbh#prepare_cached
- "set constraints pages_redirect_cn, sitemenu_url_cn,
- page_emails_url_cn, links_from_cn, recently_visited_url_cn
- deferred" in
- sth#execute [];
-
- let sth = dbh#prepare_cached "update pages set url_deleted = url,
- url = null
- where hostid = ? and url = ?" in
- sth#execute [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 [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
-
- let sth = dbh#prepare_cached "insert into contents (pageid, ordering,
- sectionname, content, divname)
- select ? as pageid, ordering, sectionname,
- content, divname
- from contents
- where pageid = ?" in
- sth#execute [Some pageid; Some version];
+ match rows with
+ | [row] -> row
+ | _ -> assert false in
+
+ PGSQL(dbh)
+ "set constraints pages_redirect_cn, sitemenu_url_cn,
+ page_emails_url_cn, links_from_cn, recently_visited_url_cn
+ deferred";
+ PGSQL(dbh) "update pages set url_deleted = url, url = null
+ where hostid = $hostid and url = $page";
+ PGSQL(dbh) "insert into pages (hostid, url, title,
+ description, creation_date, logged_ip,
+ logged_user, redirect, css)
+ values ($hostid, $page, $title, $description, $creation_date,
+ $?logged_ip, $?logged_user, $?redirect, $?css)";
+
+ let pageid = PGOCaml.serial4 dbh "pages_id_seq" in
+
+ PGSQL(dbh) "insert into contents (pageid, ordering,
+ sectionname, content, divname)
+ select $pageid, ordering, sectionname, content, divname
+ from contents
+ where pageid = $version";
(* Keep the links table in synch. *)
Cocanwiki_links.update_links_for_page dbh hostid page;
(* 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.12 2006/03/27 18:09:46 rich Exp $
+ * $Id: restore_form.ml,v 1.13 2006/03/28 16:24:08 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
(* 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 [Some hostid; Some page];
-
- let version = sth#fetch1int () in
+ let version = List.hd (
+ PGSQL(dbh)
+ "select id from pages
+ where hostid = $hostid and url = $page"
+ ) in
if version = old_version then (
error ~back_button:true ~title:"Restoring live version"
(* 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.9 2006/03/27 18:09:46 rich Exp $
+ * $Id: search.ml,v 1.10 2006/03/28 16:24:08 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 tsquery = String.concat "&" keywords in
(* Search the titles first. *)
- let sth =
- dbh#prepare_cached
- ("select id, url, url_deleted, title, last_modified_date,
- (lower (title) = lower (?)) as exact
- from pages
- where hostid = ? " ^
- (if not old_versions then "and url is not null " else "") ^ "
- and redirect is null
- and title_description_fti @@ to_tsquery (?, ?)
- order by exact desc, last_modified_date desc, title") in
- sth#execute [Some query;
- Some hostid; Some "default"; Some tsquery];
+ let rows =
+ if not old_versions then
+ PGSQL(dbh)
+ "select id, url, url_deleted, title, last_modified_date,
+ (lower (title) = lower ($query)) as exact
+ from pages
+ where hostid = $hostid
+ and url is not null
+ and redirect is null
+ and title_description_fti @@ to_tsquery ('default', $tsquery)
+ order by exact desc, last_modified_date desc, title"
+ else
+ PGSQL(dbh)
+ "select id, url, url_deleted, title, last_modified_date,
+ (lower (title) = lower ($query)) as exact
+ from pages
+ where hostid = $hostid
+ and redirect is null
+ and title_description_fti @@ to_tsquery ('default', $tsquery)
+ order by exact desc, last_modified_date desc, title" in
let titles =
- sth#map (function
- | [_; Some url; None; Some title;
- `Timestamp last_modified; _] ->
- url, title, None, last_modified
- | [Some version; None; Some url; Some title;
- `Timestamp last_modified; _] ->
- url, title, Some version, last_modified
- | _ -> assert false) in
+ List.map (function
+ | (_, Some url, None, title, last_modified, _) ->
+ url, title, None, last_modified
+ | (version, None, Some url, title, last_modified, _) ->
+ url, title, Some version, last_modified
+ | _ -> assert false) rows in
let have_titles = titles <> [] in
template#conditional "have_titles" have_titles;
(* Search the contents. *)
- let sth =
- dbh#prepare_cached
- ("select c.id, p.id, p.url, p.url_deleted, p.title,
- p.last_modified_date
- from contents c, pages p
- where c.pageid = p.id
- and p.hostid = ? " ^
- (if not old_versions then "and url is not null " else "") ^ "
- and p.redirect is null
- and c.content_fti @@ to_tsquery (?, ?)
- order by p.last_modified_date desc, p.title
- limit 50") in
- sth#execute [Some hostid; Some "default"; Some tsquery];
+ let rows =
+ if not old_versions then
+ PGSQL(dbh)
+ "select c.id, p.id, p.url, p.url_deleted, p.title,
+ p.last_modified_date
+ from contents c, pages p
+ where c.pageid = p.id
+ and p.hostid = $hostid
+ and url is not null
+ and p.redirect is null
+ and c.content_fti @@ to_tsquery ('default', $tsquery)
+ order by p.last_modified_date desc, p.title
+ limit 50"
+ else
+ PGSQL(dbh)
+ "select c.id, p.id, p.url, p.url_deleted, p.title,
+ p.last_modified_date
+ from contents c, pages p
+ where c.pageid = p.id
+ and p.hostid = $hostid
+ and p.redirect is null
+ and c.content_fti @@ to_tsquery ('default', $tsquery)
+ order by p.last_modified_date desc, p.title
+ limit 50" in
let contents =
- sth#map (function
- | [Some contentid; _; Some url; None;
- Some title; `Timestamp last_modified] ->
+ List.map (function
+ | (contentid, _, Some url, None, title, last_modified) ->
contentid, url, title, None, last_modified
- | [Some contentid; Some version; None; Some url;
- Some title; `Timestamp last_modified] ->
+ | (contentid, version, None, Some url, title,
+ last_modified) ->
contentid, url, title, Some version, last_modified
- | _ -> assert false) in
+ | _ -> assert false) rows in
let have_contents = contents <> [] in
template#conditional "have_contents" have_contents;
- (* Pull out the actual text which matched so we can generate a summary.*)
+ (* Pull out the actual text which matched so we can generate a summary.
+ * XXX tsearch2 can actually do better than this by emboldening
+ * the text which maps.
+ *)
let content_map =
if contents = [] then []
else (
- let qs = Dbi.placeholders (List.length contents) in
- let sth =
- dbh#prepare_cached
- ("select id, sectionname, content from contents
- where id in " ^ qs) in
- sth#execute
- (List.map (fun (contentid, _,_,_,_) -> Some contentid) contents);
- sth#map (function
- | [ Some id; None; Some content ] ->
- id, (None, content)
- | [ Some id; Some sectionname; Some content ] ->
- id, (Some sectionname, content)
- | _ -> assert false)
+ let rows =
+ let contentids =
+ List.map (fun (contentid, _,_,_,_) -> contentid) contents in
+ PGSQL(dbh)
+ "select id, sectionname, content from contents
+ where id in $@contentids" in
+ List.map (fun (id, sectionname, content) ->
+ id, (sectionname, content)) rows
) in
(* Generate the final tables. *)
List.map (fun (url, title, version, last_modified) ->
let have_version, version =
match version with
- None -> false, 0
+ None -> false, 0l
| Some version -> true, version in
let last_modified = printable_date last_modified in
[ "url", Template.VarString url;
(fun (contentid, url, title, version, last_modified) ->
let have_version, version =
match version with
- None -> false, 0
+ None -> false, 0l
| Some version -> true, version in
let sectionname, content = List.assoc contentid content_map in
let have_sectionname, sectionname =
(* 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.7 2006/03/27 18:09:46 rich Exp $
+ * $Id: send_feedback.ml,v 1.8 2006/03/28 16:24:08 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
);
(* Get the feedback email for this host. *)
- let sth =
- dbh#prepare_cached "select feedback_email from hosts where id = ?" in
- sth#execute [Some hostid];
-
- let to_addr = sth#fetch1string () in
+ let to_addr = List.hd (
+ PGSQL(dbh)
+ "select feedback_email from hosts where id = $hostid"
+ ) in
+ let to_addr = Option.get to_addr in
(* Get the fields. *)
let page = q#param "page" in
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: set_password.ml,v 1.4 2006/03/27 18:09:46 rich Exp $
+ * $Id: set_password.ml,v 1.5 2006/03/28 16:24:08 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 password = password1 in
- let sth = dbh#prepare_cached "update users set password = ?
- where id = ? and hostid = ?" in
- sth#execute [Some password; Some userid; Some hostid];
+ PGSQL(dbh) "update users set password = $password
+ where id = $userid and hostid = $hostid";
PGOCaml.commit dbh;
(* 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.2 2006/03/27 18:09:46 rich Exp $
+ * $Id: set_password_form.ml,v 1.3 2006/03/28 16:24:08 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 userid = Int32.of_string (q#param "userid") in
- let sth = dbh#prepare_cached "select name from users
- where id = ? and hostid = ?" in
- sth#execute [Some userid; Some hostid];
-
- let username = sth#fetch1string () in
+ let username = List.hd (
+ PGSQL(dbh)
+ "select name from users
+ where id = $userid and hostid = $hostid"
+ ) in
template#set "userid" (Int32.to_string userid);
template#set "username" username;
(* 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.10 2006/03/27 18:09:46 rich Exp $
+ * $Id: signup.ml,v 1.11 2006/03/28 16:24:08 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
(* 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 [Some hostid];
-
- let create_account_anon =
- match sth#fetch1 () with
- [ `Bool true ] -> ()
- | _ -> assert false in
+ let create_account_anon = List.hd (
+ PGSQL(dbh) "select create_account_anon from hosts
+ where id = $hostid"
+ ) in
+
+ if not create_account_anon then (
+ error ~title:"Not allowed to create accounts"
+ dbh hostid q ("To get an account on this service, please contact the " ^
+ "administrator.");
+ return ()
+ );
let username = trim (q#param "username") in
let password1 = trim (q#param "password1") 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 ()
+ );
let email = trim (q#param "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 [Some hostid; Some username];
-
- (try
- sth#fetch1 ();
- error ~back_button:true ~title:"Username already taken"
- dbh hostid q
- ("Someone, possibly you, has already taken that username. " ^
- "If you think you have forgotten your password, try going back " ^
- "and clicking on the 'Forgotten your password?' link.");
- return ()
- with
- Not_found -> ());
+ let rows = PGSQL(dbh)
+ "select id from users where hostid = $hostid and name = $username" in
+
+ (match rows with
+ | [_] ->
+ error ~back_button:true ~title:"Username already taken"
+ dbh hostid q
+ ("Someone, possibly you, has already taken that username. " ^
+ "If you think you have forgotten your password, try going back " ^
+ "and clicking on the 'Forgotten your password?' link.");
+ return ()
+ | [] -> ()
+ | _ -> assert false
+ );
(* Create the user account. *)
- let sth = dbh#prepare_cached "insert into users (name, password, email,
- hostid)
- values (?, ?, ?, ?)" in
- sth#execute [Some username; Some password; email; Some hostid];
+ PGSQL(dbh) "insert into users (name, password, email, hostid)
+ values ($username, $password, $?email, $hostid)";
- let userid = Int64.to_int (sth#serial "users_id_seq") in
+ let userid = PGOCaml.serial4 dbh "users_id_seq" in
(* Create a cookie. *)
let cookie = random_sessionid () in
- let sth = dbh#prepare_cached "insert into usercookies (userid, cookie)
- values (?, ?)" in
- sth#execute [Some userid; Some cookie];
+ PGSQL(dbh) "insert into usercookies (userid, cookie)
+ values ($userid, $cookie)";
PGOCaml.commit dbh;
(* 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.8 2006/03/27 18:09:46 rich Exp $
+ * $Id: sitemap.ml,v 1.9 2006/03/28 16:24:08 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 dbh hostid "sitemap.html" in
(* Pull out all the current pages, and a bit of content from each. *)
- let sth = dbh#prepare_cached "select p.url, p.url = 'index',
- p.title, p.description,
- p.last_modified_date,
- (select content from contents
- where pageid = p.id
- order by ordering limit 1) as content
- from pages p
- where p.hostid = ? and p.url is not null
- and p.redirect is null
- order by 2 desc, 3, 1" in
- sth#execute [Some hostid];
+ let rows = PGSQL(dbh)
+ "select p.url, p.url = 'index', p.title, p.description,
+ p.last_modified_date, (select content from contents
+ where pageid = p.id
+ order by ordering limit 1) as content
+ from pages p
+ where p.hostid = $hostid and p.url is not null
+ and p.redirect is null
+ order by 2 desc, 3, 1" in
let table =
- sth#map
- (function [Some url; _; Some title; Some description;
- `Timestamp last_modified_date;
- (None | Some _) as content] ->
- let url = if url = "index" then "" else url in
+ List.map
+ (function (Some url, Some is_index, title, description,
+ last_modified_date, content) ->
+ let url = if is_index then "" else url in
let date = printable_date last_modified_date in
[ "url", Template.VarString url;
"title", Template.VarString title;
"has_content", Template.VarConditional (content <> None);
"content", Template.VarString
(match content with
- None -> ""
- | Some c ->
- truncate 160
- (Wikilib.text_of_xhtml
- (Wikilib.xhtml_of_content dbh hostid c))) ]
- | _ -> assert false) in
+ | None -> ""
+ | Some c ->
+ truncate 160
+ (Wikilib.text_of_xhtml
+ (Wikilib.xhtml_of_content dbh hostid c))) ]
+ | _ -> assert false) rows in
template#set "hostname" hostname;
template#table "sitemap" table;
(* 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.2 2006/03/27 18:09:47 rich Exp $
+ * $Id: sitemap_xml.ml,v 1.3 2006/03/28 16:24:08 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 dbh hostid "sitemap.xml" in
(* Pull out all the current pages. *)
- let sth = dbh#prepare_cached "select p.url, p.url = 'index',
- p.last_modified_date
- from pages p
- where p.hostid = ? and p.url is not null
- and p.redirect is null
- order by 2 desc, 1" in
- sth#execute [Some hostid];
+ let rows = PGSQL(dbh)
+ "select p.url, p.url = 'index', p.last_modified_date
+ from pages p
+ where p.hostid = $hostid and p.url is not null
+ and p.redirect is null
+ order by 2 desc, 1" in
let table =
- sth#map
- (function [Some url; `Bool is_index;
- `Timestamp last_modified_date] ->
+ List.map
+ (function (Some url, Some is_index, last_modified_date) ->
let url = if is_index then "" else url in
let last_modified_date = iso_8601_date_time last_modified_date in
let priority = if is_index then "1.0" else "0.5" in
[ "url", Template.VarString url;
"last_modified_date", Template.VarString last_modified_date;
"priority", Template.VarString priority ]
- | xs -> failwith (Dbi.sdebug xs)) in
+ | _ -> assert false) rows in
template#set "hostname" hostname;
template#table "sitemap" table;
(* 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.4 2006/03/27 18:09:47 rich Exp $
+ * $Id: source.ml,v 1.5 2006/03/28 16:24:08 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 Cgi
open Printf
+open ExtList
+
open Cocanwiki
open Cocanwiki_pages
open Cocanwiki_ok
*)
(* Get the title. *)
- let sth = dbh#prepare_cached "select title from pages
- where hostid = ? and id = ?" in
- sth#execute [Some hostid; Some model.id];
- let title = sth#fetch1string () in
+ let title = List.hd (
+ let model_id = model.id in
+ PGSQL(dbh) "select title from pages
+ where hostid = $hostid and id = $model_id"
+ ) in
(* Function to write out fields, with RFC822-like escaping. *)
let write key value =
- print_string r key;
- print_string r ": ";
- print_string r (Pcre.replace ~rex ~itempl value);
+ ignore (print_string r key);
+ ignore (print_string r ": ");
+ ignore (print_string r (Pcre.replace ~rex ~itempl value));
ignore (print_newline r);
in
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" (Int32.to_string (List.length model.contents));
+ (match model.redirect with
+ | Some redirect -> write "Redirect" redirect
+ | None ->
+ write "Section-Count" (string_of_int (List.length model.contents_))
+ );
ignore (print_newline r);
(* Now write out the sections. *)
- if model.redirect = "" then
- List.iter
- (fun (sectionname, divname, content) ->
- write "Section-Header" sectionname;
- write "Css-Id" divname;
+ if model.redirect = None then
+ List.iteri
+ (fun i (sectionname, divname, content) ->
+ write "Section-Id" (string_of_int i);
+ (match sectionname with None -> () | Some sectionname ->
+ write "Section-Header" sectionname);
+ (match divname with None -> () | Some divname ->
+ write "Css-Id" divname);
write "Content" content;
- ignore (print_newline r)) model.contents
+ ignore (print_newline r)) model.contents_
let () =
register_script ~restrict:[CanView] run
(* 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.5 2006/03/27 18:09:47 rich Exp $
+ * $Id: stats.ml,v 1.6 2006/03/28 16:24:08 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 hostid
- { canonical_hostname = canonical_hostname } _ =
+let run r (q : cgi) dbh hostid { canonical_hostname = canonical_hostname } _ =
let template = get_template dbh hostid "stats.html" in
let page = q#param "page" in
let year, week, _ = Date.to_business date in
year, week in
- template#set "year" (Int32.to_string year);
- template#set "week" (Int32.to_string week);
+ template#set "year" (string_of_int year);
+ template#set "week" (string_of_int 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: undelete_file.ml,v 1.8 2006/03/27 18:09:47 rich Exp $
+ * $Id: undelete_file.ml,v 1.9 2006/03/28 16:24:08 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
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 [Some hostid; Some id];
-
- let name = sth#fetch1string () in
+ let name = Option.get (
+ List.hd (
+ PGSQL(dbh)
+ "select name_deleted from files
+ where hostid = $hostid and id = $id"
+ )
+ ) in
(* First delete any more recent versions of this file. *)
- let sth = dbh#prepare_cached "update files
- set name_deleted = name, name = null
- where hostid = ? and name = ?" in
- sth#execute [Some hostid; Some name];
+ PGSQL(dbh) "update files
+ set name_deleted = name, name = null
+ where hostid = $hostid and name = $name";
(* Now copy the old row, changing name_deleted back to name so the file
* becomes live.
*)
- let sth = dbh#prepare_cached "insert into files
- (hostid, name, content, title, mime_type,
- upload_date)
- select hostid, name_deleted, content,
- title, mime_type, upload_date
- from files
- where hostid = ? and id = ?" in
- sth#execute [Some hostid; Some id];
+ PGSQL(dbh) "insert into files
+ (hostid, name, content, title, mime_type, upload_date)
+ select hostid, name_deleted, content,
+ title, mime_type, upload_date
+ from files
+ where hostid = $hostid and id = $id";
PGOCaml.commit dbh;
(* 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.8 2006/03/27 18:09:47 rich Exp $
+ * $Id: undelete_file_form.ml,v 1.9 2006/03/28 16:24:08 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 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 [Some hostid; Some id];
+ let rows = PGSQL(dbh)
+ "select name, name_deleted from files
+ where hostid = $hostid and id = $id" in
let name =
- match sth#fetch1 () with
- [ Some name; None]
- | [ None; Some name] -> name
- | _ -> assert false in
+ match rows with
+ | [ Some name, None]
+ | [ None, Some name] -> name
+ | _ -> assert false in
template#set "id" (Int32.to_string id);
template#set "name" name;
(* 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.8 2006/03/27 18:09:47 rich Exp $
+ * $Id: undelete_image.ml,v 1.9 2006/03/28 16:24:08 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
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 [Some hostid; Some id];
-
- let name = sth#fetch1string () in
+ let name = Option.get (
+ List.hd (
+ PGSQL(dbh) "select name_deleted from images
+ where hostid = $hostid and id = $id"
+ )
+ ) in
(* First delete any more recent versions of this image. *)
- let sth = dbh#prepare_cached "update images
- set name_deleted = name, name = null
- where hostid = ? and name = ?" in
- sth#execute [Some hostid; Some name];
+ PGSQL(dbh)
+ "update images
+ set name_deleted = name, name = null
+ where hostid = $hostid and name = $name";
(* Now copy the old row, changing name_deleted back to name so the image
* becomes live.
*)
- let sth = dbh#prepare_cached "insert into images
- (hostid, name, image, width, height,
- alt, title, longdesc, class,
- mime_type, thumbnail, tn_width,
- tn_height, tn_mime_type, upload_date)
- select hostid, name_deleted, image,
- width, height, alt, title, longdesc,
- class, mime_type, thumbnail,
- tn_width, tn_height, tn_mime_type,
- upload_date
- from images
- where hostid = ? and id = ?" in
- sth#execute [Some hostid; Some id];
+ PGSQL(dbh) "insert into images
+ (hostid, name, image, width, height,
+ alt, title, longdesc, class,
+ mime_type, thumbnail, tn_width,
+ tn_height, tn_mime_type, upload_date)
+ select hostid, name_deleted, image,
+ width, height, alt, title, longdesc,
+ class, mime_type, thumbnail,
+ tn_width, tn_height, tn_mime_type,
+ upload_date
+ from images
+ where hostid = $hostid and id = $id";
PGOCaml.commit dbh;
(* 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.8 2006/03/27 18:09:47 rich Exp $
+ * $Id: undelete_image_form.ml,v 1.9 2006/03/28 16:24:08 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 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 [Some hostid; Some id];
+ let rows = PGSQL(dbh)
+ "select name, name_deleted, width, height, alt
+ from images
+ where hostid = $hostid and id = $id" in
let name, width, height, alt =
- match sth#fetch1 () with
- [ 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
+ match rows with
+ | [ Some name, None, width, height, alt]
+ | [ None, Some name, width, height, alt] ->
+ name, width, height, alt
+ | _ -> assert false in
template#set "id" (Int32.to_string id);
template#set "name" name;
(* 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.12 2006/03/27 18:09:47 rich Exp $
+ * $Id: upload_file.ml,v 1.13 2006/03/28 16:24:08 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
* 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 [Some hostid; Some name];
-
- let exists = try sth#fetch1int () = 1 with Not_found -> false in
+ let rows = PGSQL(dbh)
+ "select 1 from files where hostid = $hostid and name = $name" in
+ let exists = rows = [Some 1l] in
if exists then (
if not replace then (
dbh hostid q "An file with the same name already exists.";
return ()
) else (
- let sth = dbh#prepare_cached "update files
- set name_deleted = name, name = null
- where hostid = ? and name = ?" in
- sth#execute [Some hostid; Some name];
+ PGSQL(dbh) "update files
+ set name_deleted = name, name = null
+ where hostid = $hostid and name = $name"
)
);
(* Put the file into the database. *)
- let sth =
- dbh#prepare_cached
- "insert into files (hostid, name, content, title, mime_type)
- values (?, ?, ?, ?, ?)" in
- sth#execute [Some hostid; Some name; `Binary file; title;
- Some mime_type];
+ PGSQL(dbh)
+ "insert into files (hostid, name, content, title, mime_type)
+ values ($hostid, $name, $file, $?title, $mime_type)";
PGOCaml.commit dbh;
(* 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.9 2006/03/27 18:09:47 rich Exp $
+ * $Id: upload_file_form.ml,v 1.10 2006/03/28 16:24:08 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
if q#param_exists "name" then q#param "name"
else if q#param_exists "id" then (
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 [Some hostid; Some id];
-
- let name = sth#fetch1string () in
+ let name = Option.get (
+ List.hd (
+ PGSQL(dbh)
+ "select coalesce (name, name_deleted) from files
+ where hostid = $hostid and id = $id"
+ )
+ ) in
name
)
else "" 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.ml,v 1.13 2006/03/27 18:09:47 rich Exp $
+ * $Id: upload_image.ml,v 1.14 2006/03/28 16:24:08 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
* 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 images
- where hostid = ? and name = ?" in
- sth#execute [Some hostid; Some name];
-
- let exists = try sth#fetch1int () = 1 with Not_found -> false in
+ let rows = PGSQL(dbh) "select 1 from images
+ where hostid = $hostid and name = $name" in
+ let exists = rows = [Some 1l] in
if exists then (
if not replace then (
dbh hostid q "An image with the same name already exists.";
return ()
) else (
- let sth = dbh#prepare_cached "update images
- set name_deleted = name, name = null
- where hostid = ? and name = ?" in
- sth#execute [Some hostid; Some name];
+ PGSQL(dbh) "update images
+ set name_deleted = name, name = null
+ where hostid = $hostid and name = $name"
)
);
(* Put the image into the database. *)
- let sth =
- dbh#prepare_cached
- "insert into images (hostid, name, image, width, height, alt,
- title, longdesc, class, thumbnail, tn_width,
- tn_height, mime_type, tn_mime_type)
- values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" in
- 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];
+ let width = Int32.of_int width in
+ let height = Int32.of_int height in
+ let tn_width = Int32.of_int tn_width in
+ let tn_height = Int32.of_int tn_height in
+ PGSQL(dbh)
+ "insert into images (hostid, name, image, width, height, alt,
+ title, longdesc, class, thumbnail, tn_width,
+ tn_height, mime_type, tn_mime_type)
+ values ($hostid, $name, $image, $width, $height, $alt, $?title,
+ $?longdesc, $?clazz, $thumbnail, $tn_width, $tn_height,
+ $mime_type, $tn_mime_type)";
PGOCaml.commit dbh;
(* 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.9 2006/03/27 18:09:47 rich Exp $
+ * $Id: upload_image_form.ml,v 1.10 2006/03/28 16:24:08 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
if q#param_exists "name" then q#param "name"
else if q#param_exists "id" then (
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 [Some hostid; Some 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
name
)
else "" in
(* 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.7 2006/03/27 18:09:47 rich Exp $
+ * $Id: user_prefs.ml,v 1.8 2006/03/28 16:24:08 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
| User (userid, _, _, _) -> userid in
(* Update the preferences fields. *)
- let sth =
- dbh#prepare_cached "update users set email_notify = ?
- where hostid = ? and id = ?" in
- sth#execute [`Bool email_notify;
- Some hostid; Some userid];
+ PGSQL(dbh)
+ "update users set email_notify = $email_notify
+ where hostid = $hostid and id = $userid";
(* Have we changed the email address? *)
let confirm_needed =
(* Set the email field in the database to null. No need for
* any confirmation.
*)
- let sth = dbh#prepare_cached "update users set email = null
- where hostid = ? and id = ?" in
- sth#execute [Some hostid; Some userid];
+ PGSQL(dbh) "update users set email = null
+ where hostid = $hostid and id = $userid";
false
) else (
(* Is the new email address different from the one currently recorded
* in the database?
*)
- let sth = dbh#prepare_cached "select ? <> coalesce (email, '')
- from users where hostid = ? and id = ?" in
- sth#execute [Some new_email; Some hostid; Some userid];
-
- let changed =
- match sth#fetch1 () with [ `Bool b ] -> b | _ -> assert false in
+ let changed = Option.get (
+ List.hd (
+ PGSQL(dbh) "select $new_email <> coalesce (email, '')
+ from users where hostid = $hostid and id = $userid"
+ )
+ ) in
if changed then (
let key = random_sessionid () 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 [Some key; Some userid; Some new_email];
+ PGSQL(dbh) "insert into pending_email_changes
+ (key, userid, email)
+ values ($key, $userid, $new_email)";
(* Send the confirm email. *)
email_change_template#set "hostname" hostname;
) in
(* Good place to remove old rows in the pending_email_changes table. *)
- let sth = dbh#prepare_cached "delete from pending_email_changes
- where change_date - current_date > 7" in
- sth#execute [];
+ PGSQL(dbh) "delete from pending_email_changes
+ where change_date - current_date > 7";
(* Commit and finish off. *)
PGOCaml.commit dbh;
(* 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.4 2006/03/27 18:09:47 rich Exp $
+ * $Id: user_prefs_form.ml,v 1.5 2006/03/28 16:24:08 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 can_edit = can_edit host user in
(* Pull out the registration date - not stored in the user object. *)
- let sth =
- dbh#prepare_cached
- "select registration_date from users where hostid = ? and id = ?" in
- sth#execute [Some hostid; Some userid];
-
- let registration_date =
- match sth#fetch1 () with
- [ `Date registration_date ] -> registration_date
- | _ -> assert false in
+ let registration_date = List.hd (
+ PGSQL(dbh)
+ "select registration_date from users
+ where hostid = $hostid and id = $userid"
+ ) in
let email, has_email =
match prefs.email 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.9 2006/03/27 18:09:47 rich Exp $
+ * $Id: users.ml,v 1.10 2006/03/28 16:24:08 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 run r (q : cgi) dbh hostid _ _ =
let template = get_template dbh hostid "users.html" in
- let sth =
- dbh#prepare_cached
+ let rows =
+ PGSQL(dbh)
"select id, name, email, registration_date, invite is not null,
can_edit, can_manage_users,
can_manage_contacts, can_manage_site, can_edit_global_css,
can_import_mail
- from users where hostid = ? order by name" in
- sth#execute [Some hostid];
+ from users where hostid = $hostid order by name" in
let table =
- sth#map
- (function
- [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 None -> "" | Some s -> s in
- [ "userid", Template.VarString (Int32.to_string userid);
- "name", Template.VarString name;
- "email", Template.VarString email;
- "registration_date",
- Template.VarString (printable_date' registration_date);
- "invite_pending",
- Template.VarConditional invite_pending;
- "can_edit", Template.VarConditional can_edit;
- "can_manage_users", Template.VarConditional can_manage_users;
- "can_manage_contacts",
- Template.VarConditional can_manage_contacts;
- "can_manage_site", Template.VarConditional can_manage_site;
- "can_edit_global_css",
- Template.VarConditional can_edit_global_css;
- "can_import_mail",
- Template.VarConditional can_import_mail;]
- | _ -> assert false) in
+ List.map
+ (fun (userid, name, email, registration_date, invite_pending,
+ can_edit, can_manage_users, can_manage_contacts, can_manage_site,
+ can_edit_global_css, can_import_mail) ->
+ let email = match email with None -> "" | Some s -> s in
+ let invite_pending = Option.get invite_pending in
+ [ "userid", Template.VarString (Int32.to_string userid);
+ "name", Template.VarString name;
+ "email", Template.VarString email;
+ "registration_date",
+ Template.VarString (printable_date' registration_date);
+ "invite_pending",
+ Template.VarConditional invite_pending;
+ "can_edit", Template.VarConditional can_edit;
+ "can_manage_users", Template.VarConditional can_manage_users;
+ "can_manage_contacts",
+ Template.VarConditional can_manage_contacts;
+ "can_manage_site", Template.VarConditional can_manage_site;
+ "can_edit_global_css",
+ Template.VarConditional can_edit_global_css;
+ "can_import_mail",
+ Template.VarConditional can_import_mail;]
+ ) rows in
template#table "users" table;
(* 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.5 2006/03/27 18:09:47 rich Exp $
+ * $Id: what_links_here.ml,v 1.6 2006/03/28 16:24:08 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 page = q#param "page" in
template#set "page" page;
- let sth = dbh#prepare_cached "select title from pages
- where hostid = ? and url = ?" in
- sth#execute [Some hostid; Some page];
-
- let title = sth#fetch1string () in
+ let title = List.hd (
+ PGSQL(dbh) "select title from pages
+ where hostid = $hostid and url = $page"
+ ) in
template#set "title" title;
let pages = what_links_here dbh hostid page in
(* Is the page in the site menu? If so, then every other page
* links here, so we should say so.
*)
- let sth = dbh#prepare_cached "select 1 from sitemenu
- where hostid = ? and url = ?" in
- sth#execute [Some hostid; Some page];
+ let rows = PGSQL(dbh)
+ "select 1 from sitemenu where hostid = $hostid and url = $page" in
- let in_sitemenu = try sth#fetch1int () = 1 with Not_found -> false in
+ let in_sitemenu = rows = [Some 1l] in
template#conditional "in_sitemenu" in_sitemenu;
q#template template
<span class="date">::last_modified_date_html::</span>
(<a href="/::url_html_tag::/diff?version=::version::">diff</a>)
(<a href="/::url_html_tag::/history">history</a>)
-::if(is_live)::<a href="/::url_html_tag::">::title_html::</a>
(live)::else::<a href="/::url_html_tag::?version=::version::">::title_html::</a>::end::
+::if(is_live)::<a href="/::url_html_tag::">::title_html::</a>
<strong>(live)</strong>::else::<a href="/::url_html_tag::?version=::version::">::title_html::</a>::end::
::if(has_logged_user)::(by ::logged_user_html::)::else::
::if(has_logged_ip)::(from ::logged_ip_html::)::end::
::end::
git.annexia.org / cocanwiki.git / commitdiff