(* 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.4 2005/11/11 09:39:21 rich Exp $
+ * $Id: wikilib.ml,v 1.5 2006/03/27 16:43:44 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 nontrivial_re = Pcre.regexp ~flags:[`CASELESS] "[a-z0-9]"
-let generate_url_of_title (dbh : Dbi.connection) hostid title =
+let generate_url_of_title dbh hostid title =
(* Create a suitable URL from this title. *)
let url =
String.map (function
* then it probably means that another page exists with similar enough
* content, so we should redirect to there instead.
*)
- let sth = dbh#prepare_cached "select 1 from pages
- where hostid = ? and url = ?" in
- sth#execute [`Int hostid; `String url];
-
- try
- sth#fetch1int ();
- GenURL_Duplicate url
- with
- Not_found ->
- GenURL_OK url
+ let rows = PGSQL(dbh) "select 1 from pages
+ where hostid = $hostid and url = $url" in
+ match rows with
+ | [Some 1l] -> GenURL_Duplicate url
+ | [] -> GenURL_OK url
+ | _ -> assert false
)
(* Obscure a mailto: URL against spammers. *)
let url = Pcre.get_substring subs 1 in
let tag name = function
- `Null -> ""
- | `String v -> " " ^ name ^ "=\"" ^ escape_html_tag v ^ "\""
+ | None -> ""
+ | Some v -> " " ^ name ^ "=\"" ^ escape_html_tag v ^ "\""
in
if Pcre.pmatch ~rex:image_re url then (
let is_thumb = (Pcre.get_substring subs 1).[0] = 't' in
let name = Pcre.get_substring subs 2 in
- let sql = "select id, " ^
- (if is_thumb then "tn_width, tn_height"
- else "width, height") ^
- ", alt, title, longdesc, class
- from images
- where hostid = ? and name = ?" in
- let sth = dbh#prepare_cached sql in
- sth#execute [`Int hostid; `String name];
+ let rows =
+ PGSQL(dbh)
+ "select id, width, height, tn_width, tn_height,
+ alt, title, longdesc, class
+ from images
+ where hostid = $hostid and name = $name" in
+
+ match is_thumb, rows with
+ (* [[image:...]] *)
+ | false, [imageid, width, height, _, _, alt, title, longdesc, clasz]
+ (* [[thumb:...]], but no thumbnail in the database - treat as image *)
+ | true, [imageid, width, height, None, None,
+ alt, title, longdesc, clasz] ->
+ let link = "/_image/" ^ escape_url name in
+
+ "<img src=\"" ^ link ^ "?version=" ^ Int32.to_string imageid ^
+ "\" width=\"" ^
+ Int32.to_string width ^
+ "\" height=\"" ^
+ Int32.to_string height ^
+ "\" alt=\"" ^
+ escape_html_tag alt ^
+ "\"" ^
+ tag "title" title ^
+ tag "longdesc" longdesc ^
+ tag "class" clasz ^
+ "/>"
+
+ (* [[thumb:...]] *)
+ | true, [imageid, _, _, Some tn_width, Some tn_height,
+ alt, title, longdesc, clasz] ->
+ let link = "/_image/" ^ escape_url name in
+ "<a href=\"" ^ link ^ "\">" ^
+ "<img src=\"" ^ link ^ "?version=" ^ Int32.to_string imageid ^
+ "&thumbnail=1" ^
+ "\" width=\"" ^
+ Int32.to_string tn_width ^
+ "\" height=\"" ^
+ Int32.to_string tn_height ^
+ "\" alt=\"" ^
+ escape_html_tag alt ^
+ "\"" ^
+ tag "title" title ^
+ tag "longdesc" longdesc ^
+ tag "class" clasz ^
+ "/>" ^
+ "</a>"
- try
- let imageid, width, height, alt, title, longdesc, clasz =
- match sth#fetch1 () with
- [`Int imageid; `Int width; `Int height; `String alt;
- (`Null | `String _) as title;
- (`Null | `String _) as longdesc;
- (`Null | `String _) as clasz] ->
- imageid, width, height, alt, title, longdesc, clasz
- | _ -> assert false in
-
- let link = "/_image/" ^ escape_url name in
-
- (if is_thumb then "<a href=\"" ^ link ^ "\">" else "") ^
- "<img src=\"" ^ link ^ "?version=" ^ string_of_int imageid ^
- (if is_thumb then "&thumbnail=1" else "") ^
- "\" width=\"" ^
- string_of_int width ^
- "\" height=\"" ^
- string_of_int height ^
- "\" alt=\"" ^
- escape_html_tag alt ^
- "\"" ^
- tag "title" title ^
- tag "longdesc" longdesc ^
- tag "class" clasz ^
- "/>" ^
- (if is_thumb then "</a>" else "")
- with
- Not_found ->
- (* Image not found. *)
- "<a class=\"image_not_found\" " ^
+ (* no image found in the database *)
+ | _, [] ->
+ "<a class=\"image_not_found\" " ^
"href=\"/_bin/upload_image_form.cmo?name=" ^
escape_url name ^
"\">" ^
escape_html name ^
"</a>"
+
+ (* image name is unique, so this shouldn't happen *)
+ | _, _ -> assert false
+
) else if Pcre.pmatch ~rex:file_re url then (
(* It may be a file. *)
let subs = Pcre.exec ~rex:file_re url in
let name = Pcre.get_substring subs 1 in
- let sth = dbh#prepare_cached "select title
- from files
- where hostid = ? and name = ?" in
- sth#execute [`Int hostid; `String name];
-
- try
- let title =
- match sth#fetch1 () with
- [(`Null | `String _) as title] -> title
- | _ -> assert false in
-
- "<a href=\"/_file/" ^
- escape_url name ^
- "\"" ^
- tag "title" title ^
- ">" ^
- escape_html name ^
- "</a>"
- with
- Not_found ->
- (* File not found. *)
- "<a class=\"file_not_found\" " ^
+ let rows = PGSQL(dbh) "select title from files
+ where hostid = $hostid and name = $name" in
+ match rows with
+ | [ title ] ->
+ "<a href=\"/_file/" ^
+ escape_url name ^
+ "\"" ^
+ tag "title" title ^
+ ">" ^
+ escape_html name ^
+ "</a>"
+ | [] ->
+ (* File not found. *)
+ "<a class=\"file_not_found\" " ^
"href=\"/_bin/upload_file_form.cmo?name=" ^
escape_url name ^
"\">" ^
escape_html name ^
"</a>"
+ | _ -> assert false
) else (
(* Pcre changed behaviour between versions. Previously a non-capture
* would return "". Now it throws 'Not_found'.
(* Look up the 'URL' against the titles in the database and
* obtain the real URL.
*)
- let sth = dbh#prepare_cached "select url from pages
- where hostid = ? and url is not null
- and lower (title) = lower (?)" in
- sth#execute [`Int hostid; `String url];
-
- try
- let url = sth#fetch1string () in
- "/" ^ url, "internal", title
- with
- Not_found ->
- (* It might be a template page ... These pages don't
- * exist in the template, but can be synthesized on the
- * fly by page.ml.
+ let rows = PGSQL(dbh)
+ "select url from pages
+ where hostid = $hostid and url is not null
+ and lower (title) = lower ($url)" in
+
+ match rows with
+ | [Some url] ->
+ "/" ^ url, "internal", title
+ | [] ->
+ (* It might be a template page ... These pages don't
+ * exist in the template, but can be synthesized on the
+ * fly by page.ml.
+ *)
+ let is_template_page url =
+ [] <> PGSQL(dbh)
+ "select 1 from templates
+ where $url ~ url_regexp
+ order by ordering
+ limit 1"
+ in
+
+ if is_template_page url then
+ "/" ^ url, "internal", title
+ else
+ (* No, it really doesn't exist, so make it a link to
+ * a new page.
*)
- let is_template_page url =
- let sth = dbh#prepare_cached "select 1 from templates
- where ? ~ url_regexp
- order by ordering
- limit 1" in
- sth#execute [`String url];
-
- try sth#fetch1int () = 1 with Not_found -> false
- in
-
- if is_template_page url then
- "/" ^ url, "internal", title
- else
- (* No, it really doesn't exist, so make it a link to
- * a new page.
- *)
"/_bin/edit.cmo?title=" ^ escape_url url, "newpage", title
+
+ | _ -> assert false
) in
"<a href=\"" ^ url ^
let html_open_re = Pcre.regexp "^<html>\\s*$"
let html_close_re = Pcre.regexp "^</html>\\s*$"
-let xhtml_of_content (dbh : Dbi.connection) hostid text =
+let xhtml_of_content dbh hostid text =
(* Split the text into lines. *)
let lines = Pcre.split ~rex:split_lines_re text in
git.annexia.org / cocanwiki.git / blobdiff