define has_tags method for the dummy article
[bse.git] / site / cgi-bin / modules / BSE / UI / Search.pm
CommitLineData
e58486b7
TC
1package BSE::UI::Search;
2use strict;
3use base 'BSE::UI::Dispatch';
e0ed81d7 4use BSE::TB::Articles;
e58486b7
TC
5use BSE::DB;
6use Constants qw(:search);
7use Carp;
8use BSE::Cfg;
9use BSE::Template;
3f9c8a96 10use BSE::Util::HTML qw':default popup_menu';
9d77df06 11use BSE::Util::Tags qw(tag_article);
e58486b7
TC
12use BSE::Request;
13
e0ed81d7 14our $VERSION = "1.004";
cb7fd78d 15
e58486b7
TC
16my %actions =
17 (
18 search => 1,
19 );
20
21sub actions { \%actions }
22
23sub default_action { 'search' }
24
25sub req_search {
26 my ($class, $req) = @_;
27
28 my $cfg = $req->cfg;
88fa9cd6 29
e58486b7 30 my $cgi = $req->cgi;
88fa9cd6
AO
31 my $results_per_page = int($cgi->param('pp') || 10);
32 $results_per_page >= 1 or $results_per_page = 10;
e58486b7
TC
33 my $words = $cgi->param('q');
34 my $section = $cgi->param('s');
35 my $date = $cgi->param('d');
36 my $admin = $cgi->param('admin') ? 1 : 0;
37 my $match_all = $cgi->param('match_all');
38 $section = '' if !defined $section;
39 $date = 'ar' if ! defined $date;
40 my @results;
41 my @terms; # terms as parsed by the search engine
42 my $case_sensitive;
43 if (defined $words && length $words) {
44 $case_sensitive = $words ne lc $words;
45 @results = getSearchResult($req, $words, $section, $date, \@terms, $match_all);
46 }
47 else {
48 $words = ''; # so we don't return junk for the form default
49 }
50
51 my $page_count = int((@results + $results_per_page - 1)/$results_per_page);
52
53 my $page_number = $cgi->param('page') || 1;
54 $page_number = $page_count if $page_number > $page_count;
55
56 my @articles;
57 if (@results) {
58 my $articles_start = ($page_number-1) * $results_per_page;
59 my $articles_end = $articles_start + $results_per_page-1;
60 $articles_end = $#results if $articles_end >= @results;
61
62 if ($cfg->entry('search', 'keep_inaccessible')) {
63 for my $entry (@results[$articles_start..$articles_end]) {
e0ed81d7 64 my $article = BSE::TB::Articles->getByPkey($entry->[0])
e58486b7
TC
65 or die "Cannot retrieve article $entry->[0]\n";
66 push(@articles, $article);
67 }
68 }
69 else {
70 my %remove; # used later to remove the inaccessible from @results;
71 # we need to check accessiblity on each article
72 my $index = 0;
73 my $seen = 0;
74 while ($index < @results && $seen <= $articles_end) {
75 my $id = $results[$index][0];
e0ed81d7 76 my $article = BSE::TB::Articles->getByPkey($id)
e58486b7
TC
77 or die "Cannot retrieve article $id\n";
78 if ($req->siteuser_has_access($article)) {
79 if ($seen >= $articles_start) {
80 push @articles, $article;
81 }
82 ++$seen;
83 }
84 else {
85 $remove{$id} = 1;
86 }
87 ++$index;
88 }
89 @results = grep !$remove{$_->[0]}, @results;
90 }
91 }
92
93 for my $article (@articles) {
94 my $generator = $article->{generator};
95 eval "use $generator";
96 my $gen = $generator->new(top=>$article, cfg=>$cfg);
97 $article = $gen->get_real_article($article);
98 }
99
100 $page_count = int((@results + $results_per_page - 1)/$results_per_page);
101
102 # make an array of hashes (to preserve order)
103 my %excluded;
104 @excluded{@SEARCH_EXCLUDE} = @SEARCH_EXCLUDE;
105 my %included;
106 @included{@SEARCH_INCLUDE} = @SEARCH_INCLUDE;
107 my @sections = map { { $_->{id} => $_->{title} } }
108 sort { $b->{displayOrder} <=> $a->{displayOrder} }
109 grep { ($_->{listed} || $included{$_->{id}})
110 && !$excluded{$_->{id}} }
e0ed81d7 111 BSE::TB::Articles->getBy('level', 1);
e58486b7
TC
112 unshift(@sections, { ""=>$SEARCH_ALL });
113 my %sections = map { %$_ } @sections;
114 # now a list of values ( in the correct order
115 @sections = map { keys %$_ } @sections;
116
117 my %scores = map @$_, @results;
118
119 my $max_score = 0;
120 for my $score (values %scores) {
121 $score > $max_score and $max_score = $score;
122 }
123
124 my %highlight_prefix;
125 my %highlight_suffix;
126 for my $type (qw(keyword author pageTitle file_displayName
127 file_description file_notes summary description product_code)) {
128 $highlight_prefix{$type} =
947d7c09 129 $cfg->entry('search highlight', "${type}_prefix", $cfg->entry('search highlight', "prefix", "<b>"));
e58486b7 130 $highlight_suffix{$type} =
947d7c09 131 $cfg->entry('search highlight', "${type}_suffix", $cfg->entry('search highlight', "suffix", "</b>"));
e58486b7
TC
132 }
133
134 my $page_num_iter = 0;
135
136 my $article_index = -1;
137 my $result_seq = ($page_number-1) * $results_per_page;
138 my $excerpt;
139 my %match_tags;
140 my $words_re_str = '\b('.join('|', map quotemeta, @terms).')';
141 my $highlight_partial = $cfg->entryBool('search', 'highlight_partial', 1);
142 $words_re_str .= '\b' unless $highlight_partial;
143 my $words_re = qr/$words_re_str/i;
144 my @files;
145 my $file_index;
146 my $current_result;
147 my %acts;
148 %acts =
149 (
150 $req->dyn_user_tags(),
151 iterate_results =>
152 sub {
153 ++$result_seq;
154 ++$article_index;
155 if ($article_index < @articles) {
156 $current_result = $articles[$article_index];
157 my $found = 0;
158 $excerpt = excerpt($cfg, $admin, $case_sensitive, $current_result, \$found, \@terms);
159
160 $req->set_article(result => $current_result);
161
162 for my $field (qw/pageTitle summary keyword description author product_code/) {
163 my $value = $current_result->{$field};
164 defined $value or $value = '';
165 $value =~ s!$words_re!$highlight_prefix{$field}$1$highlight_suffix{$field}!g
166 or $value = '';
167 $match_tags{$field} = $value;
168 }
169
170 # match files
171 @files = ();
172 for my $file ($current_result->files) {
173 my $found;
174 my %fileout;
175 for my $field (qw(displayName description notes)) {
176 my $prefix = $highlight_prefix{"file_$field"};
177 my $suffix = $highlight_suffix{"file_$field"};
178 $fileout{$field. "_matched"} = $file->{$field} =~ /$words_re/;
179 ++$found if ($fileout{$field} = $file->{$field})
180 =~ s!$words_re!$prefix$1$suffix!g;
181 }
182 if ($found) {
183 $fileout{notes_excerpt} =
184 excerpt($cfg, $admin, $case_sensitive, $current_result, \$found, \@terms, 'file_notes', $file->{notes});
185 push @files, [ \%fileout, $file ];
186 }
187 }
188
189 return 1;
190 }
191 else {
192 $req->set_article(result => undef);
193
194 return 0;
195 }
196 },
197 result =>
198 sub {
199 my $arg = shift;
200 if ($arg eq 'score') {
201 return sprintf("%.1f", 100.0 * $scores{$current_result->{id}} / $max_score);
202 }
9d77df06 203 return tag_article($current_result, $cfg, $arg);
e58486b7
TC
204 },
205 date =>
206 sub {
207 my ($func, $args) = split ' ', $_[0];
208 use POSIX 'strftime';
209 exists $acts{$func}
210 or return "** $func not found for date **";
211 my $date = $acts{$func}->($args)
212 or return '';
213 my ($year, $month, $day) = $date =~ /(\d+)\D+(\d+)\D+(\d+)/;
214 $year -= 1900;
215 --$month;
216 return strftime('%d-%b-%Y', 0, 0, 0, $day, $month, $year, 0, 0);
217 },
218 keywords => sub { $match_tags{keyword} },
219 author => sub { $match_tags{author} },
220 pageTitle => sub { $match_tags{pageTitle} },
221 match_summary => sub { $match_tags{summary} },
222 description => sub { $match_tags{description} },
223 product_code => sub { $match_tags{product_code} },
224
225 ifMatchfiles => sub { @files },
226 matchfile_count => sub { @files },
3d0a97d9 227 matchfile_index => sub { $file_index },
e58486b7
TC
228 iterate_matchfiles_reset => sub { $file_index = -1 },
229 iterate_matchfiles => sub { ++$file_index < @files },
230 matchfile =>
231 sub {
232 my ($args) = @_;
233 $file_index < @files or return '';
234 my $file_entry = $files[$file_index];
235 # already html escaped
236 exists $file_entry->[0]{$args} and return $file_entry->[0]{$args};
237
238 my $value = $file_entry->[1]{$args};
239 defined $value or return '';
240
241 escape_html($value);
242 },
243
244 ifResults => sub { scalar @results; },
245 ifSearch => sub { defined $words and length $words },
246 dateSelected => sub { $_[0] eq $date ? 'selected="selected"' : '' },
247 excerpt =>
248 sub {
249 return $excerpt;
250 },
251 articleurl =>
252 sub {
9d77df06 253 return $admin ? $current_result->{admin} : $current_result->link($cfg);
e58486b7
TC
254 },
255 count => sub { scalar @results },
256 multiple => sub { @results != 1 },
257 terms => sub { escape_html($words) },
258 resultSeq => sub { $result_seq },
4751ce20 259 list => sub { popup_menu(-name=>'s', -id => 'search_s',
e58486b7
TC
260 -values=>\@sections,
261 -labels=>\%sections,
262 -default=>$section) },
263
264 # result pages
265 iterate_pages =>
266 sub {
267 return ++$page_num_iter <= $page_count;
268 },
269 page => sub { $page_num_iter },
270 ifCurrentSearchPage =>
271 sub { $page_num_iter == $page_number },
272 pageurl =>
273 sub {
3f9c8a96
TC
274 my $work_words = $words;
275 $ENV{SCRIPT_NAME} . "?q=" . escape_uri($work_words) .
e58486b7
TC
276 "&amp;s=" . escape_uri($section) .
277 "&amp;d=" . escape_uri($date) .
3f9c8a96
TC
278 "&amp;page=".$page_num_iter .
279 "&amp;pp=$results_per_page";
e58486b7
TC
280 },
281 highlight_result =>
282 [ \&tag_highlight_result, \$current_result, $cfg, $words_re ],
4b1dcb69 283 admin_search => $admin,
e58486b7
TC
284 );
285
286 my $template = $cgi->param('embed') ? 'include/search_results' : 'search';
d060e02f 287 my $result = $req->dyn_response($template, \%acts);
e58486b7
TC
288 %acts = (); # remove any circular refs
289
290 return $result;
291}
292
293sub tag_highlight_result {
294 my ($rcurrent_result, $cfg, $words_re, $arg) = @_;
295
296 $$rcurrent_result
297 or return "** highlight_result must be in results iterator **";
298
299 my $text = $$rcurrent_result->{$arg};
300 defined $text or return '';
301
302 $text = escape_html($text);
303
947d7c09
AO
304 my $prefix = $cfg->entry('search highlight', "${arg}_prefix", $cfg->entry('search highlight', "prefix", "<b>"));
305 my $suffix = $cfg->entry('search highlight', "${arg}_suffix", $cfg->entry('search highlight', "suffix", "</b>"));
e58486b7
TC
306
307 $text =~ s/$words_re/$prefix$1$suffix/g;
308
309 $text;
310}
311
312sub getSearchResult {
313 my ($req, $words, $section, $date, $terms, $match_all) = @_;
314
315 my $cfg = $req->cfg;
316 my $searcher_class = $cfg->entry('search', 'searcher', 'BSE::Search::BSE');
317 (my $searcher_file = $searcher_class . '.pm') =~ s!::!/!g;;
318 require $searcher_file;
319 my $searcher = $searcher_class->new(cfg => $cfg);
320 return $searcher->search($words, $section, $date, $terms, $match_all, $req);
321}
322
323my %gens;
324
325sub excerpt {
326 my ($cfg, $admin, $case_sensitive, $article, $found, $terms, $type, $text) = @_;
327
328 my $generator = $article->{generator};
329
330 $generator =~ /\S/ or confess "generator for $article->{id} is blank";
331
332 eval "use $generator";
333 confess "Cannot use $generator: $@" if $@;
334
335 $gens{$generator} ||= $generator->new(admin=>$admin, cfg=>$cfg, top=>$article);
336
337 return $gens{$generator}->excerpt($article, $found, $case_sensitive, $terms, $type, $text);
338}
339
3401;