6 # Hack to work on merkel where suexec is in place
8 if ($ENV{HTTP_HOST} eq 'merkel.debian.org') {
9 unshift @INC, qw(/home/don/perl/usr/share/perl5 /home/don/perl/usr/lib/perl5 /home/don/source);
10 $ENV{DEBBUGS_CONFIG_FILE}="/home/don/config_internal";
14 # if we're running out of git, we want to use the git base directory as the
15 # first INC directory. If you're not running out of git, don't do that.
16 use File::Basename qw(dirname);
21 abs_path(dirname(abs_path(__FILE__)) . '/../');
22 # clear the taint; we'll assume that the absolute path to __FILE__ is the
23 # right path if there's a .git directory there
24 ($debbugs_dir) = $debbugs_dir =~ /([[:print:]]+)/;
25 if (defined $debbugs_dir and
26 -d $debbugs_dir . '/.git/') {
30 # if the first directory in @INC is not an absolute directory, assume that
31 # someone has overridden us via -I.
32 if ($INC[0] !~ /^\//) {
35 use if defined $debbugs_dir, lib => $debbugs_dir;
40 # use CGI::Alert 'nobody@example.com';
43 use Debbugs::Config qw(:config);
44 use Debbugs::Estraier;
45 use Debbugs::CGI qw(htmlize_packagelinks html_escape cgi_parameters);
46 use HTML::Entities qw(encode_entities);
48 my $q = new CGI::Simple;
50 #my %var_defaults = (attr => 1,);
52 my %cgi_var = cgi_parameters(query => $q,
53 single => [qw(phrase max_results order_field order_operator),
56 default => {phrase => '',
62 $cgi_var{attribute} = parse_attribute(\%cgi_var) || [];
66 if (defined $cgi_var{next}) {
68 $cgi_var{skip} += $cgi_var{max_results};
70 elsif (defined $cgi_var{prev}) {
72 $cgi_var{skip} -= $cgi_var{max_results};
73 $cgi_var{skip} = 0 if $cgi_var{skip} < 0;
77 if (defined $cgi_var{search} and length $cgi_var{phrase}) {
78 # connect to a node if we need to
79 my $node = new Search::Estraier::Node (url => $config{search_estraier}{url},
80 user => $config{search_estraier}{user},
81 passwd => $config{search_estraier}{pass},
83 ) or die "Unable to connect to the node";
84 my $cond = new Search::Estraier::Condition;
85 $cond->set_phrase($cgi_var{phrase});
86 if (defined $cgi_var{order_field} and length $cgi_var{order_field} and
87 defined $cgi_var{order_operator} and length $cgi_var{order_operator}) {
88 $cond->set_order($cgi_var{order_field}.' '.$cgi_var{order_operator});
90 foreach my $attribute (@{$cgi_var{attribute}}) {
91 if (defined $$attribute{field} and defined $$attribute{value} and
92 defined $$attribute{operator} and length $$attribute{value}) {
93 $cond->add_attr(join(' ',map {$$attribute{$_}} qw(field operator value)));
96 $cond->set_skip($cgi_var{skip}) if defined $cgi_var{skip} and $cgi_var{skip} =~ /(\d+)/;
97 $cond->set_max($cgi_var{max_results}) if defined $cgi_var{max_results} and $cgi_var{max_results} =~ /^\d+$/;
98 print STDERR "skip: ".$cond->skip()."\n";
99 print STDERR $node->cond_to_query($cond),qq(\n);
100 $nres = $node->search($cond,0) or
101 die "Unable to search for condition";
104 elsif (defined $cgi_var{add_attribute} and length $cgi_var{add_attribute}) {
105 push @{$cgi_var{attribute}}, {value => ''};
107 elsif (grep /^delete_attribute_\d+$/, keys %cgi_var) {
108 foreach my $delete_key (sort {$b <=> $a} map {/^delete_attribute_(\d+)$/?($1):()} keys %cgi_var) {
109 splice @{$cgi_var{attribute}},$delete_key,1;
113 my $url = 'http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=';
116 Content-Type: text/html
119 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
120 <HTML><HEAD><TITLE>BTS Search</TITLE>
121 <link rel="stylesheet" href="http://bugs.debian.org/css/bugs.css" type="text/css">
125 <table class="forms">
127 <p>Phrase: <input type="text" name="phrase" value="$cgi_var{phrase}" size="80" id="phrase" title="Input some words for full-text search" tabindex="1" accesskey="a" />
128 <input type="submit" name="search" value="search" title="Perform the search" tabindex="8" accesskey="f" />
129 <input type="hidden" name="skip" value="$cgi_var{skip}"></p>
134 # NUMEQ : is equal to the number or date
135 # NUMNE : is not equal to the number or date
136 # NUMGT : is greater than the number or date
137 # NUMGE : is greater than or equal to the number or date
138 # NUMLT : is less than the number or date
139 # NUMLE : is less than or equal to the number or date
140 # NUMBT : is between the two numbers or dates
141 my @num_operators = (NUMEQ => 'equal to',
142 NUMNE => 'not equal to',
143 NUMGT => 'greater than',
144 NUMGE => 'greater than or equal to',
145 NUMLT => 'less than',
146 NUMLE => 'less than or equal to',
150 # STREQ : is equal to the string
151 # STRNE : is not equal to the string
152 # STRINC : includes the string
153 # STRBW : begins with the string
154 # STREW : ends with the string
155 # STRAND : includes all tokens in the string
156 # STROR : includes at least one token in the string
157 # STROREQ : is equal to at least one token in the string
158 # STRRX : matches regular expressions of the string
159 my @str_operators = (STREQ => 'equal to',
160 STRNE => 'not equal to',
161 STRINC => 'includes',
162 STRBW => 'begins with',
163 STREW => 'ends with',
164 STRAND => 'includes all tokens',
165 STROR => 'includes at least one token',
166 STROREQ => 'is equal to at least one token',
167 STRRX => 'matches regular expression',
170 my @attributes_order = ('@cdate','@title','@author',
171 qw(status subject date submitter package tags severity),
173 my %attributes = ('@cdate' => {name => 'Date',
176 '@title' => {name => 'Message subject',
179 '@author' => {name => 'Author',
182 status => {name => 'Status',
185 subject => {name => 'Bug Title',
188 date => {name => 'Submission date',
191 submitter => {name => 'Bug Submitter',
194 package => {name => 'Package',
197 tags => {name => 'Tags',
200 severity => {name => 'Severity',
205 print qq(<p>Attributes:</p>\n);
206 for my $attribute (@{$cgi_var{attribute}}) {
207 print qq(<select name="attribute_field">\n);
208 foreach my $attr (keys %attributes) {
209 my $selected = (defined $$attribute{field} and $$attribute{field} eq $attr) ? ' selected' : '';
210 print qq(<option value="$attr"$selected>$attributes{$attr}{name}</option>\n);
212 print qq(</select>\n);
213 print qq(<select name="attribute_operator">\n);
216 my @tmp_array = (@num_operators,@str_operators);
217 while (($operator,$name) = splice(@tmp_array,0,2)) {
218 my $type = $operator =~ /^NUM/ ? 'Number' : 'String';
219 my $selected = (defined $$attribute{operator} and $$attribute{operator} eq $operator) ? 'selected' : '';
220 print qq(<option value="$operator"$selected>$name ($type)</option>\n);
222 print qq(</select>\n);
223 $$attribute{value}='' if not defined $$attribute{value};
224 print qq(<input type="text" name="attribute_value" value="$$attribute{value}"><input type="submit" name="delete_attribute_$attr_num" value="Delete"><br>\n);
228 print qq(<input type="submit" name="add_attribute" value="Add Attribute"><br>);
232 # STRA : ascending by string
233 # STRD : descending by string
234 # NUMA : ascending by number or date
235 # NUMD : descending by number or date
237 my @order_operators = (STRA => 'ascending (string)',
238 STRD => 'descending (string)',
239 NUMA => 'ascending (number or date)',
240 NUMD => 'descending (number or date)',
243 print qq(<p>Order by: <select name="order_field">\n);
244 print qq(<option value="">Default</option>);
245 foreach my $attr (keys %attributes) {
246 my $selected = (defined $cgi_var{order_field} and $cgi_var{order_field} eq $attr) ? ' selected' : '';
247 print qq(<option value="$attr"$selected>$attributes{$attr}{name}</option>\n);
249 print qq(</select>\n);
250 print qq(<select name="order_operator">\n);
253 my @tmp_array = (@order_operators);
254 while (($operator,$name) = splice(@tmp_array,0,2)) {
255 my $selected = (defined $cgi_var{order_field} and $cgi_var{order_operator} eq $operator) ? ' selected' : '';
256 print qq(<option value="$operator"$selected>$name</option>\n);
258 print qq(</select></p>\n);
262 print qq(<p>Max results: <select name="max_results">\n);
263 for my $max_results (qw(10 25 50 100 150 200)) {
264 my $selected = (defined $cgi_var{max_results} and $cgi_var{max_results} eq $max_results) ? ' selected' : '';
265 print qq(<option value="$max_results"$selected>$max_results</option>\n);
267 print qq(</select></p>\n);
269 print qq(</tr></table>\n);
274 print "<h2> Results</h2>\n";
275 my $hits = $nres->hits();
276 print "<p>Hits: ".$hits;
277 if (($cgi_var{skip} > 0)) {
278 print q(<input type="submit" name="prev" value="Prev">);
280 if ($hits > ($cgi_var{skip}+$cgi_var{max_results})) {
281 print q(<input type="submit" name="next" value="Next">);
284 print qq(<ul class="msgreceived">\n);
285 for my $rdoc (map {$nres->get_doc($_)} 0.. ($nres->doc_num-1)) {
286 my ($bugnum,$msgnum) = split m#/#,$rdoc->attr('@uri');
287 my %attr = map {($_,$rdoc->attr($_))} $rdoc->attr_names;
288 # initialize any missing variables
289 for my $var ('@title','@author','@cdate','package','severity') {
290 $attr{$var} = '' if not defined $attr{$var};
293 $showseverity = "Severity: <em>$attr{severity}</em>;\n";
295 <li><a href="$url${bugnum}#${msgnum}">#${bugnum}: $attr{'@title'}</a> @{[htmlize_packagelinks($attr{package})]}<br>
297 Sent by: @{[encode_entities($attr{'@author'})]} at $attr{'@cdate'}<br>
299 # Deal with the snippet
300 # make the things that match bits of the phrase bold, the rest normal.
301 my $snippet_mod = html_escape($attr{snippet});
302 $snippet_mod =~ s/\n\n/ . . . /g;
303 for my $phrase_bits (split /\s+/,$cgi_var{phrase}) {
304 $snippet_mod =~ s{\n(\Q$phrase_bits\E)(?:\s+\Q$phrase_bits\E\n)}{'<b>'.$1.'</b>'}gei;
306 print "<p>$snippet_mod</p>\n";
309 if (($cgi_var{skip} > 0)) {
310 print q(<input type="submit" name="prev" value="Prev">);
312 if ($hits > ($cgi_var{skip}+$cgi_var{max_results})) {
313 print q(<input type="submit" name="next" value="Next">);
321 # This CGI should make an abstract method of displaying information
322 # about specific bugs and their messages; the information should be
323 # fairly similar to the way that pkgreport.cgi works, with the
324 # addition of snippit information and links to ajavapureapi/overview-summary.html specific message
327 # For now we'll brute force the display, but methods to display a bug
328 # or a particular bug message should be made common between the two
332 sub parse_attribute {
336 if (ref $$cgi_var{attribute_operator}) {
337 for my $elem (0 ... $#{$$cgi_var{attribute_operator}}) {
338 push @attributes,{map {($_,$$cgi_var{"attribute_$_"}[$elem]);} qw(value field operator)};
341 elsif (defined $$cgi_var{attribute_operator}) {
342 push @attributes,{map {($_,$$cgi_var{"attribute_$_"});} qw(value field operator)};