Rather more work than can be completed in one evening -- needs a

few more hours of rather laborious rewriting and then it'll be
complete.  Rescheduled full migration of cocanwiki for another day.

diff --git a/scripts/edit_page_css.ml b/scripts/edit_page_css.ml
index 71e727b..d8add8d 100644 (file)
--- a/scripts/edit_page_css.ml
+++ b/scripts/edit_page_css.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
 (* 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
  *
  * 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,45 +49,40 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user =
   (* Changing the CSS creates a new version of the page.  This enables
    * us to revert changes to the CSS easily.
    *)
   (* 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 =
 
   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;
 
 
   PGOCaml.commit dbh;
 

diff --git a/scripts/edit_page_css_form.ml b/scripts/edit_page_css_form.ml
index d58c641..25f317b 100644 (file)
--- a/scripts/edit_page_css_form.ml
+++ b/scripts/edit_page_css_form.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
 (* 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
  *
  * 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,15 +32,12 @@ let run r (q : cgi) dbh hostid _ _ =
 
   let page = q#param "page" in
 
 
   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;
 
   template#set "page" page;
   template#set "css" css;

diff --git a/scripts/edit_sitemenu.ml b/scripts/edit_sitemenu.ml
index 566dbaa..6680e52 100644 (file)
--- a/scripts/edit_sitemenu.ml
+++ b/scripts/edit_sitemenu.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
 (* 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
  *
  * 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


@@ -54,24 +54,21 @@ let run r (q : cgi) dbh hostid { hostname = hostname } user=
   template#conditional "msie" msie;
 
   (* Pull in the list of URLs in useful format. *)
   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
 
   (* 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;
       model := (label, url) :: !model;
       incr i
     done;


@@ -159,7 +156,7 @@ let run r (q : cgi) dbh hostid { hostname = hostname } user=
                    "title", Template.VarString (truncate 30 title);
                    "selected", Template.VarConditional selected ]) urls in
 
                    "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
             "label", Template.VarString label;
             "url", Template.VarString url;
             "urls", Template.VarTable table; ]) model in


@@ -177,15 +174,13 @@ let run r (q : cgi) dbh hostid { hostname = hostname } user=
    * a model from it.
    *)
   let begin_editing () =
    * 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
 
     model_to_template model template
   in


@@ -218,7 +213,7 @@ let run r (q : cgi) dbh hostid { hostname = hostname } user=
                    let action_type = String.sub str 7 6 in
                    let action_value =
                      String.sub str 14 (String.length str - 14) 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
                    action_type, action_value) actions in
 
       let is_action typ = List.mem_assoc typ actions in


