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: search.ml,v 1.12 2006/08/16 15:27:02 rich Exp $
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.
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.
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.
29 open Cocanwiki_template
30 open Cocanwiki_strings
33 let split_words = Pcre.regexp "\\W+"
35 let run r (q : cgi) dbh hostid host user =
36 let template = get_template dbh hostid "search.html" in
38 template#set "canonical_hostname" host.canonical_hostname;
40 (* Get the query, if it exists. *)
41 let query = try q#param "q" with Not_found -> "" in
42 let have_query = not (string_is_whitespace query) in
43 template#set "query" query;
44 template#conditional "have_query" have_query;
47 let can_edit = can_edit host user in
48 template#conditional "can_edit" can_edit;
50 (* Search old versions? Only permit this if can_edit is true. *)
53 try q#param_true "old_versions"
54 with Not_found -> false
58 (* If we have a query, make some results. *)
61 (* Get the keywords from the query string. *)
62 let keywords = Pcre.split ~rex:split_words query in
64 List.filter (fun s -> not (string_is_whitespace s)) keywords in
65 let keywords = List.map lowercase keywords in
67 (* Turn the keywords into a tsearch2 ts_query string. *)
68 let tsquery = String.concat "&" keywords in
70 (* Search the titles first. *)
72 if not old_versions then
74 "select id, url, url_deleted, title, last_modified_date,
75 (lower (title) = lower ($query)) as exact
77 where hostid = $hostid
80 and title_description_fti @@ to_tsquery ('default', $tsquery)
81 order by exact desc, last_modified_date desc, title"
84 "select id, url, url_deleted, title, last_modified_date,
85 (lower (title) = lower ($query)) as exact
87 where hostid = $hostid
89 and title_description_fti @@ to_tsquery ('default', $tsquery)
90 order by exact desc, last_modified_date desc, title" in
94 | (_, Some url, None, title, last_modified, _) ->
95 url, title, None, last_modified
96 | (version, None, Some url, title, last_modified, _) ->
97 url, title, Some version, last_modified
98 | _ -> assert false) rows in
100 let have_titles = titles <> [] in
101 template#conditional "have_titles" have_titles;
103 (* Search the contents. *)
105 if not old_versions then
107 "select c.id, p.id, p.url, p.url_deleted, p.title,
109 from contents c, pages p
110 where c.pageid = p.id
111 and p.hostid = $hostid
113 and p.redirect is null
114 and c.content_fti @@ to_tsquery ('default', $tsquery)
115 order by p.last_modified_date desc, p.title
119 "select c.id, p.id, p.url, p.url_deleted, p.title,
121 from contents c, pages p
122 where c.pageid = p.id
123 and p.hostid = $hostid
124 and p.redirect is null
125 and c.content_fti @@ to_tsquery ('default', $tsquery)
126 order by p.last_modified_date desc, p.title
131 | (contentid, _, Some url, None, title, last_modified) ->
132 contentid, url, title, None, last_modified
133 | (contentid, version, None, Some url, title,
135 contentid, url, title, Some version, last_modified
136 | _ -> assert false) rows in
138 let have_contents = contents <> [] in
139 template#conditional "have_contents" have_contents;
141 (* Pull out the actual text which matched so we can generate a summary.
142 * XXX tsearch2 can actually do better than this by emboldening
143 * the text which maps.
146 if contents = [] then []
150 List.map (fun (contentid, _,_,_,_) -> contentid) contents in
152 "select id, sectionname, content from contents
153 where id in $@contentids" in
154 List.map (fun (id, sectionname, content) ->
155 id, (sectionname, content)) rows
158 (* Generate the final tables. *)
160 List.map (fun (url, title, version, last_modified) ->
161 let have_version, version =
164 | Some version -> true, version in
165 let last_modified = printable_date last_modified in
166 [ "url", Template.VarString url;
167 "title", Template.VarString title;
168 "have_version", Template.VarConditional have_version;
169 "version", Template.VarString (Int32.to_string version);
170 "last_modified", Template.VarString last_modified ]
172 template#table "titles" table;
176 (fun (contentid, url, title, version, last_modified) ->
177 let have_version, version =
180 | Some version -> true, version in
181 let sectionname, content = List.assoc contentid content_map in
182 let have_sectionname, sectionname =
183 match sectionname with
185 | Some sectionname -> true, sectionname in
188 (Wikilib.text_of_xhtml
189 (Wikilib.xhtml_of_content r dbh hostid content)) in
190 let linkname = linkname_of_sectionname sectionname in
191 let last_modified = printable_date last_modified in
192 [ "url", Template.VarString url;
193 "title", Template.VarString title;
194 "have_version", Template.VarConditional have_version;
195 "version", Template.VarString (Int32.to_string version);
196 "have_sectionname", Template.VarConditional have_sectionname;
197 "sectionname", Template.VarString sectionname;
198 "linkname", Template.VarString linkname;
199 "content", Template.VarString content;
200 "last_modified", Template.VarString last_modified ]
202 template#table "contents" table;
204 (* Do we have any results? *)
205 let have_results = have_titles || have_contents in
209 template#conditional "have_results" have_results;
214 register_script ~restrict:[CanView] run