From: rich Date: Tue, 28 Mar 2006 16:24:07 +0000 (+0000) Subject: Scripts updated to use new PG interface. X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=cd059731a60fd3d4dcf426430ad26ff227b91910;p=cocanwiki.git Scripts updated to use new PG interface. --- diff --git a/scripts/admin/admin.ml b/scripts/admin/admin.ml index 68416e5..82d4ee6 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.7 2006/03/27 18:09:47 rich Exp $ + * $Id: admin.ml,v 1.8 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -32,39 +32,32 @@ let template = _get_template "admin/admin.html" let run r (q : cgi) dbh _ _ _ = (* Select out the alternative hostnames. *) - let sth = dbh#prepare_cached - "select hs.hostid, hs.name from hostnames hs - where not exists (select 1 from hosts - where id = hs.hostid - and canonical_hostname = hs.name)" in - sth#execute []; - - let hostnames = sth#map (function [`Int hostid; `String name] -> - hostid, name - | _ -> assert false) in + let hostnames = PGSQL(dbh) + "select hs.hostid, hs.name from hostnames hs + where not exists (select 1 from hosts + where id = hs.hostid + and canonical_hostname = hs.name)" in (* Pull out the details of all the wikis on the server. *) - let sth = dbh#prepare_cached - "select h.id, h.canonical_hostname, - (select count(*) from pages - where hostid = h.id and url is not null), - (select max(last_modified_date) from pages - where hostid = h.id and url is not null) - from hosts h - order by 2" in - sth#execute []; + let rows = PGSQL(dbh) + "select h.id, h.canonical_hostname, + (select count(*) from pages + where hostid = h.id and url is not null), + (select max(last_modified_date) from pages + where hostid = h.id and url is not null) + from hosts h + order by 2" in let table = - sth#map - (function [`Int id; `String canonical_hostname; - (`Null | `Int _) as page_count; - (`Null | `Timestamp _) as last_modified_date] -> + List.map ( + function (id, canonical_hostname, + page_count, last_modified_date) -> let page_count = match page_count with - `Null -> 0 - | `Int n -> n in + | None -> 0L + | Some n -> n in let last_modified_date = match last_modified_date with - `Null -> "-" - | `Timestamp date -> printable_date date in + | None -> "-" + | Some date -> printable_date date in let hostnames = List.filter (fun (i, _) -> i = id) hostnames in @@ -73,13 +66,12 @@ let run r (q : cgi) dbh _ _ _ = [ "hostname", Template.VarString hostname ]) hostnames in - [ "id", Template.VarString (string_of_int id); + [ "id", Template.VarString (Int32.to_string id); "canonical_hostname", Template.VarString canonical_hostname; - "page_count", Template.VarString (string_of_int page_count); + "page_count", Template.VarString (Int64.to_string page_count); "last_modified_date", Template.VarString last_modified_date; "hostnames", Template.VarTable hostnames ] - - | _ -> assert false) in + ) rows in template#table "hosts" table; diff --git a/scripts/admin/create_host.ml b/scripts/admin/create_host.ml index 370b501..0d4f6e6 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.11 2006/03/27 18:09:47 rich Exp $ + * $Id: create_host.ml,v 1.12 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -35,7 +35,8 @@ let split_re = Pcre.regexp "[\\s,;]+" let run r = let q = new cgi r in - let dbh = Cocanwiki._get_dbh r in + let dbh = PGOCaml.connect ~database:"cocanwiki" () in + PGOCaml.begin_work dbh; let canonical_hostname = q#param "canonical_hostname" in let hostnames = try q#param "hostnames" with Not_found -> "" in @@ -45,7 +46,7 @@ let run r = let title = trim title in if title = "" then ( Cocanwiki_ok.error ~back_button:true ~title:"Bad title" - dbh (-1) q "You must give a title for this Wiki."; + dbh (-1l) q "You must give a title for this Wiki."; ) else ( (* In theory we could verify characters in hostnames. However * it's probably best to assume the sysadmin knows what they're up to @@ -64,8 +65,8 @@ let run r = let hostnames = List.filter ((<>) "") hostnames in let template = - if q#param_true "template" then int_of_string (q#param "template") - else 0 in + if q#param_true "template" then Int32.of_string (q#param "template") + else 0l in let hostid = create_host dbh canonical_hostname hostnames template title "Administrator" "123456" true None in @@ -78,11 +79,11 @@ let run r = { Template.StdPages.label = "OK"; Template.StdPages.link = "/_bin/admin/host.cmo"; Template.StdPages.method_ = None; - Template.StdPages.params = [ "hostid", string_of_int hostid ] } + Template.StdPages.params = [ "hostid", Int32.to_string hostid ] } ] in Cocanwiki_ok.ok ~title:"Wiki created" ~buttons - dbh (-1) q "A new Wiki was created." + dbh (-1l) q "A new Wiki was created." ) let () = diff --git a/scripts/admin/create_host_form.ml b/scripts/admin/create_host_form.ml index 6b55927..705f279 100644 --- a/scripts/admin/create_host_form.ml +++ b/scripts/admin/create_host_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_host_form.ml,v 1.5 2004/09/25 11:45:59 rich Exp $ + * $Id: create_host_form.ml,v 1.6 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -32,18 +32,19 @@ let template = Cocanwiki_template._get_template "admin/create_host_form.html" let run r = let q = new cgi r in - let dbh = Cocanwiki._get_dbh r in + let dbh = PGOCaml.connect ~database:"cocanwiki" () in + PGOCaml.begin_work dbh; (* Get the template hosts. *) - let sth = dbh#prepare_cached "select id, canonical_hostname from hosts - where is_template order by 2" in - sth#execute []; + let rows = PGSQL(dbh) + "select id, canonical_hostname from hosts + where is_template order by 2" in - let table = sth#map (function [`Int id; `String canonical_hostname] -> - [ "id", Template.VarString (string_of_int id); - "canonical_hostname", - Template.VarString canonical_hostname ] - | _ -> assert false) in + let table = List.map ( + fun (id, canonical_hostname) -> + [ "id", Template.VarString (Int32.to_string id); + "canonical_hostname", Template.VarString canonical_hostname ] + ) rows in template#table "templates" table; q#template template diff --git a/scripts/admin/edit_host_css.ml b/scripts/admin/edit_host_css.ml index 785b0ff..afb9ce5 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.8 2006/03/27 18:09:47 rich Exp $ + * $Id: edit_host_css.ml,v 1.9 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -29,17 +29,16 @@ open Cocanwiki_ok open Cocanwiki_strings let run r (q : cgi) dbh _ _ _ = - let hostid = int_of_string (q#param "hostid") in + let hostid = Int32.of_string (q#param "hostid") in let css = q#param "css" in - let css = if string_is_whitespace css then `Null else `String css in + let css = if string_is_whitespace css then None else Some css in (* XXX We should version the global stylesheet. However this requires * some fairly non-trivial coding. *) - let sth = dbh#prepare_cached "update hosts set css = ? where id = ?" in - sth#execute [css; `Int hostid]; + PGSQL(dbh) "update hosts set css = $?css where id = $hostid"; PGOCaml.commit dbh; @@ -47,15 +46,15 @@ let run r (q : cgi) dbh _ _ _ = { Template.StdPages.label = "OK"; Template.StdPages.link = "/_bin/admin/host.cmo"; Template.StdPages.method_ = None; - Template.StdPages.params = [ "hostid", string_of_int hostid ] }; + Template.StdPages.params = [ "hostid", Int32.to_string hostid ] }; { Template.StdPages.label = "Edit stylesheet again"; Template.StdPages.link = "/_bin/admin/edit_host_css_form.cmo"; Template.StdPages.method_ = None; - Template.StdPages.params = [ "hostid", string_of_int hostid ] } + Template.StdPages.params = [ "hostid", Int32.to_string hostid ] } ] in ok ~title:"Stylesheet changed" ~buttons - dbh (-1) q + dbh (-1l) q ("The stylesheet was changed successfully. " ^ "Note: You must RELOAD the page to see changes to stylesheets.") diff --git a/scripts/admin/edit_host_css_form.ml b/scripts/admin/edit_host_css_form.ml index 86d2d42..945d5c8 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.6 2006/03/27 18:09:47 rich Exp $ + * $Id: edit_host_css_form.ml,v 1.7 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -30,17 +30,17 @@ open Cocanwiki_template let template = _get_template "admin/edit_host_css_form.html" let run r (q : cgi) dbh _ _ _ = - let hostid = int_of_string (q#param "hostid") in - template#set "id" (string_of_int hostid); + let hostid = Int32.of_string (q#param "hostid") in + template#set "id" (Int32.to_string hostid); - let sth = dbh#prepare_cached "select css from hosts where id = ?" in - sth#execute [`Int hostid]; + let css = List.hd ( + PGSQL(dbh) "select css from hosts where id = $hostid" + ) in let css = - match sth#fetch1 () with - | [ `Null ] -> "" - | [ `String css ] -> css - | _ -> assert false in + match css with + | None -> "" + | Some css -> css in template#set "css" css; diff --git a/scripts/admin/edit_hostnames.ml b/scripts/admin/edit_hostnames.ml index 03eed09..1fe9e62 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.9 2006/03/27 18:09:47 rich Exp $ + * $Id: edit_hostnames.ml,v 1.10 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -31,12 +31,12 @@ open Cocanwiki_strings let split_re = Pcre.regexp "[\\s,;]+" let run r (q : cgi) dbh _ host' _ = - let hostid = int_of_string (q#param "hostid") in + let hostid = Int32.of_string (q#param "hostid") in if q#param_true "cancel" then ( let { hostname = hostname } = host' in q#redirect ("http://" ^ hostname ^ "/_bin/admin/host.cmo?hostid=" ^ - string_of_int hostid); + Int32.to_string hostid); return () ); @@ -61,19 +61,15 @@ let run r (q : cgi) dbh _ host' _ = let hostnames = List.filter ((<>) "") hostnames in (* Update the database. *) - let sth = dbh#prepare_cached - "set constraints \"hosts_hostname_cn\" deferred" in - sth#execute []; - let sth = dbh#prepare_cached "update hosts set canonical_hostname = ? - where id = ?" in - sth#execute [`String canonical_hostname; `Int hostid]; - let sth = dbh#prepare_cached "delete from hostnames where hostid = ?" in - sth#execute [`Int hostid]; - let sth = dbh#prepare_cached "insert into hostnames (hostid, name) - values (?, ?)" in - sth#execute [`Int hostid; `String canonical_hostname]; - List.iter (fun name -> - sth#execute [`Int hostid; `String name]) hostnames; + PGSQL(dbh) "set constraints \"hosts_hostname_cn\" deferred"; + PGSQL(dbh) "update hosts set canonical_hostname = $canonical_hostname + where id = $hostid"; + PGSQL(dbh) "delete from hostnames where hostid = $hostid"; + List.iter ( + fun name -> + PGSQL(dbh) "insert into hostnames (hostid, name) + values ($hostid, $name)"; + ) hostnames; (* Commit to the database. *) PGOCaml.commit dbh; @@ -83,11 +79,11 @@ let run r (q : cgi) dbh _ host' _ = { Template.StdPages.label = "OK"; Template.StdPages.link = "/_bin/admin/host.cmo"; Template.StdPages.method_ = None; - Template.StdPages.params = [ "hostid", string_of_int hostid ] } + Template.StdPages.params = [ "hostid", Int32.to_string hostid ] } ] in ok ~title:"Saved" ~buttons - dbh (-1) q "Hostnames updated." + dbh (-1l) q "Hostnames updated." let () = register_script run diff --git a/scripts/admin/edit_hostnames_form.ml b/scripts/admin/edit_hostnames_form.ml index df11806..b698c70 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.6 2006/03/27 18:09:47 rich Exp $ + * $Id: edit_hostnames_form.ml,v 1.7 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -30,24 +30,20 @@ open Cocanwiki_template let template = _get_template "admin/edit_hostnames_form.html" let run r (q : cgi) dbh _ _ _ = - let hostid = int_of_string (q#param "hostid") in + let hostid = Int32.of_string (q#param "hostid") in + template#set "id" (Int32.to_string hostid); - template#set "id" (string_of_int hostid); + let canonical_hostname = List.hd ( + PGSQL(dbh) + "select canonical_hostname from hosts where id = $hostid" + ) in - let sth = dbh#prepare_cached - "select canonical_hostname from hosts where id = ?" in - sth#execute [`Int hostid]; - - let canonical_hostname = sth#fetch1string () in template#set "canonical_hostname" canonical_hostname; - let sth = dbh#prepare_cached "select name from hostnames - where hostid = ? - and name <> ?" in - sth#execute [`Int hostid; `String canonical_hostname]; + let hostnames = PGSQL(dbh) + "select name from hostnames + where hostid = $hostid and name <> $canonical_hostname" in - let hostnames = sth#map (function [`String hostname] -> hostname - | _ -> assert false) in template#set "hostnames" (String.concat "\n" hostnames); q#template template diff --git a/scripts/admin/host.ml b/scripts/admin/host.ml index 0092fa6..8c4253c 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.9 2006/03/27 18:09:47 rich Exp $ + * $Id: host.ml,v 1.10 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -31,68 +31,61 @@ open Cocanwiki_date let template = _get_template "admin/host.html" let run r (q : cgi) dbh _ _ _ = - let hostid = int_of_string (q#param "hostid") in - - template#set "id" (string_of_int hostid); + let hostid = Int32.of_string (q#param "hostid") in + template#set "id" (Int32.to_string hostid); (* Pull out some overall details for this host. *) - let sth = dbh#prepare_cached - "select h.canonical_hostname, h.css is not null, - (select count(*) from pages - where hostid = h.id and url is not null), - (select count(*) from pages - where hostid = h.id), - (select max(last_modified_date) from pages - where hostid = h.id and url is not null), - (select min(last_modified_date) from pages - where hostid = h.id and url is not null) - from hosts h - where h.id = ?" in - sth#execute [`Int hostid]; + let rows = PGSQL(dbh) + "select h.canonical_hostname, h.css is not null, + (select count(*) from pages + where hostid = h.id and url is not null), + (select count(*) from pages + where hostid = h.id), + (select max(last_modified_date) from pages + where hostid = h.id and url is not null), + (select min(last_modified_date) from pages + where hostid = h.id and url is not null) + from hosts h + where h.id = $hostid" in let canonical_hostname, has_css, page_count, total_count, last_modified_date, creation_date = - match sth#fetch1 () with - [ `String canonical_hostname; - `Bool has_css; - (`Null | `Int _ | `Int64 _) as page_count; - (`Null | `Int _ | `Int64 _) as total_count; - (`Null | `Timestamp _) as last_modified_date; - (`Null | `Timestamp _) as creation_date ] -> - let page_count = match page_count with - `Null -> 0 - | `Int64 n -> Int64.to_int n - | `Int n -> n in - let total_count = match total_count with - `Null -> 0 - | `Int64 n -> Int64.to_int n - | `Int n -> n in - let last_modified_date = match last_modified_date with - `Null -> "" - | `Timestamp t -> printable_date t in - let creation_date = match creation_date with - `Null -> "" - | `Timestamp t -> printable_date t in - canonical_hostname, has_css, page_count, total_count, - last_modified_date, creation_date - | xs -> failwith (Dbi.sdebug xs) in + match rows with + | [ canonical_hostname, Some has_css, + page_count, + total_count, + last_modified_date, creation_date ] -> + let page_count = match page_count with + | None -> 0L + | Some n -> n in + let total_count = match total_count with + | None -> 0L + | Some n -> n in + let last_modified_date = match last_modified_date with + | None -> "" + | Some t -> printable_date t in + let creation_date = match creation_date with + | None -> "" + | Some t -> printable_date t in + canonical_hostname, has_css, page_count, total_count, + last_modified_date, creation_date + | _ -> assert false in template#set "canonical_hostname" canonical_hostname; template#conditional "has_css" has_css; - template#set "page_count" (string_of_int page_count); - template#set "total_count" (string_of_int total_count); + template#set "page_count" (Int64.to_string page_count); + template#set "total_count" (Int64.to_string total_count); template#set "last_modified_date" last_modified_date; template#set "creation_date" creation_date; (* Pull out any aliases. *) - let sth = dbh#prepare_cached "select name from hostnames - where hostid = ? - and name <> ?" in - sth#execute [`Int hostid; `String canonical_hostname]; - - let table = sth#map (function [`String hostname] -> - [ "hostname", Template.VarString hostname ] - | _ -> assert false) in + let rows = PGSQL(dbh) + "select name from hostnames + where hostid = $hostid and name <> $canonical_hostname" in + let table = List.map ( + fun hostname -> + [ "hostname", Template.VarString hostname ] + ) rows in template#table "hostnames" table; q#template template diff --git a/scripts/images.ml b/scripts/images.ml index a9d43b5..b11dafd 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.9 2006/03/28 13:20:00 rich Exp $ + * $Id: images.ml,v 1.10 2006/03/28 16:24:07 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -50,26 +50,26 @@ let run r (q : cgi) dbh hostid _ _ = order by 2, 3" in let table = - sth#map + List.map (fun row -> let id, name, width, height, alt, size, tn_width, tn_height, is_deleted, has_thumbnail = match row with - | [id, Some name, None, width, height, - alt, Some size, tn_width, tn_height] -> + | (id, Some name, None, width, height, + alt, Some size, Some tn_width, Some tn_height) -> id, name, width, height, alt, size, tn_width, tn_height, false, true - | [id, None, Some name, width, height, - alt, Some size, tn_width, tn_height] -> + | (id, None, Some name, width, height, + alt, Some size, Some tn_width, Some tn_height) -> id, name, width, height, alt, size, tn_width, tn_height, true, true - | [id, Some name, None, width, height, - alt, Some size, None, None] -> - id, name, width, height, alt, size, 0, 0, + | (id, Some name, None, width, height, + alt, Some size, None, None) -> + id, name, width, height, alt, size, 0l, 0l, false, false - | [id, None, Some name, width, height, - alt, Some size, None, None] -> - id, name, width, height, alt, size, 0, 0, + | (id, None, Some name, width, height, + alt, Some size, None, None) -> + id, name, width, height, alt, size, 0l, 0l, true, false | _ -> assert false in let size = Int32.to_int size in @@ -82,7 +82,8 @@ let run r (q : cgi) dbh hostid _ _ = "tn_width", Template.VarString (Int32.to_string tn_width); "tn_height", Template.VarString (Int32.to_string tn_height); "is_deleted", Template.VarConditional is_deleted; - "has_thumbnail", Template.VarConditional has_thumbnail ]) in + "has_thumbnail", Template.VarConditional has_thumbnail ] + ) rows in template#table "images" table; diff --git a/scripts/invite_user_confirm.ml b/scripts/invite_user_confirm.ml index 9db853a..89fb904 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.6 2006/03/28 13:20:00 rich Exp $ + * $Id: invite_user_confirm.ml,v 1.7 2006/03/28 16:24:07 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -42,8 +42,8 @@ let run r (q : cgi) dbh hostid { hostname = hostname } _ = let email, userid = match rows with - | [ Some email; userid ] -> Some email, userid - | [ None; userid ] -> None, userid + | [ Some email, userid ] -> Some email, userid + | [ None, userid ] -> None, userid | [] -> error ~title:"Already signed up" dbh hostid q "It looks like you have already used your invitation."; diff --git a/scripts/largest_pages.ml b/scripts/largest_pages.ml index 90d0988..161d12a 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.5 2006/03/28 13:20:00 rich Exp $ + * $Id: largest_pages.ml,v 1.6 2006/03/28 16:24:07 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -48,25 +48,27 @@ let run r (q : cgi) dbh hostid _ _ = let table = List.map - (function [pageid; page; title; Some size] -> - let size = Int32.to_int size in - let download_time = overhead + size / modem_speed in (* seconds *) - let download_time = - if download_time <= 4 then "<= 4 s" - else if download_time < 60 then sprintf "%d s" download_time - else sprintf "%d m %d s" (download_time / 60) (download_time mod 60) - in + (fun (pageid, page, title, size) -> + let page = Option.get page in + let size = Int64.to_int (Option.get size) in + let download_time = overhead + size / modem_speed in (* seconds *) + let download_time = + if download_time <= 4 then "<= 4 s" + else if download_time < 60 then sprintf "%d s" download_time + else + sprintf "%d m %d s" (download_time / 60) (download_time mod 60) + in - let size = - if size < 4096 then sprintf "%d bytes" size - else sprintf "%d K" (size / 1024) in + let size = + if size < 4096 then sprintf "%d bytes" size + else sprintf "%d K" (size / 1024) in - [ "pageid", Template.VarString (Int32.to_string pageid); - "page", Template.VarString page; - "title", Template.VarString title; - "size", Template.VarString size; - "download_time", Template.VarString download_time ] - | _ -> assert false) in + [ "pageid", Template.VarString (Int32.to_string pageid); + "page", Template.VarString page; + "title", Template.VarString title; + "size", Template.VarString size; + "download_time", Template.VarString download_time ] + ) rows in template#table "pages" table; q#template template diff --git a/scripts/lib/cocanwiki.ml b/scripts/lib/cocanwiki.ml index d1f8ec6..ad625c1 100644 --- a/scripts/lib/cocanwiki.ml +++ b/scripts/lib/cocanwiki.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: cocanwiki.ml,v 1.9 2006/03/27 16:43:44 rich Exp $ + * $Id: cocanwiki.ml,v 1.10 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -67,6 +67,24 @@ let can_manage_site host = test_permission host CanManageSite let can_edit_global_css host = test_permission host CanEditGlobalCSS let can_import_mail host = test_permission host CanImportMail +let get_uri_from_request r = + try + (* If we passed through mod_rewrite, then it saved the + * unmodified original URL in a subprocess environment + * variable called SCRIPT_URL: + *) + let tbl = Request.subprocess_env r in + Some (Table.get tbl "SCRIPT_URL") + with + Not_found -> + try + (* Otherwise try the ordinary uri field + * in request_rec. + *) + Some (Request.uri r) + with Not_found -> + None + (* Our wrapper around the standard [register_script] function. * * The optional ~restrict and ~anonymous parameters work as follows: @@ -101,14 +119,16 @@ let register_script ?(restrict = []) ?(anonymous = true) run = * table in the database. *) let hostid, hostname, canonical_hostname, edit_anon, view_anon = - let hostname = try Request.hostname r - with Not_found -> - error ~back_button:true - ~title:"Browser problem" dbh (-1l) q - ("Your browser didn't send a \"Host\" header as part of " ^ - "the HTTP request. Unfortunately this web server cannot "^ - "handle HTTP requests without a \"Host\" header."); - return () in + let hostname = + try Request.hostname r + with Not_found -> + error ~back_button:true + ~title:"Browser problem" dbh (-1l) q + ("Your browser didn't send a \"Host\" header as part of " ^ + "the HTTP request. Unfortunately this web server " ^ + "cannot handle HTTP requests without a \"Host\" " ^ + "header."); + return () in let hostname = String.lowercase hostname in let rows = @@ -226,23 +246,7 @@ let register_script ?(restrict = []) ?(anonymous = true) run = * so redirect to the login script. If possible set the * redirect parameter so that we return to the right URL. *) - let redirect = - try - (* If we passed through mod_rewrite, then it saved the - * unmodified original URL in a subprocess environment - * variable called SCRIPT_URL: - *) - let tbl = Request.subprocess_env r in - Some (Table.get tbl "SCRIPT_URL") - with - Not_found -> - try - (* Otherwise try the ordinary uri field - * in request_rec. - *) - Some (Request.uri r) - with Not_found -> - None in + let redirect = get_uri_from_request r in let url = "http://" ^ hostname ^ "/_login" ^ @@ -264,6 +268,30 @@ let register_script ?(restrict = []) ?(anonymous = true) run = (* XXX Connection pooling - see above. *) PGOCaml.close dbh; + (* To help with debugging, if there is an exception, print some + * extended details. + *) + (match exn with + | Some exn -> + fprintf stderr "COCANWIKI exception: %S\n" (Std.dump exn); + fprintf stderr "Time: %s\n" + (Printer.CalendarPrinter.to_string (Calendar.now ())); + let hostname = + try Some (Request.hostname r) with Not_found -> None in + fprintf stderr "Host: "; + (match hostname with + | None -> fprintf stderr "not available\n" + | Some hostname -> fprintf stderr "%S\n" hostname + ); + let uri = get_uri_from_request r in + fprintf stderr "Request: "; + (match uri with + | None -> fprintf stderr "not available\n" + | Some uri -> fprintf stderr "%S\n" uri + ); + | _ -> () + ); + (* May re-raise the caught exception. *) Option.may raise exn ) diff --git a/scripts/links.ml b/scripts/links.ml index eeb2804..953ad42 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.4 2006/03/28 13:20:00 rich Exp $ + * $Id: links.ml,v 1.5 2006/03/28 16:24:07 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -64,7 +64,7 @@ let run r (q : cgi) dbh hostid _ _ = q#header ~content_type:"text/plain" (); - List.iter (fun url -> ignore (print_endline r url)) + List.iter (fun url -> ignore (print_endline r url)) rows ) else failwith "'type' parameter should be 'inbound' or 'outbound'" @@ -103,18 +103,18 @@ let run r (q : cgi) dbh hostid _ _ = let rows = PGSQL(dbh) "select from_url, to_url from links where hostid = $hostid" in - sth#iter (fun (from_url, to_url) -> - add_link from_url to_url) rows; + List.iter (fun (from_url, to_url) -> + add_link from_url to_url) rows; (* Don't forget redirects! They're kinda like links ... *) let rows = PGSQL(dbh) "select url, redirect from pages where hostid = $hostid and url is not null and redirect is not null" in - sth#iter (function - | (url, Some redirect) -> add_link url redirect - | (_, None) -> () - ) rows; + List.iter (function + | (Some url, Some redirect) -> add_link url redirect + | _ -> () + ) rows; let keys h = Hashtbl.fold (fun key _ xs -> key :: xs) h [] in diff --git a/scripts/login.ml b/scripts/login.ml index 70727c5..1132798 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.10 2006/03/28 13:20:00 rich Exp $ + * $Id: login.ml,v 1.11 2006/03/28 16:24:07 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -45,7 +45,8 @@ let run r (q : cgi) dbh hostid _ _ = error ~title:"Bad name or password" ~back_button:true - dbh hostid q "The name or password was wrong." + dbh hostid q "The name or password was wrong."; + return () | [ row ] -> row | _ -> assert false in diff --git a/scripts/logout.ml b/scripts/logout.ml index 7544a57..0ec1952 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.8 2006/03/28 13:20:00 rich Exp $ + * $Id: logout.ml,v 1.9 2006/03/28 16:24:07 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -37,7 +37,7 @@ let run r (q : cgi) dbh hostid _ user = (match user with Anonymous -> () | User (userid, _, _, _) -> - PGSQL(dbh) "delete from usercookies where userid = $userid" in + PGSQL(dbh) "delete from usercookies where userid = $userid"; PGOCaml.commit dbh ); diff --git a/scripts/mail_import.ml b/scripts/mail_import.ml index f609062..ae04ef7 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.11 2006/03/28 13:20:00 rich Exp $ + * $Id: mail_import.ml,v 1.12 2006/03/28 16:24:07 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -193,7 +193,7 @@ let run r (q : cgi) dbh hostid _ user = * NB. Do not change this unique title - it is also used during thread * indexing. *) - let title = sprintf "Mail/%s (%d)" subject msgid in + let title = sprintf "Mail/%s (%ld)" subject msgid in (* Choose a suitable URL. *) let url = @@ -215,7 +215,7 @@ let run r (q : cgi) dbh hostid _ user = match overwrite with | None -> new_page (Title title) | Some _ -> load_page dbh hostid ~url () in - let model = { model with redirect = "" } in + let model = { model with redirect = None } in (* Create the first section (mail header). *) let section0 = @@ -225,11 +225,12 @@ let run r (q : cgi) dbh hostid _ user = hdr_template#set "from" from; hdr_template#set "inet_message_id" inet_message_id; - let yyyy, mm, dd = date.Dbi.year, date.Dbi.month, date.Dbi.day in - hdr_template#set "yyyy" (sprintf "%04d" yyyy); - hdr_template#set "mm" (sprintf "%02d" mm); - hdr_template#set "dd" (sprintf "%02d" dd); - hdr_template#set "short_month" (short_month mm); + let date = fst message_date in + hdr_template#set "yyyy" (Printer.CalendarPrinter.sprint "%Y" date); + hdr_template#set "mm" (Printer.CalendarPrinter.sprint "%m" date); + hdr_template#set "dd" (Printer.CalendarPrinter.sprint "%d" date); + hdr_template#set "short_month" + (Printer.short_name_of_month (Calendar.month date)); let get_table hdr = List.map (fun addr -> [ "addr", Template.VarString addr ]) @@ -244,7 +245,7 @@ let run r (q : cgi) dbh hostid _ user = hdr_template#to_string in - "", "mail_header", content in + None, Some "mail_header", content in (* Create the second section (mail body). * XXX Very simple. Should be extended to understand attachments and @@ -329,7 +330,7 @@ let run r (q : cgi) dbh hostid _ user = with Not_found -> "No plain text message body found" in - "Message", "mail_body", content in + Some "Message", Some "mail_body", content in (* Overwrite the first two sections of the current page, regardless of * what they contain. @@ -337,22 +338,24 @@ let run r (q : cgi) dbh hostid _ user = * use the divname to identify the old mail_header and mail_body and * overwrite those, or insert them if they don't exist. *) - let contents = model.contents in + let contents = model.contents_ in let contents = match contents with - [] | [_] -> [ section0; section1 ] - | _ :: _ :: xs -> section0 :: section1 :: xs in - let model = { model with contents = contents } in + | [] | [_] -> [ section0; section1 ] + | _ :: _ :: xs -> section0 :: section1 :: xs in + let model = { model with contents_ = contents } in (* Write the page back. This can throw several exceptions, but we ignore * them because we want to script to fail abruptly if any of these * unexpected conditions arises. *) - save_page dbh hostid ~user ~r model; + ignore (save_page dbh hostid ~user ~r model); (* Rebuild threads? *) if rebuild then - thread_mail dbh hostid ~user ~r date.Dbi.year date.Dbi.month; + thread_mail dbh hostid ~user ~r + (Calendar.year (fst message_date)) + (Date.int_of_month (Calendar.month (fst message_date))); (* Commit to the database. *) PGOCaml.commit dbh; diff --git a/scripts/mail_rebuild.ml b/scripts/mail_rebuild.ml index 4a56e5f..a16314a 100644 --- a/scripts/mail_rebuild.ml +++ b/scripts/mail_rebuild.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_rebuild.ml,v 1.3 2006/03/27 18:09:46 rich Exp $ + * $Id: mail_rebuild.ml,v 1.4 2006/03/28 16:24:07 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -29,8 +29,8 @@ open Cocanwiki_ok open Cocanwiki_mail let run r (q : cgi) dbh hostid _ user = - let year = Int32.of_string (q#param "year") in - let month = Int32.of_string (q#param "month") in + let year = int_of_string (q#param "year") in + let month = int_of_string (q#param "month") in thread_mail dbh hostid ~user ~r year month; diff --git a/scripts/orphans.ml b/scripts/orphans.ml index cddc0fe..945d818 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.4 2006/03/28 13:20:00 rich Exp $ + * $Id: orphans.ml,v 1.5 2006/03/28 16:24:07 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -56,7 +56,7 @@ let run r (q : cgi) dbh hostid _ _ = let border' = PGSQL(dbh) "select distinct to_url from links where hostid = $hostid and from_url in $@border - and to_url not in $@pages')" in + and to_url not in $@pages'" in if border' = [] then pages' else loop pages' border' in @@ -72,8 +72,9 @@ let run r (q : cgi) dbh hostid _ _ = let table = List.map (fun (page, title) -> - [ "page", Template.VarString page; - "title", Template.VarString title ]) rows in + let page = Option.get page in + [ "page", Template.VarString page; + "title", Template.VarString title ]) rows in template#table "pages" table; diff --git a/scripts/page.ml b/scripts/page.ml index b6a4185..7f7c0bf 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.44 2006/03/28 13:20:00 rich Exp $ + * $Id: page.ml,v 1.45 2006/03/28 16:24:07 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -34,7 +34,7 @@ open Cocanwiki_date open Cocanwiki_server_settings open Cocanwiki_links -type fp_status = FPOK of int * string * string * Dbi.datetime * bool +type fp_status = FPOK of int32 * string * string * Calendar.t * bool | FPInternalRedirect of string | FPExternalRedirect of string | FPNotFound @@ -223,8 +223,8 @@ let run r (q : cgi) dbh hostid * and background images while we compose the page. *) q#header (); - print_string r th#to_string; - Request.rflush r; + ignore (print_string r th#to_string); + ignore (Request.rflush r); t#conditional "has_feedback_email" has_feedback_email; t#conditional "mailing_list" mailing_list; @@ -410,7 +410,7 @@ let run r (q : cgi) dbh hostid from pages where hostid = $hostid and lower (url) = lower ($page)" in match rows with - | [page', _, _, _, _, _, _] + | [Some page', _, _, _, _, _, _] when page <> page' -> (* different case *) FPExternalRedirect page' | [ _, None, id, title, description, diff --git a/scripts/page_email_confirm.ml b/scripts/page_email_confirm.ml index 5c65e40..d4fcb0c 100644 --- a/scripts/page_email_confirm.ml +++ b/scripts/page_email_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: page_email_confirm.ml,v 1.4 2006/03/27 18:09:46 rich Exp $ + * $Id: page_email_confirm.ml,v 1.5 2006/03/28 16:24:07 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -31,26 +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 url, email from page_emails - where hostid = ? and pending = ?" in - sth#execute [Some hostid; Some pending]; + let rows = PGSQL(dbh) "select url, email from page_emails + where hostid = $hostid and pending = $pending" in let page, email = - try - (match sth#fetch1 () with - [ Some page; Some email ] -> page, email - | _ -> assert false) - with - Not_found -> - error ~close_button:true ~title:"Email already confirmed" - dbh hostid q - "It looks like that email address has already been confirmed."; - return () in + match rows with + | [ row ] -> row + | [] -> + error ~close_button:true ~title:"Email already confirmed" + dbh hostid q + "It looks like that email address has already been confirmed."; + return () + | _ -> assert false in (* Update the database. *) - let sth = dbh#prepare_cached "update page_emails set pending = null - where hostid = ? and pending = ?" in - sth#execute [Some hostid; Some pending]; + PGSQL(dbh) "update page_emails set pending = null + where hostid = $hostid and pending = $pending"; PGOCaml.commit dbh; diff --git a/scripts/page_email_form.ml b/scripts/page_email_form.ml index f11d1dd..f361135 100644 --- a/scripts/page_email_form.ml +++ b/scripts/page_email_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: page_email_form.ml,v 1.3 2006/03/27 18:09:46 rich Exp $ + * $Id: page_email_form.ml,v 1.4 2006/03/28 16:24:07 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -34,11 +34,10 @@ let run r (q : cgi) dbh hostid _ _ = template#set "page" page; (* Get the page title. *) - let sth = dbh#prepare_cached "select title from pages - where hostid = ? and url = ?" in - sth#execute [Some hostid; Some page]; - - let title = sth#fetch1string () in + let title = List.hd ( + PGSQL(dbh) "select title from pages + where hostid = $hostid and url = $page" + ) in template#set "title" title; q#template template diff --git a/scripts/page_email_send.ml b/scripts/page_email_send.ml index 4e18374..42ca71b 100644 --- a/scripts/page_email_send.ml +++ b/scripts/page_email_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: page_email_send.ml,v 1.5 2006/03/27 18:09:46 rich Exp $ + * $Id: page_email_send.ml,v 1.6 2006/03/28 16:24:07 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -42,18 +42,20 @@ 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 page_emails - where pending is not null - and entry_date < current_date - 7" in - sth#execute []; + PGSQL(dbh) + "delete from page_emails + where pending is not null + and entry_date < current_date - 7"; + PGOCaml.commit dbh; + PGOCaml.begin_work dbh; (* Is that email address already registered in the database? *) - let sth = dbh#prepare_cached "select 1 from page_emails where hostid = ? - and url = ? and email = ?" in - sth#execute [Some hostid; Some page; Some email]; + let rows = PGSQL(dbh) + "select 1 from page_emails where hostid = $hostid + and url = $page and email = $email" in - let registered = try sth#fetch1int () = 1 with Not_found -> false in + let registered = rows = [Some 1l] in if registered then ( error ~title:"Email address already used" ~back_button:true @@ -73,10 +75,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 page_emails (hostid, url, email, - pending, opt_out) values (?, ?, ?, ?, ?)" in - sth#execute [Some hostid; Some page; Some email; Some pending; - Some opt_out]; + PGSQL(dbh) + "insert into page_emails (hostid, url, email, pending, opt_out) + values ($hostid, $page, $email, $pending, $opt_out)"; PGOCaml.commit dbh; diff --git a/scripts/page_email_unsubscribe.ml b/scripts/page_email_unsubscribe.ml index 87b750b..0f75d86 100644 --- a/scripts/page_email_unsubscribe.ml +++ b/scripts/page_email_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: page_email_unsubscribe.ml,v 1.3 2006/03/27 18:09:46 rich Exp $ + * $Id: page_email_unsubscribe.ml,v 1.4 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -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 page_emails - where hostid = ? and opt_out = ?" in - sth#execute [Some hostid; Some opt_out]; + PGSQL(dbh) + "delete from page_emails where hostid = $hostid and opt_out = $opt_out"; PGOCaml.commit dbh; diff --git a/scripts/page_rss.ml b/scripts/page_rss.ml index 673b18e..b6bc2e0 100644 --- a/scripts/page_rss.ml +++ b/scripts/page_rss.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_rss.ml,v 1.3 2006/03/27 18:09:46 rich Exp $ + * $Id: page_rss.ml,v 1.4 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -44,36 +44,33 @@ let run r (q : cgi) dbh hostid {hostname = hostname} _ = template#set "hostname" hostname; (* Get the title and description of the page. *) - let sth = dbh#prepare_cached "select id, title, description - from pages - where hostid = ? and url = ? - and redirect is null" in - sth#execute [Some hostid; Some page]; + let rows = PGSQL(dbh) + "select id, title, description from pages + where hostid = $hostid and url = $page and redirect is null" in let pageid, title, description = - match sth#fetch1 () with - [ Some id; Some title; Some description ] -> - id, title, description - | _ -> assert false in + match rows with + | [row] -> row + | _ -> assert false in template#set "title" title; template#set "description" description; (* Get the sections in the live page. *) - let sth = dbh#prepare_cached "select sectionname, content, ordering - from contents - where pageid = ? - and sectionname is not null - order by ordering" in - sth#execute [Some pageid]; + let rows = PGSQL(dbh) + "select sectionname, content, ordering + from contents + where pageid = $pageid + and sectionname is not null + order by ordering" in let sections = - sth#map (function [Some sectionname; Some content; _] -> - sectionname, content - | _ -> assert false) in + List.map (fun (sectionname, content, _) -> sectionname, content) rows in let sections = List.map (fun (sectionname, content) -> + let sectionname = match sectionname with + | None -> "" | Some s -> s in let content = Wikilib.xhtml_of_content dbh hostid content in let linkname = linkname_of_sectionname sectionname in [ "sectionname", Template.VarString sectionname; diff --git a/scripts/pagestyle.ml b/scripts/pagestyle.ml index 8d10629..f6b7f46 100644 --- a/scripts/pagestyle.ml +++ b/scripts/pagestyle.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: pagestyle.ml,v 1.7 2006/03/27 18:09:46 rich Exp $ + * $Id: pagestyle.ml,v 1.8 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -32,25 +32,22 @@ let run r (q : cgi) dbh hostid _ _ = try Some (Int32.of_string (q#param "version")) with Not_found -> None in (* Get the CSS. *) - let sth = - match version with - None -> - let sth = dbh#prepare_cached - "select css from pages where hostid = ? and url = ?" in - sth#execute [Some hostid; Some page]; - sth - | Some version -> - let sth = dbh#prepare_cached - "select css from pages - where hostid = ? and id = ? and - (url = ? or url_deleted = ?)" in - sth#execute [Some hostid; Some version; Some page; Some page]; - sth in let css = - match sth#fetch1 () with - [ None ] -> "" - | [ Some css ] -> css - | _ -> assert false in + match version with + | None -> + List.hd ( + PGSQL(dbh) + "select css from pages where hostid = $hostid and url = $page" + ) + | Some version -> + List.hd ( + PGSQL(dbh) + "select css from pages + where hostid = $hostid and id = $version and + (url = $page or url_deleted = $page)" + ) in + + let css = match css with None -> "" | Some css -> css in (* It's crucial, for speed of page delivery and rendering, to have * an expires header for CSS. Even though this means that occasionally diff --git a/scripts/rebuild_links.ml b/scripts/rebuild_links.ml index f7afa1b..21c2904 100644 --- a/scripts/rebuild_links.ml +++ b/scripts/rebuild_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: rebuild_links.ml,v 1.5 2006/03/27 18:09:46 rich Exp $ + * $Id: rebuild_links.ml,v 1.6 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -34,50 +34,38 @@ let run r (q : cgi) dbh hostid _ _ = let template_done = _get_template "rebuild_links_done.html" in (* Delete entries in the old links table. *) - let sth = dbh#prepare_cached "delete from links where hostid = ?" in - sth#execute [Some hostid]; - - (* Estimate how many sections we will have to process. *) - let sth = - dbh#prepare_cached - "select count(c.id)::int4 from contents c, pages p - where c.pageid = p.id - and p.hostid = ? - and p.url is not null - and p.redirect is null" in - sth#execute [Some hostid]; - - let total_sections = sth#fetch1int () in + PGSQL(dbh) "delete from links where hostid = $hostid"; (* Pull out the list of sections to process. *) - let sth = - dbh#prepare_cached + let sections = + PGSQL(dbh) "select c.content, c.ordering, p.url from contents c, pages p where c.pageid = p.id - and p.hostid = ? + and p.hostid = $hostid and p.url is not null and p.redirect is null order by p.url, c.ordering" in - sth#execute [Some hostid]; + + let total_sections = List.length sections in q#header (); - print_string r template_start#to_string; + ignore (print_string r template_start#to_string); (* Process each section ... *) let i = ref 0 in - sth#iter - (function [Some content; Some ordering; Some url] -> - let pc = 100 * !i / total_sections in incr i; - template#set "ordering" (Int32.to_string ordering); - template#set "url" url; - template#set "pc" (Int32.to_string pc); - print_string r template#to_string; - - let links = get_links_from_section dbh hostid content in - List.iter (insert_link dbh hostid url) links + List.iter ( + fun (content, ordering, url) -> + let url = Option.get url in + let pc = 100 * !i / total_sections in incr i; + template#set "ordering" (Int32.to_string ordering); + template#set "url" url; + template#set "pc" (string_of_int pc); + ignore (print_string r template#to_string); - | _ -> assert false); + let links = get_links_from_section dbh hostid content in + List.iter (insert_link dbh hostid url) links + ) sections; (* Finish off. *) PGOCaml.commit dbh; diff --git a/scripts/recent.ml b/scripts/recent.ml index 5ae5092..2ff1e67 100644 --- a/scripts/recent.ml +++ b/scripts/recent.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: recent.ml,v 1.11 2006/03/27 18:09:46 rich Exp $ + * $Id: recent.ml,v 1.12 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -36,18 +36,20 @@ let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "recent.html" in (* Count the number of changes. *) - let sth = dbh#prepare_cached - "select count(*)::int4 from pages where hostid = ?" in - sth#execute [Some hostid]; - let count = sth#fetch1int () in + let count = Option.get ( + List.hd ( + PGSQL(dbh) "select count(*) from pages where hostid = $hostid" + ) + ) in + let count = Int64.to_int count in (* Get the offset and limit specified, and adjust them so that we will * be displaying some changes. *) let offset = - try Int32.of_string (q#param "offset") with Not_found -> default_offset in + try int_of_string (q#param "offset") with Not_found -> default_offset in let limit = - try Int32.of_string (q#param "limit") with Not_found -> default_limit in + try int_of_string (q#param "limit") with Not_found -> default_limit in let limit = if limit < 1 then 1 @@ -58,75 +60,72 @@ let run r (q : cgi) dbh hostid _ _ = else if offset >= count then max 0 (count - limit) else offset in - template#set "offset" (Int32.to_string offset); - template#set "last" (Int32.to_string (min (offset + limit) count - 1)); - template#set "limit" (Int32.to_string limit); - template#set "count" (Int32.to_string count); + template#set "offset" (string_of_int offset); + template#set "last" (string_of_int (min (offset + limit) count - 1)); + template#set "limit" (string_of_int limit); + template#set "count" (string_of_int count); template#conditional "has_next" (offset + limit < count); - template#set "next_offset" (Int32.to_string (offset + limit)); + template#set "next_offset" (string_of_int (offset + limit)); template#conditional "has_prev" (offset > 0); - template#set "prev_offset" (Int32.to_string (max 0 (offset - limit))); + template#set "prev_offset" (string_of_int (max 0 (offset - limit))); (* Get the actual changes. *) - let sth = - dbh#prepare_cached - "select p.id, p.url, p.url_deleted, p.title, p.last_modified_date, - p.logged_ip, u.name - from pages p left outer join users u on p.logged_user = u.id - where p.hostid = ? - order by p.last_modified_date desc - offset ? limit ?" in - sth#execute [Some hostid; Some offset; Some limit]; + let rows = + let offset = Int32.of_int offset in + let limit = Int32.of_int limit in + PGSQL(dbh) "nullable-results" + "select p.id, p.url, p.url_deleted, p.title, p.last_modified_date, + p.logged_ip, u.name + from pages p left outer join users u on p.logged_user = u.id + where p.hostid = $hostid + order by p.last_modified_date desc + offset $offset limit $limit" in let table = - sth#map + List.map (function - | [Some version; Some url; _; Some title; - `Timestamp last_modified_date; logged_ip; logged_user] -> - let date = printable_date_time last_modified_date in - let has_logged_ip, logged_ip = - match logged_ip with - None -> false, "" - | Some ip -> true, ip - | _ -> assert false in - let has_logged_user, logged_user = - match logged_user with - None -> false, "" - | Some name -> true, name - | _ -> assert false in - [ "version", Template.VarString (Int32.to_string version); - "url", Template.VarString url; - "title", Template.VarString title; - "last_modified_date", Template.VarString date; - "has_logged_ip", Template.VarConditional has_logged_ip; - "logged_ip", Template.VarString logged_ip; - "has_logged_user", Template.VarConditional has_logged_user; - "logged_user", Template.VarString logged_user; - "is_live", Template.VarConditional true ] - | [Some version; None; Some url; Some title; - `Timestamp last_modified_date; logged_ip; logged_user] -> - let date = printable_date_time last_modified_date in - let has_logged_ip, logged_ip = - match logged_ip with - None -> false, "" - | Some ip -> true, ip - | _ -> assert false in - let has_logged_user, logged_user = - match logged_user with - None -> false, "" - | Some name -> true, name - | _ -> assert false in - [ "version", Template.VarString (Int32.to_string version); - "url", Template.VarString url; - "title", Template.VarString title; - "last_modified_date", Template.VarString date; - "has_logged_ip", Template.VarConditional has_logged_ip; - "logged_ip", Template.VarString logged_ip; - "has_logged_user", Template.VarConditional has_logged_user; - "logged_user", Template.VarString logged_user; - "is_live", Template.VarConditional false ] - | _ -> assert false) in + | (Some version, Some url, _, Some title, + Some last_modified_date, logged_ip, logged_user) -> + let date = printable_date_time last_modified_date in + let has_logged_ip, logged_ip = + match logged_ip with + None -> false, "" + | Some ip -> true, ip in + let has_logged_user, logged_user = + match logged_user with + None -> false, "" + | Some name -> true, name in + [ "version", Template.VarString (Int32.to_string version); + "url", Template.VarString url; + "title", Template.VarString title; + "last_modified_date", Template.VarString date; + "has_logged_ip", Template.VarConditional has_logged_ip; + "logged_ip", Template.VarString logged_ip; + "has_logged_user", Template.VarConditional has_logged_user; + "logged_user", Template.VarString logged_user; + "is_live", Template.VarConditional true ] + | (Some version, None, Some url, Some title, + Some last_modified_date, logged_ip, logged_user) -> + let date = printable_date_time last_modified_date in + let has_logged_ip, logged_ip = + match logged_ip with + None -> false, "" + | Some ip -> true, ip in + let has_logged_user, logged_user = + match logged_user with + None -> false, "" + | Some name -> true, name in + [ "version", Template.VarString (Int32.to_string version); + "url", Template.VarString url; + "title", Template.VarString title; + "last_modified_date", Template.VarString date; + "has_logged_ip", Template.VarConditional has_logged_ip; + "logged_ip", Template.VarString logged_ip; + "has_logged_user", Template.VarConditional has_logged_user; + "logged_user", Template.VarString logged_user; + "is_live", Template.VarConditional false ] + | _ -> assert false) rows in template#table "recent_changes" table; diff --git a/scripts/recent_rss.ml b/scripts/recent_rss.ml index e9424fb..5fe133e 100644 --- a/scripts/recent_rss.ml +++ b/scripts/recent_rss.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: recent_rss.ml,v 1.3 2006/03/27 18:09:46 rich Exp $ + * $Id: recent_rss.ml,v 1.4 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -28,7 +28,7 @@ open Cocanwiki open Cocanwiki_template open Cocanwiki_date -let limit = 30 +let limit = 30_l let run r (q : cgi) dbh hostid {hostname = hostname} _ = let template = get_template dbh hostid "recent_rss.xml" in @@ -36,32 +36,29 @@ let run r (q : cgi) dbh hostid {hostname = hostname} _ = template#set "hostname" hostname; (* Get the changes. *) - let sth = - dbh#prepare_cached + let rows = + PGSQL(dbh) "nullable-results" "select p.id, p.url, p.url_deleted, p.title, p.last_modified_date, p.logged_ip, u.name from pages p left outer join users u on p.logged_user = u.id - where p.hostid = ? + where p.hostid = $hostid order by p.last_modified_date desc - limit ?" in - sth#execute [Some hostid; Some limit]; + limit $limit" in let table = - sth#map + List.map (function - | [Some version; Some url; _; Some title; - `Timestamp last_modified_date; logged_ip; logged_user] -> + | (Some version, Some url, _, Some title, + Some last_modified_date, logged_ip, logged_user) -> let date = printable_date_time last_modified_date in let has_logged_ip, logged_ip = match logged_ip with None -> false, "" - | Some ip -> true, ip - | _ -> assert false in + | Some ip -> true, ip in let has_logged_user, logged_user = match logged_user with None -> false, "" - | Some name -> true, name - | _ -> assert false in + | Some name -> true, name in [ "version", Template.VarString (Int32.to_string version); "url", Template.VarString url; "title", Template.VarString title; @@ -71,19 +68,17 @@ let run r (q : cgi) dbh hostid {hostname = hostname} _ = "has_logged_user", Template.VarConditional has_logged_user; "logged_user", Template.VarString logged_user; "is_live", Template.VarConditional true ] - | [Some version; None; Some url; Some title; - `Timestamp last_modified_date; logged_ip; logged_user] -> + | (Some version, None, Some url, Some title, + Some last_modified_date, logged_ip, logged_user) -> let date = printable_date_time last_modified_date in let has_logged_ip, logged_ip = match logged_ip with None -> false, "" - | Some ip -> true, ip - | _ -> assert false in + | Some ip -> true, ip in let has_logged_user, logged_user = match logged_user with None -> false, "" - | Some name -> true, name - | _ -> assert false in + | Some name -> true, name in [ "version", Template.VarString (Int32.to_string version); "url", Template.VarString url; "title", Template.VarString title; @@ -93,7 +88,7 @@ let run r (q : cgi) dbh hostid {hostname = hostname} _ = "has_logged_user", Template.VarConditional has_logged_user; "logged_user", Template.VarString logged_user; "is_live", Template.VarConditional false ] - | _ -> assert false) in + | _ -> assert false) rows in template#table "recent_changes" table; diff --git a/scripts/recently_visited.ml b/scripts/recently_visited.ml index 64d0638..ef709c7 100644 --- a/scripts/recently_visited.ml +++ b/scripts/recently_visited.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: recently_visited.ml,v 1.3 2006/03/27 18:09:46 rich Exp $ + * $Id: recently_visited.ml,v 1.4 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -35,17 +35,18 @@ let run r (q : cgi) dbh hostid _ user = User (userid, _, _, _) -> userid | _ -> assert false in - let sth = dbh#prepare_cached "select rv.url, p.title, rv.visit_time - from recently_visited rv, pages p - where rv.hostid = ? and rv.userid = ? - and rv.hostid = p.hostid and rv.url = p.url - order by 3 desc" in - sth#execute [Some hostid; Some userid]; - - let table = sth#map (function [Some page; Some title; _] -> - [ "page", Template.VarString page; - "title", Template.VarString title ] - | _ -> assert false) in + let rows = PGSQL(dbh) + "select rv.url, p.title, rv.visit_time + from recently_visited rv, pages p + where rv.hostid = $hostid and rv.userid = $userid + and rv.hostid = p.hostid and rv.url = p.url + order by 3 desc" in + + let table = List.map ( + fun (page, title, _) -> + [ "page", Template.VarString page; + "title", Template.VarString title ] + ) rows in template#table "recently_visited" table; q#template template diff --git a/scripts/rename_page.ml b/scripts/rename_page.ml index 5363625..a1d287c 100644 --- a/scripts/rename_page.ml +++ b/scripts/rename_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: rename_page.ml,v 1.4 2006/03/27 18:09:46 rich Exp $ + * $Id: rename_page.ml,v 1.5 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -49,11 +49,10 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = ); (* Get the old title. *) - let sth = dbh#prepare_cached "select title from pages - where hostid = ? and url = ?" in - sth#execute [Some hostid; Some page]; - - let old_title = sth#fetch1string () in + let old_title = List.hd ( + PGSQL (dbh) "select title from pages + where hostid = $hostid and url = $page" + ) in (* Generate URL for the new title. *) let new_page = @@ -82,9 +81,9 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = let old_model = load_page dbh hostid ~url:page () in let new_model = new_page_with_title new_title in let new_model = { new_model with description = old_model.description; - contents = old_model.contents } in - let old_model = { old_model with redirect = new_page } in - save_page dbh hostid ~user ~r old_model; + contents_ = old_model.contents_ } in + let old_model = { old_model with redirect = Some new_page } in + ignore (save_page dbh hostid ~user ~r old_model); try ignore (save_page dbh hostid ~user ~r new_model) diff --git a/scripts/rename_page_form.ml b/scripts/rename_page_form.ml index 46ec6ac..5d60967 100644 --- a/scripts/rename_page_form.ml +++ b/scripts/rename_page_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: rename_page_form.ml,v 1.2 2006/03/27 18:09:46 rich Exp $ + * $Id: rename_page_form.ml,v 1.3 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -32,11 +32,10 @@ let run r (q : cgi) dbh hostid _ _ = let page = q#param "page" in - let sth = dbh#prepare_cached "select title from pages - where hostid = ? and url = ?" in - sth#execute [Some hostid; Some page]; - - let title = sth#fetch1string () in + let title = List.hd ( + PGSQL(dbh) "select title from pages + where hostid = $hostid and url = $page" + ) in template#set "page" page; template#set "title" title; diff --git a/scripts/restore.ml b/scripts/restore.ml index 2d40f6e..f7ce475 100644 --- a/scripts/restore.ml +++ b/scripts/restore.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: restore.ml,v 1.20 2006/03/27 18:09:46 rich Exp $ + * $Id: restore.ml,v 1.21 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -45,47 +45,37 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = | _ -> None in (* Copy the old version of the page to be live. *) - let sth = dbh#prepare_cached "select title, description, creation_date, - redirect, css - from pages - where hostid = ? - and url_deleted = ? and id = ?" in - sth#execute [Some hostid; Some page; Some version]; + let rows = PGSQL(dbh) + "select title, description, creation_date, + redirect, css + from pages + where hostid = $hostid + and url_deleted = $page and id = $version" in let title, description, creation_date, redirect, css = - match sth#fetch1 () with - [ title; description; creation_date; redirect; css ] -> - title, description, creation_date, redirect, css - | _ -> assert false in - - let sth = - dbh#prepare_cached - "set constraints pages_redirect_cn, sitemenu_url_cn, - page_emails_url_cn, links_from_cn, recently_visited_url_cn - deferred" in - sth#execute []; - - let sth = dbh#prepare_cached "update pages set url_deleted = url, - url = null - where hostid = ? and url = ?" in - sth#execute [Some hostid; Some page]; - - let sth = dbh#prepare_cached "insert into pages (hostid, url, title, - description, creation_date, logged_ip, - logged_user, redirect, css) - values (?, ?, ?, ?, ?, ?, ?, ?, ?)" in - sth#execute [Some hostid; Some page; title; description; - creation_date; logged_ip; logged_user; redirect; css ]; - - let pageid = Int64.to_int (sth#serial "pages_id_seq") in - - let sth = dbh#prepare_cached "insert into contents (pageid, ordering, - sectionname, content, divname) - select ? as pageid, ordering, sectionname, - content, divname - from contents - where pageid = ?" in - sth#execute [Some pageid; Some version]; + match rows with + | [row] -> row + | _ -> assert false in + + PGSQL(dbh) + "set constraints pages_redirect_cn, sitemenu_url_cn, + page_emails_url_cn, links_from_cn, recently_visited_url_cn + deferred"; + PGSQL(dbh) "update pages set url_deleted = url, url = null + where hostid = $hostid and url = $page"; + PGSQL(dbh) "insert into pages (hostid, url, title, + description, creation_date, logged_ip, + logged_user, redirect, css) + values ($hostid, $page, $title, $description, $creation_date, + $?logged_ip, $?logged_user, $?redirect, $?css)"; + + let pageid = PGOCaml.serial4 dbh "pages_id_seq" in + + PGSQL(dbh) "insert into contents (pageid, ordering, + sectionname, content, divname) + select $pageid, ordering, sectionname, content, divname + from contents + where pageid = $version"; (* Keep the links table in synch. *) Cocanwiki_links.update_links_for_page dbh hostid page; diff --git a/scripts/restore_form.ml b/scripts/restore_form.ml index 774e2fe..f09a1fe 100644 --- a/scripts/restore_form.ml +++ b/scripts/restore_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: restore_form.ml,v 1.12 2006/03/27 18:09:46 rich Exp $ + * $Id: restore_form.ml,v 1.13 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -42,11 +42,11 @@ let run r (q : cgi) dbh hostid _ user = (* Compute the diff between the latest version of this page and the * page we're wanting to restore. *) - let sth = dbh#prepare_cached "select id from pages - where hostid = ? and url = ?" in - sth#execute [Some hostid; Some page]; - - let version = sth#fetch1int () in + let version = List.hd ( + PGSQL(dbh) + "select id from pages + where hostid = $hostid and url = $page" + ) in if version = old_version then ( error ~back_button:true ~title:"Restoring live version" diff --git a/scripts/search.ml b/scripts/search.ml index 2d449b8..13899ce 100644 --- a/scripts/search.ml +++ b/scripts/search.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: search.ml,v 1.9 2006/03/27 18:09:46 rich Exp $ + * $Id: search.ml,v 1.10 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -68,77 +68,91 @@ let run r (q : cgi) dbh hostid host user = let tsquery = String.concat "&" keywords in (* Search the titles first. *) - let sth = - dbh#prepare_cached - ("select id, url, url_deleted, title, last_modified_date, - (lower (title) = lower (?)) as exact - from pages - where hostid = ? " ^ - (if not old_versions then "and url is not null " else "") ^ " - and redirect is null - and title_description_fti @@ to_tsquery (?, ?) - order by exact desc, last_modified_date desc, title") in - sth#execute [Some query; - Some hostid; Some "default"; Some tsquery]; + let rows = + if not old_versions then + PGSQL(dbh) + "select id, url, url_deleted, title, last_modified_date, + (lower (title) = lower ($query)) as exact + from pages + where hostid = $hostid + and url is not null + and redirect is null + and title_description_fti @@ to_tsquery ('default', $tsquery) + order by exact desc, last_modified_date desc, title" + else + PGSQL(dbh) + "select id, url, url_deleted, title, last_modified_date, + (lower (title) = lower ($query)) as exact + from pages + where hostid = $hostid + and redirect is null + and title_description_fti @@ to_tsquery ('default', $tsquery) + order by exact desc, last_modified_date desc, title" in let titles = - sth#map (function - | [_; Some url; None; Some title; - `Timestamp last_modified; _] -> - url, title, None, last_modified - | [Some version; None; Some url; Some title; - `Timestamp last_modified; _] -> - url, title, Some version, last_modified - | _ -> assert false) in + List.map (function + | (_, Some url, None, title, last_modified, _) -> + url, title, None, last_modified + | (version, None, Some url, title, last_modified, _) -> + url, title, Some version, last_modified + | _ -> assert false) rows in let have_titles = titles <> [] in template#conditional "have_titles" have_titles; (* Search the contents. *) - let sth = - dbh#prepare_cached - ("select c.id, p.id, p.url, p.url_deleted, p.title, - p.last_modified_date - from contents c, pages p - where c.pageid = p.id - and p.hostid = ? " ^ - (if not old_versions then "and url is not null " else "") ^ " - and p.redirect is null - and c.content_fti @@ to_tsquery (?, ?) - order by p.last_modified_date desc, p.title - limit 50") in - sth#execute [Some hostid; Some "default"; Some tsquery]; + let rows = + if not old_versions then + PGSQL(dbh) + "select c.id, p.id, p.url, p.url_deleted, p.title, + p.last_modified_date + from contents c, pages p + where c.pageid = p.id + and p.hostid = $hostid + and url is not null + and p.redirect is null + and c.content_fti @@ to_tsquery ('default', $tsquery) + order by p.last_modified_date desc, p.title + limit 50" + else + PGSQL(dbh) + "select c.id, p.id, p.url, p.url_deleted, p.title, + p.last_modified_date + from contents c, pages p + where c.pageid = p.id + and p.hostid = $hostid + and p.redirect is null + and c.content_fti @@ to_tsquery ('default', $tsquery) + order by p.last_modified_date desc, p.title + limit 50" in let contents = - sth#map (function - | [Some contentid; _; Some url; None; - Some title; `Timestamp last_modified] -> + List.map (function + | (contentid, _, Some url, None, title, last_modified) -> contentid, url, title, None, last_modified - | [Some contentid; Some version; None; Some url; - Some title; `Timestamp last_modified] -> + | (contentid, version, None, Some url, title, + last_modified) -> contentid, url, title, Some version, last_modified - | _ -> assert false) in + | _ -> assert false) rows in let have_contents = contents <> [] in template#conditional "have_contents" have_contents; - (* Pull out the actual text which matched so we can generate a summary.*) + (* Pull out the actual text which matched so we can generate a summary. + * XXX tsearch2 can actually do better than this by emboldening + * the text which maps. + *) let content_map = if contents = [] then [] else ( - let qs = Dbi.placeholders (List.length contents) in - let sth = - dbh#prepare_cached - ("select id, sectionname, content from contents - where id in " ^ qs) in - sth#execute - (List.map (fun (contentid, _,_,_,_) -> Some contentid) contents); - sth#map (function - | [ Some id; None; Some content ] -> - id, (None, content) - | [ Some id; Some sectionname; Some content ] -> - id, (Some sectionname, content) - | _ -> assert false) + let rows = + let contentids = + List.map (fun (contentid, _,_,_,_) -> contentid) contents in + PGSQL(dbh) + "select id, sectionname, content from contents + where id in $@contentids" in + List.map (fun (id, sectionname, content) -> + id, (sectionname, content)) rows ) in (* Generate the final tables. *) @@ -146,7 +160,7 @@ let run r (q : cgi) dbh hostid host user = List.map (fun (url, title, version, last_modified) -> let have_version, version = match version with - None -> false, 0 + None -> false, 0l | Some version -> true, version in let last_modified = printable_date last_modified in [ "url", Template.VarString url; @@ -162,7 +176,7 @@ let run r (q : cgi) dbh hostid host user = (fun (contentid, url, title, version, last_modified) -> let have_version, version = match version with - None -> false, 0 + None -> false, 0l | Some version -> true, version in let sectionname, content = List.assoc contentid content_map in let have_sectionname, sectionname = diff --git a/scripts/send_feedback.ml b/scripts/send_feedback.ml index ce9898a..1de626e 100644 --- a/scripts/send_feedback.ml +++ b/scripts/send_feedback.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: send_feedback.ml,v 1.7 2006/03/27 18:09:46 rich Exp $ + * $Id: send_feedback.ml,v 1.8 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -40,11 +40,11 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = ); (* Get the feedback email for this host. *) - let sth = - dbh#prepare_cached "select feedback_email from hosts where id = ?" in - sth#execute [Some hostid]; - - let to_addr = sth#fetch1string () in + let to_addr = List.hd ( + PGSQL(dbh) + "select feedback_email from hosts where id = $hostid" + ) in + let to_addr = Option.get to_addr in (* Get the fields. *) let page = q#param "page" in @@ -72,7 +72,7 @@ let run r (q : cgi) dbh 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/set_password.ml b/scripts/set_password.ml index 0855836..3750e4a 100644 --- a/scripts/set_password.ml +++ b/scripts/set_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: set_password.ml,v 1.4 2006/03/27 18:09:46 rich Exp $ + * $Id: set_password.ml,v 1.5 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -40,9 +40,8 @@ let run r (q : cgi) dbh hostid _ _ = let password = password1 in - let sth = dbh#prepare_cached "update users set password = ? - where id = ? and hostid = ?" in - sth#execute [Some password; Some userid; Some hostid]; + PGSQL(dbh) "update users set password = $password + where id = $userid and hostid = $hostid"; PGOCaml.commit dbh; diff --git a/scripts/set_password_form.ml b/scripts/set_password_form.ml index d3b8140..99a309d 100644 --- a/scripts/set_password_form.ml +++ b/scripts/set_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: set_password_form.ml,v 1.2 2006/03/27 18:09:46 rich Exp $ + * $Id: set_password_form.ml,v 1.3 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -32,11 +32,11 @@ let run r (q : cgi) dbh hostid _ _ = let userid = Int32.of_string (q#param "userid") in - let sth = dbh#prepare_cached "select name from users - where id = ? and hostid = ?" in - sth#execute [Some userid; Some hostid]; - - let username = sth#fetch1string () in + let username = List.hd ( + PGSQL(dbh) + "select name from users + where id = $userid and hostid = $hostid" + ) in template#set "userid" (Int32.to_string userid); template#set "username" username; diff --git a/scripts/signup.ml b/scripts/signup.ml index 887700b..d3e28ac 100644 --- a/scripts/signup.ml +++ b/scripts/signup.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: signup.ml,v 1.10 2006/03/27 18:09:46 rich Exp $ + * $Id: signup.ml,v 1.11 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -32,14 +32,17 @@ let run r (q : cgi) dbh hostid _ _ = (* Verify that we're allowed to create accounts anonymously * on this host. *) - let sth = dbh#prepare_cached "select create_account_anon from hosts - where id = ?" in - sth#execute [Some hostid]; - - let create_account_anon = - match sth#fetch1 () with - [ `Bool true ] -> () - | _ -> assert false in + let create_account_anon = List.hd ( + PGSQL(dbh) "select create_account_anon from hosts + where id = $hostid" + ) in + + if not create_account_anon then ( + error ~title:"Not allowed to create accounts" + dbh hostid q ("To get an account on this service, please contact the " ^ + "administrator."); + return () + ); let username = trim (q#param "username") in let password1 = trim (q#param "password1") in @@ -59,43 +62,41 @@ let run r (q : cgi) dbh 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 () + ); let email = trim (q#param "email") in let email = if string_is_whitespace email then None else Some email in (* Not a duplicate? *) - let sth = dbh#prepare_cached "select id from users - where hostid = ? and name = ?" in - sth#execute [Some hostid; Some username]; - - (try - sth#fetch1 (); - error ~back_button:true ~title:"Username already taken" - dbh hostid q - ("Someone, possibly you, has already taken that username. " ^ - "If you think you have forgotten your password, try going back " ^ - "and clicking on the 'Forgotten your password?' link."); - return () - with - Not_found -> ()); + let rows = PGSQL(dbh) + "select id from users where hostid = $hostid and name = $username" in + + (match rows with + | [_] -> + error ~back_button:true ~title:"Username already taken" + dbh hostid q + ("Someone, possibly you, has already taken that username. " ^ + "If you think you have forgotten your password, try going back " ^ + "and clicking on the 'Forgotten your password?' link."); + return () + | [] -> () + | _ -> assert false + ); (* Create the user account. *) - let sth = dbh#prepare_cached "insert into users (name, password, email, - hostid) - values (?, ?, ?, ?)" in - sth#execute [Some username; Some password; email; Some hostid]; + PGSQL(dbh) "insert into users (name, password, email, hostid) + values ($username, $password, $?email, $hostid)"; - let userid = Int64.to_int (sth#serial "users_id_seq") in + let userid = PGOCaml.serial4 dbh "users_id_seq" in (* Create a cookie. *) let cookie = random_sessionid () in - let sth = dbh#prepare_cached "insert into usercookies (userid, cookie) - values (?, ?)" in - sth#execute [Some userid; Some cookie]; + PGSQL(dbh) "insert into usercookies (userid, cookie) + values ($userid, $cookie)"; PGOCaml.commit dbh; diff --git a/scripts/sitemap.ml b/scripts/sitemap.ml index 182a061..1aa8f24 100644 --- a/scripts/sitemap.ml +++ b/scripts/sitemap.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: sitemap.ml,v 1.8 2006/03/27 18:09:46 rich Exp $ + * $Id: sitemap.ml,v 1.9 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -33,24 +33,21 @@ let run r (q : cgi) dbh hostid { hostname = hostname } _ = let template = get_template dbh hostid "sitemap.html" in (* Pull out all the current pages, and a bit of content from each. *) - let sth = dbh#prepare_cached "select p.url, p.url = 'index', - p.title, p.description, - p.last_modified_date, - (select content from contents - where pageid = p.id - order by ordering limit 1) as content - from pages p - where p.hostid = ? and p.url is not null - and p.redirect is null - order by 2 desc, 3, 1" in - sth#execute [Some hostid]; + let rows = PGSQL(dbh) + "select p.url, p.url = 'index', p.title, p.description, + p.last_modified_date, (select content from contents + where pageid = p.id + order by ordering limit 1) as content + from pages p + where p.hostid = $hostid and p.url is not null + and p.redirect is null + order by 2 desc, 3, 1" in let table = - sth#map - (function [Some url; _; Some title; Some description; - `Timestamp last_modified_date; - (None | Some _) as content] -> - let url = if url = "index" then "" else url in + List.map + (function (Some url, Some is_index, title, description, + last_modified_date, content) -> + let url = if is_index then "" else url in let date = printable_date last_modified_date in [ "url", Template.VarString url; "title", Template.VarString title; @@ -59,12 +56,12 @@ let run r (q : cgi) dbh hostid { hostname = hostname } _ = "has_content", Template.VarConditional (content <> None); "content", Template.VarString (match content with - None -> "" - | Some c -> - truncate 160 - (Wikilib.text_of_xhtml - (Wikilib.xhtml_of_content dbh hostid c))) ] - | _ -> assert false) in + | None -> "" + | Some c -> + truncate 160 + (Wikilib.text_of_xhtml + (Wikilib.xhtml_of_content dbh hostid c))) ] + | _ -> assert false) rows in template#set "hostname" hostname; template#table "sitemap" table; diff --git a/scripts/sitemap_xml.ml b/scripts/sitemap_xml.ml index dc213ed..d51a934 100644 --- a/scripts/sitemap_xml.ml +++ b/scripts/sitemap_xml.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: sitemap_xml.ml,v 1.2 2006/03/27 18:09:47 rich Exp $ + * $Id: sitemap_xml.ml,v 1.3 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -37,25 +37,23 @@ let run r (q : cgi) dbh hostid { hostname = hostname } _ = let template = get_template dbh hostid "sitemap.xml" in (* Pull out all the current pages. *) - let sth = dbh#prepare_cached "select p.url, p.url = 'index', - p.last_modified_date - from pages p - where p.hostid = ? and p.url is not null - and p.redirect is null - order by 2 desc, 1" in - sth#execute [Some hostid]; + let rows = PGSQL(dbh) + "select p.url, p.url = 'index', p.last_modified_date + from pages p + where p.hostid = $hostid and p.url is not null + and p.redirect is null + order by 2 desc, 1" in let table = - sth#map - (function [Some url; `Bool is_index; - `Timestamp last_modified_date] -> + List.map + (function (Some url, Some is_index, last_modified_date) -> let url = if is_index then "" else url in let last_modified_date = iso_8601_date_time last_modified_date in let priority = if is_index then "1.0" else "0.5" in [ "url", Template.VarString url; "last_modified_date", Template.VarString last_modified_date; "priority", Template.VarString priority ] - | xs -> failwith (Dbi.sdebug xs)) in + | _ -> assert false) rows in template#set "hostname" hostname; template#table "sitemap" table; diff --git a/scripts/source.ml b/scripts/source.ml index 97fa706..39f6227 100644 --- a/scripts/source.ml +++ b/scripts/source.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: source.ml,v 1.4 2006/03/27 18:09:47 rich Exp $ + * $Id: source.ml,v 1.5 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -24,6 +24,8 @@ open Registry open Cgi open Printf +open ExtList + open Cocanwiki open Cocanwiki_pages open Cocanwiki_ok @@ -51,16 +53,17 @@ let run r (q : cgi) dbh hostid _ _ = *) (* Get the title. *) - let sth = dbh#prepare_cached "select title from pages - where hostid = ? and id = ?" in - sth#execute [Some hostid; Some model.id]; - let title = sth#fetch1string () in + let title = List.hd ( + let model_id = model.id in + PGSQL(dbh) "select title from pages + where hostid = $hostid and id = $model_id" + ) in (* Function to write out fields, with RFC822-like escaping. *) let write key value = - print_string r key; - print_string r ": "; - print_string r (Pcre.replace ~rex ~itempl value); + ignore (print_string r key); + ignore (print_string r ": "); + ignore (print_string r (Pcre.replace ~rex ~itempl value)); ignore (print_newline r); in @@ -71,20 +74,24 @@ let run r (q : cgi) dbh hostid _ _ = write "Version" (Int32.to_string model.id); write "Title" title; write "Description" model.description; - if model.redirect <> "" then - write "Redirect" model.redirect - else - write "Section-Count" (Int32.to_string (List.length model.contents)); + (match model.redirect with + | Some redirect -> write "Redirect" redirect + | None -> + write "Section-Count" (string_of_int (List.length model.contents_)) + ); ignore (print_newline r); (* Now write out the sections. *) - if model.redirect = "" then - List.iter - (fun (sectionname, divname, content) -> - write "Section-Header" sectionname; - write "Css-Id" divname; + if model.redirect = None then + List.iteri + (fun i (sectionname, divname, content) -> + write "Section-Id" (string_of_int i); + (match sectionname with None -> () | Some sectionname -> + write "Section-Header" sectionname); + (match divname with None -> () | Some divname -> + write "Css-Id" divname); write "Content" content; - ignore (print_newline r)) model.contents + ignore (print_newline r)) model.contents_ let () = register_script ~restrict:[CanView] run diff --git a/scripts/stats.ml b/scripts/stats.ml index b8ef2f1..b7ddab7 100644 --- a/scripts/stats.ml +++ b/scripts/stats.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: stats.ml,v 1.5 2006/03/27 18:09:47 rich Exp $ + * $Id: stats.ml,v 1.6 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -28,8 +28,7 @@ open Cocanwiki open Cocanwiki_template open Cocanwiki_server_settings -let run r (q : cgi) dbh hostid - { canonical_hostname = canonical_hostname } _ = +let run r (q : cgi) dbh hostid { canonical_hostname = canonical_hostname } _ = let template = get_template dbh hostid "stats.html" in let page = q#param "page" in @@ -51,8 +50,8 @@ let run r (q : cgi) dbh hostid let year, week, _ = Date.to_business date in year, week in - template#set "year" (Int32.to_string year); - template#set "week" (Int32.to_string week); + template#set "year" (string_of_int year); + template#set "week" (string_of_int week); (* Standard hashing function which we also use in tools/rocket/analysis.ml *) let hash s = Digest.to_hex (Digest.string s) in diff --git a/scripts/undelete_file.ml b/scripts/undelete_file.ml index e86ff6c..e2f42c0 100644 --- a/scripts/undelete_file.ml +++ b/scripts/undelete_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: undelete_file.ml,v 1.8 2006/03/27 18:09:47 rich Exp $ + * $Id: undelete_file.ml,v 1.9 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -33,29 +33,28 @@ let run r (q : cgi) dbh hostid { hostname = hostname } _ = if q#param_true "yes" then ( (* Get the name of the file. *) - let sth = dbh#prepare_cached "select name_deleted from files - where hostid = ? and id = ?" in - sth#execute [Some hostid; Some id]; - - let name = sth#fetch1string () in + let name = Option.get ( + List.hd ( + PGSQL(dbh) + "select name_deleted from files + where hostid = $hostid and id = $id" + ) + ) in (* First delete any more recent versions of this file. *) - let sth = dbh#prepare_cached "update files - set name_deleted = name, name = null - where hostid = ? and name = ?" in - sth#execute [Some hostid; Some name]; + PGSQL(dbh) "update files + set name_deleted = name, name = null + where hostid = $hostid and name = $name"; (* Now copy the old row, changing name_deleted back to name so the file * becomes live. *) - let sth = dbh#prepare_cached "insert into files - (hostid, name, content, title, mime_type, - upload_date) - select hostid, name_deleted, content, - title, mime_type, upload_date - from files - where hostid = ? and id = ?" in - sth#execute [Some hostid; Some id]; + PGSQL(dbh) "insert into files + (hostid, name, content, title, mime_type, upload_date) + select hostid, name_deleted, content, + title, mime_type, upload_date + from files + where hostid = $hostid and id = $id"; PGOCaml.commit dbh; diff --git a/scripts/undelete_file_form.ml b/scripts/undelete_file_form.ml index 328d6ac..af52048 100644 --- a/scripts/undelete_file_form.ml +++ b/scripts/undelete_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: undelete_file_form.ml,v 1.8 2006/03/27 18:09:47 rich Exp $ + * $Id: undelete_file_form.ml,v 1.9 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -32,16 +32,15 @@ let run r (q : cgi) dbh hostid _ _ = let id = Int32.of_string (q#param "id") in - let sth = dbh#prepare_cached "select name, name_deleted - from files - where hostid = ? and id = ?" in - sth#execute [Some hostid; Some id]; + let rows = PGSQL(dbh) + "select name, name_deleted from files + where hostid = $hostid and id = $id" in let name = - match sth#fetch1 () with - [ Some name; None] - | [ None; Some name] -> name - | _ -> assert false in + match rows with + | [ Some name, None] + | [ None, Some name] -> name + | _ -> assert false in template#set "id" (Int32.to_string id); template#set "name" name; diff --git a/scripts/undelete_image.ml b/scripts/undelete_image.ml index 73f417c..615c2b8 100644 --- a/scripts/undelete_image.ml +++ b/scripts/undelete_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: undelete_image.ml,v 1.8 2006/03/27 18:09:47 rich Exp $ + * $Id: undelete_image.ml,v 1.9 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -33,34 +33,34 @@ let run r (q : cgi) dbh hostid { hostname = hostname } _ = if q#param_true "yes" then ( (* Get the name of the image. *) - let sth = dbh#prepare_cached "select name_deleted from images - where hostid = ? and id = ?" in - sth#execute [Some hostid; Some id]; - - let name = sth#fetch1string () in + let name = Option.get ( + List.hd ( + PGSQL(dbh) "select name_deleted from images + where hostid = $hostid and id = $id" + ) + ) in (* First delete any more recent versions of this image. *) - let sth = dbh#prepare_cached "update images - set name_deleted = name, name = null - where hostid = ? and name = ?" in - sth#execute [Some hostid; Some name]; + PGSQL(dbh) + "update images + set name_deleted = name, name = null + where hostid = $hostid and name = $name"; (* Now copy the old row, changing name_deleted back to name so the image * becomes live. *) - let sth = dbh#prepare_cached "insert into images - (hostid, name, image, width, height, - alt, title, longdesc, class, - mime_type, thumbnail, tn_width, - tn_height, tn_mime_type, upload_date) - select hostid, name_deleted, image, - width, height, alt, title, longdesc, - class, mime_type, thumbnail, - tn_width, tn_height, tn_mime_type, - upload_date - from images - where hostid = ? and id = ?" in - sth#execute [Some hostid; Some id]; + PGSQL(dbh) "insert into images + (hostid, name, image, width, height, + alt, title, longdesc, class, + mime_type, thumbnail, tn_width, + tn_height, tn_mime_type, upload_date) + select hostid, name_deleted, image, + width, height, alt, title, longdesc, + class, mime_type, thumbnail, + tn_width, tn_height, tn_mime_type, + upload_date + from images + where hostid = $hostid and id = $id"; PGOCaml.commit dbh; diff --git a/scripts/undelete_image_form.ml b/scripts/undelete_image_form.ml index 72875c3..17a96f5 100644 --- a/scripts/undelete_image_form.ml +++ b/scripts/undelete_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: undelete_image_form.ml,v 1.8 2006/03/27 18:09:47 rich Exp $ + * $Id: undelete_image_form.ml,v 1.9 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -32,17 +32,17 @@ let run r (q : cgi) dbh hostid _ _ = let id = Int32.of_string (q#param "id") in - let sth = dbh#prepare_cached "select name, name_deleted, width, height, alt - from images - where hostid = ? and id = ?" in - sth#execute [Some hostid; Some id]; + let rows = PGSQL(dbh) + "select name, name_deleted, width, height, alt + from images + where hostid = $hostid and id = $id" in let name, width, height, alt = - match sth#fetch1 () with - [ Some name; None; Some width; Some height; Some alt] - | [ None; Some name; Some width; Some height; Some alt] -> - name, width, height, alt - | _ -> assert false in + match rows with + | [ Some name, None, width, height, alt] + | [ None, Some name, width, height, alt] -> + name, width, height, alt + | _ -> assert false in template#set "id" (Int32.to_string id); template#set "name" name; diff --git a/scripts/upload_file.ml b/scripts/upload_file.ml index a081c1e..852302b 100644 --- a/scripts/upload_file.ml +++ b/scripts/upload_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: upload_file.ml,v 1.12 2006/03/27 18:09:47 rich Exp $ + * $Id: upload_file.ml,v 1.13 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -69,11 +69,9 @@ let run r (q : cgi) dbh hostid { hostname = hostname } user= * then we can replace it, otherwise we must present an error message. *) let replace = q#param_true "replace" in - let sth = dbh#prepare_cached "select 1 from files - where hostid = ? and name = ?" in - sth#execute [Some hostid; Some name]; - - let exists = try sth#fetch1int () = 1 with Not_found -> false in + let rows = PGSQL(dbh) + "select 1 from files where hostid = $hostid and name = $name" in + let exists = rows = [Some 1l] in if exists then ( if not replace then ( @@ -81,20 +79,16 @@ let run r (q : cgi) dbh hostid { hostname = hostname } user= dbh hostid q "An file with the same name already exists."; return () ) else ( - let sth = dbh#prepare_cached "update files - set name_deleted = name, name = null - where hostid = ? and name = ?" in - sth#execute [Some hostid; Some name]; + PGSQL(dbh) "update files + set name_deleted = name, name = null + where hostid = $hostid and name = $name" ) ); (* Put the file into the database. *) - let sth = - dbh#prepare_cached - "insert into files (hostid, name, content, title, mime_type) - values (?, ?, ?, ?, ?)" in - sth#execute [Some hostid; Some name; `Binary file; title; - Some mime_type]; + PGSQL(dbh) + "insert into files (hostid, name, content, title, mime_type) + values ($hostid, $name, $file, $?title, $mime_type)"; PGOCaml.commit dbh; diff --git a/scripts/upload_file_form.ml b/scripts/upload_file_form.ml index 321cb2b..8cec265 100644 --- a/scripts/upload_file_form.ml +++ b/scripts/upload_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: upload_file_form.ml,v 1.9 2006/03/27 18:09:47 rich Exp $ + * $Id: upload_file_form.ml,v 1.10 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -38,12 +38,13 @@ let run r (q : cgi) dbh hostid _ _ = if q#param_exists "name" then q#param "name" else if q#param_exists "id" then ( let id = Int32.of_string (q#param "id") in - let sth = dbh#prepare_cached "select coalesce (name, name_deleted) - from files - where hostid = ? and id = ?" in - sth#execute [Some hostid; Some id]; - - let name = sth#fetch1string () in + let name = Option.get ( + List.hd ( + PGSQL(dbh) + "select coalesce (name, name_deleted) from files + where hostid = $hostid and id = $id" + ) + ) in name ) else "" in diff --git a/scripts/upload_image.ml b/scripts/upload_image.ml index 78cce2c..c777d0a 100644 --- a/scripts/upload_image.ml +++ b/scripts/upload_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: upload_image.ml,v 1.13 2006/03/27 18:09:47 rich Exp $ + * $Id: upload_image.ml,v 1.14 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -119,11 +119,9 @@ let run r (q : cgi) dbh hostid { hostname = hostname } user= * then we can replace it, otherwise we must present an error message. *) let replace = q#param_true "replace" in - let sth = dbh#prepare_cached "select 1 from images - where hostid = ? and name = ?" in - sth#execute [Some hostid; Some name]; - - let exists = try sth#fetch1int () = 1 with Not_found -> false in + let rows = PGSQL(dbh) "select 1 from images + where hostid = $hostid and name = $name" in + let exists = rows = [Some 1l] in if exists then ( if not replace then ( @@ -131,24 +129,24 @@ let run r (q : cgi) dbh hostid { hostname = hostname } user= dbh hostid q "An image with the same name already exists."; return () ) else ( - let sth = dbh#prepare_cached "update images - set name_deleted = name, name = null - where hostid = ? and name = ?" in - sth#execute [Some hostid; Some name]; + PGSQL(dbh) "update images + set name_deleted = name, name = null + where hostid = $hostid and name = $name" ) ); (* Put the image into the database. *) - let sth = - dbh#prepare_cached - "insert into images (hostid, name, image, width, height, alt, - title, longdesc, class, thumbnail, tn_width, - tn_height, mime_type, tn_mime_type) - values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" in - sth#execute [Some hostid; Some name; `Binary image; Some width; - Some height; Some alt; title; longdesc; clazz; - `Binary thumbnail; Some tn_width; Some tn_height; - Some mime_type; Some tn_mime_type]; + let width = Int32.of_int width in + let height = Int32.of_int height in + let tn_width = Int32.of_int tn_width in + let tn_height = Int32.of_int tn_height in + PGSQL(dbh) + "insert into images (hostid, name, image, width, height, alt, + title, longdesc, class, thumbnail, tn_width, + tn_height, mime_type, tn_mime_type) + values ($hostid, $name, $image, $width, $height, $alt, $?title, + $?longdesc, $?clazz, $thumbnail, $tn_width, $tn_height, + $mime_type, $tn_mime_type)"; PGOCaml.commit dbh; diff --git a/scripts/upload_image_form.ml b/scripts/upload_image_form.ml index f1c2711..52e1a20 100644 --- a/scripts/upload_image_form.ml +++ b/scripts/upload_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: upload_image_form.ml,v 1.9 2006/03/27 18:09:47 rich Exp $ + * $Id: upload_image_form.ml,v 1.10 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -38,12 +38,14 @@ let run r (q : cgi) dbh hostid _ _ = if q#param_exists "name" then q#param "name" else if q#param_exists "id" then ( let id = Int32.of_string (q#param "id") in - let sth = dbh#prepare_cached "select coalesce (name, name_deleted) - from images - where hostid = ? and id = ?" in - sth#execute [Some hostid; Some id]; - - let name = sth#fetch1string () in + let name = Option.get ( + List.hd ( + PGSQL(dbh) + "select coalesce (name, name_deleted) + from images + where hostid = $hostid and id = $id" + ) + ) in name ) else "" in diff --git a/scripts/user_prefs.ml b/scripts/user_prefs.ml index d487f1e..0cc2db0 100644 --- a/scripts/user_prefs.ml +++ b/scripts/user_prefs.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: user_prefs.ml,v 1.7 2006/03/27 18:09:47 rich Exp $ + * $Id: user_prefs.ml,v 1.8 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -42,11 +42,9 @@ let run r (q : cgi) dbh hostid {hostname=hostname} user = | User (userid, _, _, _) -> userid in (* Update the preferences fields. *) - let sth = - dbh#prepare_cached "update users set email_notify = ? - where hostid = ? and id = ?" in - sth#execute [`Bool email_notify; - Some hostid; Some userid]; + PGSQL(dbh) + "update users set email_notify = $email_notify + where hostid = $hostid and id = $userid"; (* Have we changed the email address? *) let confirm_needed = @@ -54,28 +52,27 @@ let run r (q : cgi) dbh hostid {hostname=hostname} user = (* Set the email field in the database to null. No need for * any confirmation. *) - let sth = dbh#prepare_cached "update users set email = null - where hostid = ? and id = ?" in - sth#execute [Some hostid; Some userid]; + PGSQL(dbh) "update users set email = null + where hostid = $hostid and id = $userid"; false ) else ( (* Is the new email address different from the one currently recorded * in the database? *) - let sth = dbh#prepare_cached "select ? <> coalesce (email, '') - from users where hostid = ? and id = ?" in - sth#execute [Some new_email; Some hostid; Some userid]; - - let changed = - match sth#fetch1 () with [ `Bool b ] -> b | _ -> assert false in + let changed = Option.get ( + List.hd ( + PGSQL(dbh) "select $new_email <> coalesce (email, '') + from users where hostid = $hostid and id = $userid" + ) + ) in if changed then ( let key = random_sessionid () in (* Changed, so we add to the pending_email_changes table. *) - let sth = dbh#prepare_cached "insert into pending_email_changes - (key, userid, email) values (?, ?, ?)" in - sth#execute [Some key; Some userid; Some new_email]; + PGSQL(dbh) "insert into pending_email_changes + (key, userid, email) + values ($key, $userid, $new_email)"; (* Send the confirm email. *) email_change_template#set "hostname" hostname; @@ -90,9 +87,8 @@ let run r (q : cgi) dbh hostid {hostname=hostname} user = ) in (* Good place to remove old rows in the pending_email_changes table. *) - let sth = dbh#prepare_cached "delete from pending_email_changes - where change_date - current_date > 7" in - sth#execute []; + PGSQL(dbh) "delete from pending_email_changes + where change_date - current_date > 7"; (* Commit and finish off. *) PGOCaml.commit dbh; diff --git a/scripts/user_prefs_form.ml b/scripts/user_prefs_form.ml index 6908904..4d66eb7 100644 --- a/scripts/user_prefs_form.ml +++ b/scripts/user_prefs_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: user_prefs_form.ml,v 1.4 2006/03/27 18:09:47 rich Exp $ + * $Id: user_prefs_form.ml,v 1.5 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -39,15 +39,11 @@ let run r (q : cgi) dbh hostid host user = let can_edit = can_edit host user in (* Pull out the registration date - not stored in the user object. *) - let sth = - dbh#prepare_cached - "select registration_date from users where hostid = ? and id = ?" in - sth#execute [Some hostid; Some userid]; - - let registration_date = - match sth#fetch1 () with - [ `Date registration_date ] -> registration_date - | _ -> assert false in + let registration_date = List.hd ( + PGSQL(dbh) + "select registration_date from users + where hostid = $hostid and id = $userid" + ) in let email, has_email = match prefs.email with diff --git a/scripts/users.ml b/scripts/users.ml index ca84d9e..8a3fcec 100644 --- a/scripts/users.ml +++ b/scripts/users.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: users.ml,v 1.9 2006/03/27 18:09:47 rich Exp $ + * $Id: users.ml,v 1.10 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -31,41 +31,38 @@ open Cocanwiki_date let run r (q : cgi) dbh hostid _ _ = let template = get_template dbh hostid "users.html" in - let sth = - dbh#prepare_cached + let rows = + PGSQL(dbh) "select id, name, email, registration_date, invite is not null, can_edit, can_manage_users, can_manage_contacts, can_manage_site, can_edit_global_css, can_import_mail - from users where hostid = ? order by name" in - sth#execute [Some hostid]; + from users where hostid = $hostid order by name" in let table = - sth#map - (function - [Some userid; Some name; (None | Some _) as email; - `Date registration_date; `Bool invite_pending; - `Bool can_edit; `Bool can_manage_users; - `Bool can_manage_contacts; `Bool can_manage_site; - `Bool can_edit_global_css; `Bool can_import_mail] -> - let email = match email with None -> "" | Some s -> s in - [ "userid", Template.VarString (Int32.to_string userid); - "name", Template.VarString name; - "email", Template.VarString email; - "registration_date", - Template.VarString (printable_date' registration_date); - "invite_pending", - Template.VarConditional invite_pending; - "can_edit", Template.VarConditional can_edit; - "can_manage_users", Template.VarConditional can_manage_users; - "can_manage_contacts", - Template.VarConditional can_manage_contacts; - "can_manage_site", Template.VarConditional can_manage_site; - "can_edit_global_css", - Template.VarConditional can_edit_global_css; - "can_import_mail", - Template.VarConditional can_import_mail;] - | _ -> assert false) in + List.map + (fun (userid, name, email, registration_date, invite_pending, + can_edit, can_manage_users, can_manage_contacts, can_manage_site, + can_edit_global_css, can_import_mail) -> + let email = match email with None -> "" | Some s -> s in + let invite_pending = Option.get invite_pending in + [ "userid", Template.VarString (Int32.to_string userid); + "name", Template.VarString name; + "email", Template.VarString email; + "registration_date", + Template.VarString (printable_date' registration_date); + "invite_pending", + Template.VarConditional invite_pending; + "can_edit", Template.VarConditional can_edit; + "can_manage_users", Template.VarConditional can_manage_users; + "can_manage_contacts", + Template.VarConditional can_manage_contacts; + "can_manage_site", Template.VarConditional can_manage_site; + "can_edit_global_css", + Template.VarConditional can_edit_global_css; + "can_import_mail", + Template.VarConditional can_import_mail;] + ) rows in template#table "users" table; diff --git a/scripts/what_links_here.ml b/scripts/what_links_here.ml index d68892e..d904d0f 100644 --- a/scripts/what_links_here.ml +++ b/scripts/what_links_here.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: what_links_here.ml,v 1.5 2006/03/27 18:09:47 rich Exp $ + * $Id: what_links_here.ml,v 1.6 2006/03/28 16:24:08 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -34,11 +34,10 @@ let run r (q : cgi) dbh hostid _ _ = let page = q#param "page" in template#set "page" page; - let sth = dbh#prepare_cached "select title from pages - where hostid = ? and url = ?" in - sth#execute [Some hostid; Some page]; - - let title = sth#fetch1string () in + let title = List.hd ( + PGSQL(dbh) "select title from pages + where hostid = $hostid and url = $page" + ) in template#set "title" title; let pages = what_links_here dbh hostid page in @@ -53,11 +52,10 @@ let run r (q : cgi) dbh hostid _ _ = (* Is the page in the site menu? If so, then every other page * links here, so we should say so. *) - let sth = dbh#prepare_cached "select 1 from sitemenu - where hostid = ? and url = ?" in - sth#execute [Some hostid; Some page]; + let rows = PGSQL(dbh) + "select 1 from sitemenu where hostid = $hostid and url = $page" in - let in_sitemenu = try sth#fetch1int () = 1 with Not_found -> false in + let in_sitemenu = rows = [Some 1l] in template#conditional "in_sitemenu" in_sitemenu; q#template template diff --git a/templates/recent.html b/templates/recent.html index 1e2b5e7..96dead5 100644 --- a/templates/recent.html +++ b/templates/recent.html @@ -27,7 +27,7 @@ ::last_modified_date_html:: (diff) (history) -::if(is_live)::::title_html:: (live)::else::::title_html::::end:: +::if(is_live)::::title_html:: (live)::else::::title_html::::end:: ::if(has_logged_user)::(by ::logged_user_html::)::else:: ::if(has_logged_ip)::(from ::logged_ip_html::)::end:: ::end::