Re-factor search functions
[webmin.git] / webmin-search-lib.pl
1 # Functions for searching the webmin docs and UI
2
3 =head2 search_webmin(phrase, [callback-function])
4
5 Searches all Webmin help pages, UI text, module names and config.info files
6 for entries matching the given phrase or word. Returns them sorted by relevance
7 order, each as a hash ref with the following keys :
8
9 =item mod - A module hash reference for the module the search result was in
10
11 =item rank - A result ranking, higher being better
12
13 =item type - One of mod (for module name), dir (for module directory), config (configuration setting), help (help page) or text (UI text)
14
15 =item text - The text that matched
16
17 =items cgis - An array ref of pages on which the text appears, each formatted like module/script.cgi
18
19 =cut
20 sub search_webmin
21 {
22 my ($re, $cbfunc) = @_;
23
24 # Work out this Webmin's URL base
25 my $urlhost = $ENV{'HTTP_HOST'};
26 if ($urlhost !~ /:/) {
27         $urlhost .= ":".$ENV{'SERVER_PORT'};
28         }
29 my $urlbase = ($ENV{'HTTPS'} eq 'ON' ? 'https://' : 'http://').$urlhost;
30
31 # Search module names and add to results list
32 my @rv = ( );
33 my @mods = sort { $b->{'longdesc'} cmp $a->{'longdesc'} }
34              grep { !$_->{'clone'} } &get_available_module_infos();
35 foreach my $m (@mods) {
36         if ($m->{'desc'} =~ /\Q$re\E/i) {
37                 # Module description match
38                 push(@rv, { 'mod' => $m,
39                             'rank' => 10,
40                             'type' => 'mod',
41                             'link' => $m->{'dir'}.'/',
42                             'text' => $m->{'desc'} });
43                 }
44         elsif ($m->{'dir'} =~ /\Q$re\E/i) {
45                 # Module directory match
46                 push(@rv, { 'mod' => $m,
47                             'rank' => 12,
48                             'type' => 'dir',
49                             'link' => $m->{'dir'}.'/',
50                             'text' => $urlbase."/".$m->{'dir'}."/" });
51                 }
52         &$cbfunc() if ($cbfunc);
53         }
54
55 # Search module configs and their help pages
56 foreach my $m (@mods) {
57         my %access = &get_module_acl(undef, $m);
58         next if ($access{'noconfig'});
59         my $file = $prod eq 'webmin' ? "$m->{'dir'}/config.info"
60                                      : "$m->{'dir'}/uconfig.info";
61         my %info = ( );
62         my @info_order = ( );
63         &read_file($file, \%info, \@info_order);
64         foreach my $o (@lang_order_list) {
65                 &read_file("$file.$o", \%info);
66                 }
67         my $section = undef;
68         foreach my $c (@info_order) {
69                 my @p = split(/,/, $info{$c});
70                 if ($p[1] == 11) {
71                         $section = $c;
72                         }
73                 if ($p[0] =~ /\Q$re\E/i) {
74                         # Config description matches
75                         push(@rv, { 'mod' => $m,
76                                     'rank' => 8,
77                                     'type' => 'config',
78                                     'link' => "config.cgi?module=$m->{'dir'}&".
79                                              "section=".&urlize($section)."#$c",
80                                     'text' => $p[0],
81                                   });
82                         }
83                 my $hfl = &help_file($mod->{'dir'}, "config_".$c);
84                 my ($title, $help) = &help_file_match($hfl);
85                 if ($help) {
86                         # Config help matches
87                         push(@rv, { 'mod' => $m,
88                                     'rank' => 6,
89                                     'type' => 'help',
90                                     'link' => "help.cgi/$m->{'dir'}/config_".$c,
91                                     'desc' => &text('wsearch_helpfor', $p[0]),
92                                     'text' => $help,
93                                     'cgis' => [ "/config.cgi?".
94                                                 "module=$m->{'dir'}&section=".
95                                                 &urlize($section)."#$c" ],
96                                    });
97                         }
98                 }
99         &$cbfunc() if ($cbfunc);
100         }
101
102 # Search other help pages
103 my %lang_order_list = map { $_, 1 } @lang_order_list;
104 foreach my $m (@mods) {
105         my $helpdir = &module_root_directory($m->{'dir'})."/help";
106         my %donepage = ( );
107         opendir(DIR, $helpdir);
108         foreach my $f (sort { length($b) <=> length($a) } readdir(DIR)) {
109                 next if ($f =~ /^config_/);     # For config help, already done
110
111                 # Work out if we should grep this help page - don't do the same
112                 # page twice for different languages
113                 my $grep = 0;
114                 if ($f =~ /^(\S+)\.([^\.]+)\.html$/) {
115                         my ($page, $lang) = ($1, $2);
116                         if ($lang_order_list{$lang} && !$donepage{$page}++) {
117                                 $grep = 1;
118                                 }
119                         }
120                 elsif ($f =~ /^(\S+)\.html$/) {
121                         my $page = $1;
122                         if (!$donepage{$page}++) {
123                                 $grep = 1;
124                                 }
125                         }
126
127                 # If yes, search it
128                 if ($grep) {
129                         my ($title, $help) = &help_file_match("$helpdir/$f");
130                         if ($title) {
131                                 my @cgis = &find_cgi_text(
132                                         [ "hlink\\(.*'$page'",
133                                           "hlink\\(.*\"$page\"",
134                                           "header\\([^,]+,[^,]+,[^,]+,\\s*\"$page\"",
135                                           "header\\([^,]+,[^,]+,[^,]+,\\s*'$page'",
136                                         ], $m, 1);
137                                 push(@rv, { 'mod' => $m,
138                                             'rank' => 6,
139                                             'type' => 'help',
140                                             'link' => "help.cgi/$m->{'dir'}/$page",
141                                             'desc' => $title,
142                                             'text' => $help,
143                                             'cgis' => \@cgis });
144                                 }
145                         }
146                 &$cbfunc() if ($cbfunc);
147                 }
148         closedir(DIR);
149         }
150
151 # Then do text strings
152 my %gtext = &load_language("");
153 MODULE: foreach my $m (@mods) {
154         my %mtext = &load_language($m->{'dir'});
155         foreach my $k (keys %mtext) {
156                 next if ($gtext{$k});   # Skip repeated global strings
157                 $mtext{$k} =~ s/\$[0-9]//g;
158                 if ($mtext{$k} =~ /\Q$re\E/i) {
159                         # Find CGIs that use this text
160                         my @cgis = &find_cgi_text(
161                                 [ "\$text{'$k'}",
162                                   "\$text{\"$k\"}",
163                                   "\$text{$k}",
164                                   "&text('$k'",
165                                   "&text(\"$k\"" ], $m);
166                         if (@cgis) {
167                                 push(@rv, { 'mod' => $m,
168                                             'rank' => 4,
169                                             'type' => 'text',
170                                             'text' => $mtext{$k},
171                                             'cgis' => \@cgis });
172                                 }
173                         }
174                 }
175         &$cbfunc() if ($cbfunc);
176         }
177
178 # Sort results by relevancy
179 # XXX can do better?
180 @rv = sort { $b->{'rank'} <=> $a->{'rank'} ||
181              lc($a->{'mod'}->{'desc'}) cmp lc($b->{'mod'}->{'desc'}) } @rv;
182 return @rv;
183 }
184
185 # highlight_text(text, [length])
186 # Returns text with the search term bolded, and truncated to 50 characters
187 sub highlight_text
188 {
189 local ($str, $len) = @_;
190 $len ||= 50;
191 local $hlen = $len / 2;
192 $str =~ s/<[^>]*>//g;
193 if ($str =~ /(.*)(\Q$re\E)(.*)/i) {
194         local ($before, $match, $after) = ($1, $2, $3);
195         if (length($before) > $hlen) {
196                 $before = "...".substr($before, length($before)-$hlen);
197                 }
198         if (length($after) > $hlen) {
199                 $after = substr($after, 0, $hlen)."...";
200                 }
201         $str = $before."<b>".&html_escape($match)."</b>".$after;
202         }
203 return $str;
204 }
205
206 # find_cgi_text(&regexps, module, re-mode)
207 # Returns the relative URLs of CGIs that matches some regexps, in the given
208 # module. Does not include those that don't call some header function, as
209 # they cannot be linked to normally
210 sub find_cgi_text
211 {
212 local ($res, $m, $remode) = @_;
213 local $mdir = &module_root_directory($m);
214 local @rv;
215 foreach my $f (glob("$mdir/*.cgi")) {
216         local $found = 0;
217         local $header = 0;
218         open(CGI, $f);
219         LINE: while(my $line = <CGI>) {
220                 if ($line =~ /(header|ui_print_header|ui_print_unbuffered_header)\(/) {
221                         $header++;
222                         }
223                 foreach my $r (@$res) {
224                         if (!$remode && index($line, $r) >= 0 ||
225                             $remode && $line =~ /$r/) {
226                                 $found++;
227                                 last LINE;
228                                 }
229                         }
230                 }
231         close(CGI);
232         if ($found && $header) {
233                 local $url = $f;
234                 $url =~ s/^\Q$root_directory\E\///;
235                 push(@rv, $url);
236                 }
237         }
238 return @rv;
239 }
240
241 # help_file_match(file)
242 # Returns the title if some help file matches the current search
243 sub help_file_match
244 {
245 local ($f) = @_;
246 local $data = &read_file_contents($f);
247 local $title;
248 if ($data =~ /<header>([^<]*)<\/header>/) {
249         $title = $1;
250         }
251 $data =~ s/\s+/ /g;
252 $data =~ s/<p>/\n\n/gi;
253 $data =~ s/<br>/\n/gi;
254 $data =~ s/<[^>]+>//g;
255 if ($data =~ /\Q$re\E/i) {
256         return ($title, $data);
257         }
258 return ( );
259 }
260
261 # cgi_page_title(module, cgi)
262 # Given a CGI, return the text for its page title, if possible
263 sub cgi_page_title
264 {
265 local ($m, $cgi) = @_;
266 local $data = &read_file_contents(&module_root_directory($m)."/".$cgi);
267 local $rv;
268 if ($data =~ /(ui_print_header|ui_print_unbuffered_header)\([^,]+,[^,]*(\$text{'([^']+)'|\$text{"([^"]+)"|\&text\('([^']+)'|\&text\("([^"]+)")/) {
269         # New header function, with arg before title
270         local $msg = $3 || $4 || $5 || $6;
271         local %mtext = &load_language($m);
272         $rv = $mtext{$msg};
273         }
274 elsif ($data =~ /(^|\s)header\(\s*(\$text{'([^']+)'|\$text{"([^"]+)"|\&text\('([^']+)'|\&text\("([^"]+)")/) {
275         # Old header function
276         local $msg = $3 || $4 || $5 || $6;
277         local %mtext = &load_language($m);
278         $rv = $mtext{$msg};
279         }
280 if ($cgi eq "index.cgi" && !$rv) {
281         # If no title was found for an index.cgi, use module title
282         local %minfo = &get_module_info($m);
283         $rv = $minfo{'desc'};
284         }
285 return $rv;
286 }
287
288 # cgi_page_args(module, cgi)
289 # Given a module and CGI name, returns a string of URL parameters that can be
290 # used for linking to it. Returns "none" if parameters are needed, but cannot
291 # be determined.
292 sub cgi_page_args
293 {
294 local ($m, $cgi) = @_;
295 local $mroot = &module_root_directory($m);
296 if (-r "$mroot/cgi_args.pl") {
297         # Module can tell us what args to use
298         &foreign_require($m, "cgi_args.pl");
299         $args = &foreign_call($m, "cgi_args", $cgi);
300         if (defined($args)) {
301                 return $args;
302                 }
303         }
304 if ($cgi eq "index.cgi") {
305         # Index page is always safe to link to
306         return undef;
307         }
308 # Otherwise check if it appears to parse any args
309 local $data = &read_file_contents($mroot."/".$cgi);
310 if ($data =~ /(ReadParse|ReadParseMime)\(/) {
311         return "none";
312         }
313 return undef;
314 }
315
316 1;
317