Scripts updated to use new PG interface.

[cocanwiki.git] / scripts / source.ml

diff --git a/scripts/source.ml b/scripts/source.ml
index 0a0fb20..39f6227 100644 (file)
--- 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 <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
- * $Id: source.ml,v 1.3 2005/11/24 14:54:13 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
@@ -34,7 +36,7 @@ let itempl = Pcre.subst "\r\n\t"
 (* This is a very simple script which just returns the source of a page
  * in a format which is easily machine-parsable.
  *)
-let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+let run r (q : cgi) dbh hostid _ _ =
   let url = q#param "page" in
   let url = if url = "" then "index" else url in
 
@@ -51,16 +53,17 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
    *)
 
   (* Get the title. *)
-  let sth = dbh#prepare_cached "select title from pages
-                                 where hostid = ? and id = ?" in
-  sth#execute [`Int hostid; `Int model.id];
-  let title = sth#fetch1string () in
+  let 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
 
@@ -68,23 +71,27 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
   q#header ~content_type:"text/plain" ();
 
   (* Write out the standard fields. *)
-  write "Version" (string_of_int model.id);
+  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" (string_of_int (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