X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=scripts%2Fadmin%2Fcreate_host.ml;h=0d4f6e64fd0b50e7b1c1876ea0c47ed4efa1dc1c;hb=cd059731a60fd3d4dcf426430ad26ff227b91910;hp=9cf2546ea3879d842808136a417d0ae137c6d84f;hpb=0502c7025d9f942228d6c838c2bfd73d7f253070;p=cocanwiki.git

diff --git a/scripts/admin/create_host.ml b/scripts/admin/create_host.ml
index 9cf2546..0d4f6e6 100644
--- a/scripts/admin/create_host.ml
+++ b/scripts/admin/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: create_host.ml,v 1.5 2004/09/25 12:44:36 rich Exp $
+ * $Id: create_host.ml,v 1.12 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
@@ -29,12 +29,14 @@ open Cgi
 open Printf
 
 open Cocanwiki_strings
+open Cocanwiki_create_host
 
 let split_re = Pcre.regexp "[\\s,;]+"
 
 let run r =
   let q = new cgi r in
-  let dbh = Cocanwiki._get_dbh r in
+  let dbh = PGOCaml.connect ~database:"cocanwiki" () in
+  PGOCaml.begin_work dbh;
 
   let canonical_hostname = q#param "canonical_hostname" in
   let hostnames = try q#param "hostnames" with Not_found -> "" in
@@ -44,7 +46,7 @@ let run r =
   let title = trim title in
   if title = "" then (
     Cocanwiki_ok.error ~back_button:true ~title:"Bad title"
-      q "You must give a title for this Wiki.";
+      dbh (-1l) q "You must give a title for this Wiki.";
   ) else (
     (* In theory we could verify characters in hostnames.  However
      * it's probably best to assume the sysadmin knows what they're up to
@@ -62,140 +64,26 @@ let run r =
     let hostnames = List.map check_hostname hostnames in
     let hostnames = List.filter ((<>) "") hostnames in
 
-    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];
+    let template =
+      if q#param_true "template" then Int32.of_string (q#param "template")
+      else 0l in
 
-    let hostid = sth#serial "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;
-
-    (* Are we creating a blank site or copying a template? *)
-    if not (q#param_true "template") 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];
-
-    ) else (
-      (* Copy from template. *)
-      let template = int_of_string (q#param "template") in
-
-      (*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" 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);
-
-      (* 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];
-
-      (* 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];
-
-      (* 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];
-
-      (* 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];
-
-      (* 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
-             from contact_emails ce, contacts c
-            where ce.contactid = c.id and c.hostid = ?" in
-      sth#execute [`Int hostid; `Int 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]
-    );
-
-    (* Create the administrator user. *)
-    let sth = dbh#prepare_cached "insert into users (hostid, name, password,
-                                  force_password_change, can_manage_users)
-                                  values (?, 'Administrator', '123456', true,
-                                  true)" in
-    sth#execute [`Int hostid];
+    let hostid = create_host dbh canonical_hostname hostnames template title
+		   "Administrator" "123456" true None in
 
     (* Commit to the database. *)
-    dbh#commit ();
+    PGOCaml.commit dbh;
 
     (* Print confirmation page. *)
     let buttons = [
-      { StdPages.label = "OK";
-	StdPages.link = "/_bin/admin/host.cmo";
-	StdPages.method_ = None;
-	StdPages.params = [ "hostid", string_of_int hostid ] }
+      { Template.StdPages.label = "OK";
+	Template.StdPages.link = "/_bin/admin/host.cmo";
+	Template.StdPages.method_ = None;
+	Template.StdPages.params = [ "hostid", Int32.to_string hostid ] }
     ] in
 
     Cocanwiki_ok.ok ~title:"Wiki created" ~buttons
-      q "A new Wiki was created."
+      dbh (-1l) q "A new Wiki was created."
   )
 
 let () =