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.8 2004/11/02 22:26:36 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 : Dbi.connection) 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 String.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. *)
73 ("select id, url, url_deleted, title, last_modified_date,
74 (lower (title) = lower (?)) as exact
77 (if not old_versions then "and url is not null " else "") ^ "
79 and title_description_fti @@ to_tsquery (?, ?)
80 order by exact desc, last_modified_date desc, title") in
81 sth#execute [`String query;
82 `Int hostid; `String "default"; `String tsquery];
86 | [_; `String url; `Null; `String title;
87 `Timestamp last_modified; _] ->
88 url, title, None, last_modified
89 | [`Int version; `Null; `String url; `String title;
90 `Timestamp last_modified; _] ->
91 url, title, Some version, last_modified
92 | _ -> assert false) in
94 let have_titles = titles <> [] in
95 template#conditional "have_titles" have_titles;
97 (* Search the contents. *)
100 ("select c.id, p.id, p.url, p.url_deleted, p.title,
102 from contents c, pages p
103 where c.pageid = p.id
105 (if not old_versions then "and url is not null " else "") ^ "
106 and p.redirect is null
107 and c.content_fti @@ to_tsquery (?, ?)
108 order by p.last_modified_date desc, p.title
110 sth#execute [`Int hostid; `String "default"; `String tsquery];
114 | [`Int contentid; _; `String url; `Null;
115 `String title; `Timestamp last_modified] ->
116 contentid, url, title, None, last_modified
117 | [`Int contentid; `Int version; `Null; `String url;
118 `String title; `Timestamp last_modified] ->
119 contentid, url, title, Some version, last_modified
120 | _ -> assert false) in
122 let have_contents = contents <> [] in
123 template#conditional "have_contents" have_contents;
125 (* Pull out the actual text which matched so we can generate a summary.*)
127 if contents = [] then []
129 let qs = Dbi.placeholders (List.length contents) in
132 ("select id, sectionname, content from contents
133 where id in " ^ qs) in
135 (List.map (fun (contentid, _,_,_,_) -> `Int contentid) contents);
137 | [ `Int id; `Null; `String content ] ->
139 | [ `Int id; `String sectionname; `String content ] ->
140 id, (Some sectionname, content)
144 (* Generate the final tables. *)
146 List.map (fun (url, title, version, last_modified) ->
147 let have_version, version =
150 | Some version -> true, version in
151 let last_modified = printable_date last_modified in
152 [ "url", Template.VarString url;
153 "title", Template.VarString title;
154 "have_version", Template.VarConditional have_version;
155 "version", Template.VarString (string_of_int version);
156 "last_modified", Template.VarString last_modified ]
158 template#table "titles" table;
162 (fun (contentid, url, title, version, last_modified) ->
163 let have_version, version =
166 | Some version -> true, version in
167 let sectionname, content = List.assoc contentid content_map in
168 let have_sectionname, sectionname =
169 match sectionname with
171 | Some sectionname -> true, sectionname in
174 (Wikilib.text_of_xhtml
175 (Wikilib.xhtml_of_content dbh hostid content)) in
176 let linkname = linkname_of_sectionname sectionname in
177 let last_modified = printable_date last_modified in
178 [ "url", Template.VarString url;
179 "title", Template.VarString title;
180 "have_version", Template.VarConditional have_version;
181 "version", Template.VarString (string_of_int version);
182 "have_sectionname", Template.VarConditional have_sectionname;
183 "sectionname", Template.VarString sectionname;
184 "linkname", Template.VarString linkname;
185 "content", Template.VarString content;
186 "last_modified", Template.VarString last_modified ]
188 template#table "contents" table;
190 (* Do we have any results? *)
191 let have_results = have_titles || have_contents in
195 template#conditional "have_results" have_results;
200 register_script ~restrict:[CanView] run