(* 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.8 2006/03/27 18:09:46 rich Exp $
+ * $Id: images.ml,v 1.9 2006/03/28 13:20:00 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 deleted = q#param_true "deleted" in
template#conditional "deleted" deleted;
- let sql =
- "select id, name, name_deleted, width, height, alt, octet_length (image),
- tn_width, tn_height
+ let rows =
+ if not deleted then
+ PGSQL(dbh)
+ "select id, name, name_deleted, width, height, alt,
+ octet_length (image), tn_width, tn_height
from images
- where hostid = ? and " ^
- (if not deleted then "name is not null"
- else "name_deleted is not null") ^
- " order by 2, 3" in
- let sth = dbh#prepare_cached sql in
- sth#execute [Some hostid];
+ where hostid = $hostid and name is not null
+ order by 2, 3"
+ else
+ PGSQL(dbh)
+ "select id, name, name_deleted, width, height, alt,
+ octet_length (image), tn_width, tn_height
+ from images
+ where hostid = $hostid and name_deleted is not null
+ order by 2, 3" in
let table =
sth#map
let id, name, width, height, alt, size, tn_width, tn_height,
is_deleted, has_thumbnail =
match row with
- | [Some id; Some name; None; Some width; Some height;
- Some alt; Some size; Some tn_width; Some tn_height] ->
+ | [id, Some name, None, width, height,
+ alt, Some size, tn_width, tn_height] ->
id, name, width, height, alt, size, tn_width, tn_height,
false, true
- | [Some id; None; Some name; Some width; Some height;
- Some alt; Some size; Some tn_width; Some tn_height] ->
+ | [id, None, Some name, width, height,
+ alt, Some size, tn_width, tn_height] ->
id, name, width, height, alt, size, tn_width, tn_height,
true, true
- | [Some id; Some name; None; Some width; Some height;
- Some alt; Some size; None; None] ->
+ | [id, Some name, None, width, height,
+ alt, Some size, None, None] ->
id, name, width, height, alt, size, 0, 0,
false, false
- | [Some id; None; Some name; Some width; Some height;
- Some alt; Some size; None; None] ->
+ | [id, None, Some name, width, height,
+ alt, Some size, None, None] ->
id, name, width, height, alt, size, 0, 0,
true, false
| _ -> assert false in
+ let size = Int32.to_int size in
[ "id", Template.VarString (Int32.to_string id);
"name", Template.VarString name;
"width", Template.VarString (Int32.to_string width);
"height", Template.VarString (Int32.to_string height);
"alt", Template.VarString alt;
- "ksize", Template.VarString (Int32.to_string (size / 1024));
+ "ksize", Template.VarString (string_of_int (size / 1024));
"tn_width", Template.VarString (Int32.to_string tn_width);
"tn_height", Template.VarString (Int32.to_string tn_height);
"is_deleted", Template.VarConditional is_deleted;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: invite_user.ml,v 1.6 2006/03/27 18:09:46 rich Exp $
+ * $Id: invite_user.ml,v 1.7 2006/03/28 13:20:00 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
*)
List.iter
(fun email ->
- let sth = dbh#prepare_cached "select id, invite from users
- where hostid = ? and
- (email = ? or name = ?)" in
- sth#execute [Some hostid; Some email; Some email];
+ let rows = PGSQL(dbh) "select id, invite from users
+ where hostid = $hostid and
+ (email = $email or name = $email)" in
let body =
- try
- (match sth#fetch1 () with
- [ Some userid; None ] ->
- (* Existing user account - send reminder. *)
- template_exists#set "username" username;
- template_exists#set "hostname" hostname;
- template_exists#to_string
-
- | [ Some userid; Some invite ] ->
- (* Existing user account - resend the invite. *)
- template#set "username" username;
- template#set "hostname" hostname;
- template#set "invite" invite;
- template#to_string
-
- | _ -> assert false)
- with
- Not_found ->
- (* Add user account. *)
- let invite = random_sessionid () in
- let sth = dbh#prepare_cached "insert into users (hostid, name,
- password, email, invite) values (?, ?, ?, ?, ?)" in
- sth#execute [Some hostid; Some email; Some invite;
- Some email; Some invite];
-
- template#set "username" username;
- template#set "hostname" hostname;
- template#set "invite" invite;
- template#to_string in
+ match rows with
+ | [ userid, None ] ->
+ (* Existing user account - send reminder. *)
+ template_exists#set "username" username;
+ template_exists#set "hostname" hostname;
+ template_exists#to_string
+
+ | [ userid, Some invite ] ->
+ (* Existing user account - resend the invite. *)
+ template#set "username" username;
+ template#set "hostname" hostname;
+ template#set "invite" invite;
+ template#to_string
+
+ | [] ->
+ (* Add user account. *)
+ let invite = random_sessionid () in
+ PGSQL(dbh)
+ "insert into users (hostid, name,
+ password, email, invite) values ($hostid, $email, $invite,
+ $email, $invite)";
+
+ template#set "username" username;
+ template#set "hostname" hostname;
+ template#set "invite" invite;
+ template#to_string
+
+ | _ -> assert false in
(* Send the email. *)
Sendmail.send_mail ~subject ~to_addr:[email] ~from body
(* 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.5 2006/03/27 18:09:46 rich Exp $
+ * $Id: invite_user_confirm.ml,v 1.6 2006/03/28 13:20:00 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 invite = q#param "invite" in
(* Verify the username, invite combination. *)
- let sth = dbh#prepare_cached "select email, id from users
- where hostid = ? and
- name = ? and invite = ?" in
- sth#execute [Some hostid; Some username; Some invite];
+ let rows = PGSQL(dbh) "select email, id from users
+ where hostid = $hostid and
+ name = $username and invite = $invite" in
let email, userid =
- try
- match sth#fetch1 () with
- [ Some email; Some userid ] -> Some email, userid
- | [ None; Some userid ] -> None, userid
- | _ -> assert false
- with Not_found ->
- error ~title:"Already signed up"
- dbh hostid q "It looks like you have already used your invitation.";
- return () in
+ match rows with
+ | [ 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.";
+ return ()
+ | _ -> assert false in
let password1 = q#param "password1" in
let password2 = q#param "password2" in
let password = password1 in
(* Change the password. *)
- let sth =
- dbh#prepare_cached
- "update users set password = ?, invite = null,
- force_password_change = false
- where hostid = ? and id = ?" in
- sth#execute [Some password; Some hostid; Some userid];
+ PGSQL(dbh)
+ "update users set password = $password, invite = null,
+ force_password_change = false
+ where hostid = $hostid and id = $userid";
(* Send email to this user. *)
(match email with
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: invite_user_confirm_form.ml,v 1.4 2006/03/27 18:09:46 rich Exp $
+ * $Id: invite_user_confirm_form.ml,v 1.5 2006/03/28 13:20:00 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 invite ID. *)
let invite = q#param "p" in
- let sth = dbh#prepare_cached "select name from users
- where hostid = ? and invite = ?" in
- sth#execute [Some hostid; Some invite];
+ let rows = PGSQL(dbh) "select name from users
+ where hostid = $hostid and invite = $invite" in
let username =
- try sth#fetch1string ()
- with
- Not_found ->
- error ~title:"Already signed up"
- dbh hostid q
- ("It looks like you have already used your invitation. If " ^
+ match rows with
+ | [username] -> username
+ | [] ->
+ error ~title:"Already signed up"
+ dbh hostid q
+ ("It looks like you have already used your invitation. If " ^
"you cannot get to your account, please contact the " ^
"administrator.");
- return () in
+ return ()
+ | _ -> assert false in
(* Update the template so that the user can set their preferred password. *)
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: largest_pages.ml,v 1.4 2006/03/27 18:09:46 rich Exp $
+ * $Id: largest_pages.ml,v 1.5 2006/03/28 13:20:00 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
* approximation of the final size of the page. Also, we are not taking
* into account images.
*)
- let sth =
- dbh#prepare_cached
+ let rows =
+ PGSQL(dbh)
"select p.id, p.url, p.title, sum (length (c.content))
from pages p, contents c
- where p.hostid = ? and p.url is not null and p.redirect is null
+ where p.hostid = $hostid and p.url is not null and p.redirect is null
and c.pageid = p.id group by 1, 2, 3 order by 4 desc" in
- sth#execute [Some hostid];
let table =
- sth#map
- (function [Some pageid; Some page; Some title; Some size] ->
+ 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"
"title", Template.VarString title;
"size", Template.VarString size;
"download_time", Template.VarString download_time ]
- | _ -> assert false) in
+ | _ -> assert false) 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: links.ml,v 1.3 2006/03/27 18:09:46 rich Exp $
+ * $Id: links.ml,v 1.4 2006/03/28 13:20:00 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
) else if type_ = "outbound" then (
(* Display a list of links outbound from this page. *)
- let sth =
- dbh#prepare_cached "select to_url from links
- where hostid = ? and from_url = ?" in
-
- sth#execute [Some hostid; Some page];
+ let rows =
+ PGSQL(dbh)
+ "select to_url from links
+ where hostid = $hostid and from_url = $page" in
q#header ~content_type:"text/plain" ();
- sth#iter (function [Some url] -> ignore (print_endline r url)
- | _ -> assert false)
+ List.iter (fun url -> ignore (print_endline r url))
) else
failwith "'type' parameter should be 'inbound' or 'outbound'"
(* Just return the single-row "links database" relating to this
* page.
*)
- let sth = dbh#prepare_cached "select to_url from links
- where hostid = ? and from_url = ?" in
- sth#execute [Some hostid; Some page];
+ let rows = PGSQL(dbh)
+ "select to_url from links
+ where hostid = $hostid and from_url = $page" in
let table =
- sth#map (function [Some to_url] ->
- [ "to", Template.VarString to_url ]
- | _ -> assert false) in
+ List.map (fun to_url ->
+ [ "to", Template.VarString to_url ]) rows in
let table =
[ [ "from", Template.VarString page;
"to", Template.VarTable table ] ] in
Hashtbl.replace h from_url xs
in
- let sth = dbh#prepare_cached "select from_url, to_url from links
- where hostid = ?" in
- sth#execute [Some hostid];
+ let rows = PGSQL(dbh) "select from_url, to_url from links
+ where hostid = $hostid" in
- sth#iter (function [Some from_url; Some to_url] ->
- add_link from_url to_url
- | _ -> assert false);
+ sth#iter (fun (from_url, to_url) ->
+ add_link from_url to_url) rows;
(* Don't forget redirects! They're kinda like links ... *)
- let sth = dbh#prepare_cached "select url, redirect from pages
- where hostid = ? and url is not null
- and redirect is not null" in
- sth#execute [Some hostid];
-
- sth#iter (function [Some url; Some redirect] ->
- add_link url redirect
- | _ -> assert false);
+ 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;
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.9 2006/03/27 18:09:46 rich Exp $
+ * $Id: login.ml,v 1.10 2006/03/28 13:20:00 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 permanent = try "1" = q#param "permanent" with Not_found -> false in
let redirect = try q#param "redirect" with Not_found -> "/" in
- let sth = dbh#prepare_cached "select id, force_password_change from users
- where name = ? and password = ?
- and hostid = ?" in
- sth#execute [Some username; Some password; Some hostid];
+ let rows = PGSQL(dbh)
+ "select id, force_password_change from users
+ where name = $username and password = $password and hostid = $hostid" in
- try
- let userid, force_password_change =
- match sth#fetch1 () with
- [ Some userid; `Bool force_password_change ] ->
- userid, force_password_change
- | _ -> assert false in
+ let userid, force_password_change =
+ match rows with
+ | [] ->
+ error
+ ~title:"Bad name or password"
+ ~back_button:true
+ dbh hostid q "The name or password was wrong."
+ | [ row ] -> row
+ | _ -> assert false 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];
+ (* Create a cookie. *)
+ let cookie = random_sessionid () in
+ PGSQL(dbh) "insert into usercookies (userid, cookie)
+ values ($userid, $cookie)";
- PGOCaml.commit dbh;
+ PGOCaml.commit dbh;
- (* Force password change? *)
- let redirect =
- if force_password_change then "/_bin/change_password_form.cmo"
- else redirect in
+ (* Force password change? *)
+ let redirect =
+ if force_password_change then "/_bin/change_password_form.cmo"
+ else redirect in
- let cookie =
- if permanent then
- Cookie.cookie "auth" cookie ~path:"/" ~expires
- else
- Cookie.cookie "auth" cookie ~path:"/" in
+ let cookie =
+ if permanent then
+ Cookie.cookie "auth" cookie ~path:"/" ~expires
+ else
+ Cookie.cookie "auth" cookie ~path:"/" in
- let ok_button = ok_button redirect in
- let buttons =
- if redirect <> "/" && redirect <> "/index" then (
- ok_button ::
- [ { Template.StdPages.label = " Home Page ";
- Template.StdPages.link = "/";
- Template.StdPages.method_ = None;
- Template.StdPages.params = [] } ]
- ) else [ ok_button ] in
+ let ok_button = ok_button redirect in
+ let buttons =
+ if redirect <> "/" && redirect <> "/index" then (
+ ok_button ::
+ [ { Template.StdPages.label = " Home Page ";
+ Template.StdPages.link = "/";
+ Template.StdPages.method_ = None;
+ Template.StdPages.params = [] } ]
+ ) else [ ok_button ] in
- ok ~title:"Logged in" ~buttons ~cookie
- dbh hostid q
- ("Welcome " ^ username ^ "." ^
- if force_password_change then " Please change your password now."
- else "")
- with
- Not_found ->
- error
- ~title:"Bad name or password"
- ~back_button:true
- dbh hostid q "The name or password was wrong."
+ ok ~title:"Logged in" ~buttons ~cookie
+ dbh hostid q
+ ("Welcome " ^ username ^ "." ^
+ if force_password_change then " Please change your password now."
+ else "")
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: login_form.ml,v 1.6 2006/03/27 18:09:46 rich Exp $
+ * $Id: login_form.ml,v 1.7 2006/03/28 13:20:00 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 username = try q#param "username" with Not_found -> "" in
template#set "username" username;
- 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 b ] -> b
- | _ -> assert false in
+ List.hd (
+ PGSQL(dbh) "select create_account_anon from hosts
+ where id = $hostid"
+ ) in
template#conditional "create_account_anon" create_account_anon;
(* 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.7 2006/03/27 18:09:46 rich Exp $
+ * $Id: logout.ml,v 1.8 2006/03/28 13:20:00 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, _, _, _) ->
- let sth = dbh#prepare_cached "delete from usercookies
- where userid = ?" in
- sth#execute [Some userid];
-
+ PGSQL(dbh) "delete from usercookies where userid = $userid" in
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.10 2006/03/27 18:09:46 rich Exp $
+ * $Id: mail_import.ml,v 1.11 2006/03/28 13:20:00 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 Char.code c < 32 then ' ' else c) subject in
(* Parse the date field. *)
- let date, time =
+ let message_date =
try
let date = Netdate.parse date in
- let date, time =
- { Dbi.year = date.Netdate.year;
- Dbi.month = date.Netdate.month;
- Dbi.day = date.Netdate.day; },
- { Dbi.hour = date.Netdate.hour;
- Dbi.min = date.Netdate.minute;
- Dbi.sec = date.Netdate.second;
- Dbi.microsec = 0;
- Dbi.timezone = Some (date.Netdate.zone / 60); } in
- date, time
+ let cal = Calendar.make
+ date.Netdate.year
+ date.Netdate.month
+ date.Netdate.day
+ date.Netdate.hour
+ date.Netdate.minute
+ date.Netdate.second in
+ let tz = Time_Zone.UTC_Plus (date.Netdate.zone / 60) in
+ cal, tz
with
- Invalid_argument _ ->
- failwith ("cannot parse date: " ^ date) in
+ Invalid_argument _ ->
+ failwith ("cannot parse date: " ^ date) in
(* Find the first thing in the In-Reply-To field which looks like a
* message ID.
* else 'None' if this is a never-seen-before message.
*)
let overwrite =
- let sth = dbh#prepare_cached "select id from messages
- where hostid = ? and inet_message_id = ?" in
- sth#execute [Some hostid; Some inet_message_id];
- try
- let id = sth#fetch1int () in
- if not overwrite then (
- ok ~title:"Message exists"
- dbh hostid q "Message already imported";
- return ()
- );
- Some id
- with
- Not_found -> None in
+ let rows = PGSQL(dbh)
+ "select id from messages
+ where hostid = $hostid and inet_message_id = $inet_message_id" in
+ match rows with
+ | [id] ->
+ if not overwrite then (
+ ok ~title:"Message exists"
+ dbh hostid q "Message already imported";
+ return ()
+ );
+ Some id
+ | [] -> None
+ | _ -> assert false in
(* Save all of this in the database. *)
let msgid =
match overwrite with
None -> (* Never-seen-before message. *)
- let sth =
- dbh#prepare_cached
- "insert into messages (hostid, subject, inet_message_id,
- message_date) values (?, ?, ?, ?)" in
- sth#execute [Some hostid; Some subject; Some inet_message_id;
- `Timestamp (date, time)];
- let msgid = Int64.to_int (sth#serial "messages_id_seq") in
-
- let sth =
- dbh#prepare_cached
- "insert into msg_references (message_id, inet_message_id,
- ordering) values (?, ?, ?)" in
+ PGSQL(dbh)
+ "insert into messages (hostid, subject, inet_message_id,
+ message_date)
+ values ($hostid, $subject, $inet_message_id, $message_date)";
+ let msgid = PGOCaml.serial4 dbh "messages_id_seq" in
+
let ordering = ref 0 in
List.iter (fun inet_message_id ->
- incr ordering; let ordering = !ordering in
- sth#execute [Some msgid; Some inet_message_id;
- Some ordering]) references;
+ incr ordering; let ordering = Int32.of_int !ordering in
+ PGSQL(dbh)
+ "insert into msg_references (message_id,
+ inet_message_id, ordering)
+ values ($msgid, $inet_message_id, $ordering)"
+ ) references;
msgid
(* Get all the titles from the database! We're going to exclude
* mail messages from this.
*)
- let sth =
- dbh#prepare_cached
- "select lower (title) from pages where hostid = ?
+ let links =
+ PGSQL(dbh)
+ "select lower (title) from pages where hostid = $hostid
and url is not null and title not like 'Mail/%'" in
- sth#execute [Some hostid];
- let links = sth#map (function [Some s] -> s | _ -> assert false) in
+ let links = List.map Option.get links in
(* This code cannot find titles which are split across multiple lines.
* XXX
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: mailing_list_confirm.ml,v 1.5 2006/03/27 18:09:46 rich Exp $
+ * $Id: mailing_list_confirm.ml,v 1.6 2006/03/28 13:20:00 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 email from mailing_lists
- where hostid = ? and pending = ?" in
- sth#execute [Some hostid; Some pending];
+ let rows = PGSQL(dbh) "select email from mailing_lists
+ where hostid = $hostid and pending = $pending" in
let email =
- try
- sth#fetch1string ()
- 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
+ | [email] -> email
+ | [] ->
+ 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 mailing_lists set pending = null
- where hostid = ? and pending = ?" in
- sth#execute [Some hostid; Some pending];
+ PGSQL(dbh) "update mailing_lists 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: mailing_list_send.ml,v 1.7 2006/03/27 18:09:46 rich Exp $
+ * $Id: mailing_list_send.ml,v 1.8 2006/03/28 13:20:00 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 mailing_lists
- where pending is not null
- and entry_date < current_date - 7" in
- sth#execute [];
+ PGSQL(dbh) "delete from mailing_lists
+ where pending is not null
+ and entry_date < current_date - 7";
PGOCaml.commit dbh;
+ PGOCaml.begin_work dbh; (* We do some more writes below. *)
(* Is that email address already registered in the database? *)
- let sth = dbh#prepare_cached "select 1 from mailing_lists where hostid = ?
- and email = ?" in
- sth#execute [Some hostid; Some email];
-
- let registered = try sth#fetch1int () = 1 with Not_found -> false in
+ let rows = PGSQL(dbh)
+ "select 1 from mailing_lists where hostid = $hostid and email = $email" 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 mailing_lists (hostid, email, name,
- pending, opt_out) values (?, ?, ?, ?, ?)" in
- sth#execute [Some hostid; Some email; Some name;
- Some pending; Some opt_out];
+ PGSQL(dbh) "insert into mailing_lists (hostid, email, name,
+ pending, opt_out)
+ values ($hostid, $email, $name, $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: mailing_list_unsubscribe.ml,v 1.3 2006/03/27 18:09:46 rich Exp $
+ * $Id: mailing_list_unsubscribe.ml,v 1.4 2006/03/28 13:20:00 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 mailing_lists
- where hostid = ? and opt_out = ?" in
- sth#execute [Some hostid; Some opt_out];
+ PGSQL(dbh) "delete from mailing_lists
+ 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: mailing_list_view.ml,v 1.3 2006/03/27 18:09:46 rich Exp $
+ * $Id: mailing_list_view.ml,v 1.4 2006/03/28 13:20:00 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
else "text/html", template in
(* Get the mailing list. *)
- let sth = dbh#prepare_cached "select email, name, entry_date
- from mailing_lists
- where hostid = ? and pending is null
- order by 1" in
- sth#execute [Some hostid];
+ let rows = PGSQL(dbh) "select email, name, entry_date
+ from mailing_lists
+ where hostid = $hostid and pending is null
+ order by 1" in
let table =
- sth#map (function [Some email; Some name; `Date entry_date] ->
- let entry_date = printable_date' entry_date in
- [ "email", Template.VarString email;
- "name", Template.VarString name;
- "entry_date", Template.VarString entry_date ]
- | _ -> assert false) in
+ List.map (
+ fun (email, name, entry_date) ->
+ let entry_date = printable_date' entry_date in
+ [ "email", Template.VarString email;
+ "name", Template.VarString name;
+ "entry_date", Template.VarString entry_date ]
+ ) rows in
template#table "emails" table;
(* 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.3 2006/03/27 18:09:46 rich Exp $
+ * $Id: orphans.ml,v 1.4 2006/03/28 13:20:00 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
(* Start with the front page, the contents of the site menu and the
* special "copyright" page.
*)
- let sth = dbh#prepare_cached "select url from sitemenu where hostid = ?" in
- sth#execute [Some hostid];
-
- let start_pages = sth#map (function [Some s] -> s | _ -> assert false) in
+ let start_pages =
+ PGSQL(dbh) "select url from sitemenu where hostid = $hostid" in
let start_pages = "index" :: "copyright" :: start_pages in
(* The find the list of orphans, we first construct the list of
* pages @ border is a list of distinct pages
*)
let pages' = pages @ border in
- let qs = Dbi.placeholders (List.length border) in
- let qs' = Dbi.placeholders (List.length pages') in
- let sth =
- dbh#prepare_cached ("select distinct to_url from links
- where hostid = ? and from_url in " ^ qs ^ "
- and to_url not in " ^ qs') in
- sth#execute (Some hostid ::
- (List.map (fun s -> Some s) border) @
- (List.map (fun s -> Some s) pages'));
- let border' = sth#map (function [Some s] -> s | _ -> assert false) in
-
+ 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
if border' = [] then pages'
else loop pages' border'
in
let non_orphans = loop [] start_pages in
(* Get the actual orphans, which are pages which do not appear in this list*)
- let qs = Dbi.placeholders (List.length non_orphans) in
- let sth = dbh#prepare_cached ("select url, title from pages
- where hostid = ?
- and url is not null
- and redirect is null
- and url not in " ^ qs ^ "
- order by 1") in
- sth#execute (Some hostid :: (List.map (fun s -> Some s) non_orphans));
+ let rows = PGSQL(dbh)
+ "select url, title from pages
+ where hostid = $hostid
+ and url is not null and redirect is null
+ and url not in $@non_orphans
+ order by 1" in
let table =
- sth#map (function [Some page; Some title] ->
+ List.map (fun (page, title) ->
[ "page", Template.VarString page;
- "title", Template.VarString title ]
- | _ -> assert false) in
+ "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.43 2006/03/27 18:09:46 rich Exp $
+ * $Id: page.ml,v 1.44 2006/03/28 13:20:00 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_404 = get_template dbh hostid "page_404.html" in
(* Host-specific fields. *)
- let sth = dbh#prepare_cached "select css is not null,
- feedback_email is not null,
- mailing_list, navigation
- from hosts where id = ?" in
- sth#execute [Some hostid];
+ let rows = PGSQL(dbh)
+ "select css is not null, feedback_email is not null, mailing_list, navigation
+ from hosts where id = $hostid" in
let has_host_css, has_feedback_email, mailing_list, navigation =
- match sth#fetch1 () with
- | [ `Bool has_host_css; `Bool has_feedback_email; `Bool mailing_list;
- `Bool navigation ] ->
+ match rows with
+ | [Some has_host_css, Some has_feedback_email,
+ mailing_list, navigation] ->
has_host_css, has_feedback_email, mailing_list, navigation
| _ -> assert false in
(* Check the templates table for extensions. *)
let get_extension url =
- let sth = dbh#prepare_cached "select extension from templates
- where ? ~ url_regexp
- order by ordering
- limit 1" in
- sth#execute [Some url];
-
try
- let name = sth#fetch1string () in
+ let name =
+ List.hd (
+ PGSQL(dbh) "select extension from templates
+ where $url ~ url_regexp
+ order by ordering
+ limit 1"
+ ) in
Some (List.assoc name !extensions)
with
- Not_found -> None
+ Not_found | ExtList.List.Empty_list -> None
in
(* This code generates ordinary pages. *)
match pageid with
None -> []
| Some pageid ->
- let sth = dbh#prepare_cached
- "select ordering, sectionname, content, divname
- from contents where pageid = ? order by ordering" in
- sth#execute [Some pageid];
-
- sth#map
- (function [Some ordering;
- (None | Some _) as sectionname;
- Some content;
- (None | Some _) as divname] ->
+ let rows = PGSQL(dbh)
+ "select ordering, sectionname, content, divname
+ from contents where pageid = $pageid order by ordering" in
+
+ List.map
+ (fun (ordering, sectionname, content, divname) ->
let divname, has_divname =
match divname with
- None -> "", false
- | Some divname -> divname, true in
+ | None -> "", false
+ | Some divname -> divname, true in
let sectionname, has_sectionname =
match sectionname with
- None -> "", false
- | Some sectionname -> sectionname, true in
+ | None -> "", false
+ | Some sectionname -> sectionname, true in
let linkname = linkname_of_sectionname sectionname in
[ "ordering", Template.VarString (Int32.to_string ordering);
"has_sectionname",
Template.VarString
(Wikilib.xhtml_of_content dbh hostid content);
"has_divname", Template.VarConditional has_divname;
- "divname", Template.VarString divname ]
- | _ -> assert false) in
+ "divname", Template.VarString divname ]) rows in
(* Call an extension to generate the first section in this page? *)
let sections =
if pageid <> None then (
match user with
| User (userid, _, _, _) ->
- let sth = dbh#prepare_cached "delete from recently_visited
- where hostid = ? and userid = ?
- and url = ?" in
- sth#execute [Some hostid; Some userid; Some page'];
- let sth = dbh#prepare_cached
- "insert into recently_visited (hostid, userid, url)
- values (?, ?, ?)" in
- sth#execute [Some hostid; Some userid; Some page'];
- PGOCaml.commit dbh
+ PGSQL(dbh)
+ "delete from recently_visited
+ where hostid = $hostid and userid = $userid and url = $page'";
+ PGSQL(dbh)
+ "insert into recently_visited (hostid, userid, url)
+ values ($hostid, $userid, $page')";
+ PGOCaml.commit dbh;
+ PGOCaml.begin_work dbh;
| _ -> ()
);
* links here' section, and don't link to self.
*)
let not_urls = page' :: wlh_urls in
- let limit = max_links - List.length wlh_urls in
- let qs = Dbi.placeholders (List.length not_urls) 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.url not in " ^ qs ^ "
- and rv.hostid = p.hostid and rv.url = p.url
- order by 3 desc
- limit ?") in
- let args = List.map (fun s -> Some s) not_urls in
- sth#execute
- ([Some hostid; Some userid] @ args @ [Some limit]);
- sth#map
- (function [Some url; Some title; _] ->
- url, title
- | _ -> assert false)
+ let limit = Int32.of_int (max_links - List.length wlh_urls) 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.url not in $@not_urls
+ and rv.hostid = p.hostid and rv.url = p.url
+ order by 3 desc
+ limit $limit" in
+ List.map (
+ fun (url, title, _) -> url, title
+ ) rows
| _ -> [] in
(* Links to page. *)
match version with
| None ->
if allow_redirect then (
- let sth =
- dbh#prepare_cached
- "select url, redirect, id, title, description,
- last_modified_date, css is not null
- from pages where hostid = ? and lower (url) = lower (?)" in
- sth#execute [Some hostid; Some page];
- (try
- (match sth#fetch1 () with
- | Some page' :: _ when page <> page' -> (* different case *)
- FPExternalRedirect page'
- | [ _; None; Some id; Some title; Some description;
- `Timestamp last_modified_date; `Bool has_page_css ] ->
- FPOK (id, title, description, last_modified_date,
- has_page_css)
- | _ :: Some redirect :: _ ->
- FPInternalRedirect redirect
- | xs -> failwith (Dbi.sdebug xs))
- with
- Not_found -> FPNotFound)
+ let rows = PGSQL(dbh)
+ "select url, redirect, id, title, description,
+ last_modified_date, css is not null
+ from pages
+ where hostid = $hostid and lower (url) = lower ($page)" in
+ match rows with
+ | [page', _, _, _, _, _, _]
+ when page <> page' -> (* different case *)
+ FPExternalRedirect page'
+ | [ _, None, id, title, description,
+ last_modified_date, has_page_css ] ->
+ let has_page_css = Option.get has_page_css in
+ FPOK (id, title, description, last_modified_date,
+ has_page_css)
+ | [_, Some redirect, _, _, _, _, _] ->
+ FPInternalRedirect redirect
+ | [] -> FPNotFound
+ | _ -> assert false
) else (* redirects not allowed ... *) (
- let sth =
- dbh#prepare_cached
- "select id, title, description, last_modified_date,
- css is not null
- from pages where hostid = ? and url = ?" in
- sth#execute [Some hostid; Some page];
- (try
- (match sth#fetch1 () with
- | [ Some id; Some title; Some description;
- `Timestamp last_modified_date; `Bool has_page_css ] ->
- FPOK (id, title, description, last_modified_date,
- has_page_css)
- | xs -> failwith (Dbi.sdebug xs))
- with
- Not_found -> FPNotFound)
+ let rows = PGSQL(dbh)
+ "select id, title, description, last_modified_date,
+ css is not null
+ from pages where hostid = $hostid and url = $page" in
+ match rows with
+ | [ id, title, description,
+ last_modified_date, has_page_css ] ->
+ let has_page_css = Option.get has_page_css in
+ FPOK (id, title, description, last_modified_date,
+ has_page_css)
+ | [] -> FPNotFound
+ | _ -> assert false
)
| Some version ->
- let sth =
- dbh#prepare_cached
- "select id, title, description, last_modified_date,
- css is not null
- from pages
- where hostid = ? and id = ? and
- (url = ? or url_deleted = ?)" in
- sth#execute [Some hostid; Some version;
- Some page; Some page];
- (try
- (match sth#fetch1 () with
- | [ Some id; Some title; Some description;
- `Timestamp last_modified_date; `Bool has_page_css ] ->
- FPOK (id, title, description, last_modified_date,
- has_page_css)
- | xs -> failwith (Dbi.sdebug xs))
- with
- Not_found -> FPNotFound)
+ let rows = PGSQL(dbh)
+ "select id, title, description, last_modified_date,
+ css is not null
+ from pages
+ where hostid = $hostid and id = $version and
+ (url = $page or url_deleted = $page)" in
+ match rows with
+ | [ id, title, description,
+ last_modified_date, has_page_css ] ->
+ let has_page_css = Option.get has_page_css in
+ FPOK (id, title, description, last_modified_date,
+ has_page_css)
+ | [] -> FPNotFound
+ | _ -> assert false
in
(* Here we deal with the complex business of redirects and versions. *)
git.annexia.org / cocanwiki.git / commitdiff