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.12 2006/08/16 15:27:02 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 hostid host user =
  36   let template = get_template dbh hostid "search.html" in
  37
  38   template#set "canonical_hostname" host.canonical_hostname;
  39
  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;
  45
  46   (* Permissions. *)
  47   let can_edit = can_edit host user in
  48   template#conditional "can_edit" can_edit;
  49
  50   (* Search old versions?  Only permit this if can_edit is true. *)
  51   let old_versions =
  52     if can_edit then (
  53       try q#param_true "old_versions"
  54       with Not_found -> false
  55     )
  56     else false in
  57
  58   (* If we have a query, make some results. *)
  59   let have_results =
  60     if have_query then (
  61       (* Get the keywords from the query string. *)
  62       let keywords = Pcre.split ~rex:split_words query in
  63       let keywords =
  64         List.filter (fun s -> not (string_is_whitespace s)) keywords in
  65       let keywords = List.map lowercase keywords in
  66
  67       (* Turn the keywords into a tsearch2 ts_query string. *)
  68       let tsquery = String.concat "&" keywords in
  69
  70       (* Search the titles first. *)
  71       let rows =
  72         if not old_versions then
  73           PGSQL(dbh)
  74             "select id, url, url_deleted, title, last_modified_date,
  75                     (lower (title) = lower ($query)) as exact
  76                from pages
  77               where hostid = $hostid
  78                 and url is not null
  79                 and redirect is null
  80                 and title_description_fti @@ to_tsquery ('default', $tsquery)
  81               order by exact desc, last_modified_date desc, title"
  82         else
  83           PGSQL(dbh)
  84             "select id, url, url_deleted, title, last_modified_date,
  85                     (lower (title) = lower ($query)) as exact
  86                from pages
  87               where hostid = $hostid
  88                 and redirect is null
  89                 and title_description_fti @@ to_tsquery ('default', $tsquery)
  90               order by exact desc, last_modified_date desc, title" in
  91
  92       let titles =
  93         List.map (function
  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
  99
 100       let have_titles = titles <> [] in
 101       template#conditional "have_titles" have_titles;
 102
 103       (* Search the contents. *)
 104       let rows =
 105         if not old_versions then
 106           PGSQL(dbh)
 107           "select c.id, p.id, p.url, p.url_deleted, p.title,
 108                   p.last_modified_date
 109              from contents c, pages p
 110             where c.pageid = p.id
 111               and p.hostid = $hostid
 112               and url is not null
 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
 116             limit 50"
 117         else
 118           PGSQL(dbh)
 119           "select c.id, p.id, p.url, p.url_deleted, p.title,
 120                   p.last_modified_date
 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
 127             limit 50" in
 128
 129       let contents =
 130         List.map (function
 131                    | (contentid, _, Some url, None, title, last_modified) ->
 132                        contentid, url, title, None, last_modified
 133                    | (contentid, version, None, Some url, title,
 134                       last_modified) ->
 135                        contentid, url, title, Some version, last_modified
 136                    | _ -> assert false) rows in
 137
 138       let have_contents = contents <> [] in
 139       template#conditional "have_contents" have_contents;
 140
 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.
 144        *)
 145       let content_map =
 146         if contents = [] then []
 147         else (
 148           let rows =
 149             let contentids =
 150               List.map (fun (contentid, _,_,_,_) -> contentid) contents in
 151             PGSQL(dbh)
 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
 156         ) in
 157
 158       (* Generate the final tables. *)
 159       let table =
 160         List.map (fun (url, title, version, last_modified) ->
 161                     let have_version, version =
 162                       match version with
 163                           None -> false, 0l
 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 ]
 171                  ) titles in
 172       template#table "titles" table;
 173
 174       let table =
 175         List.map
 176           (fun (contentid, url, title, version, last_modified) ->
 177              let have_version, version =
 178                match version with
 179                    None -> false, 0l
 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
 184                    None -> false, ""
 185                  | Some sectionname -> true, sectionname in
 186              let content =
 187                truncate 160
 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 ]
 201           ) contents in
 202       template#table "contents" table;
 203
 204       (* Do we have any results? *)
 205       let have_results = have_titles || have_contents in
 206       have_results
 207     )
 208     else false in
 209   template#conditional "have_results" have_results;
 210
 211   q#template template
 212
 213 let () =
 214   register_script ~restrict:[CanView] run