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.7 2004/11/02 19:21:17 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   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 = List.map String.lowercase keywords in
  64
  65       (* Turn the keywords into a tsearch2 ts_query string. *)
  66       let tsquery = String.concat "&" keywords in
  67
  68       (* Search the titles first. *)
  69       let sth =
  70         dbh#prepare_cached
  71           ("select id, url, url_deleted, title, last_modified_date,
  72                    (lower (title) = lower (?)) as exact
  73               from pages
  74              where hostid = ? " ^
  75            (if not old_versions then "and url is not null " else "") ^ "
  76                and redirect is null
  77                and title_description_fti @@ to_tsquery (?, ?)
  78              order by exact desc, last_modified_date desc, title") in
  79       sth#execute [`String query;
  80                    `Int hostid; `String "default"; `String tsquery];
  81
  82       let titles =
  83         sth#map (function
  84                    | [_; `String url; `Null; `String title;
  85                       `Timestamp last_modified; _] ->
  86                        url, title, None, last_modified
  87                    | [`Int version; `Null; `String url; `String title;
  88                       `Timestamp last_modified; _] ->
  89                        url, title, Some version, last_modified
  90                    | _ -> assert false) in
  91
  92       let have_titles = titles <> [] in
  93       template#conditional "have_titles" have_titles;
  94
  95       (* Search the contents. *)
  96       let sth =
  97         dbh#prepare_cached
  98           ("select c.id, p.id, p.url, p.url_deleted, p.title,
  99                    p.last_modified_date
 100               from contents c, pages p
 101              where c.pageid = p.id
 102                and p.hostid = ? " ^
 103            (if not old_versions then "and url is not null " else "") ^ "
 104                and p.redirect is null
 105                and c.content_fti @@ to_tsquery (?, ?)
 106              order by p.last_modified_date desc, p.title
 107              limit 50") in
 108       sth#execute [`Int hostid; `String "default"; `String tsquery];
 109
 110       let contents =
 111         sth#map (function
 112                    | [`Int contentid; _; `String url; `Null;
 113                       `String title; `Timestamp last_modified] ->
 114                        contentid, url, title, None, last_modified
 115                    | [`Int contentid; `Int version; `Null; `String url;
 116                       `String title; `Timestamp last_modified] ->
 117                        contentid, url, title, Some version, last_modified
 118                    | _ -> assert false) in
 119
 120       let have_contents = contents <> [] in
 121       template#conditional "have_contents" have_contents;
 122
 123       (* Pull out the actual text which matched so we can generate a summary.*)
 124       let content_map =
 125         if contents = [] then []
 126         else (
 127           let qs = Dbi.placeholders (List.length contents) in
 128           let sth =
 129             dbh#prepare_cached
 130               ("select id, sectionname, content from contents
 131                  where id in " ^ qs) in
 132           sth#execute
 133             (List.map (fun (contentid, _,_,_,_) -> `Int contentid) contents);
 134           sth#map (function
 135                      | [ `Int id; `Null; `String content ] ->
 136                          id, (None, content)
 137                      | [ `Int id; `String sectionname; `String content ] ->
 138                          id, (Some sectionname, content)
 139                      | _ -> assert false)
 140         ) in
 141
 142       (* Generate the final tables. *)
 143       let table =
 144         List.map (fun (url, title, version, last_modified) ->
 145                     let have_version, version =
 146                       match version with
 147                           None -> false, 0
 148                         | Some version -> true, version in
 149                     let last_modified = printable_date last_modified in
 150                     [ "url", Template.VarString url;
 151                       "title", Template.VarString title;
 152                       "have_version", Template.VarConditional have_version;
 153                       "version", Template.VarString (string_of_int version);
 154                       "last_modified", Template.VarString last_modified ]
 155                  ) titles in
 156       template#table "titles" table;
 157
 158       let table =
 159         List.map
 160           (fun (contentid, url, title, version, last_modified) ->
 161              let have_version, version =
 162                match version with
 163                    None -> false, 0
 164                  | Some version -> true, version in
 165              let sectionname, content = List.assoc contentid content_map in
 166              let have_sectionname, sectionname =
 167                match sectionname with
 168                    None -> false, ""
 169                  | Some sectionname -> true, sectionname in
 170              let content =
 171                truncate 160
 172                  (Wikilib.text_of_xhtml
 173                     (Wikilib.xhtml_of_content dbh hostid content)) in
 174              let linkname = linkname_of_sectionname sectionname in
 175              let last_modified = printable_date last_modified in
 176              [ "url", Template.VarString url;
 177                "title", Template.VarString title;
 178                "have_version", Template.VarConditional have_version;
 179                "version", Template.VarString (string_of_int version);
 180                "have_sectionname", Template.VarConditional have_sectionname;
 181                "sectionname", Template.VarString sectionname;
 182                "linkname", Template.VarString linkname;
 183                "content", Template.VarString content;
 184                "last_modified", Template.VarString last_modified ]
 185           ) contents in
 186       template#table "contents" table;
 187
 188       (* Do we have any results? *)
 189       let have_results = have_titles || have_contents in
 190       have_results
 191     )
 192     else false in
 193   template#conditional "have_results" have_results;
 194
 195   q#template template
 196
 197 let () =
 198   register_script ~restrict:[CanView] run