+csv dep for PG'OCaml.
[cocanwiki.git] / scripts / create_contact.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: create_contact.ml,v 1.7 2006/12/06 09:46:56 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_ok
29 open Cocanwiki_strings
30
31 let split_re = Pcre.regexp "[\\r\\n,;]+"
32
33 let run r (q : cgi) dbh hostid _ _ =
34   let name = trim (q#param "name") in
35   let subject = trim (q#param "subject") in
36   let emails = try q#param "emails" with Not_found -> "" in
37
38   let emails = Pcre.split ~rex:split_re emails in
39   let emails = List.map trim emails in
40   let emails = List.filter ((<>) "") emails in
41
42   if name = "" then (
43     error ~back_button:true ~title:"Name field missing"
44       r dbh hostid q "You must name your contact form.";
45     return ()
46   );
47
48   if subject = "" then (
49     error ~back_button:true ~title:"Subject line missing"
50       r dbh hostid q
51       "You must give a subject line, which appears on contact emails.";
52     return ()
53   );
54
55   if emails = [] then (
56     error ~back_button:true ~title:"No email addresses"
57       r dbh hostid q
58       ("There are no email addresses listed for this contact form.  You " ^
59        "must list at least one valid email address.");
60     return ()
61   );
62
63   (* Update the database. *)
64   PGSQL(dbh) "insert into contacts (hostid, name, subject)
65               values ($hostid, $name, $subject)";
66
67   let contactid = PGOCaml.serial4 dbh "contacts_id_seq" in
68
69   List.iter (
70     fun email ->
71       PGSQL(dbh) "insert into contact_emails (contactid, email)
72                   values ($contactid, $email)"
73   ) emails;
74
75   (* Finish off. *)
76   PGOCaml.commit dbh;
77
78   let msg = sprintf "Contact form created.  The contact id is %ld.  On the next page you will be given some same <html> code which you should copy and paste onto a web page to create a simple form, which can then be modified for your requirements." contactid in
79
80   let buttons = [ { Template.StdPages.label = "   View contact form   ";
81                     Template.StdPages.link = "/_bin/contact_show.cmo";
82                     Template.StdPages.method_ = None;
83                     Template.StdPages.params =
84                       [ "id", Int32.to_string contactid ] } ] in
85   ok ~title:"Contact form created" ~buttons r dbh hostid q msg
86
87 let () =
88   register_script ~restrict:[CanManageContacts] run