Fixed some problems found in testing. Now appears to be working fully.
[cocanwiki.git] / scripts / edit_host_settings_form.ml
1 (* COCANWIKI - a wiki written in Objective CAML.
2  * Written by Richard W.M. Jones <rich@merjis.com>.
3  * Copyright (C) 2004 Merjis Ltd.
4  * $Id: edit_host_settings_form.ml,v 1.7 2006/03/27 18:09:46 rich Exp $
5  *
6  * This program is free software; you can redistribute it and/or modify
7  * it under the terms of the GNU General Public License as published by
8  * the Free Software Foundation; either version 2 of the License, or
9  * (at your option) any later version.
10  *
11  * This program is distributed in the hope that it will be useful,
12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14  * GNU General Public License for more details.
15  *
16  * You should have received a copy of the GNU General Public License
17  * along with this program; see the file COPYING.  If not, write to
18  * the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19  * Boston, MA 02111-1307, USA.
20  *)
21
22 open Apache
23 open Registry
24 open Cgi
25 open Printf
26
27 open Cocanwiki
28 open Cocanwiki_template
29
30 let run r (q : cgi) dbh hostid _ _ =
31   let template = get_template dbh hostid "edit_host_settings_form.html" in
32
33   (* List of themes. *)
34   let rows =
35     PGSQL(dbh) "select theme_css, name, description
36                   from themes order by 2, 1" in
37
38   let themes =
39     List.map (fun (theme_css, name, description) ->
40                 theme_css, (name, description)) rows in
41
42   (* Get lots of host-specific stuff from the database. *)
43   let rows =
44     PGSQL(dbh)
45       "select canonical_hostname, edit_anon, create_account_anon, theme_css,
46               feedback_email, mailing_list, search_box, navigation, view_anon,
47               brand, brand_tagline, brand_description
48          from hosts where id = $hostid" in
49
50   let canonical_hostname, edit_anon, create_account_anon, theme_css,
51       feedback_email, mailing_list, search_box, navigation, view_anon,
52       brand, brand_tagline, brand_description =
53     match rows with
54     | [canonical_hostname, edit_anon, create_account_anon, theme_css,
55        feedback_email, mailing_list, search_box, navigation, view_anon,
56        brand, brand_tagline, brand_description] ->
57         let theme_css =
58           match theme_css with Some s -> s | None -> "" in
59         let feedback_email =
60           match feedback_email with Some s -> s | None -> "" in
61         let brand =
62           match brand with Some s -> s | None -> "" in
63         let brand_tagline =
64           match brand_tagline with Some s -> s | None -> "" in
65         let brand_description =
66           match brand_description with Some s -> s | None -> "" in
67         canonical_hostname, edit_anon, create_account_anon, theme_css,
68         feedback_email, mailing_list, search_box, navigation, view_anon,
69         brand, brand_tagline, brand_description
70     | _ -> assert false in
71
72   template#set "canonical_hostname" canonical_hostname;
73   template#conditional "edit_anon" edit_anon;
74   template#conditional "create_account_anon" create_account_anon;
75   template#set "feedback_email" feedback_email;
76   template#conditional "mailing_list" mailing_list;
77   template#conditional "search_box" search_box;
78   template#conditional "navigation" navigation;
79   template#conditional "view_anon" view_anon;
80   template#set "brand" brand;
81   template#set "brand_tagline" brand_tagline;
82   template#set "brand_description" brand_description;
83
84   (* Themes table. *)
85   let table =
86     List.map (fun (css, (name, description)) ->
87                 let selected = css = theme_css in
88                 [ "theme_css", Template.VarString css;
89                   "name", Template.VarString name;
90                   "description", Template.VarString description;
91                   "selected", Template.VarConditional selected ]) themes in
92   template#table "themes" table;
93
94   q#template template
95
96 let () =
97   register_script ~restrict:[CanManageSite] run