From bfa88724ee152ba00c2b2fca881dd78a6599820a Mon Sep 17 00:00:00 2001 From: rich Date: Mon, 27 Mar 2006 18:09:46 +0000 Subject: [PATCH] Probably about 1/2 way through now ... --- scripts/admin/admin.ml | 4 +- scripts/admin/create_host.ml | 4 +- scripts/admin/edit_host_css.ml | 6 +- scripts/admin/edit_host_css_form.ml | 4 +- scripts/admin/edit_hostnames.ml | 6 +- scripts/admin/edit_hostnames_form.ml | 4 +- scripts/admin/host.ml | 4 +- scripts/broken_links.ml | 22 ++-- scripts/change_password.ml | 28 ++--- scripts/change_password_form.ml | 4 +- scripts/contact.ml | 30 ++--- scripts/contact_show.ml | 34 +++--- scripts/contacts.ml | 34 +++--- scripts/crash.ml | 4 +- scripts/create_contact.ml | 26 ++-- scripts/create_contact_form.ml | 4 +- scripts/create_user.ml | 56 ++++----- scripts/create_user_form.ml | 4 +- scripts/dead_ends.ml | 21 ++-- scripts/delete_contact.ml | 27 ++--- scripts/delete_contact_form.ml | 29 ++--- scripts/delete_file.ml | 31 +++-- scripts/delete_file_form.ml | 19 ++- scripts/delete_image.ml | 31 ++--- scripts/delete_image_form.ml | 31 +++-- scripts/delete_user.ml | 43 +++---- scripts/delete_user_form.ml | 26 ++-- scripts/diff.ml | 12 +- scripts/edit.ml | 222 +++++++++++++++++++---------------- scripts/edit_contact.ml | 37 +++--- scripts/edit_contact_form.ml | 31 ++--- scripts/edit_file.ml | 18 ++- scripts/edit_file_form.ml | 28 ++--- scripts/edit_host_css.ml | 11 +- scripts/edit_host_css_form.ml | 15 ++- scripts/edit_host_settings.ml | 45 ++++--- scripts/edit_host_settings_form.ml | 59 +++++----- scripts/edit_image.ml | 26 ++-- scripts/edit_image_form.ml | 52 ++++---- scripts/edit_page_css.ml | 26 ++-- scripts/edit_page_css_form.ml | 10 +- scripts/edit_sitemenu.ml | 30 ++--- scripts/edit_user.ml | 16 +-- scripts/edit_user_form.ml | 20 ++-- scripts/email_change.ml | 14 +-- scripts/file.ml | 14 +-- scripts/files.ml | 14 +-- scripts/forgot_password.ml | 8 +- scripts/forgot_password_form.ml | 4 +- scripts/history.ml | 30 ++--- scripts/history_rss.ml | 30 ++--- scripts/host_menu.ml | 30 ++--- scripts/hoststyle.ml | 10 +- scripts/image.ml | 14 +-- scripts/images.ml | 34 +++--- scripts/invite_user.ml | 16 +-- scripts/invite_user_confirm.ml | 14 +-- scripts/invite_user_confirm_form.ml | 6 +- scripts/invite_user_form.ml | 4 +- scripts/largest_pages.ml | 10 +- scripts/links.ml | 20 ++-- scripts/login.ml | 12 +- scripts/login_form.ml | 6 +- scripts/logout.ml | 8 +- scripts/mail_import.ml | 18 +-- scripts/mail_import_form.ml | 4 +- scripts/mail_rebuild.ml | 10 +- scripts/mailing_list_confirm.ml | 10 +- scripts/mailing_list_form.ml | 4 +- scripts/mailing_list_send.ml | 14 +-- scripts/mailing_list_unsubscribe.ml | 8 +- scripts/mailing_list_view.ml | 8 +- scripts/new_page_form.ml | 4 +- scripts/orphans.ml | 20 ++-- scripts/page.ml | 64 +++++----- scripts/page_email_confirm.ml | 12 +- scripts/page_email_form.ml | 6 +- scripts/page_email_send.ml | 14 +-- scripts/page_email_unsubscribe.ml | 8 +- scripts/page_rss.ml | 12 +- scripts/pagestyle.ml | 14 +-- scripts/preview.ml | 4 +- scripts/rebuild_links.ml | 18 +-- scripts/recent.ml | 48 ++++---- scripts/recent_rss.ml | 30 ++--- scripts/recently_visited.ml | 8 +- scripts/rename_page.ml | 8 +- scripts/rename_page_form.ml | 6 +- scripts/restore.ml | 24 ++-- scripts/restore_form.ml | 10 +- scripts/search.ml | 32 ++--- scripts/send_feedback.ml | 6 +- scripts/send_feedback_form.ml | 4 +- scripts/set_password.ml | 10 +- scripts/set_password_form.ml | 10 +- scripts/signup.ml | 16 +-- scripts/sitemap.ml | 16 +-- scripts/sitemap_xml.ml | 8 +- scripts/source.ml | 10 +- scripts/stats.ml | 8 +- scripts/stats_top.ml | 4 +- scripts/undelete_file.ml | 14 +-- scripts/undelete_file_form.ml | 14 +-- scripts/undelete_image.ml | 14 +-- scripts/undelete_image_form.ml | 18 +-- scripts/upload_file.ml | 16 +-- scripts/upload_file_form.ml | 8 +- scripts/upload_image.ml | 24 ++-- scripts/upload_image_form.ml | 8 +- scripts/user_prefs.ml | 14 +-- scripts/user_prefs_form.ml | 6 +- scripts/users.ml | 12 +- scripts/what_links_here.ml | 8 +- 113 files changed, 1062 insertions(+), 1096 deletions(-) diff --git a/scripts/admin/admin.ml b/scripts/admin/admin.ml index cbbbd10..68416e5 100644 --- a/scripts/admin/admin.ml +++ b/scripts/admin/admin.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: admin.ml,v 1.6 2004/09/09 12:21:22 rich Exp $ + * $Id: admin.ml,v 1.7 2006/03/27 18:09:47 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -30,7 +30,7 @@ open Cocanwiki_date let template = _get_template "admin/admin.html" -let run r (q : cgi) (dbh : Dbi.connection) _ _ _ = +let run r (q : cgi) dbh _ _ _ = (* Select out the alternative hostnames. *) let sth = dbh#prepare_cached "select hs.hostid, hs.name from hostnames hs diff --git a/scripts/admin/create_host.ml b/scripts/admin/create_host.ml index 3d0a03a..370b501 100644 --- a/scripts/admin/create_host.ml +++ b/scripts/admin/create_host.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: create_host.ml,v 1.10 2005/11/24 14:54:14 rich Exp $ + * $Id: create_host.ml,v 1.11 2006/03/27 18:09:47 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -71,7 +71,7 @@ let run r = "Administrator" "123456" true None in (* Commit to the database. *) - dbh#commit (); + PGOCaml.commit dbh; (* Print confirmation page. *) let buttons = [ diff --git a/scripts/admin/edit_host_css.ml b/scripts/admin/edit_host_css.ml index abf26c1..785b0ff 100644 --- a/scripts/admin/edit_host_css.ml +++ b/scripts/admin/edit_host_css.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_host_css.ml,v 1.7 2005/11/24 14:54:14 rich Exp $ + * $Id: edit_host_css.ml,v 1.8 2006/03/27 18:09:47 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -28,7 +28,7 @@ open Cocanwiki open Cocanwiki_ok open Cocanwiki_strings -let run r (q : cgi) (dbh : Dbi.connection) _ _ _ = +let run r (q : cgi) dbh _ _ _ = let hostid = int_of_string (q#param "hostid") in let css = q#param "css" in @@ -41,7 +41,7 @@ let run r (q : cgi) (dbh : Dbi.connection) _ _ _ = let sth = dbh#prepare_cached "update hosts set css = ? where id = ?" in sth#execute [css; `Int hostid]; - dbh#commit (); + PGOCaml.commit dbh; let buttons = [ { Template.StdPages.label = "OK"; diff --git a/scripts/admin/edit_host_css_form.ml b/scripts/admin/edit_host_css_form.ml index be65685..86d2d42 100644 --- a/scripts/admin/edit_host_css_form.ml +++ b/scripts/admin/edit_host_css_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: edit_host_css_form.ml,v 1.5 2004/09/09 12:21:22 rich Exp $ + * $Id: edit_host_css_form.ml,v 1.6 2006/03/27 18:09:47 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -29,7 +29,7 @@ open Cocanwiki_template let template = _get_template "admin/edit_host_css_form.html" -let run r (q : cgi) (dbh : Dbi.connection) _ _ _ = +let run r (q : cgi) dbh _ _ _ = let hostid = int_of_string (q#param "hostid") in template#set "id" (string_of_int hostid); diff --git a/scripts/admin/edit_hostnames.ml b/scripts/admin/edit_hostnames.ml index 9d8bbfb..03eed09 100644 --- a/scripts/admin/edit_hostnames.ml +++ b/scripts/admin/edit_hostnames.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_hostnames.ml,v 1.8 2005/11/24 14:54:14 rich Exp $ + * $Id: edit_hostnames.ml,v 1.9 2006/03/27 18:09:47 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -30,7 +30,7 @@ open Cocanwiki_strings let split_re = Pcre.regexp "[\\s,;]+" -let run r (q : cgi) (dbh : Dbi.connection) _ host' _ = +let run r (q : cgi) dbh _ host' _ = let hostid = int_of_string (q#param "hostid") in if q#param_true "cancel" then ( @@ -76,7 +76,7 @@ let run r (q : cgi) (dbh : Dbi.connection) _ host' _ = sth#execute [`Int hostid; `String name]) hostnames; (* Commit to the database. *) - dbh#commit (); + PGOCaml.commit dbh; (* Print confirmation page. *) let buttons = [ diff --git a/scripts/admin/edit_hostnames_form.ml b/scripts/admin/edit_hostnames_form.ml index 858105f..df11806 100644 --- a/scripts/admin/edit_hostnames_form.ml +++ b/scripts/admin/edit_hostnames_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: edit_hostnames_form.ml,v 1.5 2004/09/09 12:21:22 rich Exp $ + * $Id: edit_hostnames_form.ml,v 1.6 2006/03/27 18:09:47 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -29,7 +29,7 @@ open Cocanwiki_template let template = _get_template "admin/edit_hostnames_form.html" -let run r (q : cgi) (dbh : Dbi.connection) _ _ _ = +let run r (q : cgi) dbh _ _ _ = let hostid = int_of_string (q#param "hostid") in template#set "id" (string_of_int hostid); diff --git a/scripts/admin/host.ml b/scripts/admin/host.ml index 8625632..0092fa6 100644 --- a/scripts/admin/host.ml +++ b/scripts/admin/host.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: host.ml,v 1.8 2005/12/05 10:07:45 rich Exp $ + * $Id: host.ml,v 1.9 2006/03/27 18:09:47 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -30,7 +30,7 @@ open Cocanwiki_date let template = _get_template "admin/host.html" -let run r (q : cgi) (dbh : Dbi.connection) _ _ _ = +let run r (q : cgi) dbh _ _ _ = let hostid = int_of_string (q#param "hostid") in template#set "id" (string_of_int hostid); diff --git a/scripts/broken_links.ml b/scripts/broken_links.ml index 901d555..a736fbc 100644 --- a/scripts/broken_links.ml +++ b/scripts/broken_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: broken_links.ml,v 1.1 2004/10/09 16:25:08 rich Exp $ + * $Id: broken_links.ml,v 1.2 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -29,7 +29,7 @@ open Cocanwiki_template let keys h = Hashtbl.fold (fun key _ xs -> key :: xs) h [] -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "broken_links.html" in (* The links table (to_url) field can now point to a non-existant @@ -38,11 +38,11 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = * aren't broken links either because some of the content is * synthesized. *) - let sth = - dbh#prepare_cached + let rows = + PGSQL(dbh) "select l.from_url, p.title, l.to_url from links l, pages p - where l.hostid = ? + where l.hostid = $hostid and l.hostid = p.hostid and l.from_url = p.url and p.redirect is null and not exists (select id from pages @@ -50,15 +50,15 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = and not exists (select id from templates where l.to_url ~ url_regexp) order by 3, 1 desc" in - sth#execute [`Int hostid]; (* Group the links together. *) let h = Hashtbl.create 32 in - sth#iter (function [`String from_url; `String from_title; `String to_url] -> - let a = try Hashtbl.find h to_url with Not_found -> [] in - let a = (from_url, from_title) :: a in - Hashtbl.replace h to_url a - | _ -> assert false); + List.iter ( + fun (from_url, from_title, to_url) -> + let a = try Hashtbl.find h to_url with Not_found -> [] in + let a = (from_url, from_title) :: a in + Hashtbl.replace h to_url a + ) rows; let keys = List.sort compare (keys h) in let table = diff --git a/scripts/change_password.ml b/scripts/change_password.ml index 37d92aa..06e44be 100644 --- a/scripts/change_password.ml +++ b/scripts/change_password.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: change_password.ml,v 1.4 2005/11/24 14:54:11 rich Exp $ + * $Id: change_password.ml,v 1.5 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,7 +27,7 @@ open Printf open Cocanwiki open Cocanwiki_ok -let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = +let run r (q : cgi) dbh hostid _ user = let old_password = q#param "old_password" in (* Check the old password was supplied correctly. *) @@ -36,15 +36,15 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = Anonymous -> assert false (* cannot happen *) | User (userid, _, _, _) -> userid in - let sth = dbh#prepare_cached "select 1 from users - where hostid = ? and id = ? - and password = ?" in - sth#execute [`Int hostid; `Int userid; `String old_password]; + let rows = PGSQL(dbh) + "select 1 from users + where hostid = $hostid and id = $userid and password = $old_password" in let old_password_ok = - try 1 = sth#fetch1int () - with - Not_found -> false in + match rows with + | [Some 1l] -> true + | [] -> false + | _ -> assert false in if not old_password_ok then ( error ~title:"Bad password" @@ -71,13 +71,11 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = let password = password1 in (* Change the password. *) - let sth = - dbh#prepare_cached - "update users set password = ?, force_password_change = false - where hostid = ? and id = ?" in - sth#execute [`String password; `Int hostid; `Int userid]; + PGSQL(dbh) + "update users set password = $password, force_password_change = false + where hostid = $hostid and id = $userid"; - dbh#commit (); + PGOCaml.commit dbh; let buttons = [ ok_button "/" ] in ok ~buttons ~title:"Password changed" diff --git a/scripts/change_password_form.ml b/scripts/change_password_form.ml index 4ca1e4e..85fd414 100644 --- a/scripts/change_password_form.ml +++ b/scripts/change_password_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: change_password_form.ml,v 1.1 2004/09/25 13:17:00 rich Exp $ + * $Id: change_password_form.ml,v 1.2 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,7 +27,7 @@ open Printf open Cocanwiki open Cocanwiki_template -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "change_password_form.html" in q#template template diff --git a/scripts/contact.ml b/scripts/contact.ml index 4ec8e5e..b64bd56 100644 --- a/scripts/contact.ml +++ b/scripts/contact.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: contact.ml,v 1.9 2005/11/24 14:54:11 rich Exp $ + * $Id: contact.ml,v 1.10 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -30,7 +30,7 @@ open Cocanwiki open Cocanwiki_template open Cocanwiki_ok -let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = +let run r (q : cgi) dbh hostid {hostname = hostname} user = let template = get_template dbh hostid "contact.txt" in let fail msg = @@ -47,24 +47,18 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = fail "The 'name' field is missing in that form." in (* Get the contacts / emails from the database. *) - let sth = dbh#prepare_cached "select id, subject from contacts - where hostid = ? and name = ?" in - sth#execute [`Int hostid; `String name]; + let rows = PGSQL(dbh) + "select id, subject from contacts + where hostid = $hostid and name = $name" in let id, subject = - try - (match sth#fetch1 () with - [ `Int id; `String subject ] -> id, subject - | _ -> assert false - ) - with Not_found -> fail "There is no such contact form in the database." in + match rows with + | [row] -> row + | [] -> fail "There is no such contact form in the database." + | _ -> assert false in - let sth = dbh#prepare_cached "select email from contact_emails - where contactid = ?" in - sth#execute [`Int id]; - - let emails = sth#map (function [`String email] -> email - | _ -> assert false) in + let emails = + PGSQL(dbh) "select email from contact_emails where contactid = $id" in if emails = [] then fail "There are no email addresses associated with that contact id."; @@ -118,7 +112,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = 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; diff --git a/scripts/contact_show.ml b/scripts/contact_show.ml index d65c99c..69e49aa 100644 --- a/scripts/contact_show.ml +++ b/scripts/contact_show.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: contact_show.ml,v 1.1 2004/09/17 16:03:34 rich Exp $ + * $Id: contact_show.ml,v 1.2 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,36 +27,32 @@ open Printf open Cocanwiki open Cocanwiki_template -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "contact_show.html" in - let id = int_of_string (q#param "id") in - template#set "id" (string_of_int id); + let id = Int32.of_string (q#param "id") in + template#set "id" (Int32.to_string id); (* Pull out all the details out of the database. *) - let sth = dbh#prepare_cached - "select name, subject - from contacts where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int id]; + let rows = PGSQL(dbh) + "select name, subject from contacts + where hostid = $hostid and id = $id" in let name, subject = - match sth#fetch1 () with - [ `String name; `String subject ] -> name, subject - | _ -> assert false in + match rows with + | [row] -> row + | _ -> assert false in template#set "name" name; template#set "subject" subject; (* Get the emails. *) - let sth = dbh#prepare_cached - "select email from contact_emails where contactid = ? - order by 1" in - sth#execute [`Int id]; - - let table = sth#map (function [`String email] -> - [ "email", Template.VarString email ] - | _ -> assert false) in + let rows = PGSQL(dbh) + "select email from contact_emails where contactid = $id + order by 1" in + let table = + List.map (fun email -> [ "email", Template.VarString email ]) rows in template#table "emails" table; q#template template diff --git a/scripts/contacts.ml b/scripts/contacts.ml index 9ba8e65..5a0762c 100644 --- a/scripts/contacts.ml +++ b/scripts/contacts.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: contacts.ml,v 1.2 2005/11/23 11:32:12 rich Exp $ + * $Id: contacts.ml,v 1.3 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,28 +27,26 @@ open Printf open Cocanwiki open Cocanwiki_template -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "contacts.html" in (* Pull out all the contacts from the database. *) - let sth = dbh#prepare_cached - "select c.id, c.name, c.subject, - (select count(*)::int4 from contact_emails - where contactid = c.id) - from contacts c - where c.hostid = ? - order by c.name, c.id" in - sth#execute [`Int hostid]; + let rows = PGSQL(dbh) + "select c.id, c.name, c.subject, + (select count(*)::int4 from contact_emails + where contactid = c.id) + from contacts c + where c.hostid = $hostid + order by c.name, c.id" in let table = - sth#map - (function - [`Int id; `String name; `String subject; `Int count] -> - [ "id", Template.VarString (string_of_int id); - "name", Template.VarString name; - "subject", Template.VarString subject; - "count", Template.VarString (string_of_int count) ] - | _ -> assert false) in + List.map + (fun (id, name, subject, count) -> + [ "id", Template.VarString (Int32.to_string id); + "name", Template.VarString name; + "subject", Template.VarString subject; + "count", Template.VarString (Int32.to_string (Option.get count)) ] + ) rows in template#table "contacts" table; diff --git a/scripts/crash.ml b/scripts/crash.ml index 232ec4b..15c391f 100644 --- a/scripts/crash.ml +++ b/scripts/crash.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: crash.ml,v 1.4 2005/03/31 14:24:04 rich Exp $ + * $Id: crash.ml,v 1.5 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -30,7 +30,7 @@ open Cocanwiki open Cocanwiki_template open Cocanwiki_server_settings -let run r (q : cgi) (dbh : Dbi.connection) hostid +let run r (q : cgi) dbh hostid { canonical_hostname = canonical_hostname } _ = let template = get_template dbh hostid "crash.html" in let crash_email = server_settings_crash_email dbh in diff --git a/scripts/create_contact.ml b/scripts/create_contact.ml index 17e70f8..0ec61db 100644 --- a/scripts/create_contact.ml +++ b/scripts/create_contact.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: create_contact.ml,v 1.5 2005/11/24 14:54:11 rich Exp $ + * $Id: create_contact.ml,v 1.6 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -30,7 +30,7 @@ open Cocanwiki_strings let split_re = Pcre.regexp "[\\r\\n,;]+" -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let name = trim (q#param "name") in let subject = trim (q#param "subject") in let emails = try q#param "emails" with Not_found -> "" in @@ -61,27 +61,27 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = ); (* Update the database. *) - let sth = dbh#prepare_cached "insert into contacts (hostid, name, subject) - values (?, ?, ?)" in - sth#execute [`Int hostid; `String name; `String subject]; + PGSQL(dbh) "insert into contacts (hostid, name, subject) + values ($hostid, $name, $subject)"; - let contactid = Int64.to_int (sth#serial "contacts_id_seq") in + let contactid = PGOCaml.serial4 dbh "contacts_id_seq" in - let sth = dbh#prepare_cached "insert into contact_emails (contactid, email) - values (?, ?)" in - List.iter (fun email -> - sth#execute [`Int contactid; `String email]) emails; + List.iter ( + fun email -> + PGSQL(dbh) "insert into contact_emails (contactid, email) + values ($contactid, $email)" + ) emails; (* Finish off. *) - dbh#commit (); + PGOCaml.commit dbh; - let msg = sprintf "Contact form created. The contact id is %d. On the next page you will be given some same code which you should copy and paste onto a web page to create a simple form, which can then be modified for your requirements." contactid in + let msg = sprintf "Contact form created. The contact id is %ld. On the next page you will be given some same code which you should copy and paste onto a web page to create a simple form, which can then be modified for your requirements." contactid in let buttons = [ { Template.StdPages.label = " View contact form "; Template.StdPages.link = "/_bin/contact_show.cmo"; Template.StdPages.method_ = None; Template.StdPages.params = - [ "id", string_of_int contactid ] } ] in + [ "id", Int32.to_string contactid ] } ] in ok ~title:"Contact form created" ~buttons dbh hostid q msg let () = diff --git a/scripts/create_contact_form.ml b/scripts/create_contact_form.ml index 8462c70..c7fdb7b 100644 --- a/scripts/create_contact_form.ml +++ b/scripts/create_contact_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: create_contact_form.ml,v 1.1 2004/09/21 15:55:48 rich Exp $ + * $Id: create_contact_form.ml,v 1.2 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,7 +27,7 @@ open Printf open Cocanwiki open Cocanwiki_template -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "create_contact_form.html" in q#template template diff --git a/scripts/create_user.ml b/scripts/create_user.ml index 1f5bc5a..e8e136e 100644 --- a/scripts/create_user.ml +++ b/scripts/create_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: create_user.ml,v 1.6 2005/11/24 14:54:11 rich Exp $ + * $Id: create_user.ml,v 1.7 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -28,7 +28,7 @@ open Cocanwiki open Cocanwiki_ok open Cocanwiki_strings -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let username = trim (q#param "username") in let password1 = trim (q#param "password1") in let password2 = trim (q#param "password2") in @@ -47,23 +47,24 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = let password = password1 in - (* - Uh oh ... Not making UNICODE assumptions ... XXX - if String.length username > 32 || String.length password > 32 then - *) + if UTF8.length username > 32 || UTF8.length password > 128 then ( + error ~back_button:true ~title:"Username or password too long" + dbh hostid q "Usernames should be less than 32 characters long. For passwords we let you have a generous 128 characters."; + return () + ); (* Not a duplicate? *) - let sth = dbh#prepare_cached "select id from users - where hostid = ? and name = ?" in - sth#execute [`Int hostid; `String username]; + let rows = PGSQL(dbh) + "select id from users where hostid = $hostid and name = $username" in - (try - sth#fetch1 (); - error ~back_button:true ~title:"Username already taken" - dbh hostid q "Someone has already taken that username."; - return () - with - Not_found -> ()); + (match rows with + | [_] -> + error ~back_button:true ~title:"Username already taken" + dbh hostid q "Someone has already taken that username."; + return () + | [] -> () + | _ -> assert false + ); let can_edit = q#param_true "can_edit" in let can_manage_users = q#param_true "can_manage_users" in @@ -74,19 +75,18 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = let force_password_change = q#param_true "force_password_change" in (* Create the user account. *) - let sth = dbh#prepare_cached "insert into users (name, password, - hostid, can_edit, can_manage_users, - can_manage_contacts, can_manage_site, - can_edit_global_css, can_import_mail, - force_password_change) - values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" in - sth#execute [`String username; `String password; `Int hostid; - `Bool can_edit; `Bool can_manage_users; - `Bool can_manage_contacts; `Bool can_manage_site; - `Bool can_edit_global_css; `Bool can_import_mail; - `Bool force_password_change]; + PGSQL(dbh) + "insert into users (name, password, + hostid, can_edit, can_manage_users, + can_manage_contacts, can_manage_site, + can_edit_global_css, can_import_mail, + force_password_change) + values ($username, $password, $hostid, $can_edit, $can_manage_users, + $can_manage_contacts, $can_manage_site, + $can_edit_global_css, $can_import_mail, + $force_password_change)"; - dbh#commit (); + PGOCaml.commit dbh; let buttons = [ ok_button "/_users" ] in diff --git a/scripts/create_user_form.ml b/scripts/create_user_form.ml index f3bf33e..8a43809 100644 --- a/scripts/create_user_form.ml +++ b/scripts/create_user_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: create_user_form.ml,v 1.1 2004/09/21 13:01:15 rich Exp $ + * $Id: create_user_form.ml,v 1.2 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,7 +27,7 @@ open Printf open Cocanwiki open Cocanwiki_template -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "create_user_form.html" in q#template template diff --git a/scripts/dead_ends.ml b/scripts/dead_ends.ml index 1fe5d04..c72f56c 100644 --- a/scripts/dead_ends.ml +++ b/scripts/dead_ends.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: dead_ends.ml,v 1.2 2004/10/04 15:19:56 rich Exp $ + * $Id: dead_ends.ml,v 1.3 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,27 +27,28 @@ open Printf open Cocanwiki open Cocanwiki_template -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "dead_ends.html" in - let sth = - dbh#prepare_cached + let rows = + PGSQL(dbh) "select p.url, p.title, count (l.to_url) from pages p left outer join links l on p.hostid = l.hostid and p.url = l.from_url - where p.hostid = ? + where p.hostid = $hostid and p.url is not null and p.redirect is null group by 1, 2 having count(l.to_url) = 0 order by 1" in - sth#execute [`Int hostid]; let table = - sth#map (function [`String page; `String title; _] -> - [ "page", Template.VarString page; - "title", Template.VarString title ] - | _ -> assert false) in + List.map ( + fun (page, title, _) -> + let page = Option.get page in + [ "page", Template.VarString page; + "title", Template.VarString title ] + ) rows in template#table "pages" table; diff --git a/scripts/delete_contact.ml b/scripts/delete_contact.ml index 54c4538..07758f1 100644 --- a/scripts/delete_contact.ml +++ b/scripts/delete_contact.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: delete_contact.ml,v 1.4 2005/11/24 14:54:11 rich Exp $ + * $Id: delete_contact.ml,v 1.5 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,7 +27,7 @@ open Printf open Cocanwiki open Cocanwiki_ok -let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = +let run r (q : cgi) dbh hostid { hostname = hostname } _ = (* Cancel? *) if q#param_true "cancel" then ( q#redirect ("http://" ^ hostname ^ "/_bin/contacts.cmo"); @@ -37,31 +37,24 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = (* We can delete multiple contact forms from this script, which is * quite unusual. *) - let ids = List.map int_of_string (q#param_all "delete") in + let ids = List.map Int32.of_string (q#param_all "delete") in if ids = [] then ( q#redirect ("http://" ^ hostname ^ "/_bin/contacts.cmo"); return () ); (* Need to check the contact emails all belong to this host. *) - let qs = Dbi.placeholders (List.length ids) in - let sth = dbh#prepare_cached ("select count(*)::int4 from contacts - where hostid = ? and id in " ^ qs) in - sth#execute (`Int hostid :: (List.map (fun id -> `Int id) ids)); - - assert (sth#fetch1int () = List.length ids); + let rows = PGSQL(dbh) + "select count(*)::int4 from contacts + where hostid = $hostid and id in $@ids" in + assert (List.length rows = List.length ids); (* Delete them. *) - let sth = dbh#prepare_cached ("delete from contact_emails - where contactid in " ^ qs) in - sth#execute (List.map (fun id -> `Int id) ids); - - let sth = dbh#prepare_cached ("delete from contacts - where hostid = ? and id in " ^ qs) in - sth#execute (`Int hostid :: (List.map (fun id -> `Int id) ids)); + PGSQL(dbh) "delete from contact_emails where contactid in $@ids"; + PGSQL(dbh) "delete from contacts where hostid = $hostid and id in $@ids"; (* Finish off. *) - dbh#commit (); + PGOCaml.commit dbh; ok ~title:"Contact form(s) deleted" ~buttons:[ok_button "/_bin/contacts.cmo"] dbh hostid q "Those contact form(s) were deleted." diff --git a/scripts/delete_contact_form.ml b/scripts/delete_contact_form.ml index 55a943b..1dd0bfd 100644 --- a/scripts/delete_contact_form.ml +++ b/scripts/delete_contact_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: delete_contact_form.ml,v 1.2 2004/09/23 11:56:47 rich Exp $ + * $Id: delete_contact_form.ml,v 1.3 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,35 +27,36 @@ open Printf open Cocanwiki open Cocanwiki_template -let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = +let run r (q : cgi) dbh hostid { hostname = hostname } _ = let template = get_template dbh hostid "delete_contact_form.html" in (* We can delete multiple contact forms from this script, which is * quite unusual. *) - let ids = List.map int_of_string (q#param_all "delete") in + let ids = List.map Int32.of_string (q#param_all "delete") in if ids = [] then ( q#redirect ("http://" ^ hostname ^ "/_bin/contacts.cmo"); return () ); - let qs = Dbi.placeholders (List.length ids) in - let sth = dbh#prepare_cached ("select id, name, subject from contacts - where hostid = ? and id in " ^ qs ^ " - order by name, id") in - sth#execute (`Int hostid :: (List.map (fun id -> `Int id) ids)); + let rows = PGSQL(dbh) + "select id, name, subject from contacts + where hostid = $hostid and id in $@ids + order by name, id" in let table = - sth#map (function [`Int id; `String name; `String subject] -> - [ "id", Template.VarString (string_of_int id); - "name", Template.VarString name; - "subject", Template.VarString subject ] - | _ -> assert false) in + List.map ( + fun (id, name, subject) -> + [ "id", Template.VarString (Int32.to_string id); + "name", Template.VarString name; + "subject", Template.VarString subject ] + ) rows in template#table "deletes" table; let table = - List.map (fun id -> [ "id", Template.VarString (string_of_int id) ]) ids in + List.map (fun id -> + [ "id", Template.VarString (Int32.to_string id) ]) ids in template#table "ids" table; q#template template diff --git a/scripts/delete_file.ml b/scripts/delete_file.ml index 77401e0..4e37289 100644 --- a/scripts/delete_file.ml +++ b/scripts/delete_file.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: delete_file.ml,v 1.9 2005/11/24 14:54:11 rich Exp $ + * $Id: delete_file.ml,v 1.10 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -28,31 +28,28 @@ open Cocanwiki open Cocanwiki_ok open Cocanwiki_emailnotify -let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user= - let id = int_of_string (q#param "id") in +let run r (q : cgi) dbh hostid { hostname = hostname } user= + let id = Int32.of_string (q#param "id") in if q#param_true "yes" then ( (* Get the name. *) - let sth = dbh#prepare_cached "select coalesce (name, name_deleted) - from files - where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int id]; - let name = sth#fetch1string () in + let rows = PGSQL(dbh) "select coalesce (name, name_deleted) + from files + where hostid = $hostid and id = $id" in + let name = Option.get (List.hd rows) in (* Delete the file. *) - let sth = dbh#prepare_cached "update files - set name_deleted = name, name = null - where hostid = ? and id = ? - and name is not null" in - sth#execute [`Int hostid; `Int id]; + PGSQL(dbh) "update files + set name_deleted = name, name = null + where hostid = $hostid and id = $id + and name is not null"; - dbh#commit (); + PGOCaml.commit dbh; (* Email notify. *) - let subject = "File " ^ name ^ "#" ^ string_of_int id ^ + let subject = "File " ^ name ^ "#" ^ Int32.to_string id ^ " has been deleted." in - let body = fun () -> - "Page: http://" ^ hostname ^ "/_files?deleted=1" in + let body = fun () -> "Page: http://" ^ hostname ^ "/_files?deleted=1" in email_notify ~body ~subject ~user dbh hostid; diff --git a/scripts/delete_file_form.ml b/scripts/delete_file_form.ml index d97a2da..bc1e00e 100644 --- a/scripts/delete_file_form.ml +++ b/scripts/delete_file_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: delete_file_form.ml,v 1.7 2004/09/09 12:21:22 rich Exp $ + * $Id: delete_file_form.ml,v 1.8 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,19 +27,18 @@ open Printf open Cocanwiki open Cocanwiki_template -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "delete_file_form.html" in - let id = int_of_string (q#param "id") in + let id = Int32.of_string (q#param "id") in - let sth = dbh#prepare_cached "select name from files - where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int id]; + let name = List.hd ( + PGSQL(dbh) "select name from files + where hostid = $hostid and id = $id" + ) in - let name = sth#fetch1string () in - - template#set "id" (string_of_int id); - template#set "name" name; + template#set "id" (Int32.to_string id); + template#set "name" (Option.get name); q#template template diff --git a/scripts/delete_image.ml b/scripts/delete_image.ml index 93ae79e..04cc50a 100644 --- a/scripts/delete_image.ml +++ b/scripts/delete_image.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: delete_image.ml,v 1.9 2005/11/24 14:54:11 rich Exp $ + * $Id: delete_image.ml,v 1.10 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -28,28 +28,29 @@ open Cocanwiki open Cocanwiki_ok open Cocanwiki_emailnotify -let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user= - let id = int_of_string (q#param "id") in +let run r (q : cgi) dbh hostid { hostname = hostname } user= + let id = Int32.of_string (q#param "id") in if q#param_true "yes" then ( (* Get the name. *) - let sth = dbh#prepare_cached "select coalesce (name, name_deleted) - from images - where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int id]; - let name = sth#fetch1string () in + let name = Option.get ( + List.hd ( + PGSQL(dbh) "select coalesce (name, name_deleted) + from images + where hostid = $hostid and id = $id" + ) + ) in (* Delete the image. *) - let sth = dbh#prepare_cached "update images - set name_deleted = name, name = null - where hostid = ? and id = ? - and name is not null" in - sth#execute [`Int hostid; `Int id]; + PGSQL(dbh) "update images + set name_deleted = name, name = null + where hostid = $hostid and id = $id + and name is not null"; - dbh#commit (); + PGOCaml.commit dbh; (* Email notify. *) - let subject = "Image " ^ name ^ "#" ^ string_of_int id ^ + let subject = "Image " ^ name ^ "#" ^ Int32.to_string id ^ " has been deleted." in let body = fun () -> "Page: http://" ^ hostname ^ "/_images?deleted=1" in diff --git a/scripts/delete_image_form.ml b/scripts/delete_image_form.ml index cafb274..955b46a 100644 --- a/scripts/delete_image_form.ml +++ b/scripts/delete_image_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: delete_image_form.ml,v 1.7 2004/09/09 12:21:22 rich Exp $ + * $Id: delete_image_form.ml,v 1.8 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,26 +27,25 @@ open Printf open Cocanwiki open Cocanwiki_template -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "delete_image_form.html" in - let id = int_of_string (q#param "id") in + let id = Int32.of_string (q#param "id") in - let sth = dbh#prepare_cached "select name, width, height, alt - from images - where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int id]; + let rows = PGSQL(dbh) + "select name, width, height, alt + from images + where hostid = $hostid and id = $id" in let name, width, height, alt = - match sth#fetch1 () with - [ `String name; `Int width; `Int height; `String alt] -> - name, width, height, alt - | _ -> assert false in - - template#set "id" (string_of_int id); - template#set "name" name; - template#set "width" (string_of_int width); - template#set "height" (string_of_int height); + match rows with + | [row] -> row + | _ -> assert false in + + template#set "id" (Int32.to_string id); + template#set "name" (Option.get name); + template#set "width" (Int32.to_string width); + template#set "height" (Int32.to_string height); template#set "alt" alt; q#template template diff --git a/scripts/delete_user.ml b/scripts/delete_user.ml index da705f5..9e4cffd 100644 --- a/scripts/delete_user.ml +++ b/scripts/delete_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: delete_user.ml,v 1.5 2005/11/24 14:54:11 rich Exp $ + * $Id: delete_user.ml,v 1.6 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,23 +27,21 @@ open Printf open Cocanwiki open Cocanwiki_ok -let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} self = +let run r (q : cgi) dbh hostid {hostname = hostname} self = if q#param_true "cancel" then ( (* Request cancelled. *) q#redirect ("http://" ^ hostname ^ "/_users"); return () ); - let userid = int_of_string (q#param "userid") in + let userid = Int32.of_string (q#param "userid") in (* Check userid belongs to host. The statements below wouldn't * enforce this correctly ... *) - let sth = - dbh#prepare_cached "select 1 from users where id = ? and hostid = ?" in - sth#execute [`Int userid; `Int hostid]; - - assert (sth#fetch1int () = 1); + let rows = + PGSQL(dbh) "select 1 from users where id = $userid and hostid = $hostid" in + assert (rows = [Some 1l]); (* Can't delete self! *) let () = @@ -55,29 +53,16 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} self = | _ -> () in (* Delete the user. *) - let sth = - dbh#prepare_cached "delete from recently_visited - where userid = ? and hostid = ?" in - sth#execute [`Int userid; `Int hostid]; - - let sth = - dbh#prepare_cached "delete from pending_email_changes - where userid = ?" in - sth#execute [`Int userid]; - - - let sth = dbh#prepare_cached "delete from usercookies where userid = ?" in - sth#execute [`Int userid]; - - let sth = dbh#prepare_cached "update pages set logged_user = null - where logged_user = ? and hostid = ?" in - sth#execute [`Int userid; `Int hostid]; + PGSQL(dbh) "delete from recently_visited + where userid = $userid and hostid = $hostid"; - let sth = - dbh#prepare_cached "delete from users where id = ? and hostid = ?" in - sth#execute [`Int userid; `Int hostid]; + PGSQL(dbh) "delete from pending_email_changes where userid = $userid"; + PGSQL(dbh) "delete from usercookies where userid = $userid"; + PGSQL(dbh) "update pages set logged_user = null + where logged_user = $userid and hostid = $hostid"; + PGSQL(dbh) "delete from users where id = $userid and hostid = $hostid"; - dbh#commit (); + PGOCaml.commit dbh; ok ~title:"Account deleted" ~buttons:[ok_button "/_users"] dbh hostid q "That user account was deleted." diff --git a/scripts/delete_user_form.ml b/scripts/delete_user_form.ml index 0c7a9a1..8437488 100644 --- a/scripts/delete_user_form.ml +++ b/scripts/delete_user_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: delete_user_form.ml,v 1.4 2005/11/24 14:54:11 rich Exp $ + * $Id: delete_user_form.ml,v 1.5 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -28,11 +28,11 @@ open Cocanwiki open Cocanwiki_template open Cocanwiki_ok -let run r (q : cgi) (dbh : Dbi.connection) hostid _ self = +let run r (q : cgi) dbh hostid _ self = let template = get_template dbh hostid "delete_user_form.html" in - let userid = int_of_string (q#param "userid") in - template#set "userid" (string_of_int userid); + let userid = Int32.of_string (q#param "userid") in + template#set "userid" (Int32.to_string userid); (* Can't delete self! *) let () = @@ -44,17 +44,17 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ self = | _ -> () in (* Get this user from the database. *) - let sth = dbh#prepare_cached "select name, email from users - where id = ? and hostid = ?" in - sth#execute [`Int userid; `Int hostid]; + let rows = + PGSQL(dbh) "select name, email from users + where id = $userid and hostid = $hostid" in let username, email = - match sth#fetch1 () with - [ `String username; `String email ] -> - username, email - | [ `String username; `Null ] -> - username, "" - | _ -> assert false in + match rows with + | [ username, Some email ] -> + username, email + | [ username, None ] -> + username, "" + | _ -> assert false in template#set "username" username; template#set "email" email; diff --git a/scripts/diff.ml b/scripts/diff.ml index 09d21a1..fb576c5 100644 --- a/scripts/diff.ml +++ b/scripts/diff.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: diff.ml,v 1.9 2004/11/01 12:57:53 rich Exp $ + * $Id: diff.ml,v 1.10 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -28,7 +28,7 @@ open Cocanwiki open Cocanwiki_template open Cocanwiki_diff -let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = +let run r (q : cgi) dbh hostid _ user = let template = get_template dbh hostid "diff.html" in let page = q#param "page" in @@ -44,18 +44,18 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = * NB. In case you hadn't worked it out yet, version numbers are * page.ids. *) - let version = int_of_string (q#param "version") in + let version = Int32.of_string (q#param "version") in let diff, old_version = try - let old_version = int_of_string (q#param "old_version") in + let old_version = Int32.of_string (q#param "old_version") in get_diff dbh hostid page ~old_version ~version () with Not_found -> get_diff dbh hostid page ~version () in - template#set "version" (string_of_int version); - template#set "old_version" (string_of_int old_version); + template#set "version" (Int32.to_string version); + template#set "old_version" (Int32.to_string old_version); template#set "page" page; template#set "diff" diff; diff --git a/scripts/edit.ml b/scripts/edit.ml index 4e9996f..db31b59 100644 --- a/scripts/edit.ml +++ b/scripts/edit.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit.ml,v 1.27 2005/11/24 14:54:11 rich Exp $ + * $Id: edit.ml,v 1.28 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -34,7 +34,7 @@ open Cocanwiki_diff open Cocanwiki_strings open Cocanwiki_pages -let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = +let run r (q : cgi) dbh hostid {hostname = hostname} user = let template = get_template dbh hostid "edit.html" in let template_conflict = get_template dbh hostid "edit_conflict.html" in let template_email = get_template dbh hostid "edit_page_email.txt" in @@ -53,11 +53,14 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = (* Build the internal model from the parameters passed to the script. *) let build_internal_model () = - let id = int_of_string (q#param "id") in + let id = Int32.of_string (q#param "id") in let description = q#param "description" in let redirect = q#param "redirect" in + let redirect = + if string_is_whitespace redirect then + None else Some redirect in let pt = match q#param "pt_type" with - "page" -> Page (q#param "pt_value") + | "page" -> Page (q#param "pt_value") | "title" -> Title (q#param "pt_value") | _ -> failwith "unknown value for pt_type parameter" in @@ -65,8 +68,12 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = let i = ref 1 in while q#param_exists ("content_" ^ string_of_int !i) do let sectionname = q#param ("sectionname_" ^ string_of_int !i) in + let sectionname = + if string_is_whitespace sectionname then None else Some sectionname in let content = q#param ("content_" ^ string_of_int !i) in let divname = q#param ("divname_" ^ string_of_int !i) in + let divname = + if string_is_whitespace divname then None else Some divname in contents := (sectionname, divname, content) :: !contents; incr i done; @@ -76,7 +83,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = pt = pt; description = description; redirect = redirect; - contents = contents; } + contents_ = contents; } in (* Check for errors in the model. *) @@ -85,44 +92,45 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = let add_error msg = errors := msg :: !errors in let get_errors () = List.rev !errors in - if model.redirect = "" then ( - (* Empty page? *) - if model.contents = [] then - add_error ("This page is empty. Use 'Insert new section here' " ^ - "to write something!"); - - (* Description field? *) - if model.description = "" then - add_error ("The description field is very important! This field is " ^ - "used by search engines and directories to describe " ^ - "what's on this page."); - ) - else (* it's a redirect *) ( - (* Redirect points to a real page? *) - let sth = dbh#prepare_cached "select 1 from pages - where hostid = ? - and url is not null - and url = ? - and id <> ? - and redirect is null" in - sth#execute [`Int hostid; `String model.redirect; `Int model.id]; - - let ok = try sth#fetch1 () = [`Int 1] with Not_found -> false in - if not ok then - add_error ("Redirect must point to an ordinary page " ^ - "(ie. not to a page which is itself a redirect).") + (match model.redirect with + | None -> + (* Empty page? *) + if model.contents_ = [] then + add_error ("This page is empty. Use 'Insert new section here' " ^ + "to write something!"); + + (* Description field? *) + if model.description = "" then + add_error ("The description field is very important! " ^ + "This field is " ^ + "used by search engines and directories to describe " ^ + "what's on this page."); + + | Some redirect -> + (* Redirect points to a real page? *) + let rows = + let model_id = model.id in + PGSQL(dbh) + "select 1 from pages + where hostid = $hostid and url is not null + and url = $redirect and id <> $model_id + and redirect is null" in + + let ok = rows = [Some 1l] in + if not ok then + add_error ("Redirect must point to an ordinary page " ^ + "(ie. not to a page which is itself a redirect).") ); (* All sections after the first one have sectionnames? The first * section ONLY is allowed to have an empty title. *) - if model.contents <> [] then - List.iter (function (sectionnames, _, _) - when string_is_whitespace sectionnames -> - add_error - ("Every section except the first must have a title."); - | _ -> ()) - (List.tl model.contents); + if model.contents_ <> [] then + List.iter (function (None, _, _) -> + add_error + ("Every section except the first must have a title."); + | _ -> ()) + (List.tl model.contents_); get_errors () in @@ -136,8 +144,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = | _, [] -> [ item ] | n, x :: xs -> x :: (loop (n-1, xs)) in - let contents = loop (posn, model.contents) in - { model with contents = contents } + let contents = loop (posn, model.contents_) in + { model with contents_ = contents } in let action_moveup model posn = (* posn = 1 means move up the first element, ie. do nothing @@ -152,8 +160,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = | 2, x :: y :: xs -> y :: x :: xs | n, x :: xs -> x :: (loop (n-1, xs)) in - let contents = loop (posn, model.contents) in - { model with contents = contents } + let contents = loop (posn, model.contents_) in + { model with contents_ = contents } in let action_movedn model posn = (* posn = 1 means move down the first element to the second position @@ -166,8 +174,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = | 1, x :: y :: xs -> y :: x :: xs | n, x :: xs -> x :: (loop (n-1, xs)) in - let contents = loop (posn, model.contents) in - { model with contents = contents } + let contents = loop (posn, model.contents_) in + { model with contents_ = contents } in let action_delete model posn = (* posn = 1 means delete the first element *) @@ -178,13 +186,13 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = | 1, x :: xs -> xs | n, x :: xs -> x :: (loop (n-1, xs)) in - let contents = loop (posn, model.contents) in - { model with contents = contents } + let contents = loop (posn, model.contents_) in + { model with contents_ = contents } in (* Convert model to template. *) let model_to_template model template = - template#set "id" (string_of_int model.id); + template#set "id" (Int32.to_string model.id); template#set "description" model.description; (match model.pt with @@ -196,42 +204,50 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = template#set "pt_value" title); (* Redirects table. *) - let sth = dbh#prepare_cached "select url, title from pages - where url is not null - and redirect is null - and hostid = ? and id <> ? - order by 2" in - sth#execute [`Int hostid; `Int model.id]; - let table = sth#map (function [`String url; `String title] -> - let selected = model.redirect = url in - [ "url", Template.VarString url; - "title", Template.VarString title; - "selected", Template.VarConditional selected ] - | _ -> assert false) in + let rows = + let model_id = model.id in + PGSQL(dbh) + "select url, title from pages + where url is not null + and redirect is null + and hostid = $hostid and id <> $model_id + order by 2" in + let table = List.map ( + fun (url, title) -> + let url = Option.get url in + let selected = model.redirect = Some url in + [ "url", Template.VarString url; + "title", Template.VarString title; + "selected", Template.VarConditional selected ] + ) rows in template#table "redirects" table; - if model.id <> 0 then ( + if model.id <> 0l then ( (* Need to go to the database to get the title of the page ... *) - let sth = dbh#prepare_cached "select title from pages - where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int model.id]; - let title = sth#fetch1string () in + let rows = + let model_id = model.id in + PGSQL(dbh) + "select title from pages + where hostid = $hostid and id = $model_id" in + let title = List.hd rows in template#set "title" title; ) else ( match model.pt with - Page page -> template#set "title" page - | Title title -> template#set "title" title + | Page page -> template#set "title" page + | Title title -> template#set "title" title ); let ordering = ref 0 in let table = List.map (fun (sectionname, divname, content) -> - incr ordering; let ordering = !ordering in - [ "ordering", Template.VarString (string_of_int ordering); + incr ordering; let ordering = Int32.of_int !ordering in + let sectionname = match sectionname with None -> "" | Some s -> s in + let divname = match divname with None -> "" | Some s -> s in + [ "ordering", Template.VarString (Int32.to_string ordering); "sectionname", Template.VarString sectionname; "divname", Template.VarString divname; - "content", Template.VarString content ]) model.contents in + "content", Template.VarString content ]) model.contents_ in template#table "contents" table; (* Check for errors and put those into the template. *) @@ -244,11 +260,9 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = (* Check if a URL exists in the database. *) let page_exists page = - let sth = - dbh#prepare_cached "select 1 from pages where hostid = ? and url = ?" in - sth#execute [`Int hostid; `String page]; - - try sth#fetch1int () = 1 with Not_found -> false + let rows = PGSQL(dbh) + "select 1 from pages where hostid = $hostid and url = $page" in + rows = [ Some 1l ] in (* Begin editing a page, pulling the page out of the database and building @@ -322,7 +336,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = if is_action "insert" then ( let posn = get_action "insert" in - let item = "New section - change this", "", "Write some content here." in + let item = + Some "The title of this section", None, "Write something here." in model := action_insert !model posn item ) else if is_action "moveup" then ( let posn = get_action "moveup" in @@ -365,15 +380,20 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = (* Synthesize our own changes. *) let old_page = get_version_for_diff dbh old_version in let new_page = - page_for_diff css (List.map (fun (sectionname, _, content) -> - sectionname, content) model.contents) in + page_for_diff css (List.map ( + fun (sectionname, _, content) -> + let sectionname = match sectionname with + | None -> "" + | Some s -> s in + sectionname, content + ) model.contents_) in let our_diff = diff_cmd old_page new_page in (* Fill out the conflict template. *) template_conflict#set "other_diff" other_diff; template_conflict#set "our_diff" our_diff; - template_conflict#set "old_version" (string_of_int old_version); - template_conflict#set "new_version" (string_of_int new_version); + template_conflict#set "old_version" (Int32.to_string old_version); + template_conflict#set "new_version" (Int32.to_string new_version); template_conflict#set "url" url; q#template template_conflict; @@ -383,15 +403,15 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = * anyone in the page_emails table who has a confirmed address * and who hasn't received an email already today. *) - let sth = dbh#prepare_cached "select email, opt_out from page_emails - where hostid = ? and url = ? - and pending is null - and last_sent < current_date" in - sth#execute [`Int hostid; `String url]; - - let addrs = sth#map (function [`String email; `String opt_out] -> - email, opt_out - | _ -> assert false) in + let rows = PGSQL(dbh) + "select email, opt_out from page_emails + where hostid = $hostid and url = $url + and pending is null + and last_sent < current_date" in + let addrs = List.map ( + fun (email, opt_out) -> + email, opt_out + ) rows in if addrs <> [] then ( (* Construct the email. *) @@ -413,14 +433,14 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = ); (* Update the database to record when these emails were sent. *) - let sth = dbh#prepare_cached "update page_emails - set last_sent = current_date - where hostid = ? and url = ? - and pending is null" in - sth#execute [`Int hostid; `String url]; + PGSQL(dbh) + "update page_emails + set last_sent = current_date + where hostid = $hostid and url = $url + and pending is null"; (* Commit changes to the database. *) - dbh#commit (); + PGOCaml.commit dbh; (* Email notification, if anyone is listed for this host. *) let subject = "Page " ^ url ^ " has been edited" in @@ -441,12 +461,12 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = let cancel id = let url = - if id <> 0 then ( - let sth = dbh#prepare_cached "select coalesce (url, url_deleted) - from pages - where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int id]; - sth#fetch1string () + if id <> 0l then ( + let rows = PGSQL(dbh) + "select coalesce (url, url_deleted) + from pages + where hostid = $hostid and id = $id" in + Option.get (List.hd rows) ) else if q#param "pt_type" = "page" then q#param "pt_value" else @@ -472,7 +492,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = * title - page doesn't yet exist; create it. *) let id = - try Some (int_of_string (q#param "id")) with Not_found -> None in + try Some (Int32.of_string (q#param "id")) with Not_found -> None in (match id with | None -> (* Begin editing the page. *) if q#param_exists "page" then ( diff --git a/scripts/edit_contact.ml b/scripts/edit_contact.ml index 46002f9..fa49661 100644 --- a/scripts/edit_contact.ml +++ b/scripts/edit_contact.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_contact.ml,v 1.4 2005/11/24 14:54:11 rich Exp $ + * $Id: edit_contact.ml,v 1.5 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -30,8 +30,8 @@ open Cocanwiki_strings let split_re = Pcre.regexp "[\\r\\n,;]+" -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = - let id = int_of_string (q#param "id") in +let run r (q : cgi) dbh hostid _ _ = + let id = Int32.of_string (q#param "id") in let name = trim (q#param "name") in let subject = trim (q#param "subject") in @@ -64,35 +64,30 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = ); (* Need to verify that the contact belongs to the host. *) - let sth = dbh#prepare_cached "select 1 from contacts - where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int id]; - - assert (sth#fetch1int () = 1); + let rows = PGSQL(dbh) "select 1 from contacts + where hostid = $hostid and id = $id" in + assert (rows = [ Some 1l ]); (* Update the database. *) - let sth = dbh#prepare_cached "update contacts set name = ?, subject = ? - where hostid = ? and id = ?" in - sth#execute [`String name; `String subject; `Int hostid; `Int id]; - - let sth = - dbh#prepare_cached "delete from contact_emails where contactid = ?" in - sth#execute [`Int id]; + PGSQL(dbh) "update contacts set name = $name, subject = $subject + where hostid = $hostid and id = $id"; + PGSQL(dbh) "delete from contact_emails where contactid = $id"; - let sth = dbh#prepare_cached "insert into contact_emails (contactid, email) - values (?, ?)" in - List.iter (fun email -> - sth#execute [`Int id; `String email]) emails; + List.iter ( + fun email -> + PGSQL(dbh) "insert into contact_emails (contactid, email) + values ($id, $email)" + ) emails; (* Finish off. *) - dbh#commit (); + PGOCaml.commit dbh; let buttons = [ ok_button "/_bin/contacts.cmo"; { Template.StdPages.label = " View contact form "; Template.StdPages.link = "/_bin/contact_show.cmo"; Template.StdPages.method_ = None; - Template.StdPages.params = [ "id", string_of_int id ] } ] in + Template.StdPages.params = [ "id", Int32.to_string id ] } ] in ok ~title:"Contact form edited" ~buttons dbh hostid q "The contact form was edited." diff --git a/scripts/edit_contact_form.ml b/scripts/edit_contact_form.ml index bc888eb..7c5c97b 100644 --- a/scripts/edit_contact_form.ml +++ b/scripts/edit_contact_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: edit_contact_form.ml,v 1.1 2004/09/21 18:24:15 rich Exp $ + * $Id: edit_contact_form.ml,v 1.2 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,32 +27,27 @@ open Printf open Cocanwiki open Cocanwiki_template -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "edit_contact_form.html" in - let id = int_of_string (q#param "id") in - template#set "id" (string_of_int id); + let id = Int32.of_string (q#param "id") in + template#set "id" (Int32.to_string id); (* Get details from the database. *) - let sth = dbh#prepare_cached "select name, subject from contacts - where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int id]; - + let rows = PGSQL(dbh) "select name, subject from contacts + where hostid = $hostid and id = $id" in let name, subject = - match sth#fetch1 () with - [ `String name; `String subject ] -> name, subject - | _ -> assert false in + match rows with + | [row] -> row + | _ -> assert false in template#set "name" name; template#set "subject" subject; - let sth = dbh#prepare_cached "select email from contact_emails - where contactid = ? order by 1" in - sth#execute [`Int id]; - - let table = sth#map (function [`String email] -> - [ "email", Template.VarString email ] - | _ -> assert false) in + let rows = PGSQL(dbh) "select email from contact_emails + where contactid = $id order by 1" in + let table = List.map (fun email -> + [ "email", Template.VarString email ]) rows in template#table "emails" table; q#template template diff --git a/scripts/edit_file.ml b/scripts/edit_file.ml index 230e1ed..681430c 100644 --- a/scripts/edit_file.ml +++ b/scripts/edit_file.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_file.ml,v 1.3 2005/11/24 14:54:11 rich Exp $ + * $Id: edit_file.ml,v 1.4 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -29,29 +29,27 @@ open Cocanwiki_ok open Cocanwiki_strings open Cocanwiki_emailnotify -let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = - let id = int_of_string (q#param "id") in +let run r (q : cgi) dbh hostid {hostname = hostname} user = + let id = Int32.of_string (q#param "id") in (* Get the fields. *) let title = q#param "title" in - let title = if string_is_whitespace title then `Null else `String title in + let title = if string_is_whitespace title then None else Some title in (* Edit it. *) - let sth = dbh#prepare_cached "update files set title = ? - where hostid = ? and id = ? - and name is not null" in - sth#execute [title; `Int hostid; `Int id]; + PGSQL(dbh) "update files set title = $?title + where hostid = $hostid and id = $id and name is not null"; (* Email notify. *) let subject = "Description fields on file #" ^ - string_of_int id ^ " were changed." in + Int32.to_string id ^ " were changed." in let body = fun () -> "Page: http://" ^ hostname ^ "/_files" in email_notify ~body ~subject ~user dbh hostid; (* Done it. *) - dbh#commit (); + PGOCaml.commit dbh; let buttons = [ ok_button "/_files" ] in ok ~title:"Description fields updated" ~buttons diff --git a/scripts/edit_file_form.ml b/scripts/edit_file_form.ml index 6db29c9..85605e2 100644 --- a/scripts/edit_file_form.ml +++ b/scripts/edit_file_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: edit_file_form.ml,v 1.1 2004/11/01 17:05:14 rich Exp $ + * $Id: edit_file_form.ml,v 1.2 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -28,26 +28,24 @@ open Cocanwiki open Cocanwiki_template open Cocanwiki_date -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "edit_file_form.html" in - let id = int_of_string (q#param "id") in + let id = Int32.of_string (q#param "id") in - let sth = dbh#prepare_cached "select name, coalesce (title, ''), - mime_type, - upload_date - from files - where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int id]; + let rows = PGSQL(dbh) + "select name, title, mime_type, upload_date from files + where hostid = $hostid and id = $id and name is not null" in let name, title, mime_type, upload_date = - match sth#fetch1 () with - [ `String name; `String title; `String mime_type; - `Timestamp upload_date ] -> - name, title, mime_type, upload_date - | _ -> assert false in + match rows with + | [row] -> row + | _ -> assert false in - template#set "id" (string_of_int id); + let name = Option.get name in + let title = match title with None -> "" | Some t -> t in + + template#set "id" (Int32.to_string id); template#set "name" name; template#set "title" title; template#set "mime_type" mime_type; diff --git a/scripts/edit_host_css.ml b/scripts/edit_host_css.ml index 790486b..b322acb 100644 --- a/scripts/edit_host_css.ml +++ b/scripts/edit_host_css.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_host_css.ml,v 1.5 2005/11/24 14:54:11 rich Exp $ + * $Id: edit_host_css.ml,v 1.6 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -28,18 +28,17 @@ open Cocanwiki open Cocanwiki_ok open Cocanwiki_strings -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let css = q#param "css" in - let css = if string_is_whitespace css then `Null else `String css in + let css = if string_is_whitespace css then None else Some css in (* XXX We should version the global stylesheet. However this requires * some fairly non-trivial coding. *) - let sth = dbh#prepare_cached "update hosts set css = ? where id = ?" in - sth#execute [css; `Int hostid]; + PGSQL(dbh) "update hosts set css = $?css where id = $hostid"; - dbh#commit (); + PGOCaml.commit dbh; let buttons = [ ok_button "/_bin/host_menu.cmo"; diff --git a/scripts/edit_host_css_form.ml b/scripts/edit_host_css_form.ml index 1bef710..66a3954 100644 --- a/scripts/edit_host_css_form.ml +++ b/scripts/edit_host_css_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: edit_host_css_form.ml,v 1.3 2004/10/23 09:36:11 rich Exp $ + * $Id: edit_host_css_form.ml,v 1.4 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,17 +27,16 @@ open Printf open Cocanwiki open Cocanwiki_template -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "edit_host_css_form.html" in - let sth = dbh#prepare_cached "select css from hosts where id = ?" in - sth#execute [`Int hostid]; + let rows = PGSQL(dbh) "select css from hosts where id = $hostid" in let css = - match sth#fetch1 () with - | [ `Null ] -> "" - | [ `String css ] -> css - | _ -> assert false in + match rows with + | [ None ] -> "" + | [ Some css ] -> css + | _ -> assert false in template#set "css" css; diff --git a/scripts/edit_host_settings.ml b/scripts/edit_host_settings.ml index e8bbebf..b7dc999 100644 --- a/scripts/edit_host_settings.ml +++ b/scripts/edit_host_settings.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_host_settings.ml,v 1.9 2005/11/24 14:54:11 rich Exp $ + * $Id: edit_host_settings.ml,v 1.10 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -28,7 +28,7 @@ open Cocanwiki open Cocanwiki_ok open Cocanwiki_strings -let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = +let run r (q : cgi) dbh hostid { hostname = hostname } _ = (* Cancel? *) if q#param_true "cancel" then ( (* Request cancelled. *) @@ -50,35 +50,32 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ = let brand_description = trim (q#param "brand_description") in let pagebug = trim (q#param "pagebug") in - let theme_css = if theme_css = "" then `Null else `String theme_css in + let theme_css = if theme_css = "" then None else Some theme_css in let feedback_email = - if feedback_email = "" then `Null else `String feedback_email in - let brand = if brand = "" then `Null else `String brand in + if string_is_whitespace feedback_email then + None else Some feedback_email in + let brand = if string_is_whitespace brand then None else Some brand in let brand_tagline = - if brand_tagline = "" then `Null else `String brand_tagline in + if string_is_whitespace brand_tagline then None else Some brand_tagline in let brand_description = - if brand_description = "" then `Null else `String brand_description in + if string_is_whitespace brand_description then + None else Some brand_description in let pagebug = - if pagebug = "" then `Null else `String pagebug in + if string_is_whitespace pagebug then None else Some pagebug in (* Update the database. *) - let sth = dbh#prepare_cached "update hosts set edit_anon = ?, - create_account_anon = ?, theme_css = ?, - feedback_email = ?, mailing_list = ?, - search_box = ?, navigation = ?, - view_anon = ?, - brand = ?, brand_tagline = ?, - brand_description = ?, - pagebug = ? - where id = ?" in - sth#execute [`Bool edit_anon; `Bool create_account_anon; - theme_css; feedback_email; `Bool mailing_list; `Bool search_box; - `Bool navigation; `Bool view_anon; - brand; brand_tagline; brand_description; - pagebug; - `Int hostid]; + PGSQL(dbh) + "update hosts set edit_anon = $edit_anon, + create_account_anon = $create_account_anon, theme_css = $?theme_css, + feedback_email = $?feedback_email, mailing_list = $mailing_list, + search_box = $search_box, navigation = $navigation, + view_anon = $view_anon, + brand = $?brand, brand_tagline = $?brand_tagline, + brand_description = $?brand_description, + pagebug = $?pagebug + where id = $hostid"; - dbh#commit (); + PGOCaml.commit dbh; (* Finish off. *) ok ~title:"Global settings updated" diff --git a/scripts/edit_host_settings_form.ml b/scripts/edit_host_settings_form.ml index 553e7d2..6b8e73c 100644 --- a/scripts/edit_host_settings_form.ml +++ b/scripts/edit_host_settings_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: edit_host_settings_form.ml,v 1.6 2004/11/03 13:36:45 rich Exp $ + * $Id: edit_host_settings_form.ml,v 1.7 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,48 +27,47 @@ open Printf open Cocanwiki open Cocanwiki_template -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "edit_host_settings_form.html" in (* List of themes. *) - let sth = dbh#prepare_cached "select theme_css, name, description - from themes order by 2, 1" in - sth#execute []; + let rows = + PGSQL(dbh) "select theme_css, name, description + from themes order by 2, 1" in let themes = - sth#map (function [`String theme_css; `String name; `String description] -> - theme_css, (name, description) - | _ -> assert false) in + List.map (fun (theme_css, name, description) -> + theme_css, (name, description)) rows in (* Get lots of host-specific stuff from the database. *) - let sth = - dbh#prepare_cached + let rows = + PGSQL(dbh) "select canonical_hostname, edit_anon, create_account_anon, theme_css, feedback_email, mailing_list, search_box, navigation, view_anon, - coalesce (brand, ''), coalesce (brand_tagline, ''), - coalesce (brand_description, '') - from hosts where id = ?" in - sth#execute [`Int hostid]; + brand, brand_tagline, brand_description + from hosts where id = $hostid" in let canonical_hostname, edit_anon, create_account_anon, theme_css, feedback_email, mailing_list, search_box, navigation, view_anon, brand, brand_tagline, brand_description = - match sth#fetch1 () with - [ `String canonical_hostname; - `Bool edit_anon; `Bool create_account_anon; - (`String _ | `Null) as theme_css; - (`String _ | `Null) as feedback_email; - `Bool mailing_list; `Bool search_box; `Bool navigation; - `Bool view_anon; - `String brand; `String brand_tagline; `String brand_description ] -> - let theme_css = - match theme_css with `String s -> s | `Null -> "" in - let feedback_email = - match feedback_email with `String s -> s | `Null -> "" in - canonical_hostname, edit_anon, create_account_anon, theme_css, - feedback_email, mailing_list, search_box, navigation, view_anon, - brand, brand_tagline, brand_description - | _ -> assert false in + match rows with + | [canonical_hostname, edit_anon, create_account_anon, theme_css, + feedback_email, mailing_list, search_box, navigation, view_anon, + brand, brand_tagline, brand_description] -> + let theme_css = + match theme_css with Some s -> s | None -> "" in + let feedback_email = + match feedback_email with Some s -> s | None -> "" in + let brand = + match brand with Some s -> s | None -> "" in + let brand_tagline = + match brand_tagline with Some s -> s | None -> "" in + let brand_description = + match brand_description with Some s -> s | None -> "" in + canonical_hostname, edit_anon, create_account_anon, theme_css, + feedback_email, mailing_list, search_box, navigation, view_anon, + brand, brand_tagline, brand_description + | _ -> assert false in template#set "canonical_hostname" canonical_hostname; template#conditional "edit_anon" edit_anon; diff --git a/scripts/edit_image.ml b/scripts/edit_image.ml index 9760a3d..4ddd68b 100644 --- a/scripts/edit_image.ml +++ b/scripts/edit_image.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_image.ml,v 1.3 2005/11/24 14:54:11 rich Exp $ + * $Id: edit_image.ml,v 1.4 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -29,8 +29,8 @@ open Cocanwiki_ok open Cocanwiki_strings open Cocanwiki_emailnotify -let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = - let id = int_of_string (q#param "id") in +let run r (q : cgi) dbh hostid {hostname = hostname} user = + let id = Int32.of_string (q#param "id") in (* Get the fields. *) let alt = q#param "alt" in @@ -48,28 +48,26 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = return () ); - let title = if string_is_whitespace title then `Null else `String title in + let title = if string_is_whitespace title then None else Some title in let longdesc = - if string_is_whitespace longdesc then `Null else `String longdesc in - let clazz = if string_is_whitespace clazz then `Null else `String clazz in + if string_is_whitespace longdesc then None else Some longdesc in + let clazz = if string_is_whitespace clazz then None else Some clazz in (* Edit it. *) - let sth = dbh#prepare_cached "update images set alt = ?, title = ?, - longdesc = ?, class = ? - where hostid = ? and id = ? - and name is not null" in - sth#execute [`String alt; title; longdesc; clazz; - `Int hostid; `Int id]; + PGSQL(dbh) + "update images set alt = $alt, title = $?title, + longdesc = $?longdesc, class = $?clazz + where hostid = $hostid and id = $id and name is not null"; (* Email notify. *) let subject = "Description fields on image #" ^ - string_of_int id ^ " were changed." in + Int32.to_string id ^ " were changed." in let body = fun () -> "Page: http://" ^ hostname ^ "/_images" in email_notify ~body ~subject ~user dbh hostid; (* Done it. *) - dbh#commit (); + PGOCaml.commit dbh; let buttons = [ ok_button "/_images" ] in ok ~title:"Description fields updated" ~buttons diff --git a/scripts/edit_image_form.ml b/scripts/edit_image_form.ml index 7e29d9d..ff83135 100644 --- a/scripts/edit_image_form.ml +++ b/scripts/edit_image_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: edit_image_form.ml,v 1.1 2004/11/01 17:05:14 rich Exp $ + * $Id: edit_image_form.ml,v 1.2 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -28,41 +28,47 @@ open Cocanwiki open Cocanwiki_template open Cocanwiki_date -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "edit_image_form.html" in - let id = int_of_string (q#param "id") in + let id = Int32.of_string (q#param "id") in - let sth = dbh#prepare_cached "select name, alt, coalesce (title, ''), - coalesce (longdesc, ''), - coalesce (class, ''), - mime_type, - coalesce (tn_width, 0), - coalesce (tn_height, 0), - upload_date - from images - where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int id]; + let rows = PGSQL(dbh) + "select name, alt, title, + longdesc, + class, + mime_type, + tn_width, + tn_height, + upload_date + from images + where hostid = $hostid and id = $id and name is not null" in let name, alt, title, longdesc, clazz, mime_type, tn_width, tn_height, upload_date = - match sth#fetch1 () with - [ `String name; `String alt; `String title; `String longdesc; - `String clazz; `String mime_type; `Int tn_width; `Int tn_height; - `Timestamp upload_date ] -> - name, alt, title, longdesc, clazz, mime_type, tn_width, tn_height, - upload_date - | _ -> assert false in + match rows with + | [name, alt, title, longdesc, clazz, mime_type, tn_width, tn_height, + upload_date] -> + name, alt, title, longdesc, clazz, mime_type, tn_width, tn_height, + upload_date + | _ -> assert false in - template#set "id" (string_of_int id); + let name = Option.get name in + let title = match title with None -> "" | Some s -> s in + let longdesc = match longdesc with None -> "" | Some s -> s in + let clazz = match clazz with None -> "" | Some s -> s in + let tn_width = match tn_width with None -> 0l | Some s -> s in + let tn_height = match tn_height with None -> 0l | Some s -> s in + + template#set "id" (Int32.to_string id); template#set "name" name; template#set "alt" alt; template#set "title" title; template#set "longdesc" longdesc; template#set "class" clazz; template#set "mime_type" mime_type; - template#set "tn_width" (string_of_int tn_width); - template#set "tn_height" (string_of_int tn_height); + template#set "tn_width" (Int32.to_string tn_width); + template#set "tn_height" (Int32.to_string tn_height); template#set "upload_date" (printable_date upload_date); q#template template diff --git a/scripts/edit_page_css.ml b/scripts/edit_page_css.ml index 6937665..71e727b 100644 --- a/scripts/edit_page_css.ml +++ b/scripts/edit_page_css.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_page_css.ml,v 1.18 2005/11/24 14:54:11 rich Exp $ + * $Id: edit_page_css.ml,v 1.19 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -30,21 +30,21 @@ open Cocanwiki_diff open Cocanwiki_emailnotify open Cocanwiki_strings -let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = +let run r (q : cgi) dbh hostid {hostname = hostname} user = let page = q#param "page" in let css = q#param "css" in - let css = if string_is_whitespace css then `Null else `String css in + let css = if string_is_whitespace css then None else Some css in (* Get the IP address of the user, if available. *) let logged_ip = - try `String (Connection.remote_ip (Request.connection r)) - with Not_found -> `Null in + try Some (Connection.remote_ip (Request.connection r)) + with Not_found -> None in let logged_user = match user with - | User (id, _, _, _) -> `Int id - | _ -> `Null in + | User (id, _, _, _) -> Some id + | _ -> None in (* Changing the CSS creates a new version of the page. This enables * us to revert changes to the CSS easily. @@ -53,11 +53,11 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = redirect from pages where hostid = ? and url = ?" in - sth#execute [`Int hostid; `String page]; + sth#execute [Some hostid; Some page]; let oldpageid, title, description, creation_date, redirect = match sth#fetch1 () with - [ `Int id; title; description; creation_date; redirect ] -> + [ Some id; title; description; creation_date; redirect ] -> id, title, description, creation_date, redirect | _ -> assert false in @@ -70,13 +70,13 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = let sth = dbh#prepare_cached "update pages set url_deleted = url, url = null where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int oldpageid]; + sth#execute [Some hostid; Some oldpageid]; let sth = dbh#prepare_cached "insert into pages (hostid, url, title, description, creation_date, logged_ip, logged_user, redirect, css) values (?, ?, ?, ?, ?, ?, ?, ?, ?)" in - sth#execute [`Int hostid; `String page; title; description; + sth#execute [Some hostid; Some page; title; description; creation_date; logged_ip; logged_user; redirect; css ]; let pageid = Int64.to_int (sth#serial "pages_id_seq") in @@ -87,9 +87,9 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = content, divname from contents where pageid = ?" in - sth#execute [`Int pageid; `Int oldpageid]; + sth#execute [Some pageid; Some oldpageid]; - dbh#commit (); + PGOCaml.commit dbh; (* Email notification. *) let subject = "CSS for page " ^ page ^ " has been modified" in diff --git a/scripts/edit_page_css_form.ml b/scripts/edit_page_css_form.ml index 105094a..d58c641 100644 --- a/scripts/edit_page_css_form.ml +++ b/scripts/edit_page_css_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: edit_page_css_form.ml,v 1.6 2004/09/09 12:21:22 rich Exp $ + * $Id: edit_page_css_form.ml,v 1.7 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -27,19 +27,19 @@ open Printf open Cocanwiki open Cocanwiki_template -let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = +let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "edit_page_css_form.html" in let page = q#param "page" in let sth = dbh#prepare_cached "select css from pages where hostid = ? and url = ?" in - sth#execute [`Int hostid; `String page]; + sth#execute [Some hostid; Some page]; let css = match sth#fetch1 () with - | [ `Null ] -> "" - | [ `String css ] -> css + | [ None ] -> "" + | [ Some css ] -> css | _ -> assert false in template#set "page" page; diff --git a/scripts/edit_sitemenu.ml b/scripts/edit_sitemenu.ml index 676b0b3..566dbaa 100644 --- a/scripts/edit_sitemenu.ml +++ b/scripts/edit_sitemenu.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_sitemenu.ml,v 1.9 2005/11/24 14:54:11 rich Exp $ + * $Id: edit_sitemenu.ml,v 1.10 2006/03/27 18:09:46 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -38,7 +38,7 @@ open Cocanwiki_strings *) type model_t = (string * string) list (* label, url *) -let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user= +let run r (q : cgi) dbh hostid { hostname = hostname } user= let template = get_template dbh hostid "edit_sitemenu.html" in (* Workaround bugs in IE, specifically lack of support for