(* 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.2 2005/11/17 10:14:43 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
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 = Int64.to_int (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
git.annexia.org / cocanwiki.git / blobdiff