scripts/search.ml

   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.6 2004/11/02 18:47:54 rich Exp $
   5  *
   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.
  10  *
  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.
  15  *
  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.
  20  *)
  21
  22 open Apache
  23 open Registry
  24 open Cgi
  25 open Cgi_escape
  26 open Printf
  27
  28 open Cocanwiki
  29 open Cocanwiki_template
  30 open Cocanwiki_strings
  31 open Cocanwiki_date
  32
  33 let split_words = Pcre.regexp "\\W+"
  34
  35 let run r (q : cgi) (dbh : Dbi.connection) hostid host user =
  36   let template = get_template dbh hostid "search.html" in
  37
  38   (* Get the query, if it exists. *)
  39   let query = try q#param "q" with Not_found -> "" in
  40   let have_query = not (string_is_whitespace query) in
  41   template#set "query" query;
  42   template#conditional "have_query" have_query;
  43
  44   (* Permissions. *)
  45   let can_edit = can_edit host user in
  46   template#conditional "can_edit" can_edit;
  47
  48   (* Search old versions?  Only permit this if can_edit is true. *)
  49   let old_versions =
  50     if can_edit then (
  51       try q#param_true "old_versions"
  52       with Not_found -> false
  53     )
  54     else false in
  55
  56   (* If we have a query, make some results. *)
  57   let have_results =
  58     if have_query then (
  59       (* Get the keywords from the query string. *)
  60       let keywords = Pcre.split ~rex:split_words query in
  61       let keywords = List.map String.lowercase keywords in
  62
  63       (* Turn the keywords into a tsearch2 ts_query string. *)
  64       let tsquery = String.concat "&" keywords in
  65
  66       (* Search the titles first. *)
  67       let sth =
  68         dbh#prepare_cached
  69           ("select id, url, url_deleted, title, last_modified_date,
  70                    (lower (title) = lower (?)) as exact
  71               from pages
  72              where hostid = ? " ^
  73            (if not old_versions then "and url is not null " else "") ^ "
  74                and redirect is null
  75                and title_description_fti @@ to_tsquery (?, ?)
  76              order by exact desc, last_modified_date desc, title") in
  77       sth#execute [`String query;
  78                    `Int hostid; `String "default"; `String tsquery];
  79
  80       let titles =
  81         sth#map (function
  82                    | [_; `String url; `Null; `String title;
  83                       `Timestamp last_modified; _] ->
  84                        url, title, None, last_modified
  85                    | [`Int version; `Null; `String url; `String title;
  86                       `Timestamp last_modified; _] ->
  87                        url, title, Some version, last_modified
  88                    | _ -> assert false) in
  89
  90       let have_titles = titles <> [] in
  91       template#conditional "have_titles" have_titles;
  92
  93       (* Search the contents. *)
  94       let sth =
  95         dbh#prepare_cached
  96           ("select c.id, p.id, p.url, p.url_deleted, p.title,
  97                    p.last_modified_date
  98               from contents c, pages p
  99              where c.pageid = p.id
 100                and p.hostid = ? " ^
 101            (if not old_versions then "and url is not null " else "") ^ "
 102                and p.redirect is null
 103                and c.content_fti @@ to_tsquery (?, ?)
 104              order by p.last_modified_date desc, p.title
 105              limit 50") in
 106       sth#execute [`Int hostid; `String "default"; `String tsquery];
 107
 108       let contents =
 109         sth#map (function
 110                    | [`Int contentid; _; `String url; `Null;
 111                       `String title; `Timestamp last_modified] ->
 112                        contentid, url, title, None, last_modified
 113                    | [`Int contentid; `Int version; `Null; `String url;
 114                       `String title; `Timestamp last_modified] ->
 115                        contentid, url, title, Some version, last_modified
 116                    | _ -> assert false) in
 117
 118       let have_contents = contents <> [] in
 119       template#conditional "have_contents" have_contents;
 120
 121       (* Pull out the actual text which matched so we can generate a summary.*)
 122       let content_map =
 123         if contents = [] then []
 124         else (
 125           let qs = Dbi.placeholders (List.length contents) in
 126           let sth =
 127             dbh#prepare_cached
 128               ("select id, sectionname, content from contents
 129                  where id in " ^ qs) in
 130           sth#execute
 131             (List.map (fun (contentid, _,_,_,_) -> `Int contentid) contents);
 132           sth#map (function
 133                      | [ `Int id; `Null; `String content ] ->
 134                          id, (None, content)
 135                      | [ `Int id; `String sectionname; `String content ] ->
 136                          id, (Some sectionname, content)
 137                      | _ -> assert false)
 138         ) in
 139
 140       (* Generate the final tables. *)
 141       let table =
 142         List.map (fun (url, title, version, last_modified) ->
 143                     let have_version, version =
 144                       match version with
 145                           None -> false, 0
 146                         | Some version -> true, version in
 147                     let last_modified = printable_date last_modified in
 148                     [ "url", Template.VarString url;
 149                       "title", Template.VarString title;
 150                       "have_version", Template.VarConditional have_version;
 151                       "version", Template.VarString (string_of_int version);
 152                       "last_modified", Template.VarString last_modified ]
 153                  ) titles in
 154       template#table "titles" table;
 155
 156       let table =
 157         List.map
 158           (fun (contentid, url, title, version, last_modified) ->
 159              let have_version, version =
 160                match version with
 161                    None -> false, 0
 162                  | Some version -> true, version in
 163              let sectionname, content = List.assoc contentid content_map in
 164              let have_sectionname, sectionname =
 165                match sectionname with
 166                    None -> false, ""
 167                  | Some sectionname -> true, sectionname in
 168              let content =
 169                truncate 160
 170                  (Wikilib.text_of_xhtml
 171                     (Wikilib.xhtml_of_content dbh hostid content)) in
 172              let linkname = linkname_of_sectionname sectionname in
 173              let last_modified = printable_date last_modified in
 174              [ "url", Template.VarString url;
 175                "title", Template.VarString title;
 176                "have_version", Template.VarConditional have_version;
 177                "version", Template.VarString (string_of_int version);
 178                "have_sectionname", Template.VarConditional have_sectionname;
 179                "sectionname", Template.VarString sectionname;
 180                "linkname", Template.VarString linkname;
 181                "content", Template.VarString content;
 182                "last_modified", Template.VarString last_modified ]
 183           ) contents in
 184       template#table "contents" table;
 185
 186       (* Do we have any results? *)
 187       let have_results = have_titles || have_contents in
 188       have_results
 189     )
 190     else false in
 191   template#conditional "have_results" have_results;
 192
 193   q#template template
 194
 195 let () =
 196   register_script ~restrict:[CanView] run