scripts/create.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.ml,v 1.5 2004/09/09 12:21:22 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 ExtString
  28
  29 open Cocanwiki
  30 open Cocanwiki_emailnotify
  31 open Cocanwiki_ok
  32
  33 let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
  34   (* Get the page title. *)
  35   let title = q#param "title" in
  36
  37   let url =
  38     match Wikilib.generate_url_of_title dbh hostid title with
  39         Wikilib.GenURL_OK url -> url
  40       | Wikilib.GenURL_TooShort | Wikilib.GenURL_BadURL ->
  41           error ~back_button:true ~title:"Bad page name"
  42             q "The page name supplied is too short or invalid.";
  43           raise CgiExit
  44       | Wikilib.GenURL_Duplicate url ->
  45           q#redirect ("http://" ^ hostname ^ "/" ^ url);
  46           raise CgiExit in
  47
  48   (* Description field must contain something. *)
  49   let description = q#param "description" in
  50   if description = "" then (
  51     error ~back_button:true ~title:"Description field missing"
  52       q "You must write a brief description for search engines and
  53          directories.";
  54     raise CgiExit
  55   );
  56
  57   (* Get the IP address of the user, if available. *)
  58   let logged_ip =
  59     try `String (Connection.remote_ip (Request.connection r))
  60     with Not_found -> `Null in
  61
  62   (* Create the page. *)
  63   let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
  64                                   description, logged_ip)
  65                                 values (?, ?, ?, ?, ?)" in
  66   sth#execute [`Int hostid; `String url; `String title; `String description;
  67                logged_ip];
  68
  69   let pageid = sth#serial "pages_id_seq" in
  70
  71   (* Create a single section. *)
  72   let sectionname = "Section title - change this" in
  73   let content = "Write some content here." in
  74
  75   let sth = dbh#prepare_cached "insert into contents (pageid, ordering,
  76                                   sectionname, content) values (?, 1, ?, ?)" in
  77   sth#execute [`Int pageid; `String sectionname; `String content];
  78
  79   (* Commit. *)
  80   dbh#commit ();
  81
  82   (* Email notification, if anyone is listed for this host. *)
  83   let subject = "Page " ^ url ^ " has been created" in
  84   let body = fun () ->
  85     "Page: http://" ^ hostname ^ "/" ^ url ^ "\n" in
  86
  87   email_notify ~subject ~body dbh hostid;
  88
  89   (* Redirect to the editing page. *)
  90   q#redirect ("http://" ^ hostname ^ "/" ^ url ^ "/edit")
  91
  92 let () =
  93   register_script ~restrict:[CanEdit] run