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 # 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);
  17 use Cwd qw(abs_path);
  18 our $debbugs_dir;
  19 BEGIN {
  20     $debbugs_dir =
  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/') {
  27     } else {
  28         undef $debbugs_dir;
  29     }
  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] !~ /^\//) {
  33     }
  34 }
  35 use if defined $debbugs_dir, lib => $debbugs_dir.'/lib/';
  36
  37
  38 use CGI::Simple;
  39
  40 # use CGI::Alert 'nobody@example.com';
  41
  42 use Search::Estraier;
  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);
  47
  48 my $q = new CGI::Simple;
  49
  50 #my %var_defaults = (attr => 1,);
  51
  52 my %cgi_var = cgi_parameters(query => $q,
  53                              single => [qw(phrase max_results order_field order_operator),
  54                                         qw(skip prev next),
  55                                        ],
  56                              default => {phrase      => '',
  57                                          max_results => 10,
  58                                          skip        => 0,
  59                                         },
  60                             );
  61
  62 $cgi_var{attribute} = parse_attribute(\%cgi_var) || [];
  63
  64 my @results;
  65
  66 if (defined $cgi_var{next}) {
  67      $cgi_var{search} = 1;
  68      $cgi_var{skip} += $cgi_var{max_results};
  69 }
  70 elsif (defined $cgi_var{prev}) {
  71      $cgi_var{search} = 1;
  72      $cgi_var{skip} -= $cgi_var{max_results};
  73      $cgi_var{skip} = 0 if $cgi_var{skip} < 0;
  74 }
  75
  76 my $nres;
  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},
  82                                              croak_on_error => 1,
  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});
  89      }
  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)));
  94           }
  95      }
  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";
 102
 103 }
 104 elsif (defined $cgi_var{add_attribute} and length $cgi_var{add_attribute}) {
 105      push @{$cgi_var{attribute}}, {value => ''};
 106 }
 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;
 110      }
 111 }
 112
 113 my $url = 'http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=';
 114
 115 print <<END;
 116 Content-Type: text/html
 117
 118
 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">
 122 </HEAD>
 123 <BODY>
 124 <FORM>
 125 <table class="forms">
 126 <tr><td>
 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>
 130 END
 131
 132 # phrase
 133 # attributes
 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',
 147                      NUMBT => 'between',
 148                     );
 149
 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',
 168                     );
 169
 170 my @attributes_order = ('@cdate','@title','@author',
 171                         qw(status subject date submitter package tags severity),
 172                        );
 173 my %attributes = ('@cdate'  => {name => 'Date',
 174                                 type      => 'num',
 175                                },
 176                   '@title'  => {name => 'Message subject',
 177                                 type      => 'str',
 178                                },
 179                   '@author' => {name => 'Author',
 180                                 type      => 'str',
 181                                },
 182                   status    => {name => 'Status',
 183                                 type      => 'str',
 184                                },
 185                   subject   => {name => 'Bug Title',
 186                                 type      => 'str',
 187                                },
 188                   date      => {name => 'Submission date',
 189                                 type      => 'num',
 190                                },
 191                   submitter => {name => 'Bug Submitter',
 192                                 type      => 'str',
 193                                },
 194                   package   => {name => 'Package',
 195                                 type      => 'str',
 196                                },
 197                   tags      => {name => 'Tags',
 198                                 type      => 'str',
 199                                },
 200                   severity  => {name => 'Severity',
 201                                 type      => 'str',
 202                                },
 203                  );
 204 my $attr_num = 0;
 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);
 211      }
 212      print qq(</select>\n);
 213      print qq(<select name="attribute_operator">\n);
 214      my $operator;
 215      my $name;
 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);
 221      }
 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);
 225      $attr_num++;
 226
 227 }
 228 print qq(<input type="submit" name="add_attribute" value="Add Attribute"><br>);
 229
 230 # order
 231
 232 # STRA : ascending by string
 233 # STRD : descending by string
 234 # NUMA : ascending by number or date
 235 # NUMD : descending by number or date
 236
 237 my @order_operators = (STRA => 'ascending (string)',
 238                        STRD => 'descending (string)',
 239                        NUMA => 'ascending (number or date)',
 240                        NUMD => 'descending (number or date)',
 241                       );
 242
 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);
 248 }
 249 print qq(</select>\n);
 250 print qq(<select name="order_operator">\n);
 251 my $operator;
 252 my $name;
 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);
 257 }
 258 print qq(</select></p>\n);
 259
 260 # max results
 261
 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);
 266 }
 267 print qq(</select></p>\n);
 268
 269 print qq(</tr></table>\n);
 270
 271
 272
 273 if (defined $nres) {
 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">);
 279      }
 280      if ($hits > ($cgi_var{skip}+$cgi_var{max_results})) {
 281           print q(<input type="submit" name="next" value="Next">);
 282      }
 283      print "</p>\n";
 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};
 291           }
 292           my $showseverity;
 293           $showseverity = "Severity: <em>$attr{severity}</em>;\n";
 294           print <<END;
 295 <li><a href="$url${bugnum}#${msgnum}">#${bugnum}: $attr{'@title'}</a> @{[htmlize_packagelinks($attr{package})]}<br>
 296 $showseverity<br>
 297 Sent by: @{[encode_entities($attr{'@author'})]} at $attr{'@cdate'}<br>
 298 END
 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/&nbsp;&nbsp;. . .&nbsp;&nbsp;/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;
 305           }
 306           print "<p>$snippet_mod</p>\n";
 307      }
 308      print "</ul>\n<p>";
 309      if (($cgi_var{skip} > 0)) {
 310           print q(<input type="submit" name="prev" value="Prev">);
 311      }
 312      if ($hits > ($cgi_var{skip}+$cgi_var{max_results})) {
 313           print q(<input type="submit" name="next" value="Next">);
 314      }
 315      print "</p>\n";
 316
 317 }
 318
 319 print "</form>\n";
 320
 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
 325 # within the bug.
 326
 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
 329 # setups
 330
 331
 332 sub parse_attribute {
 333      my ($cgi_var) = @_;
 334
 335      my @attributes = ();
 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)};
 339           }
 340      }
 341      elsif (defined $$cgi_var{attribute_operator}) {
 342           push @attributes,{map {($_,$$cgi_var{"attribute_$_"});} qw(value field operator)};
 343      }
 344      return \@attributes;
 345 }