X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=scripts%2Flib%2Fcocanwiki_create_host.ml;h=3d00e52672c34da52190273766701a0ba6fb1c44;hb=d303f75eed3a09bbe2516d9a2a9a4aa9b862ceb3;hp=cfc1819da1a009d57fe67aabd07cf7b13ec756a2;hpb=20923b33c08fccfca617b21935c4a4f6201593f8;p=cocanwiki.git

diff --git a/scripts/lib/cocanwiki_create_host.ml b/scripts/lib/cocanwiki_create_host.ml
index cfc1819..3d00e52 100644
--- a/scripts/lib/cocanwiki_create_host.ml
+++ b/scripts/lib/cocanwiki_create_host.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: cocanwiki_create_host.ml,v 1.1 2004/10/21 11:42:05 rich Exp $
+ * $Id: cocanwiki_create_host.ml,v 1.3 2006/03/27 16:43:44 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
@@ -26,126 +26,112 @@ open Printf
 
 let create_host dbh canonical_hostname hostnames template
     title username password force_password_change email =
-  let sth =
-    dbh#prepare_cached "set constraints hosts_hostname_cn deferred" in
-  sth#execute [];
-  let sth = dbh#prepare_cached "insert into hosts (canonical_hostname)
-                                  values (?)" in
-  sth#execute [`String canonical_hostname];
+  PGSQL(dbh) "set constraints hosts_hostname_cn deferred";
+  PGSQL(dbh)
+    "insert into hosts (canonical_hostname) values ($canonical_hostname)";
 
-  let hostid = sth#serial "hosts_id_seq" in
+  let hostid = PGOCaml.serial4 dbh "hosts_id_seq" in
 
-  let sth = dbh#prepare_cached "insert into hostnames (hostid, name)
-                                  values (?, ?)" in
-  sth#execute [`Int hostid; `String canonical_hostname];
-  List.iter (fun name ->
-	       sth#execute [`Int hostid; `String name]) hostnames;
+  let insert name =
+    PGSQL(dbh) "insert into hostnames (hostid, name) values ($hostid, $name)"
+  in
+  insert canonical_hostname;
+  List.iter insert hostnames;
 
   (* Are we creating a blank site or copying a template? *)
-  if template = 0 then (
+  if template = 0l then (
     (* Blank site. *)
-    let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
-                                  description) values (?, 'index', ?, ?)" in
-    sth#execute [`Int hostid; `String title; `String title];
-
+    PGSQL(dbh) "insert into pages (hostid, url, title,
+                  description) values ($hostid, 'index', $title, $title)"
   ) else (
     (* Copy from template. *)
 
-    (*dbh#set_debug true;*)
-
-    let sth = dbh#prepare_cached "select * from hosts where id = ?" in
-    sth#execute [`Int template];
-
-    let names = sth#names in
-    let row = sth#fetch1 () in
-    sth#finish ();
-
-    List.iter
-      (fun (name, field) ->
-	 if name <> "id" && name <> "canonical_hostname" &&
-	   name <> "is_template" then (
-	     let sql = "update hosts set " ^ name ^ " = ? where id = ?" in
-	     let sth = dbh#prepare_cached sql in
-	     sth#execute [field; `Int hostid]
-	   )
-      ) (List.combine names row);
+    (* Use low-level PG'OCaml calls to make a duplicate of the
+     * old hosts row where id = template.
+     *
+     * But don't duplicate id (it's the new site number), or
+     * canonical_hostname (the hostname has changed) or
+     * is_template (new site is a copy of a template, not a template).
+     *)
+    let query = "select * from hosts where id = $1" in
+    PGOCaml.prepare dbh ~query ();
+    let types = Option.get (snd (PGOCaml.describe_statement dbh ())) in
+    let params = [Some (Int32.to_string template)] in
+    let fields = List.hd (PGOCaml.execute dbh ~params ()) in
+
+    List.iter (
+      fun (field, {PGOCaml.name = name}) ->
+	if name <> "id" && name <> "canonical_hostname" &&
+	  name <> "is_template" then (
+	    let query =
+	      sprintf "update hosts set %s = $1 where id = $2" name in
+	    PGOCaml.prepare dbh ~query ();
+	    let params = [ field; Some (Int32.to_string hostid) ] in
+	    ignore (PGOCaml.execute dbh ~params ())
+	  )
+    ) (List.combine fields types);
 
     (* Copy pages. *)
-    let sth =
-      dbh#prepare_cached
-	"insert into pages (hostid, url, title, description, redirect, css)
-         select ?, url, title, description, redirect, css
-           from pages
-          where hostid = ? and url is not null" in
-    sth#execute [`Int hostid; `Int template];
+    PGSQL(dbh)
+      "insert into pages (hostid, url, title, description, redirect, css)
+       select $hostid, url, title, description, redirect, css
+         from pages
+        where hostid = $template and url is not null";
 
     (* Copy page contents. *)
-    let sth =
-      dbh#prepare_cached
-	"insert into contents (pageid, ordering, sectionname, content,
-                               divname)
-         select (select id from pages where hostid = ? and url = p.url),
-                c.ordering, c.sectionname, c.content, c.divname
-           from contents c, pages p
-          where c.pageid = p.id and p.hostid = ? and p.url is not null" in
-    sth#execute [`Int hostid; `Int template];
+    PGSQL(dbh)
+      "insert into contents (pageid, ordering, sectionname, content,
+                             divname)
+       select (select id from pages where hostid = $hostid and url = p.url),
+              c.ordering, c.sectionname, c.content, c.divname
+         from contents c, pages p
+        where c.pageid = p.id and p.hostid = $template and p.url is not null";
 
     (* Copy files and images. *)
