#!/usr/bin/perl use warnings; use strict; # Hack to work on merkel where suexec is in place BEGIN{ if ($ENV{HTTP_HOST} eq 'merkel.debian.org') { unshift @INC, qw(/home/don/perl/usr/share/perl5 /home/don/perl/usr/lib/perl5 /home/don/source); $ENV{DEBBUGS_CONFIG_FILE}="/home/don/config_internal"; } } use CGI::Simple; use CGI::Alert 'don@donarmstrong.com'; use Search::Estraier; use Debbugs::Config qw(:config); use Debbugs::Estraier; use Debbugs::CGI qw(htmlize_packagelinks html_escape); use HTML::Entities qw(encode_entities); my $q = new CGI::Simple; #my %var_defaults = (attr => 1,); my %cgi_var = cgi_parameters($q); $cgi_var{phrase} = '' if not defined $cgi_var{phrase}; $cgi_var{max_results} = 10 if not defined $cgi_var{max_results}; $cgi_var{attribute} = parse_attribute(\%cgi_var) || []; $cgi_var{skip} = 0 if not defined $cgi_var{skip}; my @results; if (defined $cgi_var{next}) { $cgi_var{search} = 1; $cgi_var{skip} += $cgi_var{max_results}; } elsif (defined $cgi_var{prev}) { $cgi_var{search} = 1; $cgi_var{skip} -= $cgi_var{max_results}; $cgi_var{skip} = 0 if $cgi_var{skip} < 0; } my $nres; if (defined $cgi_var{search} and length $cgi_var{phrase}) { # connect to a node if we need to my $node = new Search::Estraier::Node (url => $config{search_estraier}{url}, user => $config{search_estraier}{user}, passwd => $config{search_estraier}{pass}, croak_on_error => 1, ) or die "Unable to connect to the node"; my $cond = new Search::Estraier::Condition; $cond->set_phrase($cgi_var{phrase}); if (defined $cgi_var{order_field} and length $cgi_var{order_field} and defined $cgi_var{order_operator} and length $cgi_var{order_operator}) { $cond->set_order($cgi_var{order_field}.' '.$cgi_var{order_operator}); } foreach my $attribute (@{$cgi_var{attribute}}) { if (defined $$attribute{field} and defined $$attribute{value} and defined $$attribute{operator} and length $$attribute{value}) { $cond->add_attr(join(' ',map {$$attribute{$_}} qw(field operator value))); } } $cond->set_skip($cgi_var{skip}) if defined $cgi_var{skip} and $cgi_var{skip} =~ /(\d+)/; $cond->set_max($cgi_var{max_results}) if defined $cgi_var{max_results} and $cgi_var{max_results} =~ /^\d+$/; print STDERR "skip: ".$cond->skip()."\n"; print STDERR $node->cond_to_query($cond),qq(\n); $nres = $node->search($cond,0) or die "Unable to search for condition"; } elsif (defined $cgi_var{add_attribute} and length $cgi_var{add_attribute}) { push @{$cgi_var{attribute}}, {value => ''}; } elsif (grep /^delete_attribute_\d+$/, keys %cgi_var) { foreach my $delete_key (sort {$b <=> $a} map {/^delete_attribute_(\d+)$/?($1):()} keys %cgi_var) { splice @{$cgi_var{attribute}},$delete_key,1; } } my $url = 'http://bugs.debian.org/cgi-bin/bugreport.cgi?bug='; print < BTS Search

Phrase:

END # phrase # attributes # NUMEQ : is equal to the number or date # NUMNE : is not equal to the number or date # NUMGT : is greater than the number or date # NUMGE : is greater than or equal to the number or date # NUMLT : is less than the number or date # NUMLE : is less than or equal to the number or date # NUMBT : is between the two numbers or dates my @num_operators = (NUMEQ => 'equal to', NUMNE => 'not equal to', NUMGT => 'greater than', NUMGE => 'greater than or equal to', NUMLT => 'less than', NUMLE => 'less than or equal to', NUMBT => 'between', ); # STREQ : is equal to the string # STRNE : is not equal to the string # STRINC : includes the string # STRBW : begins with the string # STREW : ends with the string # STRAND : includes all tokens in the string # STROR : includes at least one token in the string # STROREQ : is equal to at least one token in the string # STRRX : matches regular expressions of the string my @str_operators = (STREQ => 'equal to', STRNE => 'not equal to', STRINC => 'includes', STRBW => 'begins with', STREW => 'ends with', STRAND => 'includes all tokens', STROR => 'includes at least one token', STROREQ => 'is equal to at least one token', STRRX => 'matches regular expression', ); my @attributes_order = ('@cdate','@title','@author', qw(status subject date submitter package tags severity), ); my %attributes = ('@cdate' => {name => 'Date', type => 'num', }, '@title' => {name => 'Message subject', type => 'str', }, '@author' => {name => 'Author', type => 'str', }, status => {name => 'Status', type => 'str', }, subject => {name => 'Bug Title', type => 'num', }, date => {name => 'Submission date', type => 'num', }, submitter => {name => 'Bug Submitter', type => 'str', }, package => {name => 'Package', type => 'str', }, tags => {name => 'Tags', type => 'str', }, severity => {name => 'Severity', type => 'str', }, ); my $attr_num = 0; print qq(

Attributes:

\n); for my $attribute (@{$cgi_var{attribute}}) { print qq(\n); print qq(\n); $$attribute{value}='' if not defined $$attribute{value}; print qq(
\n); $attr_num++; } print qq(
); # order # STRA : ascending by string # STRD : descending by string # NUMA : ascending by number or date # NUMD : descending by number or date my @order_operators = (STRA => 'ascending (string)', STRD => 'descending (string)', NUMA => 'ascending (number or date)', NUMD => 'descending (number or date)', ); print qq(

Order by: \n); print qq(

\n); # max results print qq(

Max results:

\n); print qq(
\n); if (defined $nres) { print "

Results

\n"; my $hits = $nres->hits(); print "

Hits: ".$hits; if (($cgi_var{skip} > 0)) { print q(); } if ($hits > ($cgi_var{skip}+$cgi_var{max_results})) { print q(); } print "

\n"; print qq(\n

"; if (($cgi_var{skip} > 0)) { print q(); } if ($hits > ($cgi_var{skip}+$cgi_var{max_results})) { print q(); } print "

\n"; } print "
\n"; # This CGI should make an abstract method of displaying information # about specific bugs and their messages; the information should be # fairly similar to the way that pkgreport.cgi works, with the # addition of snippit information and links to ajavapureapi/overview-summary.html specific message # within the bug. # For now we'll brute force the display, but methods to display a bug # or a particular bug message should be made common between the two # setups sub parse_attribute { my ($cgi_var) = @_; my @attributes = (); if (ref $$cgi_var{attribute_operator}) { for my $elem (0 ... $#{$$cgi_var{attribute_operator}}) { push @attributes,{map {($_,$$cgi_var{"attribute_$_"}[$elem]);} qw(value field operator)}; } } elsif (defined $$cgi_var{attribute_operator}) { push @attributes,{map {($_,$$cgi_var{"attribute_$_"});} qw(value field operator)}; } return \@attributes; } sub cgi_parameters { my ($q) = @_; my %param; foreach my $paramname ($q->param) { my @value = $q->param($paramname); $param{$paramname} = @value > 1 ? [@value] : $value[0]; } return %param; }