(* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. * $Id: search.ml,v 1.8 2004/11/02 22:26:36 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 Registry open Cgi open Cgi_escape open Printf open Cocanwiki open Cocanwiki_template open Cocanwiki_strings open Cocanwiki_date let split_words = Pcre.regexp "\\W+" let run r (q : cgi) (dbh : Dbi.connection) hostid host user = let template = get_template dbh hostid "search.html" in template#set "canonical_hostname" host.canonical_hostname; (* Get the query, if it exists. *) let query = try q#param "q" with Not_found -> "" in let have_query = not (string_is_whitespace query) in template#set "query" query; template#conditional "have_query" have_query; (* Permissions. *) let can_edit = can_edit host user in template#conditional "can_edit" can_edit; (* Search old versions? Only permit this if can_edit is true. *) let old_versions = if can_edit then ( try q#param_true "old_versions" with Not_found -> false ) else false in (* If we have a query, make some results. *) let have_results = if have_query then ( (* Get the keywords from the query string. *) let keywords = Pcre.split ~rex:split_words query in let keywords = List.filter (fun s -> not (string_is_whitespace s)) keywords in let keywords = List.map String.lowercase keywords in (* Turn the keywords into a tsearch2 ts_query string. *) let tsquery = String.concat "&" keywords in (* Search the titles first. *) let sth = dbh#prepare_cached ("select id, url, url_deleted, title, last_modified_date, (lower (title) = lower (?)) as exact from pages where hostid = ? " ^ (if not old_versions then "and url is not null " else "") ^ " and redirect is null and title_description_fti @@ to_tsquery (?, ?) order by exact desc, last_modified_date desc, title") in sth#execute [`String query; `Int hostid; `String "default"; `String tsquery]; let titles = sth#map (function | [_; `String url; `Null; `String title; `Timestamp last_modified; _] -> url, title, None, last_modified | [`Int version; `Null; `String url; `String title; `Timestamp last_modified; _] -> url, title, Some version, last_modified | _ -> assert false) in let have_titles = titles <> [] in template#conditional "have_titles" have_titles; (* Search the contents. *) let sth = dbh#prepare_cached ("select c.id, p.id, p.url, p.url_deleted, p.title, p.last_modified_date from contents c, pages p where c.pageid = p.id and p.hostid = ? " ^ (if not old_versions then "and url is not null " else "") ^ " and p.redirect is null and c.content_fti @@ to_tsquery (?, ?) order by p.last_modified_date desc, p.title limit 50") in sth#execute [`Int hostid; `String "default"; `String tsquery]; let contents = sth#map (function | [`Int contentid; _; `String url; `Null; `String title; `Timestamp last_modified] -> contentid, url, title, None, last_modified | [`Int contentid; `Int version; `Null; `String url; `String title; `Timestamp last_modified] -> contentid, url, title, Some version, last_modified | _ -> assert false) in let have_contents = contents <> [] in template#conditional "have_contents" have_contents; (* Pull out the actual text which matched so we can generate a summary.*) let content_map = if contents = [] then [] else ( let qs = Dbi.placeholders (List.length contents) in let sth = dbh#prepare_cached ("select id, sectionname, content from contents where id in " ^ qs) in sth#execute (List.map (fun (contentid, _,_,_,_) -> `Int contentid) contents); sth#map (function | [ `Int id; `Null; `String content ] -> id, (None, content) | [ `Int id; `String sectionname; `String content ] -> id, (Some sectionname, content) | _ -> assert false) ) in (* Generate the final tables. *) let table = List.map (fun (url, title, version, last_modified) -> let have_version, version = match version with None -> false, 0 | Some version -> true, version in let last_modified = printable_date last_modified in [ "url", Template.VarString url; "title", Template.VarString title; "have_version", Template.VarConditional have_version; "version", Template.VarString (string_of_int version); "last_modified", Template.VarString last_modified ] ) titles in template#table "titles" table; let table = List.map (fun (contentid, url, title, version, last_modified) -> let have_version, version = match version with None -> false, 0 | Some version -> true, version in let sectionname, content = List.assoc contentid content_map in let have_sectionname, sectionname = match sectionname with None -> false, "" | Some sectionname -> true, sectionname in let content = truncate 160 (Wikilib.text_of_xhtml (Wikilib.xhtml_of_content dbh hostid content)) in let linkname = linkname_of_sectionname sectionname in let last_modified = printable_date last_modified in [ "url", Template.VarString url; "title", Template.VarString title; "have_version", Template.VarConditional have_version; "version", Template.VarString (string_of_int version); "have_sectionname", Template.VarConditional have_sectionname; "sectionname", Template.VarString sectionname; "linkname", Template.VarString linkname; "content", Template.VarString content; "last_modified", Template.VarString last_modified ] ) contents in template#table "contents" table; (* Do we have any results? *) let have_results = have_titles || have_contents in have_results ) else false in template#conditional "have_results" have_results; q#template template let () = register_script ~restrict:[CanView] run