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