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.8 2004/11/02 22:26:36 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 =
  64         List.filter (fun s -> not (string_is_whitespace s)) keywords in
  65       let keywords = List.map String.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 sth =
  72         dbh#prepare_cached
  73           ("select id, url, url_deleted, title, last_modified_date,
  74                    (lower (title) = lower (?)) as exact
  75               from pages
  76              where hostid = ? " ^
  77            (if not old_versions then "and url is not null " else "") ^ "
  78                and redirect is null
  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];
  83
  84       let titles =
  85         sth#map (function
  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
  93
  94       let have_titles = titles <> [] in
  95       template#conditional "have_titles" have_titles;
  96
  97       (* Search the contents. *)
  98       let sth =
  99         dbh#prepare_cached
 100           ("select c.id, p.id, p.url, p.url_deleted, p.title,
 101                    p.last_modified_date
 102               from contents c, pages p
 103              where c.pageid = p.id
 104                and p.hostid = ? " ^
 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
 109              limit 50") in
 110       sth#execute [`Int hostid; `String "default"; `String tsquery];
 111
 112       let contents =
 113         sth#map (function
 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
 121
 122       let have_contents = contents <> [] in
 123       template#conditional "have_contents" have_contents;
 124
 125       (* Pull out the actual text which matched so we can generate a summary.*)
 126       let content_map =
 127         if contents = [] then []
 128         else (
 129           let qs = Dbi.placeholders (List.length contents) in
 130           let sth =
 131             dbh#prepare_cached
 132               ("select id, sectionname, content from contents
 133                  where id in " ^ qs) in
 134           sth#execute
 135             (List.map (fun (contentid, _,_,_,_) -> `Int contentid) contents);
 136           sth#map (function
 137                      | [ `Int id; `Null; `String content ] ->
 138                          id, (None, content)
 139                      | [ `Int id; `String sectionname; `String content ] ->
 140                          id, (Some sectionname, content)
 141                      | _ -> assert false)
 142         ) in
 143
 144       (* Generate the final tables. *)
 145       let table =
 146         List.map (fun (url, title, version, last_modified) ->
 147                     let have_version, version =
 148                       match version with
 149                           None -> false, 0
 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 ]
 157                  ) titles in
 158       template#table "titles" table;
 159
 160       let table =
 161         List.map
 162           (fun (contentid, url, title, version, last_modified) ->
 163              let have_version, version =
 164                match version with
 165                    None -> false, 0
 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
 170                    None -> false, ""
 171                  | Some sectionname -> true, sectionname in
 172              let content =
 173                truncate 160
 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 ]
 187           ) contents in
 188       template#table "contents" table;
 189
 190       (* Do we have any results? *)
 191       let have_results = have_titles || have_contents in
 192       have_results
 193     )
 194     else false in
 195   template#conditional "have_results" have_results;
 196
 197   q#template template
 198
 199 let () =
 200   register_script ~restrict:[CanView] run