cgi/search.cgi

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 # Hack to work on merkel where suexec is in place
   7 BEGIN{
   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";
  11      }
  12 }
  13
  14
  15 use CGI::Simple;
  16
  17 use CGI::Alert 'don@donarmstrong.com';
  18
  19 use Search::Estraier;
  20 use Debbugs::Config qw(:config);
  21 use Debbugs::Estraier;
  22 use Debbugs::CGI qw(htmlize_packagelinks html_escape);
  23 use HTML::Entities qw(encode_entities);
  24
  25 my $q = new CGI::Simple;
  26
  27 #my %var_defaults = (attr => 1,);
  28
  29 my %cgi_var = cgi_parameters($q);
  30
  31 $cgi_var{phrase} = '' if not defined $cgi_var{phrase};
  32 $cgi_var{max_results} = 10 if not defined $cgi_var{max_results};
  33 $cgi_var{attribute} = parse_attribute(\%cgi_var) || [];
  34 $cgi_var{skip} = 0 if not defined $cgi_var{skip};
  35
  36 my @results;
  37
  38 if (defined $cgi_var{next}) {
  39      $cgi_var{search} = 1;
  40      $cgi_var{skip} += $cgi_var{max_results};
  41 }
  42 elsif (defined $cgi_var{prev}) {
  43      $cgi_var{search} = 1;
  44      $cgi_var{skip} -= $cgi_var{max_results};
  45      $cgi_var{skip} = 0 if $cgi_var{skip} < 0;
  46 }
  47
  48 my $nres;
  49 if (defined $cgi_var{search} and length $cgi_var{phrase}) {
  50      # connect to a node if we need to
  51      my $node =  new Search::Estraier::Node (url    => $config{search_estraier}{url},
  52                                              user   => $config{search_estraier}{user},
  53                                              passwd => $config{search_estraier}{pass},
  54                                              croak_on_error => 1,
  55                                             ) or die "Unable to connect to the node";
  56      my $cond = new Search::Estraier::Condition;
  57      $cond->set_phrase($cgi_var{phrase});
  58      if (defined $cgi_var{order_field} and length $cgi_var{order_field} and
  59          defined $cgi_var{order_operator} and length $cgi_var{order_operator}) {
  60           $cond->set_order($cgi_var{order_field}.' '.$cgi_var{order_operator});
  61      }
  62      foreach my $attribute (@{$cgi_var{attribute}}) {
  63           if (defined $$attribute{field} and defined $$attribute{value} and
  64               defined $$attribute{operator} and length $$attribute{value}) {
  65                $cond->add_attr(join(' ',map {$$attribute{$_}} qw(field operator value)));
  66           }
  67      }
  68      $cond->set_skip($cgi_var{skip}) if defined $cgi_var{skip} and $cgi_var{skip} =~ /(\d+)/;
  69      $cond->set_max($cgi_var{max_results}) if defined $cgi_var{max_results} and $cgi_var{max_results} =~ /^\d+$/;
  70      print STDERR "skip: ".$cond->skip()."\n";
  71      print STDERR $node->cond_to_query($cond),qq(\n);
  72      $nres = $node->search($cond,0) or
  73           die "Unable to search for condition";
  74
  75 }
  76 elsif (defined $cgi_var{add_attribute} and length $cgi_var{add_attribute}) {
  77      push @{$cgi_var{attribute}}, {value => ''};
  78 }
  79 elsif (grep /^delete_attribute_\d+$/, keys %cgi_var) {
  80      foreach my $delete_key (sort {$b <=> $a} map {/^delete_attribute_(\d+)$/?($1):()} keys %cgi_var) {
  81           splice @{$cgi_var{attribute}},$delete_key,1;
  82      }
  83 }
  84
  85 my $url = 'http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=';
  86
  87 print <<END;
  88 Content-Type: text/html
  89
  90
  91 <HTML><HEAD><TITLE>BTS Search</TITLE>
  92 <link rel="stylesheet" href="http://bugs.debian.org/css/bugs.css" type="text/css">
  93 </HEAD>
  94 <BODY>
  95 <FORM>
  96 <table class="forms">
  97 <tr><td>
  98 <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" />
  99 <input type="submit" name="search" value="search" title="Perform the search" tabindex="8" accesskey="f" />
 100 <input type="hidden" name="skip" value="$cgi_var{skip}"></p>
 101 END
 102
 103 # phrase
 104 # attributes
 105 # NUMEQ : is equal to the number or date
 106 # NUMNE : is not equal to the number or date
 107 # NUMGT : is greater than the number or date
 108 # NUMGE : is greater than or equal to the number or date
 109 # NUMLT : is less than the number or date
 110 # NUMLE : is less than or equal to the number or date
 111 # NUMBT : is between the two numbers or dates
 112 my @num_operators = (NUMEQ => 'equal to',
 113                      NUMNE => 'not equal to',
 114                      NUMGT => 'greater than',
 115                      NUMGE => 'greater than or equal to',
 116                      NUMLT => 'less than',
 117                      NUMLE => 'less than or equal to',
 118                      NUMBT => 'between',
 119                     );
 120
 121 # STREQ : is equal to the string
 122 # STRNE : is not equal to the string
 123 # STRINC : includes the string
 124 # STRBW : begins with the string
 125 # STREW : ends with the string
 126 # STRAND : includes all tokens in the string
 127 # STROR : includes at least one token in the string
 128 # STROREQ : is equal to at least one token in the string
 129 # STRRX : matches regular expressions of the string
 130 my @str_operators = (STREQ   => 'equal to',
 131                      STRNE   => 'not equal to',
 132                      STRINC  => 'includes',
 133                      STRBW   => 'begins with',
 134                      STREW   => 'ends with',
 135                      STRAND  => 'includes all tokens',
 136                      STROR   => 'includes at least one token',
 137                      STROREQ => 'is equal to at least one token',
 138                      STRRX   => 'matches regular expression',
 139                     );
 140
 141 my @attributes_order = ('@cdate','@title','@author',
 142                         qw(status subject date submitter package tags severity),
 143                        );
 144 my %attributes = ('@cdate'  => {name => 'Date',
 145                                 type      => 'num',
 146                                },
 147                   '@title'  => {name => 'Message subject',
 148                                 type      => 'str',
 149                                },
 150                   '@author' => {name => 'Author',
 151                                 type      => 'str',
 152                                },
 153                   status    => {name => 'Status',
 154                                 type      => 'str',
 155                                },
 156                   subject   => {name => 'Bug Title',
 157                                 type      => 'num',
 158                                },
 159                   date      => {name => 'Submission date',
 160                                 type      => 'num',
 161                                },
 162                   submitter => {name => 'Bug Submitter',
 163                                 type      => 'str',
 164                                },
 165                   package   => {name => 'Package',
 166                                 type      => 'str',
 167                                },
 168                   tags      => {name => 'Tags',
 169                                 type      => 'str',
 170                                },
 171                   severity  => {name => 'Severity',
 172                                 type      => 'str',
 173                                },
 174                  );
 175 my $attr_num = 0;
 176 print qq(<p>Attributes:</p>\n);
 177 for my $attribute (@{$cgi_var{attribute}}) {
 178      print qq(<select name="attribute_field">\n);
 179      foreach my $attr (keys %attributes) {
 180           my $selected = (defined $$attribute{field} and $$attribute{field} eq $attr) ? ' selected' : '';
 181           print qq(<option value="$attr"$selected>$attributes{$attr}{name}</option>\n);
 182      }
 183      print qq(</select>\n);
 184      print qq(<select name="attribute_operator">\n);
 185      my $operator;
 186      my $name;
 187      my @tmp_array = (@num_operators,@str_operators);
 188      while (($operator,$name) = splice(@tmp_array,0,2)) {
 189           my $type = $operator =~ /^NUM/ ? 'Number' : 'String';
 190           my $selected = (defined $$attribute{operator} and $$attribute{operator} eq $operator) ? 'selected' : '';
 191           print qq(<option value="$operator"$selected>$name ($type)</option>\n);
 192      }
 193      print qq(</select>\n);
 194      $$attribute{value}='' if not defined $$attribute{value};
 195      print qq(<input type="text" name="attribute_value" value="$$attribute{value}"><input type="submit" name="delete_attribute_$attr_num" value="Delete"><br/>\n);
 196      $attr_num++;
 197
 198 }
 199 print qq(<input type="submit" name="add_attribute" value="Add Attribute"><br/>);
 200
 201 # order
 202
 203 # STRA : ascending by string
 204 # STRD : descending by string
 205 # NUMA : ascending by number or date
 206 # NUMD : descending by number or date
 207
 208 my @order_operators = (STRA => 'ascending (string)',
 209                        STRD => 'descending (string)',
 210                        NUMA => 'ascending (number or date)',
 211                        NUMD => 'descending (number or date)',
 212                       );
 213
 214 print qq(<p>Order by: <select name="order_field">\n);
 215 print qq(<option value="">Default</option>);
 216 foreach my $attr (keys %attributes) {
 217      my $selected = (defined $cgi_var{order_field} and $cgi_var{order_field} eq $attr) ? ' selected' : '';
 218      print qq(<option value="$attr"$selected>$attributes{$attr}{name}</option>\n);
 219 }
 220 print qq(</select>\n);
 221 print qq(<select name="order_operator">\n);
 222 my $operator;
 223 my $name;
 224 my @tmp_array = (@order_operators);
 225 while (($operator,$name) = splice(@tmp_array,0,2)) {
 226      my $selected = (defined $cgi_var{order_field} and $cgi_var{order_operator} eq $operator) ? ' selected' : '';
 227      print qq(<option value="$operator"$selected>$name</option>\n);
 228 }
 229 print qq(</select></p>\n);
 230
 231 # max results
 232
 233 print qq(<p>Max results: <select name="max_results">\n);
 234 for my $max_results (qw(10 25 50 100 150 200)) {
 235      my $selected = (defined $cgi_var{max_results} and $cgi_var{max_results} eq $max_results) ? ' selected' : '';
 236      print qq(<option value="$max_results"$selected>$max_results</optiion>\n);
 237 }
 238 print qq(</select></p>\n);
 239
 240 print qq(</tr></td></table>\n);
 241
 242
 243
 244 if (defined $nres) {
 245      print "<h2> Results</h2>\n";
 246      my $hits = $nres->hits();
 247      print "<p>Hits: ".$hits;
 248      if (($cgi_var{skip} > 0)) {
 249           print q(<input type="submit" name="prev" value="Prev">);
 250      }
 251      if ($hits > ($cgi_var{skip}+$cgi_var{max_results})) {
 252           print q(<input type="submit" name="next" value="Next">);
 253      }
 254      print "</p>\n";
 255      print qq(<ul class="msgreceived">\n);
 256      for my $rdoc (map {$nres->get_doc($_)} 0.. ($nres->doc_num-1)) {
 257           my ($bugnum,$msgnum) = split m#/#,$rdoc->attr('@uri');
 258           my %attr = map {($_,$rdoc->attr($_))} $rdoc->attr_names;
 259           # initialize any missing variables
 260           for my $var ('@title','@author','@cdate','package','severity') {
 261                $attr{$var} = '' if not defined $attr{$var};
 262           }
 263           my $showseverity;
 264           $showseverity = "Severity: <em>$attr{severity}</em>;\n";
 265           print <<END;
 266 <li><a href="$url${bugnum}#${msgnum}">#${bugnum}: $attr{'@title'}</a> @{[htmlize_packagelinks($attr{package})]}<br/>
 267 $showseverity<br/>
 268 Sent by: @{[encode_entities($attr{'@author'})]} at $attr{'@cdate'}<br/>
 269 END
 270           # Deal with the snippet
 271           # make the things that match bits of the phrase bold, the rest normal.
 272           my $snippet_mod = html_escape($attr{snippet});
 273           $snippet_mod =~ s/\n\n/&nbsp;&nbsp;. . .&nbsp;&nbsp;/g;
 274           for my $phrase_bits (split /\s+/,$cgi_var{phrase}) {
 275                $snippet_mod =~ s{\n(\Q$phrase_bits\E)(?:\s+\Q$phrase_bits\E\n)}{'<b>'.$1.'</b>'}gei;
 276           }
 277           print "<p>$snippet_mod</p>\n";
 278      }
 279      print "</ul>\n<p>";
 280      if (($cgi_var{skip} > 0)) {
 281           print q(<input type="submit" name="prev" value="Prev">);
 282      }
 283      if ($hits > ($cgi_var{skip}+$cgi_var{max_results})) {
 284           print q(<input type="submit" name="next" value="Next">);
 285      }
 286      print "</p>\n";
 287
 288 }
 289
 290 print "</form>\n";
 291
 292 # This CGI should make an abstract method of displaying information
 293 # about specific bugs and their messages; the information should be
 294 # fairly similar to the way that pkgreport.cgi works, with the
 295 # addition of snippit information and links to ajavapureapi/overview-summary.html specific message
 296 # within the bug.
 297
 298 # For now we'll brute force the display, but methods to display a bug
 299 # or a particular bug message should be made common between the two
 300 # setups
 301
 302
 303 sub parse_attribute {
 304      my ($cgi_var) = @_;
 305
 306      my @attributes = ();
 307      if (ref $$cgi_var{attribute_operator}) {
 308           for my $elem (0 ... $#{$$cgi_var{attribute_operator}}) {
 309                push @attributes,{map {($_,$$cgi_var{"attribute_$_"}[$elem]);} qw(value field operator)};
 310           }
 311      }
 312      elsif (defined $$cgi_var{attribute_operator}) {
 313           push @attributes,{map {($_,$$cgi_var{"attribute_$_"});} qw(value field operator)};
 314      }
 315      return \@attributes;
 316 }
 317
 318
 319 sub cgi_parameters {
 320      my ($q) = @_;
 321
 322      my %param;
 323      foreach my $paramname ($q->param) {
 324           my @value = $q->param($paramname);
 325           $param{$paramname} = @value > 1 ? [@value] : $value[0];
 326      }
 327      return %param;
 328 }