-    let sth =
-      dbh#prepare_cached
-	"insert into files (hostid, name, content, title, mime_type)
-         select ?, name, content, title, mime_type
-           from files
-          where hostid = ? and name is not null" in
-    sth#execute [`Int hostid; `Int template];
-
-    let sth =
-      dbh#prepare_cached
-	"insert into images (hostid, name, image, width, height, alt, title,
-                             longdesc, class, mime_type, thumbnail,
-                             tn_width, tn_height, tn_mime_type)
-         select ?, name, image, width, height, alt, title, longdesc, class,
-                mime_type, thumbnail, tn_width, tn_height, tn_mime_type
-           from images
-          where hostid = ? and name is not null" in
-    sth#execute [`Int hostid; `Int template];
+    PGSQL(dbh)
+      "insert into files (hostid, name, content, title, mime_type)
+       select $hostid, name, content, title, mime_type
+         from files
+        where hostid = $template and name is not null";
+
+    PGSQL(dbh)
+      "insert into images (hostid, name, image, width, height, alt, title,
+                           longdesc, class, mime_type, thumbnail,
+                           tn_width, tn_height, tn_mime_type)
+       select $hostid, name, image, width, height, alt, title, longdesc, class,
+              mime_type, thumbnail, tn_width, tn_height, tn_mime_type
+         from images
+        where hostid = $template and name is not null";
 
     (* Copy sitemenu. *)
-    let sth =
-      dbh#prepare_cached
-	"insert into sitemenu (hostid, url, label, ordering)
-         select ?, url, label, ordering from sitemenu where hostid = ?" in
-    sth#execute [`Int hostid; `Int template];
+    PGSQL(dbh)
+      "insert into sitemenu (hostid, url, label, ordering)
+       select $hostid, url, label, ordering from sitemenu
+        where hostid = $template";
 
     (* Copy contacts. *)
-    let sth =
-      dbh#prepare_cached
-	"insert into contacts (hostid, name, subject)
-         select ?, name, subject from contacts where hostid = ?" in
-    sth#execute [`Int hostid; `Int template];
-
-    let sth =
-      dbh#prepare_cached
-	"insert into contact_emails (contactid, email)
-         select (select id from contacts
-                  where hostid = ? and name = c.name), ce.email
+    PGSQL(dbh)
+      "insert into contacts (hostid, name, subject)
+       select $hostid, name, subject from contacts where hostid = $template";
+
+    PGSQL(dbh)
+      "insert into contact_emails (contactid, email)
+       select (select id from contacts
+               where hostid = $hostid and name = c.name), ce.email
            from contact_emails ce, contacts c
-          where ce.contactid = c.id and c.hostid = ?" in
-    sth#execute [`Int hostid; `Int template];
+          where ce.contactid = c.id and c.hostid = $template";
 
     (* Set the title of the index page. *)
-    let sth = dbh#prepare_cached "update pages set title = ?
-                                   where hostid = ? and url = 'index'" in
-    sth#execute [`String title; `Int hostid]
+    PGSQL(dbh)
+      "update pages set title = $title
+        where hostid = $hostid and url = 'index'"
   );
 
   (* Create the administrator user. *)
-  let email = match email with Some e -> `String e | None -> `Null in
-
-  let sth = dbh#prepare_cached "insert into users (hostid, name, password,
-                                force_password_change, email, can_manage_users)
-                                values (?, ?, ?, ?, ?, true)" in
-  sth#execute [`Int hostid; `String username; `String password;
-	       `Bool force_password_change; email];
+  PGSQL(dbh)
+    "insert into users (hostid, name, password,
+                        force_password_change, email, can_manage_users)
+     values ($hostid, $username, $password, $force_password_change,
+             $?email, true)";
 
   hostid