(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_page_css.ml,v 1.19 2006/03/27 18:09:46 rich Exp $
+ * $Id: edit_page_css.ml,v 1.20 2006/03/27 19:10:29 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
(* Changing the CSS creates a new version of the page. This enables
* us to revert changes to the CSS easily.
*)
- let sth = dbh#prepare_cached "select id, title, description, creation_date,
- redirect
- from pages
- where hostid = ? and url = ?" in
- sth#execute [Some hostid; Some page];
+ let rows = PGSQL(dbh)
+ "select id, title, description, creation_date, redirect
+ from pages
+ where hostid = $hostid and url = $page" in
let oldpageid, title, description, creation_date, redirect =
- match sth#fetch1 () with
- [ Some id; title; description; creation_date; redirect ] ->
- id, title, description, creation_date, redirect
- | _ -> 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 id = ?" in
- sth#execute [Some hostid; Some oldpageid];
-
- let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
- description, creation_date, logged_ip,
- logged_user, redirect, css)
- values (?, ?, ?, ?, ?, ?, ?, ?, ?)" in
- sth#execute [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 oldpageid];
+ match rows with
+ | [id, title, description, creation_date, redirect ] ->
+ id, title, description, creation_date, redirect
+ | _ -> 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 id = $oldpageid";
+
+ 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 as pageid, ordering, sectionname,
+ content, divname
+ from contents
+ where pageid = $oldpageid";
PGOCaml.commit dbh;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_page_css_form.ml,v 1.7 2006/03/27 18:09:46 rich Exp $
+ * $Id: edit_page_css_form.ml,v 1.8 2006/03/27 19:10:29 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
let page = q#param "page" in
- let sth = dbh#prepare_cached "select css from pages
- where hostid = ? and url = ?" in
- sth#execute [Some hostid; Some page];
+ let css = List.hd (
+ PGSQL(dbh) "select css from pages
+ where hostid = $hostid and url = $page"
+ ) in
- let css =
- match sth#fetch1 () with
- | [ None ] -> ""
- | [ Some css ] -> css
- | _ -> assert false in
+ let css = match css with None -> "" | Some css -> css in
template#set "page" page;
template#set "css" css;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_sitemenu.ml,v 1.10 2006/03/27 18:09:46 rich Exp $
+ * $Id: edit_sitemenu.ml,v 1.11 2006/03/27 19:10:29 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
template#conditional "msie" msie;
(* Pull in the list of URLs in useful format. *)
- let sth = dbh#prepare_cached "select url, title from pages
- where hostid = ?
- and url is not null
- and url <> 'index'
- order by 2" in
- sth#execute [Some hostid];
-
- let urls = sth#map (function [Some url; Some title] ->
- url, title
- | _ -> assert false) in
+ let urls = PGSQL(dbh)
+ "select url, title from pages
+ where hostid = $hostid
+ and url is not null
+ and url <> 'index'
+ order by 2" in
+ let urls = List.map (fun (url, title) -> Option.get url, title) urls in
(* Build the internal model from the parameters passed to the script. *)
let build_internal_model () =
let model = ref [] in
let i = ref 1 in
- while q#param_exists ("label_" ^ Int32.to_string !i) do
- let label = q#param ("label_" ^ Int32.to_string !i) in
- let url = q#param ("url_" ^ Int32.to_string !i) in
+ while q#param_exists ("label_" ^ string_of_int !i) do
+ let label = q#param ("label_" ^ string_of_int !i) in
+ let url = q#param ("url_" ^ string_of_int !i) in
model := (label, url) :: !model;
incr i
done;
"title", Template.VarString (truncate 30 title);
"selected", Template.VarConditional selected ]) urls in
- [ "ordering", Template.VarString (Int32.to_string ordering);
+ [ "ordering", Template.VarString (string_of_int ordering);
"label", Template.VarString label;
"url", Template.VarString url;
"urls", Template.VarTable table; ]) model in
* a model from it.
*)
let begin_editing () =
- let sth = dbh#prepare_cached "select label, url, ordering
- from sitemenu
- where hostid = ?
- order by ordering" in
- sth#execute [Some hostid];
+ let rows =
+ PGSQL(dbh) "select label, url, ordering
+ from sitemenu
+ where hostid = $hostid
+ order by ordering" in
- let model = sth#map (function [Some label; Some url; _] ->
- label, url
- | _ -> assert false) in
+ let model = List.map (fun (label, url, _) -> label, url) rows in
model_to_template model template
in
let action_type = String.sub str 7 6 in
let action_value =
String.sub str 14 (String.length str - 14) in
- let action_value = Int32.of_string action_value in
+ let action_value = int_of_string action_value in
action_type, action_value) actions in
let is_action typ = List.mem_assoc typ actions in
if no_errors then (
(* No errors, so we can save the page ... *)
- let sth = dbh#prepare_cached "delete from sitemenu where hostid = ?" in
- sth#execute [Some hostid];
-
- let sth = dbh#prepare_cached "insert into sitemenu (hostid, label, url,
- ordering) values (?, ?, ?, ?)" in
-
- List.iteri (fun i (label, url) ->
- let ordering = 10 * (i+1) in
- sth#execute [Some hostid; Some label; Some url;
- Some ordering]) model;
+ PGSQL(dbh) "delete from sitemenu where hostid = $hostid";
+ List.iteri (
+ fun i (label, url) ->
+ let ordering = Int32.of_int (10 * (i+1)) in
+ PGSQL(dbh)
+ "insert into sitemenu (hostid, label, url, ordering)
+ values ($hostid, $label, $url, $ordering)"
+ ) model;
(* Commit changes to the database. *)
PGOCaml.commit dbh;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_user.ml,v 1.11 2006/03/27 18:09:46 rich Exp $
+ * $Id: edit_user.ml,v 1.12 2006/03/27 19:10:29 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
(* Get the user's original name. If we're going to change the
* name, we need to do additional checks.
*)
- let sth = dbh#prepare_cached "select name from users
- where hostid = ? and id = ?" in
- sth#execute [Some hostid; Some userid];
- let original_name = sth#fetch1string () in
+ let original_name =
+ List.hd (
+ PGSQL(dbh)
+ "select name from users where hostid = $hostid and id = $userid"
+ ) in
let name = trim (q#param "name") in
);
(* Check it's not a duplicate, then change it. *)
- let sth = dbh#prepare_cached "select id from users
- where hostid = ? and name = ?" in
- sth#execute [Some hostid; Some name];
+ let rows = PGSQL(dbh)
+ "select 1 from users where hostid = $hostid and name = $name" in
- (try
- sth#fetch1 ();
- error ~back_button:true ~title:"Username already taken"
- dbh hostid q
- ("That username has already been taken by another user.");
- return ()
- with
- Not_found -> ());
+ (match rows with
+ | [Some 1l] ->
+ error ~back_button:true ~title:"Username already taken"
+ dbh hostid q
+ ("That username has already been taken by another user.");
+ return ()
+ | _ -> ()
+ );
- let sth = dbh#prepare_cached "update users set name = ?
- where hostid = ? and id = ?" in
- sth#execute [Some name; Some hostid; Some userid]
+ PGSQL(dbh) "update users set name = $name
+ where hostid = $hostid and id = $userid"
);
(* Change permissions. *)
return ()
| _ -> ());
- let sth = dbh#prepare_cached "update users set
- can_edit = ?, can_manage_users = ?,
- can_manage_contacts = ?,
- can_manage_site = ?,
- can_edit_global_css = ?,
- can_import_mail = ?
- where hostid = ? and id = ?" in
- sth#execute [`Bool can_edit; `Bool can_manage_users;
- `Bool can_manage_contacts; `Bool can_manage_site;
- `Bool can_edit_global_css; `Bool can_import_mail;
- Some hostid; Some userid];
+ PGSQL(dbh)
+ "update users set
+ can_edit = $can_edit, can_manage_users = $can_manage_users,
+ can_manage_contacts = $can_manage_contacts,
+ can_manage_site = $can_manage_site,
+ can_edit_global_css = $can_edit_global_css,
+ can_import_mail = $can_import_mail
+ where hostid = $hostid and id = $userid";
(* Finish up. *)
PGOCaml.commit dbh;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_user_form.ml,v 1.9 2006/03/27 18:09:46 rich Exp $
+ * $Id: edit_user_form.ml,v 1.10 2006/03/27 19:10:29 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
let userid = Int32.of_string (q#param "userid") in
- let sth =
- dbh#prepare_cached
+ let rows =
+ PGSQL(dbh)
"select u.name, u.email, u.registration_date,
u.can_edit, u.can_manage_users, u.can_manage_contacts,
u.can_manage_site, u.can_edit_global_css, u.can_import_mail,
(select count(*) from pages where logged_user = u.id)::int4,
(select count(*) from pages
where logged_user = u.id and url_deleted is null)::int4
- from users u where u.hostid = ? and u.id = ?" in
- sth#execute [Some hostid; Some userid];
+ from users u where u.hostid = $hostid and u.id = $userid" in
let name, email, registration_date, can_edit, can_manage_users,
can_manage_contacts, can_manage_site, can_edit_global_css,
can_import_mail, nr_edits, nr_edits_live =
- match sth#fetch1 () with
- [Some name; (None | Some _) as email;
- `Date registration_date;
- `Bool can_edit; `Bool can_manage_users; `Bool can_manage_contacts;
- `Bool can_manage_site; `Bool can_edit_global_css;
- `Bool can_import_mail;
- Some nr_edits; Some nr_edits_live] ->
- name, email, registration_date, can_edit, can_manage_users,
- can_manage_contacts, can_manage_site, can_edit_global_css,
- can_import_mail, nr_edits, nr_edits_live
- | _ -> assert false in
+ match rows with
+ | [name, email, registration_date,
+ can_edit, can_manage_users, can_manage_contacts,
+ can_manage_site, can_edit_global_css,
+ can_import_mail,
+ nr_edits, nr_edits_live] ->
+ name, email, registration_date, can_edit, can_manage_users,
+ can_manage_contacts, can_manage_site, can_edit_global_css,
+ can_import_mail, nr_edits, nr_edits_live
+ | _ -> assert false in
template#set "userid" (Int32.to_string userid);
template#set "name" name;
template#conditional "can_manage_site" can_manage_site;
template#conditional "can_edit_global_css" can_edit_global_css;
template#conditional "can_import_mail" can_import_mail;
- template#set "nr_edits" (Int32.to_string nr_edits);
- template#set "nr_edits_live" (Int32.to_string nr_edits_live);
+ template#set "nr_edits" (Int32.to_string (Option.get nr_edits));
+ template#set "nr_edits_live" (Int32.to_string (Option.get nr_edits_live));
q#template template
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: email_change.ml,v 1.3 2006/03/27 18:09:46 rich Exp $
+ * $Id: email_change.ml,v 1.4 2006/03/27 19:10:29 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
(* Get the key in the pending_email_changes table. *)
let key = q#param "key" in
- let sth = dbh#prepare_cached "select userid, email from pending_email_changes
- where key = ?" in
- sth#execute [Some key];
+ let rows = PGSQL(dbh) "select userid, email from pending_email_changes
+ where key = $key" in
let userid, email =
- try
- (match sth#fetch1 () with
- [ Some userid; Some email ] -> userid, email
- | _ -> assert false)
- with
- Not_found ->
- error ~title:"Already verified"
- dbh hostid q
- ("It looks like you have already verified this email address.");
- return () in
+ match rows with
+ | [ row ] -> row
+ | [] ->
+ error ~title:"Already verified"
+ dbh hostid q
+ ("It looks like you have already verified this email address.");
+ return ()
+ | _ -> assert false in
(* Update the database. *)
- let sth = dbh#prepare_cached "delete from pending_email_changes
- where key = ?" in
- sth#execute [Some key];
-
- let sth = dbh#prepare_cached "update users set email = ? where id = ?" in
- sth#execute [Some email; Some userid];
+ PGSQL(dbh) "delete from pending_email_changes where key = $key";
+ PGSQL(dbh) "update users set email = $email where id = $userid";
PGOCaml.commit dbh;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: file.ml,v 1.14 2006/03/27 18:09:46 rich Exp $
+ * $Id: file.ml,v 1.15 2006/03/27 19:10:29 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
try Some (Int32.of_string (q#param "version")) with Not_found -> None in
(* Get the file and its MIME type. *)
- let where, args =
- match version with
- None -> "hostid = ? and name = ?", [Some hostid; Some name]
- | Some version ->
- "hostid = ? and (name = ? or name_deleted = ?) and id = ?",
- [Some hostid; Some name; Some name; Some version] in
-
- let sth =
- dbh#prepare_cached ("select content, mime_type, name is null as deleted
- from files
- where " ^ where) in
- sth#execute args;
-
let data, mime_type, deleted =
try
- (match sth#fetch1 () with
- [ `Binary data; Some mime_type; `Bool deleted ] ->
- data, mime_type, deleted
- | _ -> assert false)
+ List.hd (
+ match version with
+ | None ->
+ PGSQL(dbh) "select content, mime_type, name is null as deleted
+ from files
+ where hostid = $hostid and name = $name"
+ | Some version ->
+ PGSQL(dbh) "select content, mime_type, name is null as deleted
+ from files
+ where hostid = $hostid
+ and (name = $name or name_deleted = $name)
+ and id = $version"
+ )
with
- Not_found -> raise (HttpError cHTTP_NOT_FOUND) in
+ Not_found | ExtList.List.Empty_list ->
+ raise (HttpError cHTTP_NOT_FOUND) in
+
+ let deleted = Option.get deleted in
(* If deleted, refuse to serve this file except if called from the site. *)
if deleted then (
let referer =
try Table.get (Request.headers_in r) "Referer" with Not_found -> "" in
let ok =
- try String.find referer hostname; true
+ try ignore (String.find referer hostname); true
with Invalid_string -> false in
if not ok then (
(* Content-length header. *)
Table.set (Request.headers_out r) "Content-Length"
- (Int32.to_string (String.length data));
+ (string_of_int (String.length data));
q#header ~content_type:mime_type ();
ignore (print_string r data)
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: files.ml,v 1.8 2006/03/27 18:09:46 rich Exp $
+ * $Id: files.ml,v 1.9 2006/03/27 19:10:29 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
let deleted = q#param_true "deleted" in
template#conditional "deleted" deleted;
- let sql =
- "select id, name, name_deleted, octet_length (content)
- from files
- where hostid = ? and " ^
- (if not deleted then "name is not null"
- else "name_deleted is not null") ^
- " order by 2, 3" in
- let sth = dbh#prepare_cached sql in
- sth#execute [Some hostid];
+ let rows =
+ if not deleted then
+ PGSQL(dbh)
+ "select id, name, name_deleted, octet_length (content)
+ from files
+ where hostid = $hostid and name is not null
+ order by 2, 3"
+ else
+ PGSQL(dbh)
+ "select id, name, name_deleted, octet_length (content)
+ from files
+ where hostid = $hostid and name_deleted is not null
+ order by 2, 3" in
let table =
- sth#map
+ List.map
(fun row ->
let id, name, size, is_deleted =
match row with
- | [Some id; Some name; None; Some size] ->
+ | (id, Some name, None, size) ->
id, name, size, false
- | [Some id; None; Some name; Some size] ->
+ | (id, None, Some name, size) ->
id, name, size, true
| _ -> assert false in
+ let size = Int32.to_int (Option.get size) in
[ "id", Template.VarString (Int32.to_string id);
"name", Template.VarString name;
- "ksize", Template.VarString (Int32.to_string (size / 1024));
- "is_deleted", Template.VarConditional is_deleted ]) in
+ "ksize", Template.VarString (string_of_int (size / 1024));
+ "is_deleted", Template.VarConditional is_deleted ]
+ ) rows in
template#table "files" table;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: forgot_password.ml,v 1.9 2006/03/27 18:09:46 rich Exp $
+ * $Id: forgot_password.ml,v 1.10 2006/03/27 19:10:29 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
);
(* Look it up in the database. *)
- let sth = dbh#prepare_cached "select email, name, password from users
- where hostid = ?
- and email is not null
- and (lower (name) = lower (?)
- or lower (email) = lower (?))" in
- sth#execute [Some hostid; Some name; Some name];
+ let rows = PGSQL(dbh)
+ "select email, name, password from users
+ where hostid = $hostid
+ and email is not null
+ and (lower (name) = lower ($name) or lower (email) = lower ($name))" in
try
- let email, name, password = match sth#fetch1 () with
- [ Some email; Some name; Some password ] ->
+ let email, name, password =
+ match rows with
+ | [ Some email, name, password ] ->
email, name, password
| _ -> assert false in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: history.ml,v 1.10 2006/03/27 18:09:46 rich Exp $
+ * $Id: history.ml,v 1.11 2006/03/27 19:10:29 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
let page = if page = "" then "index" else page in
template#set "page" page;
- 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 = ? and (p.url = ? or p.url_deleted = ?)
+ where p.hostid = $hostid and (p.url = $page or p.url_deleted = $page)
order by p.last_modified_date desc" in
- sth#execute [Some hostid; Some page; Some page];
let table =
- sth#map
+ List.map
(function
- | [Some version; Some url; _; Some title;
- `Timestamp last_modified_date; logged_ip; logged_user ] ->
+ | (Some version, Some url, _, Some title,
+ Some last_modified_date, logged_ip, logged_user) ->
let date = printable_date_time last_modified_date in
let has_logged_ip, logged_ip =
match logged_ip with
None -> false, ""
- | Some ip -> true, ip
- | _ -> assert false in
+ | Some ip -> true, ip in
let has_logged_user, logged_user =
match logged_user with
None -> false, ""
- | Some name -> true, name
- | _ -> assert false in
+ | Some name -> true, name in
[ "version", Template.VarString (Int32.to_string version);
"url", Template.VarString url;
"title", Template.VarString title;
"has_logged_user", Template.VarConditional has_logged_user;
"logged_user", Template.VarString logged_user;
"is_live", Template.VarConditional true ]
- | [Some version; None; Some url; Some title;
- `Timestamp last_modified_date; logged_ip; logged_user ] ->
+ | (Some version, None, Some url, Some title,
+ Some last_modified_date, logged_ip, logged_user) ->
let date = printable_date_time last_modified_date in
let has_logged_ip, logged_ip =
match logged_ip with
None -> false, ""
- | Some ip -> true, ip
- | _ -> assert false in
+ | Some ip -> true, ip in
let has_logged_user, logged_user =
match logged_user with
None -> false, ""
- | Some name -> true, name
- | _ -> assert false in
+ | Some name -> true, name in
[ "version", Template.VarString (Int32.to_string version);
"url", Template.VarString url;
"title", Template.VarString title;
"has_logged_user", Template.VarConditional has_logged_user;
"logged_user", Template.VarString logged_user;
"is_live", Template.VarConditional false ]
- | _ -> assert false) in
+ | _ -> assert false
+ ) rows in
template#table "history" table;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: history_rss.ml,v 1.3 2006/03/27 18:09:46 rich Exp $
+ * $Id: history_rss.ml,v 1.4 2006/03/27 19:10:29 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
template#set "hostname" hostname;
- 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 = ? and (p.url = ? or p.url_deleted = ?)
+ where p.hostid = $hostid and (p.url = $page or p.url_deleted = $page)
order by p.last_modified_date desc" in
- sth#execute [Some hostid; Some page; Some page];
let table =
- sth#map
+ List.map
(function
- | [Some version; Some url; _; Some title;
- `Timestamp last_modified_date; logged_ip; logged_user ] ->
+ | (Some version, Some url, _, Some title,
+ Some last_modified_date, logged_ip, logged_user) ->
let date = printable_date_time last_modified_date in
let has_logged_ip, logged_ip =
match logged_ip with
None -> false, ""
- | Some ip -> true, ip
- | _ -> assert false in
+ | Some ip -> true, ip in
let has_logged_user, logged_user =
match logged_user with
None -> false, ""
- | Some name -> true, name
- | _ -> assert false in
+ | Some name -> true, name in
[ "version", Template.VarString (Int32.to_string version);
"url", Template.VarString url;
"title", Template.VarString title;
"has_logged_user", Template.VarConditional has_logged_user;
"logged_user", Template.VarString logged_user;
"is_live", Template.VarConditional true ]
- | [Some version; None; Some url; Some title;
- `Timestamp last_modified_date; logged_ip; logged_user ] ->
+ | (Some version, None, Some url, Some title,
+ Some last_modified_date, logged_ip, logged_user) ->
let date = printable_date_time last_modified_date in
let has_logged_ip, logged_ip =
match logged_ip with
None -> false, ""
- | Some ip -> true, ip
- | _ -> assert false in
+ | Some ip -> true, ip in
let has_logged_user, logged_user =
match logged_user with
None -> false, ""
- | Some name -> true, name
- | _ -> assert false in
+ | Some name -> true, name in
[ "version", Template.VarString (Int32.to_string version);
"url", Template.VarString url;
"title", Template.VarString title;
"has_logged_user", Template.VarConditional has_logged_user;
"logged_user", Template.VarString logged_user;
"is_live", Template.VarConditional false ]
- | _ -> assert false) in
+ | _ -> assert false
+ ) rows in
template#table "history" table;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: host_menu.ml,v 1.8 2006/03/27 18:09:46 rich Exp $
+ * $Id: host_menu.ml,v 1.9 2006/03/27 19:10:29 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
if can_manage_site then (
(* Get lots of host-specific stuff from the database. *)
- let sth =
- dbh#prepare_cached
+ let rows =
+ PGSQL(dbh) "nullable-results"
"select h.canonical_hostname, h.css is not null, h.edit_anon,
h.create_account_anon, h.theme_css is not null,
t.name, t.description, h.feedback_email, h.mailing_list,
h.brand, coalesce (h.brand_tagline, ''),
coalesce (h.brand_description, '')
from hosts h left outer join themes t on h.theme_css = t.theme_css
- where h.id = ?" in
- sth#execute [Some hostid];
+ where h.id = $hostid" in
let canonical_hostname, has_global_css, edit_anon, create_account_anon,
- has_theme_css, theme_name, theme_description, has_feedback_email,
- feedback_email, mailing_list, search_box, navigation, view_anon,
- has_brand, brand, brand_tagline, brand_description =
- match sth#fetch1 () with
- [ Some canonical_hostname; `Bool has_global_css;
- `Bool edit_anon; `Bool create_account_anon; `Bool has_theme_css;
- (Some _ | None) as theme_name;
- (Some _ | None) as theme_description;
- (Some _ | None) as feedback_email;
- `Bool mailing_list; `Bool search_box; `Bool navigation;
- `Bool view_anon;
- (Some _ | None) as brand; Some brand_tagline;
- Some brand_description ] ->
- let theme_name =
- match theme_name with Some s -> s | None -> "" in
- let theme_description =
- match theme_description with Some s -> s | None -> "" in
- let feedback_email, has_feedback_email =
- match feedback_email with
- Some s -> s, true
- | None -> "", false in
- let brand, has_brand =
- match brand with
- Some s -> s, true
- | None -> "", false in
- canonical_hostname, has_global_css, edit_anon, create_account_anon,
- has_theme_css, theme_name, theme_description, has_feedback_email,
- feedback_email, mailing_list, search_box, navigation, view_anon,
- has_brand, brand, brand_tagline, brand_description
- | _ -> assert false in
+ has_theme_css, theme_name, theme_description, has_feedback_email,
+ feedback_email, mailing_list, search_box, navigation, view_anon,
+ has_brand, brand, brand_tagline, brand_description =
+ match rows with
+ [ Some canonical_hostname, Some has_global_css,
+ Some edit_anon, Some create_account_anon, Some has_theme_css,
+ theme_name, theme_description,
+ feedback_email,
+ Some mailing_list, Some search_box, Some navigation, Some view_anon,
+ brand, brand_tagline, brand_description ] ->
+ let theme_name =
+ match theme_name with Some s -> s | None -> "" in
+ let theme_description =
+ match theme_description with Some s -> s | None -> "" in
+ let feedback_email, has_feedback_email =
+ match feedback_email with
+ Some s -> s, true
+ | None -> "", false in
+ let brand, has_brand =
+ match brand with
+ Some s -> s, true
+ | None -> "", false in
+ let brand_tagline =
+ match brand_tagline with None -> "" | Some s -> s in
+ let brand_description =
+ match brand_description with None -> "" | Some s -> s in
+ canonical_hostname, has_global_css, edit_anon, create_account_anon,
+ has_theme_css, theme_name, theme_description, has_feedback_email,
+ feedback_email, mailing_list, search_box, navigation, view_anon,
+ has_brand, brand, brand_tagline, brand_description
+ | _ -> assert false in
template#set "canonical_hostname" canonical_hostname;
template#conditional "has_global_css" has_global_css;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: hoststyle.ml,v 1.7 2006/03/27 18:09:46 rich Exp $
+ * $Id: hoststyle.ml,v 1.8 2006/03/27 19:10:29 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
let run r (q : cgi) dbh hostid _ _ =
(* Get the CSS. *)
- let sth = dbh#prepare_cached "select css from hosts where id = ?" in
- sth#execute [Some hostid];
-
+ let css = List.hd (PGSQL(dbh) "select css from hosts where id = $hostid") in
let css =
- match sth#fetch1 () with
- [ None ] -> ""
- | [ Some css ] -> css
- | _ -> assert false in
+ match css with
+ | None -> ""
+ | Some css -> css in
(* It's crucial, for speed of page delivery and rendering, to have
* an expires header for CSS. Even though this means that occasionally
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: image.ml,v 1.15 2006/03/27 18:09:46 rich Exp $
+ * $Id: image.ml,v 1.16 2006/03/27 19:10:29 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
try Some (Int32.of_string (q#param "version")) with Not_found -> None in
(* Get the image and its MIME type. *)
- let what =
- if not is_thumbnail then "image, mime_type, name is null as deleted"
- else "thumbnail, tn_mime_type, name is null as deleted" in
- let where, args =
- match version with
- None -> "hostid = ? and name = ?", [Some hostid; Some image]
- | Some version ->
- "hostid = ? and (name = ? or name_deleted = ?) and id = ?",
- [Some hostid; Some image; Some image; Some version] in
-
- let sth = dbh#prepare_cached
- ("select " ^ what ^ " from images where " ^ where) in
- sth#execute args;
-
let data, mime_type, deleted =
try
- (match sth#fetch1 () with
- [ `Binary data; Some mime_type; `Bool deleted ] ->
- data, mime_type, deleted
- | _ -> assert false)
+ if not is_thumbnail then
+ List.hd (
+ match version with
+ | None ->
+ PGSQL(dbh) "select image, mime_type, name is null
+ from images
+ where hostid = $hostid and name = $image"
+ | Some version ->
+ PGSQL(dbh) "select image, mime_type, name is null
+ from images
+ where hostid = $hostid
+ and (name = $image or name_deleted = $image)
+ and id = $version"
+ )
+ else (
+ let data, mime_type, deleted =
+ List.hd (
+ match version with
+ | None ->
+ PGSQL(dbh) "select thumbnail, tn_mime_type, name is null
+ from images
+ where hostid = $hostid and name = $image"
+ | Some version ->
+ PGSQL(dbh) "select thumbnail, tn_mime_type, name is null
+ from images
+ where hostid = $hostid
+ and (name = $image or name_deleted = $image)
+ and id = $version"
+ ) in
+ Option.get data, Option.get mime_type, deleted
+ )
with
- Not_found -> raise (HttpError cHTTP_NOT_FOUND) in
+ Not_found | ExtList.List.Empty_list ->
+ raise (HttpError cHTTP_NOT_FOUND) in
+
+ let deleted = Option.get deleted in
(* If deleted, refuse to serve this image except if shown on the site. *)
if deleted then (
let referer =
try Table.get (Request.headers_in r) "Referer" with Not_found -> "" in
let ok =
- try String.find referer hostname; true
+ try ignore (String.find referer hostname); true
with Invalid_string -> false in
if not ok then (
(* Content-length header. *)
Table.set (Request.headers_out r) "Content-Length"
- (Int32.to_string (String.length data));
+ (string_of_int (String.length data));
q#header ~content_type:mime_type ();
ignore (print_string r data)
git.annexia.org / cocanwiki.git / commitdiff