First extension: {{phone}} which automates CDVMM phone numbers.
# Makefile for COCANWIKI.
-# $Id: Makefile,v 1.48 2006/07/26 13:11:44 rich Exp $
+# $Id: Makefile,v 1.49 2006/07/27 16:46:55 rich Exp $
include ../Makefile.config
# PGDATABASE=cocanwiki ocamldsort -pp "'$(PGOCAML_PP)'" -byte *.ml *.mli
LIB_OBJS := \
lib/cocanwiki_version.cmo \
+ lib/cocanwiki_extensions.cmo \
lib/cocanwiki_date.cmo \
lib/cocanwiki_files.cmo \
lib/cocanwiki_server_settings.cmo \
lib/cocanwiki_emailnotify.cmo \
lib/cocanwiki_diff.cmo \
lib/cocanwiki_pages.cmo \
- lib/cocanwiki_mail.cmo
+ lib/cocanwiki_mail.cmo \
+ lib/cdvmm_phone_numbers.cmo
INSTDIR := ../html/_bin
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit.ml,v 1.30 2006/07/26 13:41:37 rich Exp $
+ * $Id: edit.ml,v 1.31 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
(match pt with
| Page url -> ()
| Title title ->
- match Wikilib.generate_url_of_title dbh hostid title with
+ match Wikilib.generate_url_of_title r dbh hostid title with
| Wikilib.GenURL_OK url -> ()
| Wikilib.GenURL_Duplicate url ->
q#redirect ("http://" ^ hostname ^ "/" ^ url)
let url, pageid =
try
- save_page dbh hostid ~user ~r model
+ save_page r dbh hostid ~user model
with
SaveURLError ->
error ~back_button:true ~title:"Page exists"
--- /dev/null
+(* An example of a pre-page handler and an external function.
+ * $Id: cdvmm_phone_numbers.ml,v 1.1 2006/07/27 16:46:55 rich Exp $
+ *)
+
+open Apache
+open Cgi
+
+open ExtString
+
+open Cocanwiki_extensions
+
+(* Check we're running against the correct website. *)
+let rex =
+ Pcre.regexp "(\\.cdvmortgage\\.com|chasedevere\\.team-?notepad\\.com)$"
+let check_website r =
+ let hostname =
+ try Request.hostname r
+ with Not_found ->
+ failwith "Cdvmm_phone_numbers: no Host header sent in request" in
+ Pcre.pmatch ~rex (String.lowercase hostname)
+
+(* The phone numbers. *)
+let numbers = [
+ "bweb", "0800 358 5062"; (* Bweb *)
+ "cweb", "0800 358 5063"; (* Cweb *)
+ "dweb", "0800 358 5064"; (* Dweb *)
+ "eweb", "0800 358 5066"; (* Eweb *)
+ "fweb", "0800 358 5067"; (* Fweb *)
+ "aweb", "0800 358 5068"; (* Aweb (not paid) *)
+ "mse", "0800 358 5533"; (* Moneysavingexpert *)
+ "euro", "0800 358 1780"; (* Euro/dollar/euribor/libor *)
+ "mass", "0800 358 1781"; (* Mortgage broker *)
+ "offset", "0800 358 1782"; (* Offset *)
+ "hnw", "0800 358 1783"; (* Professionals / HNW *)
+ "btl", "0800 358 1784"; (* Buy to let *)
+ "sp", "0800 358 1785"; (* Subprimes *)
+ "selfcert", "0800 358 1786"; (* Self-cert *)
+ "hweb", "0800 358 1787"; (* Hweb (appears in brand adverts) *)
+ "iweb", "0800 358 1788"; (* Iweb Bidvertiser *)
+]
+
+(* Default numbers go to Fweb. *)
+let default_id = "fweb"
+let default_number = "0800 358 5067"
+
+(* The name of the cookie. *)
+let cookie_name = "phone"
+
+(* When cookies expire. *)
+let expires = "Wed, 18-May-2033 04:33:20 GMT"
+
+(* Get the phone cookie if the browser sent one.
+ * If no phone cookies, raises Not_found.
+ *)
+let get_phone_cookie q = q#cookie cookie_name
+
+let mse_re = Pcre.regexp ~flags:[`CASELESS] "moneysavingexpert"
+
+let pre_page r (q : cgi) dbh hostid _ =
+ if check_website r then (
+ let id =
+ try
+ (* Get the phone cookie, if it exists. *)
+ let phone = get_phone_cookie q in
+ let phone = phone#value in
+
+ (* Is it a valid cookie? If not this raises Not_found and we
+ * treat it as if we hadn't seen a cookie at all.
+ *)
+ ignore (List.assoc phone numbers);
+
+ phone
+ with
+ Not_found -> (* No cookie or invalid cookie - send one. *)
+ (* Which cookie should we send? *)
+ let id =
+ let headers = Request.headers_in r in
+ let referer =
+ try Table.get headers "Referer" with Not_found -> "" in
+ if Pcre.pmatch ~rex:mse_re referer then
+ "mse"
+ else (
+ let utm_source =
+ try q#param "utm_source" with Not_found -> "" in
+ let utm_campaign =
+ try q#param "utm_campaign" with Not_found -> "" in
+
+ if String.starts_with utm_campaign "currency" ||
+ String.starts_with utm_campaign "libor" then
+ "euro"
+ else if String.starts_with utm_campaign "mass" then
+ "mass"
+ else if String.starts_with utm_campaign "offset" then
+ "offset"
+ else if String.starts_with utm_campaign "hnw" then
+ "hnw"
+ else if String.starts_with utm_campaign "buy" then
+ "btl"
+ else if String.starts_with utm_campaign "sub" then
+ "sp"
+ else if String.starts_with utm_campaign "self" then
+ "selfcert"
+ else if String.starts_with utm_source "bidver" then
+ "iweb"
+ else
+ default_id
+ ) in
+
+ let cookie = Cookie.cookie cookie_name id ~path:"/" ~expires in
+ Table.set (Request.headers_out r) "Set-Cookie" cookie#to_string;
+
+ id in
+ (* Make a note of the id which we can use in the {{phone}}
+ * external function (defined below).
+ *)
+ let notes = Request.notes r in
+ Table.set notes cookie_name id
+ )
+
+let phone r dbh hostid _ =
+ if check_website r then (
+ (* Have we got a noted phone number? *)
+ let notes = Request.notes r in
+ let id =
+ try
+ Table.get notes cookie_name
+ with
+ Not_found ->
+ prerr_endline "Cdvmm_phone_numbers: warning: no 'phone' note";
+ default_id in
+
+ (* Is it a valid note? Get the phone number itself. *)
+ let number =
+ try List.assoc id numbers
+ with
+ Not_found ->
+ prerr_endline ("Cdvmm_phone_numbers: warning: bad id: " ^ id);
+ default_number in
+
+ (* Return the number. *)
+ number
+
+ ) else
+ "{{phone}}" (* XXX Should be able to decline this call. *)
+
+(* Register pre-page handler and external function. *)
+let () =
+ pre_page_handlers := pre_page :: !pre_page_handlers;
+ external_functions := ("phone", phone) :: !external_functions
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki.ml,v 1.12 2006/07/26 16:26:44 rich Exp $
+ * $Id: cocanwiki.ml,v 1.13 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
done;
str
-(* List of extensions currently registered. *)
-type extension_t = PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> string
-let extensions = ref ([] : (string * extension_t) list)
-
(* Maximum degree of redirection. *)
let max_redirect = 4
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki_ext_calendar.ml,v 1.4 2006/07/26 13:12:11 rich Exp $
+ * $Id: cocanwiki_ext_calendar.ml,v 1.5 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
open ExtList
open Cocanwiki
+open Cocanwiki_extensions
open Cocanwiki_template
open Cocanwiki_strings
open Cocanwiki_date
else
[]
-let extension dbh hostid url =
+let extension r dbh hostid url =
(* Validate a date in the form "yyyy[/mm[/dd]]". Returns a (yyyy, mm, dd)
* tuple with missing fields set to 0. If the string doesn't parse or the
* date isn't valid, then raises Not_found.
--- /dev/null
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004-2006 Merjis Ltd.
+ * $Id: cocanwiki_extensions.ml,v 1.1 2006/07/27 16:46:55 rich Exp $
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ * Boston, MA 02111-1307, USA.
+ *)
+
+open Apache
+open Cgi
+
+(* List of extensions currently registered. These are special template
+ * pages. See for example Cocanwiki_ext_calendar.
+ *)
+type extension_t =
+ Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> string
+let extensions : (string * extension_t) list ref = ref []
+
+(* List of external functions currently registered. These are used
+ * within wiki markup as {{function}} or {{function:arg}}.
+ *)
+type external_function_t =
+ Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 ->
+ string option -> string
+let external_functions : (string * external_function_t) list ref = ref []
+
+(* List of external pre-page handlers. These are called before
+ * each content page is displayed. See page.ml for more details.
+ *)
+type pre_page_handler_t =
+ Request.t -> cgi -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> unit
+let pre_page_handlers : pre_page_handler_t list ref = ref []
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki_links.ml,v 1.2 2006/03/27 16:43:44 rich Exp $
+ * $Id: cocanwiki_links.ml,v 1.3 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
let href_re = Pcre.regexp "href=\"/(.*?)\""
let title_re = Pcre.regexp "title=\"(.*?)\""
-let get_links_from_section dbh hostid content =
- let html = Wikilib.xhtml_of_content dbh hostid content in
+let get_links_from_section r dbh hostid content =
+ let html = Wikilib.xhtml_of_content r dbh hostid content in
(* Split into attrs and non-attrs. We end up with a list like this:
* [ "<ul>"; "<li>"; "Some text"; "</li>"; ... ]
(* Map the titles to URLs. *)
List.filter_map
(fun title ->
- match Wikilib.generate_url_of_title dbh hostid title with
+ match Wikilib.generate_url_of_title r dbh hostid title with
| Wikilib.GenURL_OK url -> Some url
| _ -> None) titles in
)
)
-let update_links_for_page dbh hostid page =
+let update_links_for_page r dbh hostid page =
(* Delete entries in the old links table. *)
PGSQL(dbh) "delete from links
where hostid = $hostid and from_url = $page";
(* Get the links from each section. *)
List.iter (
fun content ->
- let links = get_links_from_section dbh hostid content in
+ let links = get_links_from_section r dbh hostid content in
List.iter (insert_link dbh hostid page) links
) rows
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki_links.mli,v 1.2 2006/03/27 16:43:44 rich Exp $
+ * $Id: cocanwiki_links.mli,v 1.3 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* Boston, MA 02111-1307, USA.
*)
-val get_links_from_section : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> string list
-val update_links_for_page : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> unit
+val get_links_from_section : Apache.Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> string list
+val update_links_for_page : Apache.Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> unit
val insert_link : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> string -> unit
val what_links_here : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> (string * string) list
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki_mail.ml,v 1.3 2006/07/26 13:41:40 rich Exp $
+ * $Id: cocanwiki_mail.ml,v 1.4 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* The algorithm was originally by JWZ, http://www.jwz.org/doc/threading.html,
* simplified and implemented by Radu Grigore <radugrigore@yahoo.com>.
*)
-let thread_mail dbh hostid ?user ?r year month =
+let thread_mail r dbh hostid ?user year month =
(* Pull out all the emails relevant to this month. *)
let rows =
let year = Int32.of_int year in
let title = sprintf "Mail/%04d/%02d/Thread Index" year month in
let url =
- match Wikilib.generate_url_of_title dbh hostid title with
+ match Wikilib.generate_url_of_title r dbh hostid title with
Wikilib.GenURL_OK url -> url
| Wikilib.GenURL_Duplicate url -> url
| Wikilib.GenURL_TooShort | Wikilib.GenURL_BadURL ->
let url =
let title = sprintf "Mail/%s (%ld)" subject id in
- match Wikilib.generate_url_of_title dbh hostid title with
+ match Wikilib.generate_url_of_title r dbh hostid title with
Wikilib.GenURL_OK url | Wikilib.GenURL_Duplicate url -> url
| Wikilib.GenURL_TooShort | Wikilib.GenURL_BadURL ->
failwith ("error finding URL for message: " ^ title) in
(* Save the page. *)
try
- ignore (save_page dbh hostid ?user ?r model)
+ ignore (save_page r dbh hostid ?user model)
with
| SaveURLError ->
failwith "cocanwiki_mail: thread_mail: unexpected SaveURLError"
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki_mail.mli,v 1.2 2006/03/27 16:43:44 rich Exp $
+ * $Id: cocanwiki_mail.mli,v 1.3 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
open Cocanwiki
-val thread_mail : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> ?user:user_t -> ?r:Apache.Request.t -> int -> int -> unit
+val thread_mail : Apache.Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> ?user:user_t -> int -> int -> unit
(** [thread_mail dbh hostid year month] rebuilds the thread index
* for (year, month).
*)
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki_pages.ml,v 1.6 2006/07/26 13:41:40 rich Exp $
+ * $Id: cocanwiki_pages.ml,v 1.7 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
contents_ = contents } in
model
-let save_page dbh hostid ?user ?r model =
+let save_page r dbh hostid ?user model =
(* Logging information, if available. *)
let logged_user =
match user with
| _ -> None in
let logged_ip =
- match r with
- None -> None
- | Some r ->
- try Some (Connection.remote_ip (Request.connection r))
- with Not_found -> None in
+ try Some (Connection.remote_ip (Request.connection r))
+ with Not_found -> None in
let url, pageid =
(* Creating a new page (id = 0)? If so, we're just going to insert
match model.pt with
Page url -> url, url
| Title title ->
- match Wikilib.generate_url_of_title dbh hostid title with
+ match Wikilib.generate_url_of_title r dbh hostid title with
Wikilib.GenURL_OK url -> url, title
| _ ->
raise SaveURLError in
) in
(* Keep the links table in synch. *)
- Cocanwiki_links.update_links_for_page dbh hostid url;
+ Cocanwiki_links.update_links_for_page r dbh hostid url;
url, pageid
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki_pages.mli,v 1.3 2006/07/26 13:41:40 rich Exp $
+ * $Id: cocanwiki_pages.mli,v 1.4 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* @raise Not_found If the page cannot be found.
*)
-val save_page : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> ?user:user_t -> ?r:Apache.Request.t -> model -> string * int32
+val save_page : Apache.Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> ?user:user_t -> model -> string * int32
(** Save a page. If the page is new, this creates a new page in the
* database. If the page is old, then the page is edited.
*
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: wikilib.ml,v 1.7 2006/07/26 15:01:17 rich Exp $
+ * $Id: wikilib.ml,v 1.8 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
open ExtString
open Cocanwiki_strings
+open Cocanwiki_extensions
(* Generate a URL for a new page with the given title. This code checks
* if the URL already exists in the database and can return one of several
let nontrivial_re = Pcre.regexp ~flags:[`CASELESS] "[a-z0-9]"
-let generate_url_of_title dbh hostid title =
+let generate_url_of_title r dbh hostid title =
(* Create a suitable URL from this title. *)
let url =
String.map (function
| '\000' .. ' ' | '<' | '>' | '&' | '"'
| '+' | '#' | '%' | '?'
-> '_'
- | c -> Char.lowercase c) title in
+ | ('A' .. 'Z' as c) -> Char.lowercase c
+ | c -> c) title in
(* Check URL is not too trivial. *)
if not (Pcre.pmatch ~rex:nontrivial_re url) then
(* This matches any markup. *)
let markup_re =
+ (* A link, like [[...]]. *)
let link = "\\[\\[\\s*(?:.+?)\\s*(?:\\|.+?\\s*)?\\]\\]" in
- let tag = "</?(?:b|i|strong|em|code|tt|sup|sub|nowiki|big|small|strike|s|br)>" in
- Pcre.regexp ("(.*?)((?:" ^ link ^ ")|(?:" ^ tag ^ "))(.*)")
+ (* A restricted HTML element, like <b> or </b>. *)
+ let tag =
+ "</?(?:b|i|strong|em|code|tt|sup|sub|nowiki|big|small|strike|s|br)>" in
+ (* An external function call, like {{call}} or {{call:arg}}. *)
+ let func = "{{(?:\\w+)(?::.*?)?}}" in
+ (* Combined. *)
+ Pcre.regexp ("(.*?)((?:" ^ link ^ ")|(?:" ^ tag ^ ")|(?:" ^ func ^ "))(.*)")
(* This matches links only, and should be compatible with the link contained
* in the above regexp.
let url_re = Pcre.regexp "^[a-z]+://"
let mailto_re = Pcre.regexp "^mailto:"
+(* This matches external function calls only, and should be compatible
+ * with the link contained in the above regexp.
+ *)
+let func_re = Pcre.regexp "{{(\\w+)(?::(.*?))?}}"
+
(* Links. *)
-let markup_link dbh hostid link =
+let markup_link r dbh hostid link =
let subs = Pcre.exec ~rex:link_re link in
let url = Pcre.get_substring subs 1 in
escape_html text ^ "</a>"
)
+let markup_function r dbh hostid str =
+ let subs = Pcre.exec ~rex:func_re str in
+ let function_name = Pcre.get_substring subs 1 in
+ let function_arg =
+ try Some (Pcre.get_substring subs 2) with Not_found -> None in
+
+ (* Look to see if there is a registered external function
+ * with that name.
+ *)
+ try
+ let fn = List.assoc function_name !external_functions in
+
+ (* Call the external function and return the result. *)
+ fn r dbh hostid function_arg
+
+ with
+ Not_found ->
+ str (* Not found - return the original string. *)
+
type find_t = FoundNothing
| FoundOpen of string * string * string
| FoundClose of string * string * string * string
| FoundLink of string * string * string
+ | FoundCall of string * string * string
-let _markup_paragraph dbh hostid text =
+let _markup_paragraph r dbh hostid text =
let find_earliest_markup text =
let convert_b_and_i elem =
if elem = "b" then "strong"
let rest = Pcre.get_substring subs 3 in
if String.length markup > 2 &&
markup.[0] = '[' && markup.[1] = '[' then (
- let link = markup_link dbh hostid markup in
+ let link = markup_link r dbh hostid markup in
FoundLink (first, link, rest)
)
else if String.length markup > 2 &&
let elem = convert_b_and_i elem in
FoundOpen (first, elem, rest)
)
+ else if String.length markup > 2 &&
+ markup.[0] = '{' && markup.[1] = '{' then (
+ let call = markup_function r dbh hostid markup in
+ FoundCall (first, call, rest)
+ )
else
failwith ("bad regexp: markup is '" ^ markup ^ "'");
with
escape_html first :: "<" :: elem :: ">" :: loop (rest, [elem])
| FoundLink (first, link, rest) ->
escape_html first :: link :: loop (rest, [])
+ | FoundCall (first, link, rest) ->
+ escape_html first :: link :: loop (rest, [])
)
| text, ((x :: xs) as stack) ->
| FoundLink (first, link, rest) ->
(* link *)
escape_html first :: link :: loop (rest, stack)
+ | FoundCall (first, link, rest) ->
+ (* external function *)
+ escape_html first :: link :: loop (rest, stack)
)
in
(*prerr_endline ("after loop = " ^ text);*)
text
-let markup_paragraph ~first_para dbh hostid text =
+let markup_paragraph ~first_para r dbh hostid text =
let p = if first_para then "<p class=\"first_para\">" else "<p>" in
- p ^ _markup_paragraph dbh hostid text ^ "</p>"
+ p ^ _markup_paragraph r dbh hostid text ^ "</p>"
-let markup_heading dbh hostid level text =
- let text = _markup_paragraph dbh hostid text in
+let markup_heading r dbh hostid level text =
+ let text = _markup_paragraph r dbh hostid text in
sprintf "<h%d>%s</h%d>" level text level
-let markup_ul dbh hostid lines =
+let markup_ul r dbh hostid lines =
"<ul><li>" ^
String.concat "</li>\n<li>"
- (List.map (fun t -> _markup_paragraph dbh hostid t) lines) ^
+ (List.map (fun t -> _markup_paragraph r dbh hostid t) lines) ^
"</li></ul>"
-let markup_ol dbh hostid lines =
+let markup_ol r dbh hostid lines =
"<ol><li>" ^
String.concat "</li>\n<li>"
- (List.map (fun t -> _markup_paragraph dbh hostid t) lines) ^
+ (List.map (fun t -> _markup_paragraph r dbh hostid t) lines) ^
"</li></ol>"
let markup_pre lines =
let html_close_re = Pcre.regexp "^</html>\\s*$"
let macro_re = Pcre.regexp "^{{(\\w+)}}\\s*$"
-let xhtml_of_content dbh hostid text =
+let xhtml_of_content r dbh hostid text =
(* Split the text into lines. *)
let lines = Pcre.split ~rex:split_lines_re text in
match st with
| STBlank -> assert false (* Should never happen. *)
| STParagraph para ->
- markup_paragraph ~first_para:!first_para dbh hostid para
+ let first_para = !first_para in
+ markup_paragraph ~first_para r dbh hostid para
| STHeading (level, text) ->
- markup_heading dbh hostid level text
+ markup_heading r dbh hostid level text
| STUnnumbered lines ->
- markup_ul dbh hostid lines
+ markup_ul r dbh hostid lines
| STNumbered lines ->
- markup_ol dbh hostid lines
+ markup_ol r dbh hostid lines
| STPreformatted lines ->
markup_pre lines
| STHTML html ->
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: wikilib.mli,v 1.2 2006/03/27 16:43:44 rich Exp $
+ * $Id: wikilib.mli,v 1.3 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
| GenURL_BadURL
| GenURL_Duplicate of string
-val generate_url_of_title : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> genurl_error_t
+val generate_url_of_title : Apache.Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> genurl_error_t
-val xhtml_of_content : PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> string
+val xhtml_of_content : Apache.Request.t -> PGOCaml.pa_pg_data PGOCaml.t -> int32 -> string -> string
val text_of_xhtml : string -> string
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: mail_import.ml,v 1.13 2006/07/26 13:41:37 rich Exp $
+ * $Id: mail_import.ml,v 1.14 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
(* Choose a suitable URL. *)
let url =
- match Wikilib.generate_url_of_title dbh hostid title with
+ match Wikilib.generate_url_of_title r dbh hostid title with
(* Duplicate URL is OK - eg. in the case where we are overwriting
* an already imported message.
*)
* them because we want to script to fail abruptly if any of these
* unexpected conditions arises.
*)
- ignore (save_page dbh hostid ~user ~r model);
+ ignore (save_page r dbh hostid ~user model);
(* Rebuild threads? *)
if rebuild then
- thread_mail dbh hostid ~user ~r
+ thread_mail r dbh hostid ~user
(Calendar.year (fst message_date))
(Date.int_of_month (Calendar.month (fst message_date)));
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: mail_rebuild.ml,v 1.4 2006/03/28 16:24:07 rich Exp $
+ * $Id: mail_rebuild.ml,v 1.5 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
let year = int_of_string (q#param "year") in
let month = int_of_string (q#param "month") in
- thread_mail dbh hostid ~user ~r year month;
+ thread_mail r dbh hostid ~user year month;
(* Commit to the database. *)
PGOCaml.commit dbh;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: page.ml,v 1.47 2006/07/26 13:19:49 rich Exp $
+ * $Id: page.ml,v 1.48 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
open Cocanwiki_date
open Cocanwiki_server_settings
open Cocanwiki_links
+open Cocanwiki_extensions
type fp_status = FPOK of int32 * string * string * Calendar.t * bool
| FPInternalRedirect of string
t#set "old_version" (Int32.to_string pageid);
th#set "old_version" (Int32.to_string pageid));
+ (* Just before we show the header, call any registered pre-page
+ * handlers. They might want to send cookies.
+ *)
+ List.iter (fun handler ->
+ handler r q dbh hostid page') !pre_page_handlers;
+
(* At this point, we can print out the header and flush it back to
* the user, allowing the browser to start fetching stylesheets
* and background images while we compose the page.
"linkname", Template.VarString linkname;
"content",
Template.VarString
- (Wikilib.xhtml_of_content dbh hostid content);
+ (Wikilib.xhtml_of_content r dbh hostid content);
"has_divname", Template.VarConditional has_divname;
"divname", Template.VarString divname;
"has_jsgo", Template.VarConditional has_jsgo;
match extension with
None -> sections
| Some extension ->
- let content = extension dbh hostid page' in
+ let content = extension r dbh hostid page' in
let section = [
"ordering", Template.VarString "0";
"has_sectionname", Template.VarConditional false;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: page_rss.ml,v 1.4 2006/03/28 16:24:08 rich Exp $
+ * $Id: page_rss.ml,v 1.5 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
List.map (fun (sectionname, content) ->
let sectionname = match sectionname with
| None -> "" | Some s -> s in
- let content = Wikilib.xhtml_of_content dbh hostid content in
+ let content = Wikilib.xhtml_of_content r dbh hostid content in
let linkname = linkname_of_sectionname sectionname in
[ "sectionname", Template.VarString sectionname;
"linkname", Template.VarString linkname;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: preview.ml,v 1.8 2006/03/27 18:09:46 rich Exp $
+ * $Id: preview.ml,v 1.9 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
let run r (q : cgi) dbh hostid _ _ =
let content = q#param "content" in
- let xhtml = Wikilib.xhtml_of_content dbh hostid content in
+ let xhtml = Wikilib.xhtml_of_content r dbh hostid content in
q#header ~content_type:"text/html; charset=utf-8" ();
ignore (print_string r xhtml)
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: rebuild_links.ml,v 1.6 2006/03/28 16:24:08 rich Exp $
+ * $Id: rebuild_links.ml,v 1.7 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
template#set "pc" (string_of_int pc);
ignore (print_string r template#to_string);
- let links = get_links_from_section dbh hostid content in
+ let links = get_links_from_section r dbh hostid content in
List.iter (insert_link dbh hostid url) links
) sections;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: rename_page.ml,v 1.6 2006/07/26 13:12:10 rich Exp $
+ * $Id: rename_page.ml,v 1.7 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
let new_page =
if page = "index" then page
else
- match Wikilib.generate_url_of_title dbh hostid new_title with
+ match Wikilib.generate_url_of_title r dbh hostid new_title with
| Wikilib.GenURL_OK url | Wikilib.GenURL_Duplicate url -> url
| Wikilib.GenURL_TooShort | Wikilib.GenURL_BadURL ->
error ~title:"Bad title" ~back_button:true
(* If it's the same as the old URL, then this is a simple title change. *)
let model = load_page dbh hostid ~url:page () in
let model = { model with pt = Title new_title } in
- let url, _ = save_page dbh hostid ~user ~r model in
+ let url, _ = save_page r dbh hostid ~user model in
assert (url = new_page)
) else (
(* Not the same as the old URL, so set the old page to a redirect and
let new_model = { new_model with description = old_model.description;
contents_ = old_model.contents_ } in
let old_model = { old_model with redirect = Some new_page } in
- ignore (save_page dbh hostid ~user ~r old_model);
+ ignore (save_page r dbh hostid ~user old_model);
try
- ignore (save_page dbh hostid ~user ~r new_model)
+ ignore (save_page r dbh hostid ~user new_model)
with
SaveURLError ->
error ~title:"Page exists"
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: restore.ml,v 1.22 2006/07/26 13:41:37 rich Exp $
+ * $Id: restore.ml,v 1.23 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
where pageid = $version";
(* Keep the links table in synch. *)
- Cocanwiki_links.update_links_for_page dbh hostid page;
+ Cocanwiki_links.update_links_for_page r dbh hostid page;
PGOCaml.commit dbh;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: search.ml,v 1.10 2006/03/28 16:24:08 rich Exp $
+ * $Id: search.ml,v 1.11 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
let content =
truncate 160
(Wikilib.text_of_xhtml
- (Wikilib.xhtml_of_content dbh hostid content)) in
+ (Wikilib.xhtml_of_content r dbh hostid content)) in
let linkname = linkname_of_sectionname sectionname in
let last_modified = printable_date last_modified in
[ "url", Template.VarString url;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: sitemap.ml,v 1.9 2006/03/28 16:24:08 rich Exp $
+ * $Id: sitemap.ml,v 1.10 2006/07/27 16:46:55 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
| Some c ->
truncate 160
(Wikilib.text_of_xhtml
- (Wikilib.xhtml_of_content dbh hostid c))) ]
+ (Wikilib.xhtml_of_content r dbh hostid c))) ]
| _ -> assert false) rows in
template#set "hostname" hostname;
git.annexia.org / cocanwiki.git / commitdiff