scripts/source.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: source.ml,v 1.2 2004/11/02 18:47:54 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_pages
  29 open Cocanwiki_ok
  30
  31 let rex = Pcre.regexp "\r?\n"
  32 let itempl = Pcre.subst "\r\n\t"
  33
  34 (* This is a very simple script which just returns the source of a page
  35  * in a format which is easily machine-parsable.
  36  *)
  37 let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
  38   let url = q#param "page" in
  39   let url = if url = "" then "index" else url in
  40
  41   let model =
  42     try load_page dbh hostid ~url ()
  43     with
  44         Not_found ->
  45           error ~title:"Page not found"
  46             q "That page was not found";
  47           return () in
  48
  49   (* XXX CSS - eventually both title and CSS fields should be returned in
  50    * the Cocanwiki_pages.model_t structure.
  51    *)
  52
  53   (* Get the title. *)
  54   let sth = dbh#prepare_cached "select title from pages
  55                                  where hostid = ? and id = ?" in
  56   sth#execute [`Int hostid; `Int model.id];
  57   let title = sth#fetch1string () in
  58
  59   (* Function to write out fields, with RFC822-like escaping. *)
  60   let write key value =
  61     print_string r key;
  62     print_string r ": ";
  63     print_string r (Pcre.replace ~rex ~itempl value);
  64     ignore (print_newline r);
  65   in
  66
  67   (* HTTP header. *)
  68   q#header ~content_type:"text/plain" ();
  69
  70   (* Write out the standard fields. *)
  71   write "Version" (string_of_int model.id);
  72   write "Title" title;
  73   write "Description" model.description;
  74   if model.redirect <> "" then
  75     write "Redirect" model.redirect
  76   else
  77     write "Section-Count" (string_of_int (List.length model.contents));
  78   ignore (print_newline r);
  79
  80   (* Now write out the sections. *)
  81   if model.redirect = "" then
  82     List.iter
  83       (fun (sectionname, divname, content) ->
  84          write "Section-Header" sectionname;
  85          write "Css-Id" divname;
  86          write "Content" content;
  87          ignore (print_newline r)) model.contents
  88
  89 let () =
  90   register_script ~restrict:[CanView] run