@@ -254,16 +249,14 @@ let run r (q : cgi) dbh hostid { hostname = hostname } user=
     if no_errors then (
       (* No errors, so we can save the page ... *)
 
     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;
 
       (* Commit changes to the database. *)
       PGOCaml.commit dbh;

diff --git a/scripts/edit_user.ml b/scripts/edit_user.ml
index c93d4ee..bfbd191 100644 (file)
--- a/scripts/edit_user.ml
+++ b/scripts/edit_user.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
 (* 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
  *
  * 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,10 +34,11 @@ let run r (q : cgi) dbh hostid _ self =
   (* Get the user's original name.  If we're going to change the
    * name, we need to do additional checks.
    *)
   (* 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
 
 
   let name = trim (q#param "name") in
 


@@ -49,22 +50,20 @@ let run r (q : cgi) dbh hostid _ self =
     );
 
     (* Check it's not a duplicate, then change it. *)
     );
 
     (* 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. *)
   );
 
   (* Change permissions. *)


@@ -86,17 +85,14 @@ let run r (q : cgi) dbh hostid _ self =
         return ()
      | _ -> ());
 
         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;
 
   (* Finish up. *)
   PGOCaml.commit dbh;

diff --git a/scripts/edit_user_form.ml b/scripts/edit_user_form.ml
index 76ff9bd..76caf6a 100644 (file)
--- a/scripts/edit_user_form.ml
+++ b/scripts/edit_user_form.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
 (* 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
  *
  * 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,31 +33,29 @@ let run r (q : cgi) dbh hostid _ _ =
 
   let userid = Int32.of_string (q#param "userid") in
 
 
   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
       "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 =
 
   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#set "userid" (Int32.to_string userid);
   template#set "name" name;


@@ -69,8 +67,8 @@ let run r (q : cgi) dbh hostid _ _ =
   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#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
 
 
   q#template template
 

diff --git a/scripts/email_change.ml b/scripts/email_change.ml
index 9b4699d..1d254a8 100644 (file)
--- a/scripts/email_change.ml
+++ b/scripts/email_change.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
 (* 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
  *
  * 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,29 +31,22 @@ let run r (q : cgi) dbh hostid _ _ =
   (* Get the key in the pending_email_changes table. *)
   let key = q#param "key" in
 
   (* 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 =
 
   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. *)
 
   (* 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;
 
 
   PGOCaml.commit dbh;
 

diff --git a/scripts/file.ml b/scripts/file.ml
index 7b96eba..ae4f9ed 100644 (file)
--- a/scripts/file.ml
+++ b/scripts/file.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
 (* 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
  *
  * 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,34 +34,33 @@ let run r (q : cgi) dbh hostid {hostname = hostname} _ =
     try Some (Int32.of_string (q#param "version")) with Not_found -> None in
 
   (* Get the file and its MIME type. *)
     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
   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
     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 =
 
   (* 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 (
       with Invalid_string -> false in
 
     if not ok then (


@@ -76,7 +75,7 @@ let run r (q : cgi) dbh hostid {hostname = hostname} _ =
 
   (* Content-length header. *)
   Table.set (Request.headers_out r) "Content-Length"
 
   (* 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)
 
   q#header ~content_type:mime_type ();
   ignore (print_string r data)

diff --git a/scripts/files.ml b/scripts/files.ml
index 5f8814e..31900a2 100644 (file)
--- a/scripts/files.ml
+++ b/scripts/files.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
 (* 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
  *
  * 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,30 +33,36 @@ let run r (q : cgi) dbh hostid _ _ =
   let deleted = q#param_true "deleted" in
   template#conditional "deleted" deleted;
 
   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 =
 
   let table =

-    sth#map
+    List.map

       (fun row ->
         let id, name, size, is_deleted =
           match row with
       (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
                 id, name, size, false

-            | [Some id; None; Some name; Some size] ->
+            | (id, None, Some name, size) ->

                 id, name, size, true
             | _ -> assert false in
                 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;
         [ "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;
 
 
   template#table "files" table;
 

diff --git a/scripts/forgot_password.ml b/scripts/forgot_password.ml
index 6d2f6e8..e51e998 100644 (file)
--- a/scripts/forgot_password.ml
+++ b/scripts/forgot_password.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
 (* 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
  *
  * 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,16 +38,16 @@ let run r (q : cgi) dbh hostid { hostname = hostname } _ =
   );
 
   (* Look it up in the database. *)
   );
 
   (* 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
 
   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
 
          email, name, password
       | _ -> assert false in
 

diff --git a/scripts/history.ml b/scripts/history.ml
index 65708db..9560ba4 100644 (file)
--- a/scripts/history.ml
+++ b/scripts/history.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
 (* 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
  *
  * 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,31 +35,28 @@ let run r (q : cgi) dbh hostid _ _ =
   let page = if page = "" then "index" else page in
   template#set "page" page;
 
   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
       "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
         order by p.last_modified_date desc" in

-  sth#execute [Some hostid; Some page; Some page];

 
   let table =
 
   let table =

-    sth#map
+    List.map

       (function
       (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, ""
             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, ""
             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;
             [ "version", Template.VarString (Int32.to_string version);
               "url", Template.VarString url;
               "title", Template.VarString title;


@@ -69,19 +66,17 @@ let run r (q : cgi) dbh hostid _ _ =
               "has_logged_user", Template.VarConditional has_logged_user;
               "logged_user", Template.VarString logged_user;
               "is_live", Template.VarConditional true ]
               "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, ""
             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, ""
             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;
             [ "version", Template.VarString (Int32.to_string version);
               "url", Template.VarString url;
               "title", Template.VarString title;


@@ -91,7 +86,8 @@ let run r (q : cgi) dbh hostid _ _ =
               "has_logged_user", Template.VarConditional has_logged_user;
               "logged_user", Template.VarString logged_user;
               "is_live", Template.VarConditional false ]
               "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;
 
 
   template#table "history" table;
 

diff --git a/scripts/history_rss.ml b/scripts/history_rss.ml
index 2b90001..f6f2a32 100644 (file)
--- a/scripts/history_rss.ml
+++ b/scripts/history_rss.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
 (* 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
  *
  * 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,31 +37,28 @@ let run r (q : cgi) dbh hostid {hostname = hostname} _ =
 
   template#set "hostname" hostname;
 
 
   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
       "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
         order by p.last_modified_date desc" in

-  sth#execute [Some hostid; Some page; Some page];

 
   let table =
 
   let table =

-    sth#map
+    List.map

       (function
       (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, ""
             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, ""
             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;
             [ "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 ]
               "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, ""
             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, ""
             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;
             [ "version", Template.VarString (Int32.to_string version);
               "url", Template.VarString url;
               "title", Template.VarString title;


@@ -93,7 +88,8 @@ 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 ]
               "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;
 
 
   template#table "history" table;
 

diff --git a/scripts/host_menu.ml b/scripts/host_menu.ml
index 81f02fd..0aa5ea9 100644 (file)
--- a/scripts/host_menu.ml
+++ b/scripts/host_menu.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
 (* 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
  *
  * 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 host user =
 
   if can_manage_site then (
     (* Get lots of host-specific stuff from the database. *)
 
   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,
        "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,


@@ -51,40 +51,40 @@ let run r (q : cgi) dbh hostid host user =
                 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
                 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,
 
     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;
 
     template#set "canonical_hostname" canonical_hostname;
     template#conditional "has_global_css" has_global_css;

diff --git a/scripts/hoststyle.ml b/scripts/hoststyle.ml
index 05bfa54..c3a259c 100644 (file)
--- a/scripts/hoststyle.ml
+++ b/scripts/hoststyle.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
 (* 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
  *
  * 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,14 +29,11 @@ open Cocanwiki_template
 
 let run r (q : cgi) dbh hostid _ _ =
   (* Get the CSS. *)
 
 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 =
   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
 
   (* 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/image.ml b/scripts/image.ml
index 9b10e84..966c35b 100644 (file)
--- a/scripts/image.ml
+++ b/scripts/image.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
 (* 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
  *
  * 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,35 +35,51 @@ let run r (q : cgi) dbh hostid {hostname = hostname} _ =
     try Some (Int32.of_string (q#param "version")) with Not_found -> None in
 
   (* Get the image and its MIME type. *)
     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
   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
     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 =
 
   (* 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 (
       with Invalid_string -> false in
 
     if not ok then (


@@ -77,7 +93,7 @@ let run r (q : cgi) dbh hostid {hostname = hostname} _ =
 
   (* Content-length header. *)
   Table.set (Request.headers_out r) "Content-Length"
 
   (* 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)
 
   q#header ~content_type:mime_type ();
   ignore (print_string r data)