Fixed this template to use new-style database API.

[cocanwiki.git] / scripts / source.ml

diff --git a/scripts/source.ml b/scripts/source.ml
index 269a3ad..9bf5476 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.2 2004/11/02 18:47:54 rich Exp $
+ * $Id: source.ml,v 1.6 2006/07/26 13:41:37 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
 
@@ -43,7 +45,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
     with
        Not_found ->
          error ~title:"Page not found"
-           q "That page was not found";
+           dbh hostid q "That page was not found";
          return () in
 
   (* XXX CSS - eventually both title and CSS fields should be returned 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,29 @@ 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, jsgo, 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);
+        (match jsgo with None -> () | Some jsgo ->
+           write "Javascript-Onclick" jsgo);
         write "Content" content;
-        ignore (print_newline r)) model.contents
+        ignore (print_newline r)) model.contents_
 
 let () =
   register_script ~restrict:[CanView] run