X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=scripts%2Fadmin%2Fcreate_host.ml;h=ff414909179e8654b19f05ac01834be207f67c00;hb=2b332786c6f216c5e2e72cc1596ba4c66b5aa2a4;hp=a2e9ccda83b16c38e829ce56a7b4f76cb7c5f7e0;hpb=afe5e5f759988c04d9b3bcee7cf75e2c15e1d1d5;p=cocanwiki.git diff --git a/scripts/admin/create_host.ml b/scripts/admin/create_host.ml index a2e9ccd..ff41490 100644 --- a/scripts/admin/create_host.ml +++ b/scripts/admin/create_host.ml @@ -1,7 +1,22 @@ -(* COCANWIKI scripts. +(* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: create_host.ml,v 1.2 2004/09/07 14:58:34 rich Exp $ + * $Id: create_host.ml,v 1.6 2004/10/04 14:46:51 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 + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place - Suite 330, + * Boston, MA 02111-1307, USA. * * NB. Because there might not be any hosts existing when this Wiki * is created, this is not a normal Cocanwiki.register_script script. @@ -47,25 +62,132 @@ let run r = let hostnames = List.map check_hostname hostnames in let hostnames = List.filter ((<>) "") hostnames in - (* Update the database. *) - let sth = dbh#prepare_cached - "set constraints \"hosts_hostname_cn\" deferred" 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 + values (?)" in sth#execute [`String canonical_hostname]; let hostid = sth#serial "hosts_id_seq" in let sth = dbh#prepare_cached "insert into hostnames (hostid, name) - values (?, ?)" in + values (?, ?)" in sth#execute [`Int hostid; `String canonical_hostname]; List.iter (fun name -> sth#execute [`Int hostid; `String name]) hostnames; - let sth = dbh#prepare_cached "insert into pages (hostid, url, title, + (* 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]; + 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); + + (* Force new host.is_template field to false. *) + let sth = + dbh#prepare_cached + "update hosts set is_template = false where id = ?" in + sth#execute [`Int hostid]; + + (* 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]; (* Commit to the database. *) dbh#commit ();