From c912392e889fc28c6444b7e38cd92b9d0fd960a8 Mon Sep 17 00:00:00 2001 From: rich Date: Tue, 28 Mar 2006 13:20:00 +0000 Subject: [PATCH] Changes done on the Mac. --- scripts/images.ml | 44 ++++---- scripts/invite_user.ml | 66 ++++++------ scripts/invite_user_confirm.ml | 36 +++---- scripts/invite_user_confirm_form.ml | 22 ++-- scripts/largest_pages.ml | 16 +-- scripts/links.ml | 51 ++++----- scripts/login.ml | 87 ++++++++-------- scripts/login_form.ml | 13 +-- scripts/logout.ml | 7 +- scripts/mail_import.ml | 89 ++++++++-------- scripts/mailing_list_confirm.ml | 28 +++-- scripts/mailing_list_send.ml | 25 ++--- scripts/mailing_list_unsubscribe.ml | 7 +- scripts/mailing_list_view.ml | 24 ++--- scripts/orphans.ml | 42 +++----- scripts/page.ml | 203 ++++++++++++++++-------------------- 16 files changed, 350 insertions(+), 410 deletions(-) diff --git a/scripts/images.ml b/scripts/images.ml index e65bfe0..a9d43b5 100644 --- a/scripts/images.ml +++ b/scripts/images.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -33,16 +33,21 @@ let run r (q : cgi) dbh hostid _ _ = 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 @@ -50,29 +55,30 @@ let run r (q : cgi) dbh hostid _ _ = 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; diff --git a/scripts/invite_user.ml b/scripts/invite_user.ml index 66aa47b..19bd170 100644 --- a/scripts/invite_user.ml +++ b/scripts/invite_user.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -61,41 +61,39 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = *) 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 diff --git a/scripts/invite_user_confirm.ml b/scripts/invite_user_confirm.ml index e44265c..9db853a 100644 --- a/scripts/invite_user_confirm.ml +++ b/scripts/invite_user_confirm.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -36,21 +36,19 @@ let run r (q : cgi) dbh hostid { hostname = hostname } _ = 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 @@ -70,12 +68,10 @@ let run r (q : cgi) dbh hostid { hostname = hostname } _ = 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 diff --git a/scripts/invite_user_confirm_form.ml b/scripts/invite_user_confirm_form.ml index b6aa4ae..9497adb 100644 --- a/scripts/invite_user_confirm_form.ml +++ b/scripts/invite_user_confirm_form.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -34,20 +34,20 @@ let run r (q : cgi) dbh hostid _ _ = (* 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; diff --git a/scripts/largest_pages.ml b/scripts/largest_pages.ml index 13e0413..90d0988 100644 --- a/scripts/largest_pages.ml +++ b/scripts/largest_pages.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -39,17 +39,17 @@ let run r (q : cgi) dbh hostid _ _ = * 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" @@ -66,7 +66,7 @@ let run r (q : cgi) dbh hostid _ _ = "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 diff --git a/scripts/links.ml b/scripts/links.ml index da3a153..eeb2804 100644 --- a/scripts/links.ml +++ b/scripts/links.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -57,16 +57,14 @@ let run r (q : cgi) dbh hostid _ _ = ) 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'" @@ -75,14 +73,13 @@ let run r (q : cgi) dbh hostid _ _ = (* 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 @@ -103,23 +100,21 @@ let run r (q : cgi) dbh hostid _ _ = 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 diff --git a/scripts/login.ml b/scripts/login.ml index 2b73d7f..70727c5 100644 --- a/scripts/login.ml +++ b/scripts/login.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -35,58 +35,53 @@ let run r (q : cgi) dbh hostid _ _ = 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 diff --git a/scripts/login_form.ml b/scripts/login_form.ml index d165726..39fbb06 100644 --- a/scripts/login_form.ml +++ b/scripts/login_form.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -43,14 +43,11 @@ let run r (q : cgi) dbh hostid _ _ = 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; diff --git a/scripts/logout.ml b/scripts/logout.ml index 400e140..7544a57 100644 --- a/scripts/logout.ml +++ b/scripts/logout.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -37,10 +37,7 @@ let run r (q : cgi) dbh hostid _ user = (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 ); diff --git a/scripts/mail_import.ml b/scripts/mail_import.ml index 8549758..f609062 100644 --- a/scripts/mail_import.ml +++ b/scripts/mail_import.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -96,22 +96,21 @@ let run r (q : cgi) dbh hostid _ user = 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. @@ -149,41 +148,38 @@ let run r (q : cgi) dbh hostid _ user = * 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 @@ -276,12 +272,11 @@ let run r (q : cgi) dbh hostid _ user = (* 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 diff --git a/scripts/mailing_list_confirm.ml b/scripts/mailing_list_confirm.ml index 1ed1f85..d7b7316 100644 --- a/scripts/mailing_list_confirm.ml +++ b/scripts/mailing_list_confirm.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -31,24 +31,22 @@ let run r (q : cgi) dbh hostid _ _ = let pending = q#param "p" in (* Get the relevant fields from the database. *) - let sth = dbh#prepare_cached "select email from mailing_lists - where hostid = ? and pending = ?" in - sth#execute [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; diff --git a/scripts/mailing_list_send.ml b/scripts/mailing_list_send.ml index 886aa9b..b576d56 100644 --- a/scripts/mailing_list_send.ml +++ b/scripts/mailing_list_send.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -42,18 +42,16 @@ let run r (q : cgi) dbh hostid { hostname = hostname } _ = ); (* 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 @@ -73,10 +71,9 @@ let run r (q : cgi) dbh hostid { hostname = hostname } _ = 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; diff --git a/scripts/mailing_list_unsubscribe.ml b/scripts/mailing_list_unsubscribe.ml index 970cf4e..346a332 100644 --- a/scripts/mailing_list_unsubscribe.ml +++ b/scripts/mailing_list_unsubscribe.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -31,9 +31,8 @@ let run r (q : cgi) dbh hostid _ _ = let opt_out = q#param "o" in (* Update the database. *) - let sth = dbh#prepare_cached "delete from mailing_lists - where hostid = ? and opt_out = ?" in - sth#execute [Some hostid; Some opt_out]; + PGSQL(dbh) "delete from mailing_lists + where hostid = $hostid and opt_out = $opt_out"; PGOCaml.commit dbh; diff --git a/scripts/mailing_list_view.ml b/scripts/mailing_list_view.ml index 1204466..f0cfc38 100644 --- a/scripts/mailing_list_view.ml +++ b/scripts/mailing_list_view.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -40,19 +40,19 @@ let run r (q : cgi) dbh hostid _ _ = 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; diff --git a/scripts/orphans.ml b/scripts/orphans.ml index a83f883..cddc0fe 100644 --- a/scripts/orphans.ml +++ b/scripts/orphans.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -33,10 +33,8 @@ let run r (q : cgi) dbh hostid _ _ = (* 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 @@ -55,37 +53,27 @@ let run r (q : cgi) dbh hostid _ _ = * 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; diff --git a/scripts/page.ml b/scripts/page.ml index 9e63c07..b6a4185 100644 --- a/scripts/page.ml +++ b/scripts/page.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -76,15 +76,13 @@ let run r (q : cgi) dbh hostid 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 @@ -167,17 +165,17 @@ let run r (q : cgi) dbh hostid (* 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. *) @@ -241,24 +239,20 @@ let run r (q : cgi) dbh hostid 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", @@ -269,8 +263,7 @@ let run r (q : cgi) dbh hostid 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 = @@ -302,15 +295,14 @@ let run r (q : cgi) dbh hostid 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; | _ -> () ); @@ -330,24 +322,19 @@ let run r (q : cgi) dbh hostid * 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. *) @@ -417,61 +404,53 @@ let run r (q : cgi) dbh hostid 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. *) -- 1.8.3.1