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.8 2004/09/23 11:56:47 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} user =
  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           return ()
  44       | Wikilib.GenURL_Duplicate url ->
  45           q#redirect ("http://" ^ hostname ^ "/" ^ url);
  46           return () 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     return ()
  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   let logged_user =
  63     match user with
  64       | User (id, _, _) -> `Int id
  65       | _ -> `Null in
  66
  67   (* Create the page. *)
  68   let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
  69                                   description, logged_ip, logged_user)
  70                                 values (?, ?, ?, ?, ?, ?)" in
  71   sth#execute [`Int hostid; `String url; `String title; `String description;
  72                logged_ip; logged_user];
  73
  74   let pageid = sth#serial "pages_id_seq" in
  75
  76   (* Create a single section. *)
  77   let content = "Write some content here." in
  78
  79   let sth = dbh#prepare_cached "insert into contents (pageid, ordering,
  80                                   sectionname, content) values (?, 1, ?, ?)" in
  81   sth#execute [`Int pageid; `Null; `String content];
  82
  83   (* Commit. *)
  84   dbh#commit ();
  85
  86   (* Email notification, if anyone is listed for this host. *)
  87   let subject = "Page " ^ url ^ " has been created" in
  88   let body = fun () ->
  89     "Page: http://" ^ hostname ^ "/" ^ url ^ "\n" in
  90
  91   email_notify ~subject ~body dbh hostid;
  92
  93   (* Redirect to the editing page. *)
  94   q#redirect ("http://" ^ hostname ^ "/" ^ url ^ "/edit")
  95
  96 let () =
  97   register_script ~restrict:[CanEdit] run