#!/usr/bin/perl
# $Id: search,v 1.10 2006/12/07 04:59:38 reed%reedloden.com Exp $
# search -- Freetext search
#
# Arne Georg Gleditsch <argggh@ifi.uio.no>
# Per Kristian Gjermshus <pergj@ifi.uio.no>
#
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
######################################################################
use lib 'lib';
use Local;
use LXR::Common;
use LXR::Config;
$maxhits = 1000;
my ($openlist, $lastfilepath, $skip);
my $styles="
<style type='text/css'>";
my $stylee="</style>
";
sub toggle_style
{
my ($n, $m) = @_;
my $s=0; my $t=10;
my @inline = (), @none = ();
push @none, ".$m$s"."_".(($n-1 % $t) % 10);
push @inline, ".$m$s"."_".(($n % $t) % 10);
if (($n % $t) == 0) {
do {
$n = ($n / 10) | 0;
++$s;
if ($n % 10 == 0) {
push @none, ".$m$s"."_9";
push @inline, ".$m$s"."_0";
}
} while ($n>=10 && (($n % 10) == 0));
push @none, ".$m$s"."_".(($n -1) % 10);
push @inline, ".$m$s"."_".($n % 10);
}
return join(',',@none)."{display:none;}
".join(',',@inline)."{display:inline;}";
}
sub display_line
{
my ($glimpseline) = @_;
$sourceroot = $Conf->sourceroot;
$glimpseline =~ s/$sourceroot//;
($file, $line, $text) =
$glimpseline =~ /(.*?):\s*(\d+)\s*:(.*)/;
$text =~ s/&/&/g;
$text =~ s/</</g;
$text =~ s/>/>/g;
my $filepath='';
my $filename;
my $skip = $lastfilepath eq $file;
#$skip = 0;
$lastfilepath = $file;
if ($openlist && !$skip) {
$openlist = 0;
print ('</ul>');
}
($file,$filename)=split m|/(?!.*/)|, $file;
foreach my $filepart ($file =~ m{^/?$} ? ('') : split m|/|, $file) {
$filepath .= "$filepart/";
unless ($skip) {
print(&fileref($filepart ? $filepart : '/', "$filepath"),
$filepart && '/');
}
}
$filepath = $filepath ? $filepath . $filename : "/$filename";
unless ($skip) {
print(&fileref("$filename", "$filepath"));
print(&blamerefs($file.'/'.$filename));
}
unless ($skip) {
print ('<ul>');
$openlist = 1;
}
print ('<li>');
print(&fileref("line $line", "$filepath", $line),
" -- $text<br>\n");
}
sub search {
print(qq{<P ALIGN=CENTER>
Free-text search through the source code, including comments.
<BR>By default, this form treats all characters as literals.
<BR>Search strings can have a maximum of 29 characters.
<BR>Read the <A HREF="search-help.html">documentation</A>
for help with glimpse's regular expression syntax,
});
print qq%
<script>
function changetarget() {
if (document.getElementById) {
var form = document.getElementById('search');
var target = document.getElementById('tree');
form.action='../'+target.value+'/search';
}
}
function changefindpreset() {
if (document.getElementById) {
var find = document.getElementById('find');
var findi = document.getElementById('findi');
if (findi.selectedIndex > 0)
find.value = findi.value;
}
}
</script>
%;
print('<form name=search id=search method=get action="search">
<TABLE><TR><TD>');
foreach ($Conf->allvariables) {
if ($Conf->variable($_) ne $Conf->vardefault($_)) {
print('<input type=hidden name="',$_, '" ',
'value="', $Conf->variable($_), '">
');
}
}
$s = $searchtext;
$s =~ s/\&/\&/g;
$s =~ s/"/\"/g;
print('<B>Search for: </B></TD><TD><input type=text name="string" ',
'value="',$s,'" maxlength=29 size=30>
',
'<input type=submit value="search"><BR>
',
'</TD></TR><TR><TD></TD><TD>
',
'<input type="checkbox" name="regexp"');
if ($regexp) {
print (' CHECKED');
print (' value="on"');
}
print (">Regular Expression Search\n");
print '</td><tr><td><td><input type="checkbox" name="case"';
if ($search_sensitive) {
print (' CHECKED');
print (' value="on"');
}
print '>Case sensitive
';
my $value = $find;
$value =~ s/&/&/g;
$value =~ s/"/"/g;
$value =~ s/</</g;
$value =~ s/>/>/g;
print('</td><tr><td>in files matching:</td><td><input type=text id="find" name="find" value="'.
$value.'" size=30>');
if ($find_warning) {
print ' a suggestion was made by your browser, but it was ignored in favor of the provided string, if you empty the string and search again, it will be honored.';
}
print ' Suggestions from our users: ';
print('<select id="findi" name="findi" onchange="changefindpreset()">
<option value="">none of these</option>');
# this needs to move into Local.pm
@find_options = qw(
\.xul$
\.dtd$
\.po$
\.c
\.h$
\..$
\.x.l
\.idl$
\.css
\.htm
\.xml
\.js
\.rdf
\.in
debian/control
);
$findi = cleanFind($findi);
foreach my $find_opt (@find_options) {
my $find_default = ($find_opt eq $findi)
? ' selected="selected"' : '';
print "<option$find_default value='$find_opt'>$find_opt</option>
";
}
print '</select>
';
$value = $filter;
$value =~ s/&/&/g;
$value =~ s/"/"/g;
$value =~ s/</</g;
$value =~ s/>/>/g;
print('</td></tr><tr><td>Limit output to pattern:</td>
'. '<td><input type=text name="filter" value="'.
$value.'" size=30>');
print('</td></tr><tr><td>Limit matches per file to:</td>
'. '<td><input type=text name="hitlimit" value="'.
$hitlimit.'" size=10>');
print(qq{</td></tr><tr><td>
using tree:</td><td>
<select name='tree' id='tree' onchange='changetarget()'>
});
my @treelist = @{$Conf->{'trees'}};
foreach my $othertree (@treelist) {
my $default= $othertree eq $Conf->{'treename'}
? ' selected=1' : '';
print "<option$default value='$othertree'>$othertree</option>
";
}
print (qq{</select>});
print ("</TD></TR></TABLE>\n</form>\n\n");
$| = 1; print('');
if ($searchtext ne "") {
print("<hr>\n");
print("<p><i>Searching <a href='find?string=$find'>these files</a>.</i></p>") if $find;
my $displayedsearch = $searchtext;
if (!$regexp) {
$searchtext =~ s/([;,#><\-\$.^*[^|()\!])/\\$1/g;
}
@execparams = ($Conf->glimpsebin,"-i","-H",$Conf->dbdir,'-y','-n');
if ($find) {
$find =~ s/-/\\-/g;
push @execparams, ('-F', $find);
}
push @execparams, ('-e', $searchtext);
my $glimpsepid;
unless ($glimpsepid = open(GLIMPSE, "-|")) {
open(STDERR, ">&STDOUT");
$!='';
exec(@execparams);
print("Glimpse subprocess died unexpectedly: $!\n");
exit;
}
if (0) {
local $, = "\n";
print "<!--
@execparams;
-->";
}
$numlines = 0;
my $search_case = undef;
if ($search_sensitive) {
$search_case = $searchtext;
if (!$regexp) {
$search_case =~ s/([\$.\^|\(\){}+*?])/\\$1/g;
}
}
$searchtext = $displayedsearch;
$searchtext =~ s/&/&/g;
$searchtext =~ s/</</g;
$searchtext =~ s/>/>/g;
print("<h1>$searchtext</h1>\n");
my $hit_file_count = 0;
my $hit_for_current_file = 0;
my $prev_file;
print "$styles
.status.searching {display:block}
.status {display: none}
$stylee
<p><b>
<span class='status searching'>Searching... </span>
<span class='status error_toolong'>Pattern too long. Use a maximum 29 characters.</span>
<span class='status matches_zero'>No matching files</span>
<span class='status matches_one'>Found one matching line</span>
<span class='status matches_n'>Found
$styles
.m0, .m1, .m2, .f0, .f1, .f2, .matches_f {display:none}
.m0_2 {display:inline}
$stylee";
for (my $q1=3;$q1--;) {
for (my $r1=0;$r1<10;++$r1) {
print "<span class='m$q1 m$q1"."_$r1'>$r1</span>";
}
}
print " matching lines
<span class='status matches_f'> in ";
for (my $q=3;$q--;) {
for (my $r=0;$r<10;++$r) {
print "<span class='f$q f$q"."_$r'>$r</span>";
}
}
print " files</span></span>
<span class='status matches_max'>Too many hits, displaying the first $maxhits</span>
</b></p>
";
LINE: while (my $line = <GLIMPSE>) {
next if $line =~ m|using working-directory '.*' to locate dictionaries|;
next if $search_sensitive && $line !~ /$search_case/;
if (!$filter || $line =~ /$filter/){
my ($curr_file, undef, undef) =
$line =~ /(.*?):\s*(\d+)\s*:(.*)/;
my $lstyle = '';
if ($prev_file ne $curr_file) {
$prev_file = $curr_file;
$hit_for_current_file = 1;
++$hit_file_count;
if ($hit_file_count == 2) {
$lstyle .= ".matches_f {display: inline;}";
}
$lstyle .= toggle_style($hit_file_count, 'f');
} elsif (defined $hitlimit &&
++$hit_for_current_file > $hitlimit) {
next LINE;
}
$numlines++;
if ($numlines == 1) {
$lstyle .= ".status.matches_one {display: block}
";
} elsif ($numlines == 2) {
$lstyle .= ".status.matches_one {display: none}
.status.matches_n {display: block}
";
} else {
$lstyle .= toggle_style($numlines, 'm');
}
if ($numlines > $maxhits) {
$lstyle .= ".status.matches_n {display: none}
.status.matches_max {display: block}";
}
if ($lstyle) {
print "$styles$lstyle$stylee";
}
display_line($line);
if ($numlines > $maxhits) {
last;
}
}
}
my $none = $numlines == 0 ? '.status.matches_zero {display: block}' : '';
print "$styles $none
.status.searching {display: none}
</style>";
print ('</ul>') if $openlist;
print "<p>";
if ($numlines < 5) {
close(GLIMPSE);
$retval = $? >> 8;
} else {
kill 15, $glimpsepid;
$retval = 0;
}
# The manpage for glimpse says that it returns 2 on syntax errors or
# inaccessible files. It seems this is not the case.
# We will have to work around it for the time being.
if ($retval == 0) {
if ($numlines == 0) {
print("No matching files<br>\n");
} elsif ($glimpselines[0] =~ /pattern too long/) {
print ("Pattern too long. Use a maximum 29 characters.\n");
} else {
if ($numlines > $maxhits) {
print("<b>Too many hits, displaying the first $maxhits</b><br>\n");
} else {
if ($numlines == 1) {
print("<b>Found one matching line</b><br>\n");
} else {
my $match_count = $hitlimit != 1
? " $numlines"
: '';
my $in_files = $hit_file_count > 1
? " in $hit_file_count files"
: '';
print("<b>Found$match_count matching lines$in_files</b><br>\n");
}
}
$openlist = 0;
foreach $glimpseline (@glimpselines) {
display_line($glimpseline);
}
print ('</ul>') if $openlist;
}
} elsif ($retval == 1) {
$glimpsebin = $Conf->glimpsebin;
$glimpseresponse = join("<br>",@glimpselines);
$glimpseresponse =~ s/$glimpsebin/Reason/;
$glimpseresponse =~ s/glimpse: error in searching index//;
print("<b>No results found</b><br>\n$glimpseresponse");
} else {
print("Unexpected return value $retval from Glimpse\n");
}
}
}
($Conf, $HTTP, $Path, $head) = &glimpse_init;
$searchtext = $HTTP->{'param'}->{'string'};
$regexp = $HTTP->{'param'}->{'regexp'} || $Conf->{'regexp'};
$regexp = $regexp =~ /1|on|yes/ ? 1 : '';
$find = $HTTP->{'param'}->{'find'};
$findi = $HTTP->{'param'}->{'findi'};
$search_sensitive = defined $HTTP->{'param'}->{'case'} ? $HTTP->{'param'}->{'case'} =~ /1|on|yes/ : '';
$filter = $HTTP->{'param'}->{'filter'};
$hitlimit = cleanHitlimit($HTTP->{'param'}->{'hitlimit'}) || undef;
sub cleanFilter
{
my $filter = shift;
$filter =~ s|\+| |g;
$filter =~ s|%5B|[|gi;
$filter =~ s|%5D|]|gi;
$filter =~ s|%5E|^|gi;
$filter =~ s|%2B|+|gi;
$filter =~ s|%2A|*|gi;
$filter =~ s|%21|!|g;
$filter =~ s|%28|(|g;
$filter =~ s|%29|)|g;
$filter =~ s|%3F|?|gi;
$filter =~ s{%24}{\$}g;
$filter =~ s|%40|\\@|g;
$filter =~ s/%7C/|/gi;
return $filter;
}
$filter = cleanFilter($filter);
$filter = $HTTP->{'param'}->{'filter'};
$filter =~ tr/+/ /;
$filter =~ s/%(\w\w)/chr(hex $1)/ge;
$filter =~ s/`//g;
sub cleanHitlimit {
my $hitLimit = shift;
$hitLimit =~ s/^.*?(\d*).*$/$1/;
return $hitLimit;
}
$find_warning = 0;
if (defined $findi && $findi ne '') {
if (defined $find && $find ne '') {
$find_warning = $find ne $findi;
} else {
#$find = $findi;
}
}
sub cleanFind {
my $find = shift;
$find =~ s/["`'<>|()]+//g;
$find =~ s|%2f|/|gi;
$find =~ s|%24|\$|g;
$find =~ s|%5c|\\|gi;
$find =~ s|%2a|*|gi;
return $find;
}
$find = cleanFind($find);
$searchtext =~ tr/+/ /;
$searchtext =~ s/%(\w\w)/chr(hex $1)/ge;
my $tree = $HTTP->{'param'}->{'tree'};
if ($tree && ($tree ne $Conf->{'treename'})) {
my @treelist = @{$Conf->{'trees'}};
foreach my $othertree (@treelist) {
next unless $othertree eq $tree;
push @tail, "string=$searchtext" if $searchtext ne '';
push @tail, "regexp=$regexp" if $regexp ne '';
push @tail, "case=$search_sensitive" if $search_sensitive ne '';
push @tail, "find=$find" if $find ne '';
push @tail, "findi=$findi" if $findi ne '';
push @tail, "filter=$filter" if $filter ne '';
push @tail, "hitlimit=$hitlimit" if $hitlimit ne '';
my $tail = $#tail >= 0 ? '?' . join "&", @tail : '';
$head .= "Refresh: 0; url=../$tree/search$tail
";
}
}
print "$head
";
&makeheader('search');
&search;
&makefooter('search');
1;
